diff mbox series

PR fortran/85981 -- Check kind of errmsg variable.

Message ID 20180529232428.GA70267@troutmask.apl.washington.edu
State New
Headers show
Series PR fortran/85981 -- Check kind of errmsg variable. | expand

Commit Message

Steve Kargl May 29, 2018, 11:24 p.m. UTC 
The new comment in the patch explains the patch.  This was
developed and tested on 8-branch, but will be applied to
trunk prior to committing to branches.  Built and regression
tested on x86_64-*-freebsd.  OK to commit?

2018-05-29  Steven G. Kargl  <kargl@gcc.gnu.org>

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

2018-05-29  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.

Comments

Janne Blomqvist June 1, 2018, 6:51 a.m. UTC | #1 
On Wed, May 30, 2018 at 2:24 AM, Steve Kargl <
sgk@troutmask.apl.washington.edu> wrote:

> The new comment in the patch explains the patch.  This was
> developed and tested on 8-branch, but will be applied to
> trunk prior to committing to branches.  Built and regression
> tested on x86_64-*-freebsd.  OK to commit?
>
> 2018-05-29  Steven G. Kargl  <kargl@gcc.gnu.org>
>
>         PR fortran/85981
>         * resolve.c (resolve_allocate_deallocate): Check errmsg is default
>         character kind.
>
> 2018-05-29  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.
>
> --
> Steve
>

Ok, thanks!
diff mbox series

Patch

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 260769)
+++ gcc/fortran/resolve.c	(working copy)
@@ -7763,12 +7763,17 @@  resolve_allocate_deallocate (gfc_code *code, const cha
       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)
Index: gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90	(revision 260767)
+++ gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90	(working copy)
@@ -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" }
 
Index: gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90	(working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/allocate_stat_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_stat_2.f90	(revision 260767)
+++ gcc/testsuite/gfortran.dg/allocate_stat_2.f90	(working copy)
@@ -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
 
Index: gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90	(revision 260767)
+++ gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90	(working copy)
@@ -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" }