[prev in list] [next in list] [prev in thread] [next in thread] 

List:       gcc-fortran
Subject:    [PATCH] PR fortran/85981 -- Check kind of errmsg variable.
From:       Steve Kargl <sgk () troutmask ! apl ! washington ! edu>
Date:       2018-05-29 23:24:28
Message-ID: 20180529232428.GA70267 () troutmask ! apl ! washington ! edu
[Download RAW message or body]

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

["pr85981.diff" (text/x-diff)]

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" }
 


[prev in list] [next in list] [prev in thread] [next in thread]