Hi Paul,

I do not understand the !UNLIMITED_POLY(fsym) part of the patch.
In particular, your patch causes foo.f90 to fail by wrongly diagnosting:

  Fortran runtime error: Pointer actual argument 'cptr' is not associated

I have only did some light tests – but it seems that just removing
'&& !UNLIMITED_POLY(fsym)' seems to be enough. (But I did not run
the testsuite.)

Hence:
- Please include the attached testcases or some variants of them.
- Check that removing !UNLIMITED_POLY does not cause any regressions

If that works: OK for mainline

Thanks for looking into this issue and working on the patches.

Tobias

On 26.03.21 07:58, Paul Richard Thomas via Fortran wrote:
This patch is straightforward but the isolation of the problem was rather
less so. Many thanks to Juergen for testcase reduction.

Regtested on FC33/x86_64 - OK for master?

Paul

Fortran: Fix problem with runtime pointer chack [PR99602].

2021-03-26  Paul Thomas  <pa...@gcc.gnu.org>

gcc/fortran/ChangeLog

PR fortran/99602
* trans-expr.c (gfc_conv_procedure_call): Use the _data attrs
for class expressions and detect proc pointer evaluations by
the non-null actual argument list.

gcc/testsuite/ChangeLog

PR fortran/99602
* gfortran.dg/pr99602.f90: New test.
* gfortran.dg/pr99602a.f90: New test.
* gfortran.dg/pr99602b.f90: New test.
-----------------
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" }
!
! PR fortran/99602
!

module m
  implicit none
contains
  subroutine wr(y)
    class(*) :: y
    stop 1
  end
end module m

use m
implicit none
integer, pointer :: iptr
class(*), pointer :: cptr

nullify (cptr, iptr)
call wr(iptr)
call wr(cptr)
end

! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" "original" 2 } }
! { dg-final { scan-tree-dump-times "Pointer actual argument 'cptr'" "original" 1 } }
! { dg-final { scan-tree-dump-times "Pointer actual argument 'iptr'" "original" 1 } }
! { dg-do compile }
! { dg-options "-fcheck=pointer -fdump-tree-original" }
!
! PR fortran/99602
!

module m
  implicit none
contains
  subroutine wr(y)
    class(*), pointer :: y
    if (associated (y)) stop 1
  end
end module m

use m
implicit none
class(*), pointer :: cptr

nullify (cptr)
call wr(cptr)
end

! { dg-final { scan-tree-dump-not "_gfortran_runtime_error_at" "original" } }
! { dg-final { scan-tree-dump-not "Pointer actual argument" "original" } }

Reply via email to