https://gcc.gnu.org/bugzilla/show_bug.cgi?id=94788
--- Comment #2 from Jürgen Reuter <juergen.reuter at desy dot de> ---
This is our unit test, we now confirmed that this is the only problem, so the
only failing test: it really looks like that the finalizer for the subroutine
crashes, all routines inside the subroutine get executed correctly:
subroutine simulations_10 (u)
integer, intent(in) :: u
type(string_t) :: libname, procname1, expr_text
type(rt_data_t), target :: global
type(rt_data_t), dimension(1), target :: alt_env
type(ifile_t) :: ifile
type(stream_t) :: stream
type(parse_tree_t) :: pt_weight
type(simulation_t), target :: simulation
type(event_sample_data_t) :: data
write (u, "(A)") "* Test output: simulations_10"
write (u, "(A)") "* Purpose: reweight event"
write (u, "(A)")
write (u, "(A)") "* Initialize processes"
write (u, "(A)")
call syntax_model_file_init ()
call syntax_pexpr_init ()
call global%global_init ()
call global%set_log (var_str ("?omega_openmp"), &
.false., is_known = .true.)
call global%set_int (var_str ("seed"), &
0, is_known = .true.)
libname = "simulation_10a"
procname1 = "simulation_10p"
call prepare_test_library (global, libname, 1, [procname1])
call compile_library (libname, global)
call global%append_log (&
var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_grids"), .true., intrinsic = .true.)
call global%append_log (&
var_str ("?rebuild_events"), .true., intrinsic = .true.)
call global%set_string (var_str ("$method"), &
var_str ("unit_test"), is_known = .true.)
call global%set_string (var_str ("$phs_method"), &
var_str ("single"), is_known = .true.)
call global%set_string (var_str ("$integration_method"),&
var_str ("midpoint"), is_known = .true.)
call global%set_log (var_str ("?vis_history"),&
.false., is_known = .true.)
call global%set_log (var_str ("?integration_timer"),&
.false., is_known = .true.)
call global%set_log (var_str ("?recover_beams"), &
.false., is_known = .true.)
call global%set_real (var_str ("sqrts"),&
1000._default, is_known = .true.)
call global%it_list%init ([1], [1000])
call global%set_string (var_str ("$run_id"), &
var_str ("simulations1"), is_known = .true.)
call integrate_process (procname1, global, local_stack=.true.)
write (u, "(A)") "* Initialize alternative environment with custom weight"
write (u, "(A)")
call alt_env(1)%local_init (global)
call alt_env(1)%activate ()
expr_text = "2"
write (u, "(A,A)") "weight = ", char (expr_text)
write (u, *)
call ifile_clear (ifile)
call ifile_append (ifile, expr_text)
call stream_init (stream, ifile)
call parse_tree_init_expr (pt_weight, stream, .true.)
call stream_final (stream)
alt_env(1)%pn%weight_expr => pt_weight%get_root_ptr ()
call alt_env(1)%write_expr (u)
write (u, "(A)")
write (u, "(A)") "* Initialize event generation"
write (u, "(A)")
call global%set_log (var_str ("?unweighted"), &
.false., is_known = .true.)
call simulation%init ([procname1], .true., .true., global, alt_env=alt_env)
call simulation%init_process_selector ()
data = simulation%get_data ()
call data%write (u)
write (u, "(A)")
write (u, "(A)") "* Generate an event"
write (u, "(A)")
call simulation%generate (1)
call simulation%write (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the last event"
write (u, "(A)")
call simulation%write_event (u)
write (u, "(A)")
write (u, "(A)") "* Write the event record for the alternative setup"
write (u, "(A)")
call simulation%write_alt_event (u)
print *, "written alt_event, starting cleanup ..."
write (u, "(A)")
write (u, "(A)") "* Cleanup"
call simulation%final ()
print *, "simulation finalized"
call global%final ()
print *, "global finalized"
call syntax_model_file_final ()
print *, "syntax_model_file finalized"
call syntax_pexpr_final ()
print *, "syntax pexpr finalized"
write (u, "(A)")
write (u, "(A)") "* Test output end: simulations_10"
end subroutine simulations_10
