2 ! { dg-options "-fcheck=pointer -fdump-tree-original" }
4 ! Test fix of PR99602, where a spurious runtime error was introduced
5 ! by PR99112. This is the testcase in comment #6 of the PR.
6 ! This version of PR99602.f90 turns on the runtime errors by eliminating
7 ! the pointer attribute from the formal arguments in the abstract interface
8 ! and prepare_whizard_m2.
10 ! Contributed by Jeurgen Reuter <juergen.reuter@desy.de>
26 procedure (prepare_m2_proc
), pointer :: prepare_m2
=> null ()
29 subroutine prepare_m2_proc (m2
)
31 class(m_t
), intent(inout
) :: m2
32 end subroutine prepare_m2_proc
39 use m2_testbed
, only
: prepare_m2
47 class(m_t
), pointer :: mm
49 call prepare_m2 (mm
) ! Runtime error triggered here
61 type, extends (m_t
) :: m2_t
64 procedure
:: read => m2_read
68 subroutine m2_read (mm
)
69 class(m2_t
), intent(out
), target
:: mm
70 end subroutine m2_read
77 prepare_m2
=> prepare_whizard_m2
82 subroutine prepare_whizard_m2 (mm
)
85 class(m_t
), intent(inout
) :: mm
90 end subroutine prepare_whizard_m2
92 ! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 1 "original" } }
93 ! { dg-final { scan-tree-dump-times "Pointer actual argument" 1 "original" } }