Fortran: check type-spec in ALLOCATE of dummy with assumed length [PR119338]

	PR fortran/119338

gcc/fortran/ChangeLog:

	* resolve.cc (resolve_allocate_expr): Check F2003:C626: Type-spec
	in ALLOCATE of an assumed-length character dummy argument shall be
	an asterisk.

gcc/testsuite/ChangeLog:

	* gfortran.dg/deferred_character_18.f90: Adjust testcase.
	* gfortran.dg/allocate_assumed_charlen_5.f90: New test.

3 files changed, 35 insertions, 1 deletions

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d64edff..ddd9827 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8987,6 +8987,22 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
       goto failure;
     }
 
+  /* F2003:C626 (R623) A type-param-value in a type-spec shall be an asterisk
+     if and only if each allocate-object is a dummy argument for which the
+     corresponding type parameter is assumed.  */
+  if (code->ext.alloc.ts.type == BT_CHARACTER
+      && code->ext.alloc.ts.u.cl->length != NULL
+      && e->ts.type == BT_CHARACTER && !e->ts.deferred
+      && e->ts.u.cl->length == NULL
+      && e->symtree->n.sym->attr.dummy)
+    {
+      gfc_error ("The type parameter in ALLOCATE statement with type-spec "
+		 "shall be an asterisk as allocate object %qs at %L is a "
+		 "dummy argument with assumed type parameter",
+		 sym->name, &e->where);
+      goto failure;
+    }
+
   /* Check F08:C632.  */
   if (code->ext.alloc.ts.type == BT_CHARACTER && !e->ts.deferred
       && !UNLIMITED_POLY (e))
diff --git a/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_5.f90 b/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_5.f90
new file mode 100644
index 0000000..bc75dbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_5.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/119338 - check F2003:C626
+
+module m
+  implicit none
+contains
+  subroutine sub (s, c)
+    character(len=*), allocatable, intent(out) :: s(:)
+    character(len=*), allocatable, intent(out) :: c
+    allocate(s(5))                      ! OK
+    allocate(c)                         ! OK
+    allocate(character(len=*)  :: s(5)) ! OK
+    allocate(character(len=*)  :: c)    ! OK
+    allocate(character(len=10) :: s(5)) ! { dg-error "shall be an asterisk" }
+    allocate(character(len=10) :: c)    ! { dg-error "shall be an asterisk" }
+  end subroutine sub
+end module m
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_18.f90 b/gcc/testsuite/gfortran.dg/deferred_character_18.f90
index 1b1457f..b1229c2 100644
--- a/gcc/testsuite/gfortran.dg/deferred_character_18.f90
+++ b/gcc/testsuite/gfortran.dg/deferred_character_18.f90
@@ -11,7 +11,8 @@ contains
     character(*), allocatable, intent(out) :: str
 !  Note: Star ^ should have been a colon (:)
 
-    allocate (character(n)::str)
+!   allocate (character(n)::str) ! original invalid version from pr82367
+    allocate (character(*)::str) ! corrected (see F2003:C626 and pr119338)
 
   end subroutine