re PR fortran/85981 (ICE in gfc_trans_string_copy, at fortran/trans-expr.c:6539)

2018-06-04  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/85981
	* resolve.c (resolve_allocate_deallocate): Check errmsg is default
	character kind.

2018-06-04  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/85981
	* gfortran.dg/allocate_alloc_opt_14.f90: New test.
	* gfortran.dg/allocate_alloc_opt_1.f90: Update error string.
	* gfortran.dg/allocate_stat_2.f90: Ditto.
	* gfortran.dg/deallocate_alloc_opt_1.f90: Ditto.

From-SVN: r261154

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ef7e941..079a306 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2018-06-04  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/85981
+       * resolve.c (resolve_allocate_deallocate): Check errmsg is default
+       character kind.
+
 2018-06-03  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/36497

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3a0ff80..3d53ce5 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7767,12 +7767,17 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
       gfc_check_vardef_context (errmsg, false, false, false,
                                _("ERRMSG variable"));
 
+      /* F18:R928  alloc-opt             is ERRMSG = errmsg-variable
+        F18:R930  errmsg-variable       is scalar-default-char-variable
+        F18:R906  default-char-variable is variable
+        F18:C906  default-char-variable shall be default character.  */
       if ((errmsg->ts.type != BT_CHARACTER
           && !(errmsg->ref
                && (errmsg->ref->type == REF_ARRAY
                    || errmsg->ref->type == REF_COMPONENT)))
-         || errmsg->rank > 0 )
-       gfc_error ("Errmsg-variable at %L must be a scalar CHARACTER "
+         || errmsg->rank > 0
+         || errmsg->ts.kind != gfc_default_character_kind)
+       gfc_error ("ERRMSG variable at %L shall be a scalar default CHARACTER "
                   "variable", &errmsg->where);
 
       for (p = code->ext.alloc.list; p; p = p->next)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 459958e..e27cf41 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2018-06-04  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/85981
+       * gfortran.dg/allocate_alloc_opt_14.f90: New test.
+       * gfortran.dg/allocate_alloc_opt_1.f90: Update error string.
+       * gfortran.dg/allocate_stat_2.f90: Ditto.
+       * gfortran.dg/deallocate_alloc_opt_1.f90: Ditto.
+
 2018-06-04  Richard Sandiford  <richard.sandiford@linaro.org>
 
        * gcc.target/aarch64/sve/extract_5.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
index 95571fd..12005a6 100644 (file)
--- a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
@@ -22,7 +22,7 @@ program a
   allocate(i(2))) ! { dg-error "Syntax error in ALLOCATE" }
   allocate(i(2), errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" }
   allocate(i(2), errmsg=err) ! { dg-warning "useless without a STAT" }
-  allocate(i(2), stat=j, errmsg=x) ! { dg-error "must be a scalar CHARACTER" }
+  allocate(i(2), stat=j, errmsg=x) ! { dg-error "shall be a scalar default CHARACTER" }
 
   allocate(err) ! { dg-error "neither a data pointer nor an allocatable" }
 

diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90
new file mode 100644 (file)
index 0000000..6de43a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+program p
+   integer, allocatable :: arr(:)
+   integer :: stat
+   character(len=128, kind=4) :: errmsg = ' '
+   allocate (arr(3), stat=stat, errmsg=errmsg)  ! { dg-error "shall be a scalar default CHARACTER" }
+   print *, allocated(arr), stat, trim(errmsg)
+end

diff --git a/gcc/testsuite/gfortran.dg/allocate_stat_2.f90 b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90
index 7cf6d65..a28a253 100644 (file)
--- a/gcc/testsuite/gfortran.dg/allocate_stat_2.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90
@@ -5,6 +5,6 @@ program main
   character(len=30), dimension(2) :: er
   integer, dimension (:), allocatable :: a
   allocate (a (16), stat = ier) ! { dg-error "must be a scalar INTEGER" }
-  allocate (a (14), stat=ier(1),errmsg=er) ! { dg-error "must be a scalar CHARACTER" }
+  allocate (a (14), stat=ier(1),errmsg=er) ! { dg-error "shall be a scalar default CHARACTER" }
 end
 

diff --git a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
index 969ce25..58790eb 100644 (file)
--- a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
+++ b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
@@ -22,7 +22,7 @@ program a
   deallocate(i)) ! { dg-error "Syntax error in DEALLOCATE" }
   deallocate(i, errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" }
   deallocate(i, errmsg=err) ! { dg-warning "useless without a STAT" }
-  deallocate(i, stat=j, errmsg=x) ! { dg-error "must be a scalar CHARACTER" }
+  deallocate(i, stat=j, errmsg=x) ! { dg-error "shall be a scalar default CHARACTER" }
 
   deallocate(err) ! { dg-error "nonprocedure pointer nor an allocatable" }