Dear all,

the check of dummy arguments with pointer attribute and INTENT(IN)
was broken in the case the argument was passed to an intrinsic.
We therefore rejected valid code as e.g. given in the PR.

The patch relaxes the excessive check.  This requires the adjustment
of one of the tests for MOVE_ALLOC.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

As this is a rejects-valid and possibly annoying, I would like to
backport as far seems reasonable.

Thanks,
Harald

From fa07ada75a5ea25845d7e168204cd980263a7d8d Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Sun, 5 Dec 2021 22:45:32 +0100
Subject: [PATCH] Fortran: fix check for pointer dummy arguments with
 INTENT(IN)

gcc/fortran/ChangeLog:

	PR fortran/103418
	* check.c (variable_check): Correct check of procedure dummy
	arguments with INTENT(IN) and POINTER attribute to get accepted
	when passed to intrinsics.

gcc/testsuite/ChangeLog:

	PR fortran/103418
	* gfortran.dg/move_alloc_8.f90: Adjust error messages.
	* gfortran.dg/pointer_intent_9.f90: New test.

Co-authored-by: Steven G. Kargl <ka...@gcc.gnu.org>
---
 gcc/fortran/check.c                           |  2 +-
 gcc/testsuite/gfortran.dg/move_alloc_8.f90    |  4 +--
 .../gfortran.dg/pointer_intent_9.f90          | 28 +++++++++++++++++++
 3 files changed, 31 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pointer_intent_9.f90

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ee3a51ee253..879b5b1996e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1031,7 +1031,7 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
 	    break;
 	}

-      if (!ref)
+      if (!ref && !(pointer && (e->rank == 0 || e->ref)))
 	{
 	  gfc_error ("%qs argument of %qs intrinsic at %L cannot be "
 		     "INTENT(IN)", gfc_current_intrinsic_arg[n]->name,
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_8.f90 b/gcc/testsuite/gfortran.dg/move_alloc_8.f90
index f624b703cc9..d968ea0e5cd 100644
--- a/gcc/testsuite/gfortran.dg/move_alloc_8.f90
+++ b/gcc/testsuite/gfortran.dg/move_alloc_8.f90
@@ -60,7 +60,7 @@ subroutine test2 (x, px)
   integer, allocatable :: a
   type(t2), pointer :: ta

-  call move_alloc (px, ta)      ! { dg-error "cannot be INTENT.IN." }
+  call move_alloc (px, ta)      ! { dg-error "must be ALLOCATABLE" }
   call move_alloc (x%a, a)      ! { dg-error "cannot be INTENT.IN." }
   call move_alloc (x%ptr%a, a)  ! OK (3)
   call move_alloc (px%a, a)     ! OK (4)
@@ -84,7 +84,7 @@ subroutine test3 (x, px)
   integer, allocatable :: a
   class(t2), pointer :: ta

-  call move_alloc (px, ta)      ! { dg-error "cannot be INTENT.IN." }
+  call move_alloc (px, ta)      ! { dg-error "must be ALLOCATABLE" }
   call move_alloc (x%a, a)      ! { dg-error "cannot be INTENT.IN." }
   call move_alloc (x%ptr%a, a)  ! OK (6)
   call move_alloc (px%a, a)     ! OK (7)
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_9.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_9.f90
new file mode 100644
index 00000000000..000f407d393
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_9.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! PR fortran/103418
+! Validate checks for use of dummy arguments with pointer attribute
+
+module m
+  type t
+     real, pointer :: a, b(:)
+  end type t
+contains
+  subroutine s1 (a, b, c, d)
+    real, pointer, intent(in) :: a, b(:)
+    type(t),       intent(in) :: c
+    class(t),      intent(in) :: d
+    real, pointer :: pa, pb(:)
+    call random_number (a)    ! legal
+    call random_number (b)
+    call random_number (c% a)
+    call random_number (c% b)
+    call random_number (d% a)
+    call random_number (d% b)
+    call move_alloc (a, pa)   ! { dg-error "must be ALLOCATABLE" }
+    call move_alloc (b, pb)   ! { dg-error "must be ALLOCATABLE" }
+    allocate (a)              ! { dg-error "pointer association context" }
+    allocate (b(10))          ! { dg-error "pointer association context" }
+    allocate (c% a)           ! { dg-error "pointer association context" }
+    allocate (c% b(10))       ! { dg-error "pointer association context" }
+  end subroutine s1
+end module
--
2.26.2

Reply via email to