re PR fortran/82934 (Segfault on assumed character length in allocate)

2017-12-09  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/82934
	PR fortran/83318
	* match.c (gfc_match_allocate): Enforce F2008:C631.

2017-12-09  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/82934
	PR fortran/83318
	* gfortran.dg/allocate_assumed_charlen_2.f90: new test.

From-SVN: r255524

4 files changed, 60 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a2be75a..c98c64b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2017-12-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/82934
+	PR fortran/83318
+	* match.c (gfc_match_allocate): Enforce F2008:C631.
+
 2017-12-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/83316
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index c437c85..c5bdce2 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3960,9 +3960,9 @@ gfc_match_allocate (void)
   gfc_typespec ts;
   gfc_symbol *sym;
   match m;
-  locus old_locus, deferred_locus;
+  locus old_locus, deferred_locus, assumed_locus;
   bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3;
-  bool saw_unlimited = false;
+  bool saw_unlimited = false, saw_assumed = false;
 
   head = tail = NULL;
   stat = errmsg = source = mold = tmp = NULL;
@@ -3993,6 +3993,9 @@ gfc_match_allocate (void)
     }
   else
     {
+      /* Needed for the F2008:C631 check below. */
+      assumed_locus = gfc_current_locus;
+
       if (gfc_match (" :: ") == MATCH_YES)
 	{
 	  if (!gfc_notify_std (GFC_STD_F2003, "typespec in ALLOCATE at %L",
@@ -4007,15 +4010,19 @@ gfc_match_allocate (void)
 	    }
 
 	  if (ts.type == BT_CHARACTER)
-	    ts.u.cl->length_from_typespec = true;
+	    {
+	      if (!ts.u.cl->length)
+		saw_assumed = true;
+	      else
+		ts.u.cl->length_from_typespec = true;
+	    }
 
-	  /* TODO understand why this error does not appear but, instead,
-	     the derived type is caught as a variable in primary.c.  */
-	  if (gfc_spec_list_type (type_param_spec_list, NULL) != SPEC_EXPLICIT)
+	  if (type_param_spec_list
+	      && gfc_spec_list_type (type_param_spec_list, NULL)
+		 == SPEC_DEFERRED)
 	    {
 	      gfc_error ("The type parameter spec list in the type-spec at "
-			 "%L cannot contain ASSUMED or DEFERRED parameters",
-			 &old_locus);
+			 "%L cannot contain DEFERRED parameters", &old_locus);
 	      goto cleanup;
 	    }
 	}
@@ -4055,6 +4062,19 @@ gfc_match_allocate (void)
       if (impure)
 	gfc_unset_implicit_pure (NULL);
 
+      /* F2008:C631 (R626) 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 (saw_assumed
+	  && (tail->expr->ts.deferred
+	      || tail->expr->ts.u.cl->length
+	      || tail->expr->symtree->n.sym->attr.dummy == 0))
+	{
+	  gfc_error ("Incompatible allocate-object at %C for CHARACTER "
+		     "type-spec at %L", &assumed_locus);
+	  goto cleanup;
+	}
+
       if (tail->expr->ts.deferred)
 	{
 	  saw_deferred = true;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1653d6b..3812d5f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2017-12-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/82934
+	PR fortran/83318
+	* gfortran.dg/allocate_assumed_charlen_2.f90: new test.
+
 2017-12-09  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/83338
diff --git a/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90 b/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90
new file mode 100644
index 0000000..e54a043
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/82934
+! PR fortran/83318
+program a
+ character(len=42), allocatable :: f
+ character(len=22), allocatable :: ff
+ call alloc(f, ff)
+ if (len(f) .ne. 42) call abort
+ if (len(ff) .ne. 22) call abort
+contains
+ subroutine alloc( a, b )
+  character(len=*), allocatable  :: a
+  character(len=22), allocatable :: b
+  character(len=:), allocatable :: c
+  character, allocatable :: d
+  allocate(character(len=*)::a,b) ! { dg-error "Incompatible allocate-object" }
+  allocate(character(len=*)::c)   ! { dg-error "Incompatible allocate-object" }
+  allocate(character(len=*)::d)   ! { dg-error "Incompatible allocate-object" }
+ end subroutine
+end program a