From 44f92b59c2785eb9a77c04baf7b442416f2c2dce Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Wed, 21 Oct 2015 21:40:05 +0000 Subject: [PATCH] re PR fortran/67939 (ICE on using data with negative substring range) 2015-10-21 Steven G. Kargl PR fortran/67939 * data.c (create_character_initializer): Deal with zero length string. 2015-10-21 Steven G. Kargl PR fortran/67939 * gfortran.dg/pr67939.f90: New test. From-SVN: r229153 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/data.c | 24 +++++++++++++++++------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/pr67939.f90 | 21 +++++++++++++++++++++ 4 files changed, 48 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr67939.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 44c60faa2b4..399dc573ed3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2015-10-21 Steven G. Kargl + + PR fortran/67939 + * data.c (create_character_initializer): Deal with zero length string. + 2015-10-19 Steven G. Kargl * resolve.c (gfc_verify_binding_labels): Check for NULL pointer. diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index ef9101b8d55..07ca6ad8d32 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cda024d8b27..c6cc423dfef 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-10-21 Steven G. Kargl + + PR fortran/67939 + * gfortran.dg/pr67939.f90: New test. + 2015-10-21 Aditya Kumar Sebastian Pop diff --git a/gcc/testsuite/gfortran.dg/pr67939.f90 b/gcc/testsuite/gfortran.dg/pr67939.f90 new file mode 100644 index 00000000000..d1694bb0433 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr67939.f90 @@ -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 + -- 2.30.2