Hi Paul, On 16.03.21 17:42, Paul Richard Thomas via Gcc-patches wrote:
Fortran: Fix runtime errors for class actual arguments [PR99602]. * trans-array.c (gfc_conv_procedure_call): For class formal arguments, use the _data field attributes for runtime errors. * gfortran.dg/pr99602.f90: New test.
Shouldn't there be also a testcase which triggers this run-time error? I might have messed up my testcase, but I think it should trigger? (Attached is an attempt to pass the nullified pointer as actual argument to a non-pointer argument; otherwise it is the same testcase as before.) Otherwise, at a glance, it looked sensible. Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
! { dg-do compile } ! { dg-options "-fcheck=pointer -fdump-tree-original" } ! ! Test fix of PR99602, where a spurious runtime error was introduced ! by PR99112. This is the testcase in comment #6 of the PR. ! ! Contributed by Jeurgen Reuter <juergen.reu...@desy.de> ! module m implicit none private public :: m_t type :: m_t integer :: ii(100) end type m_t end module m module m2_testbed use m implicit none private public :: prepare_m2 procedure (prepare_m2_proc), pointer :: prepare_m2 => null () abstract interface subroutine prepare_m2_proc (m2) import class(m_t), intent(inout) :: m2 end subroutine prepare_m2_proc end interface end module m2_testbed module a use m use m2_testbed, only: prepare_m2 implicit none private public :: a_1 contains subroutine a_1 () class(m_t), pointer :: mm mm => null () call prepare_m2 (mm) ! Runtime error triggered here end subroutine a_1 end module a module m2 use m implicit none private public :: m2_t type, extends (m_t) :: m2_t private contains procedure :: read => m2_read end type m2_t contains subroutine m2_read (mm) class(m2_t), intent(out), target :: mm end subroutine m2_read end module m2 program main use m2_testbed use a, only: a_1 implicit none prepare_m2 => prepare_whizard_m2 call a_1 () contains subroutine prepare_whizard_m2 (mm) use m use m2 class(m_t), intent(inout) :: mm !if (.not. associated (mm)) allocate (m2_t :: mm) mm%ii = 100 select type (mm) type is (m2_t) call mm%read () end select end subroutine prepare_whizard_m2 end program main ! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 0 "original" } } ! { dg-final { scan-tree-dump-times "Pointer actual argument" 0 "original" } }