procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Steven G. Kargl 2018-06-04 15:54:48 +00:00
parent 37cca345b4
commit 20ce6adefb
7 changed files with 32 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -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

9
gcc/fortran/resolve.c
View file

@ -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)

8
gcc/testsuite/ChangeLog
View file

@ -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.

2
gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
View file

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

8
gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90 Normal file
View file

@ -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

2
gcc/testsuite/gfortran.dg/allocate_stat_2.f90
View file

@ -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

2
gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
View file

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