[PATCH] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[PATCH] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 477 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fortran-fix-check-for-pointer-dummy-arguments-with-I.patch --]
[-- Type: text/x-patch, Size: 3785 bytes --]

From fa07ada75a5ea25845d7e168204cd980263a7d8d Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@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 <kargl@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

Re: [PATCH] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[Mikael Morin]

Hello,

On 05/12/2021 22:55, Harald Anlauf via Fortran wrote:
> 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.
> The existing code looks dubious to me (or at least difficult to 
understand), and your patch doesn’t make that any better.
I would rather try to remove the whole block, and fix the fallout on 
move_alloc by adding calls to gfc_check_vardef_context in 
gfc_check_move_alloc.
Can you try that instead?

Re: [PATCH] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[Harald Anlauf]

Hi Mikael,

Am 07.12.21 um 21:17 schrieb Mikael Morin:
> Hello,
>
> On 05/12/2021 22:55, Harald Anlauf via Fortran wrote:
>> 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.
> The existing code looks dubious to me (or at least difficult to
> understand), and your patch doesn’t make that any better.
> I would rather try to remove the whole block, and fix the fallout on
> move_alloc by adding calls to gfc_check_vardef_context in
> gfc_check_move_alloc.
> Can you try that instead?

I hadn't thought that far but will think about a possibly better
solution.

Thanks,
Harald

Re: [PATCH] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[Mikael Morin]

On 07/12/2021 21:46, Harald Anlauf wrote:
> Hi Mikael,
> 
> Am 07.12.21 um 21:17 schrieb Mikael Morin:
>> Hello,
>>
>> On 05/12/2021 22:55, Harald Anlauf via Fortran wrote:
>>> 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.
>> The existing code looks dubious to me (or at least difficult to
>> understand), and your patch doesn’t make that any better.
>> I would rather try to remove the whole block, and fix the fallout on
>> move_alloc by adding calls to gfc_check_vardef_context in
>> gfc_check_move_alloc.
>> Can you try that instead?
> 
> I hadn't thought that far but will think about a possibly better
> solution.
> 
Hello,

I thought about it some more over night, and it is probably a poor 
suggestion to restrict the check to move_alloc only.  The existing code 
was added for move_alloc, but it has a broader scope.  Still, 
gfc_check_vardef_context has the correct checks and is the one to be used.

[PATCH, v2] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 1207 bytes --]

Hi Mikael,

Am 08.12.21 um 10:32 schrieb Mikael Morin:
> On 07/12/2021 21:46, Harald Anlauf wrote:
>> Hi Mikael,
>>
>> Am 07.12.21 um 21:17 schrieb Mikael Morin:
>>> The existing code looks dubious to me (or at least difficult to
>>> understand), and your patch doesn’t make that any better.
>>> I would rather try to remove the whole block, and fix the fallout on
>>> move_alloc by adding calls to gfc_check_vardef_context in
>>> gfc_check_move_alloc.
>>> Can you try that instead?
>>
>> I hadn't thought that far but will think about a possibly better
>> solution.
>>
> Hello,
>
> I thought about it some more over night, and it is probably a poor
> suggestion to restrict the check to move_alloc only.  The existing code
> was added for move_alloc, but it has a broader scope.  Still,
> gfc_check_vardef_context has the correct checks and is the one to be used.

I have played a little, and it took some time to understand the fallout.
Your suggestion to rely on gfc_check_vardef_context actually helped to
uncover another bug: a bad check for CLASS pointer.

See attached for an updated patch and the extended testcase.

Regtested again.  OK now?

Thanks,
Harald


[-- Attachment #2: 0001-Fortran-fix-check-for-pointer-dummy-arguments-with-I.patch --]
[-- Type: text/x-patch, Size: 6151 bytes --]

From dec60c90d47211d55048e7034e95f3e6fb10a2d4 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 9 Dec 2021 22:57:13 +0100
Subject: [PATCH] Fortran: fix check for pointer dummy arguments with
 INTENT(IN)

gcc/fortran/ChangeLog:

	PR fortran/103418
	* check.c (variable_check): Replace previous check of procedure
	dummy arguments with INTENT(IN) attribute when passed to intrinsic
	procedures by gfc_check_vardef_context.
	* expr.c (gfc_check_vardef_context): Correct check of INTENT(IN)
	dummy arguments for the case of sub-components of a CLASS pointer.

gcc/testsuite/ChangeLog:

	PR fortran/103418
	* gfortran.dg/move_alloc_8.f90: Adjust error messages.
	* gfortran.dg/pointer_intent_9.f90: New test.
---
 gcc/fortran/check.c                           | 32 ++++--------------
 gcc/fortran/expr.c                            |  9 +++--
 gcc/testsuite/gfortran.dg/move_alloc_8.f90    |  4 +--
 .../gfortran.dg/pointer_intent_9.f90          | 33 +++++++++++++++++++
 4 files changed, 47 insertions(+), 31 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..3934336df2e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1011,33 +1011,13 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
   if (e->expr_type == EXPR_VARIABLE
       && e->symtree->n.sym->attr.intent == INTENT_IN
       && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
-	  || gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT))
+	  || gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT)
+      && !gfc_check_vardef_context (e, false, true, false, NULL))
     {
-      gfc_ref *ref;
-      bool pointer = e->symtree->n.sym->ts.type == BT_CLASS
-		     && CLASS_DATA (e->symtree->n.sym)
-		     ? CLASS_DATA (e->symtree->n.sym)->attr.class_pointer
-		     : e->symtree->n.sym->attr.pointer;
-
-      for (ref = e->ref; ref; ref = ref->next)
-	{
-	  if (pointer && ref->type == REF_COMPONENT)
-	    break;
-	  if (ref->type == REF_COMPONENT
-	      && ((ref->u.c.component->ts.type == BT_CLASS
-		   && CLASS_DATA (ref->u.c.component)->attr.class_pointer)
-		  || (ref->u.c.component->ts.type != BT_CLASS
-		      && ref->u.c.component->attr.pointer)))
-	    break;
-	}
-
-      if (!ref)
-	{
-	  gfc_error ("%qs argument of %qs intrinsic at %L cannot be "
-		     "INTENT(IN)", gfc_current_intrinsic_arg[n]->name,
-		     gfc_current_intrinsic, &e->where);
-	  return false;
-	}
+      gfc_error ("%qs argument of %qs intrinsic at %L cannot be INTENT(IN)",
+		 gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &e->where);
+      return false;
     }

   if (e->expr_type == EXPR_VARIABLE
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 87089321a3b..b874607db1d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -6254,10 +6254,13 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
     {
       if (ptr_component && ref->type == REF_COMPONENT)
 	check_intentin = false;
-      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+      if (ref->type == REF_COMPONENT)
 	{
-	  ptr_component = true;
-	  if (!pointer)
+	  gfc_component *comp = ref->u.c.component;
+	  ptr_component = (comp->ts.type == BT_CLASS && comp->attr.class_ok)
+			? CLASS_DATA (comp)->attr.class_pointer
+			: comp->attr.pointer;
+	  if (ptr_component && !pointer)
 	    check_intentin = false;
 	}
       if (ref->type == REF_INQUIRY
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..30ddd028359
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_9.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR fortran/103418
+! Validate checks for dummy arguments with INTENT(IN), pointer attribute
+
+module m
+  type t
+     real, pointer :: a, b(:)
+  end type t
+contains
+  subroutine s1 (a, b, c, d, e)
+    real,    pointer, intent(in) :: a, b(:)
+    type(t),          intent(in) :: c
+    class(t),         intent(in) :: d
+    type(t), pointer, intent(in) :: e
+    real, pointer :: pa, pb(:)
+    call random_number (a)    ! legal
+    call random_number (b)
+    call cpu_time      (a)
+    call system_clock  (count_rate=a)
+    call random_number (c% a)
+    call random_number (c% b)
+    call random_number (d% a)
+    call random_number (d% b)
+    call random_number (e% a)
+    call random_number (e% 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

[PATCH, v2] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 1176 bytes --]

Hi Mikael,

Am 08.12.21 um 10:32 schrieb Mikael Morin:
> On 07/12/2021 21:46, Harald Anlauf wrote:
>> Hi Mikael,
>>
>> Am 07.12.21 um 21:17 schrieb Mikael Morin:
>>> The existing code looks dubious to me (or at least difficult to
>>> understand), and your patch doesn’t make that any better.
>>> I would rather try to remove the whole block, and fix the fallout on
>>> move_alloc by adding calls to gfc_check_vardef_context in
>>> gfc_check_move_alloc.
>>> Can you try that instead?
>>
>> I hadn't thought that far but will think about a possibly better
>> solution.
>>
> Hello,
> 
> I thought about it some more over night, and it is probably a poor 
> suggestion to restrict the check to move_alloc only.  The existing code 
> was added for move_alloc, but it has a broader scope.  Still, 
> gfc_check_vardef_context has the correct checks and is the one to be used.

I have played a little, and it took some time to understand the fallout.
Your suggestion to rely on gfc_check_vardef_context actually helped to
uncover another bug: a bad check for CLASS pointer.

See attached for an updated patch and the extended testcase.

Regtested again.  OK now?

Thanks,
Harald


[-- Attachment #2: 0001-Fortran-fix-check-for-pointer-dummy-arguments-with-I.patch --]
[-- Type: text/x-patch, Size: 5998 bytes --]

From dec60c90d47211d55048e7034e95f3e6fb10a2d4 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 9 Dec 2021 22:57:13 +0100
Subject: [PATCH] Fortran: fix check for pointer dummy arguments with
 INTENT(IN)

gcc/fortran/ChangeLog:

	PR fortran/103418
	* check.c (variable_check): Replace previous check of procedure
	dummy arguments with INTENT(IN) attribute when passed to intrinsic
	procedures by gfc_check_vardef_context.
	* expr.c (gfc_check_vardef_context): Correct check of INTENT(IN)
	dummy arguments for the case of sub-components of a CLASS pointer.

gcc/testsuite/ChangeLog:

	PR fortran/103418
	* gfortran.dg/move_alloc_8.f90: Adjust error messages.
	* gfortran.dg/pointer_intent_9.f90: New test.
---
 gcc/fortran/check.c                           | 32 ++++--------------
 gcc/fortran/expr.c                            |  9 +++--
 gcc/testsuite/gfortran.dg/move_alloc_8.f90    |  4 +--
 .../gfortran.dg/pointer_intent_9.f90          | 33 +++++++++++++++++++
 4 files changed, 47 insertions(+), 31 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..3934336df2e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1011,33 +1011,13 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
   if (e->expr_type == EXPR_VARIABLE
       && e->symtree->n.sym->attr.intent == INTENT_IN
       && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
-	  || gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT))
+	  || gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT)
+      && !gfc_check_vardef_context (e, false, true, false, NULL))
     {
-      gfc_ref *ref;
-      bool pointer = e->symtree->n.sym->ts.type == BT_CLASS
-		     && CLASS_DATA (e->symtree->n.sym)
-		     ? CLASS_DATA (e->symtree->n.sym)->attr.class_pointer
-		     : e->symtree->n.sym->attr.pointer;
-
-      for (ref = e->ref; ref; ref = ref->next)
-	{
-	  if (pointer && ref->type == REF_COMPONENT)
-	    break;
-	  if (ref->type == REF_COMPONENT
-	      && ((ref->u.c.component->ts.type == BT_CLASS
-		   && CLASS_DATA (ref->u.c.component)->attr.class_pointer)
-		  || (ref->u.c.component->ts.type != BT_CLASS
-		      && ref->u.c.component->attr.pointer)))
-	    break;
-	}
-
-      if (!ref)
-	{
-	  gfc_error ("%qs argument of %qs intrinsic at %L cannot be "
-		     "INTENT(IN)", gfc_current_intrinsic_arg[n]->name,
-		     gfc_current_intrinsic, &e->where);
-	  return false;
-	}
+      gfc_error ("%qs argument of %qs intrinsic at %L cannot be INTENT(IN)",
+		 gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &e->where);
+      return false;
     }
 
   if (e->expr_type == EXPR_VARIABLE
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 87089321a3b..b874607db1d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -6254,10 +6254,13 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
     {
       if (ptr_component && ref->type == REF_COMPONENT)
 	check_intentin = false;
-      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+      if (ref->type == REF_COMPONENT)
 	{
-	  ptr_component = true;
-	  if (!pointer)
+	  gfc_component *comp = ref->u.c.component;
+	  ptr_component = (comp->ts.type == BT_CLASS && comp->attr.class_ok)
+			? CLASS_DATA (comp)->attr.class_pointer
+			: comp->attr.pointer;
+	  if (ptr_component && !pointer)
 	    check_intentin = false;
 	}
       if (ref->type == REF_INQUIRY
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..30ddd028359
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_9.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR fortran/103418
+! Validate checks for dummy arguments with INTENT(IN), pointer attribute
+
+module m
+  type t
+     real, pointer :: a, b(:)
+  end type t
+contains
+  subroutine s1 (a, b, c, d, e)
+    real,    pointer, intent(in) :: a, b(:)
+    type(t),          intent(in) :: c
+    class(t),         intent(in) :: d
+    type(t), pointer, intent(in) :: e
+    real, pointer :: pa, pb(:)
+    call random_number (a)    ! legal
+    call random_number (b)
+    call cpu_time      (a)
+    call system_clock  (count_rate=a)
+    call random_number (c% a)
+    call random_number (c% b)
+    call random_number (d% a)
+    call random_number (d% b)
+    call random_number (e% a)
+    call random_number (e% 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

Re: [PATCH, v2] PR fortran/103418 - random_number() does not accept pointer, intent(in) array argument

[Mikael Morin]

On 09/12/2021 23:05, Harald Anlauf wrote:
> Hi Mikael,
> 
> Am 08.12.21 um 10:32 schrieb Mikael Morin:
>> On 07/12/2021 21:46, Harald Anlauf wrote:
>>> Hi Mikael,
>>>
>>> Am 07.12.21 um 21:17 schrieb Mikael Morin:
>>>> The existing code looks dubious to me (or at least difficult to
>>>> understand), and your patch doesn’t make that any better.
>>>> I would rather try to remove the whole block, and fix the fallout on
>>>> move_alloc by adding calls to gfc_check_vardef_context in
>>>> gfc_check_move_alloc.
>>>> Can you try that instead?
>>>
>>> I hadn't thought that far but will think about a possibly better
>>> solution.
>>>
>> Hello,
>>
>> I thought about it some more over night, and it is probably a poor
>> suggestion to restrict the check to move_alloc only.  The existing code
>> was added for move_alloc, but it has a broader scope.  Still,
>> gfc_check_vardef_context has the correct checks and is the one to be 
>> used.
> 
> I have played a little, and it took some time to understand the fallout.
> Your suggestion to rely on gfc_check_vardef_context actually helped to
> uncover another bug: a bad check for CLASS pointer.
> 
Reading gfc_check_vardef_context, I have undersood what the existing 
code was doing, and why.  It was not that dubious after all.  Still, I 
prefer the v2 much.

> See attached for an updated patch and the extended testcase.
> 
> Regtested again.  OK now?
> 
Yes, thanks.