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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a2be75ab4b34718a437cd26b4b85b197515fc2fd..c98c64b7059b4b2c0b3e65080b88de270250d025 100644 (file)
--- 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 c437c853f71ba58633577d9ab1e730bd7507a15e..c5bdce21184fc23e605e93cce720b4e157473d2d 100644 (file)
--- 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 1653d6b57099a5725d4facd10ea41b55c07cd3b7..3812d5f98c42855e8974606f9351a6265a9a8ff8 100644 (file)
--- 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 (file)
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