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

re PR fortran/67939 (ICE on using data with negative substring range)

Browse Source 
2015-10-21  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67939
	* data.c (create_character_initializer): Deal with zero length string.


2015-10-21  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67939
	* gfortran.dg/pr67939.f90: New test.

From-SVN: r229153
This commit is contained in:
Steven G. Kargl 2015-10-21 21:40:05 +00:00
parent f9badf7134
commit 44f92b59c2
4 changed files with 48 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2015-10-21 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/67939
* data.c (create_character_initializer): Deal with zero length string.
2015-10-19 Steven G. Kargl <kargl@gcc.gnu.org>
* resolve.c (gfc_verify_binding_labels): Check for NULL pointer.

24
gcc/fortran/data.c
View File

@ -104,7 +104,7 @@ static gfc_expr *
create_character_initializer (gfc_expr *init, gfc_typespec *ts,
gfc_ref *ref, gfc_expr *rvalue)
{
int len, start, end;
int len, start, end, tlen;
gfc_char_t *dest;
bool alloced_init = false;
@ -162,12 +162,22 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
else
len = rvalue->value.character.length;
if (len > end - start)
tlen = end - start;
if (len > tlen)
{
gfc_warning_now (0, "Initialization string starting at %L was "
"truncated to fit the variable (%d/%d)",
&rvalue->where, end - start, len);
len = end - start;
if (tlen < 0)
{
gfc_warning_now (0, "Unused initialization string at %L because "
"variable has zero length", &rvalue->where);
len = 0;
}
else
{
gfc_warning_now (0, "Initialization string at %L was truncated to "
"fit the variable (%d/%d)", &rvalue->where,
tlen, len);
len = tlen;
}
}
if (rvalue->ts.type == BT_HOLLERITH)
@ -181,7 +191,7 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
len * sizeof (gfc_char_t));
/* Pad with spaces. Substrings will already be blanked. */
if (len < end - start && ref == NULL)
if (len < tlen && ref == NULL)
gfc_wide_memset (&dest[start + len], ' ', end - (start + len));
if (rvalue->ts.type == BT_HOLLERITH)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2015-10-21 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/67939
* gfortran.dg/pr67939.f90: New test.
2015-10-21 Aditya Kumar <aditya.k7@samsung.com>
Sebastian Pop <s.pop@samsung.com>

21
gcc/testsuite/gfortran.dg/pr67939.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do compile }
! PR fortran/67939
! Original code by Gerhard Steinmetz
! gerhard dot steinmetz dot fortran at t-online dot de
!
program p
character(100) :: x
data x(998:99) /'ab'/ ! { dg-warning "Unused initialization string" }
call a
end
subroutine a
character(2) :: x
data x(:-1) /'ab'/ ! { dg-warning "Unused initialization string" }
end subroutine a
subroutine b
character(8) :: x
data x(3:1) /'abc'/ ! { dg-warning "Unused initialization string" }
end subroutine b