From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 15 Jan 2025 18:42:52 +0000 (+0100)
Subject: Fortran: reject NULL as source-expr in ALLOCATE with SOURCE= or MOLD= [PR71884]
X-Git-Tag: basepoints/gcc-16~2628
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=8923099994f1fe3e808b9f498353c144f1ae0591;p=thirdparty%2Fgcc.git

Fortran: reject NULL as source-expr in ALLOCATE with SOURCE= or MOLD= [PR71884]

	PR fortran/71884

gcc/fortran/ChangeLog:

	* resolve.cc (resolve_allocate_expr): Reject intrinsic NULL as
	source-expr.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr71884.f90: New test.
---

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 3e74a2e5088..124f4ac4edc 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9433,6 +9433,18 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
   /* Some checks for the SOURCE tag.  */
   if (code->expr3)
     {
+      /* Check F03:C632: "The source-expr shall be a scalar or have the same
+	 rank as allocate-object".  This would require the MOLD argument to
+	 NULL() as source-expr for subsequent checking.  However, even the
+	 resulting disassociated pointer or unallocated array has no shape that
+	 could be used for SOURCE= or MOLD=.  */
+      if (code->expr3->expr_type == EXPR_NULL)
+	{
+	  gfc_error ("The intrinsic NULL cannot be used as source-expr at %L",
+		     &code->expr3->where);
+	  goto failure;
+	}
+
       /* Check F03:C631.  */
       if (!gfc_type_compatible (&e->ts, &code->expr3->ts))
 	{
diff --git a/gcc/testsuite/gfortran.dg/pr71884.f90 b/gcc/testsuite/gfortran.dg/pr71884.f90
new file mode 100644
index 00000000000..015a10290a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr71884.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR fortran/71884 - reject NULL as source-expr in ALLOCATE with SOURCE= or MOLD=
+!
+! Contributed by G.Steinmetz
+
+program p
+  real,     allocatable :: a
+  real,     pointer     :: b
+  class(*), allocatable :: x
+  class(*), pointer     :: y
+
+  allocate (x, source=null())  ! { dg-error "NULL cannot be used as source-expr" }
+  allocate (y, source=null(b)) ! { dg-error "NULL cannot be used as source-expr" }
+  allocate (x, mold=null(b))   ! { dg-error "NULL cannot be used as source-expr" }
+  allocate (y, mold=null())    ! { dg-error "NULL cannot be used as source-expr" }
+end