OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/89516 (ICE in gfc_calculate_transfer_sizes at gcc/fortran/check.c:5506) 

2019-03-02  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/89516
	* check.c (gfc_calculate_transfer_sizes): Correct checks for cases
	where storage size of elements of MOLD is 0.

	PR fortran/89516
	* gfortran.dg/pr89492.f90: Adjust testcase.
	* gfortran.dg/transfer_check_5.f90: New test.

From-SVN: r269341
This commit is contained in:
Harald Anlauf 2019-03-02 15:29:27 +00:00 committed by Harald Anlauf
parent 574eaf0fda
commit 4716603bf8
5 changed files with 43 additions and 11 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 @@
2019-03-02 Harald Anlauf <anlauf@gmx.de>
PR fortran/89516
* check.c (gfc_calculate_transfer_sizes): Correct checks for cases
where storage size of elements of MOLD is 0.
2019-02-28 Thomas Schwinge <thomas@codesourcery.com>
Cesar Philippidis <cesar@codesourcery.com>

24
gcc/fortran/check.c
View File

@ -5487,23 +5487,29 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
if (!gfc_element_size (mold, &result_elt_size))
return false;
if (result_elt_size == 0 && *source_size > 0)
/* If the storage size of SOURCE is greater than zero and MOLD is an array,
* a scalar with the type and type parameters of MOLD shall not have a
* storage size equal to zero.
* If MOLD is a scalar and SIZE is absent, the result is a scalar.
* If MOLD is an array and SIZE is absent, the result is an array and of
* rank one. Its size is as small as possible such that its physical
* representation is not shorter than that of SOURCE.
* If SIZE is present, the result is an array of rank one and size SIZE.
*/
if (result_elt_size == 0 && *source_size > 0 && !size
&& mold->expr_type == EXPR_ARRAY)
{
gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L "
"shall not have storage size 0 when %<SOURCE%> "
gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L is an "
"array and shall not have storage size 0 when %<SOURCE%> "
"argument has size greater than 0", &mold->where);
return false;
}
/* If MOLD is a scalar and SIZE is absent, the result is a scalar.
* If MOLD is an array and SIZE is absent, the result is an array and of
* rank one. Its size is as small as possible such that its physical
* representation is not shorter than that of SOURCE.
*/
if (result_elt_size == 0 && *source_size == 0 && !size)
{
*result_size = 0;
*result_length_p = 0;
if (result_length_p)
*result_length_p = 0;
return true;
}

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2019-03-02 Harald Anlauf <anlauf@gmx.de>
PR fortran/89516
* gfortran.dg/pr89492.f90: Adjust testcase.
* gfortran.dg/transfer_check_5.f90: New test.
2019-03-02 Jakub Jelinek <jakub@redhat.com>
PR c++/71446

4
gcc/testsuite/gfortran.dg/pr89492.f90
View File

@ -19,9 +19,9 @@ program bug4a
integer, parameter :: n(l) = l
print *, k,i,l,m,j,n
print *, transfer(1,['']) ! { dg-error "shall not have storage size 0" }
print *, transfer(1, '' ) ! { dg-error "shall not have storage size 0" }
print *, transfer(1, '' ) ! No error
print *, size(transfer(1,[''])) ! { dg-error "shall not have storage size 0" }
print *, len (transfer(1, '' )) ! { dg-error "shall not have storage size 0" }
print *, len (transfer(1, '' )) ! No error
print *, size(transfer([1],[bug4()])) ! { dg-error "shall not have storage size 0" }
print *, transfer(transfer([1],[bug4()]),[1]) ! { dg-error "shall not have storage size 0" }
end program bug4a

14
gcc/testsuite/gfortran.dg/transfer_check_5.f90 Normal file
View File

@ -0,0 +1,14 @@
! { dg-do compile }
! { dg-options "-Wsurprising" }
!
! PR fortran/89516 - ICE in gfc_calculate_transfer_sizes at gcc/fortran/check.c:5506
! Found by Martin Liška
program test
character(*), parameter :: n = ''
character(*), parameter :: o = transfer ([''], n)
print *, transfer(1,'',size=0) ! No warning
print *, transfer(1,'',size=1) ! No warning
print *, transfer('',1,size=0) ! No warning
print *, transfer('',1,size=1) ! { dg-warning "has partly undefined result" }
end program test