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 ef7e941fd660686437205e25e51c3ace78c38a58..079a306c451a3b90df07859199e54b96bf4b4d87 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 3a0ff80ab89b7819ea6c0f9b3ce86b26047fde5a..3d53ce56699e38956cf7a525f087bf1abcbef780 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 459958eb5eaa88a9f7b74259752842c200e9581f..e27cf415b704965017522f3be9264cbe997dad9d 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 95571fdfe124092ee0abe19db4aedfa6f69bb313..12005a6cc16cd5a3e0804772896a6e45206a10a3 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 7cf6d659ea29bd83e3dcfe6eff18fbe186365566..a28a253604642650c19ed6a77e1fd49a4b1ebb99 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 969ce257efe96e15d27203bb1dbe240750a6520a..58790ebfb589f74b4005c1e3c8e567f37d9833ba 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" }