Commit b35c5f01 by Tobias Schlüter

dump-parse-tree.c (show_char_const): New function.

fortran/
* dump-parse-tree.c (show_char_const): New function.
(gfc_show_expr): Use it.
* expr.c (find_substring_ref): Rework to not keep characters
dangling beyond end of string.
testsuite/
* gfortran.dg/substr_6.f90: New test.

From-SVN: r128027
parent 3c83544d
2007-09-02 Tobias Schluter <tobi@gcc.gnu.org>
* dump-parse-tree.c (show_char_const): New function.
(gfc_show_expr): Use it.
* expr.c (find_substring_ref): Rework to not keep characters
dangling beyond end of string.
2007-09-02 H.J. Lu <hongjiu.lu@intel.com> 2007-09-02 H.J. Lu <hongjiu.lu@intel.com>
PR fortran/33276 PR fortran/33276
......
...@@ -290,6 +290,28 @@ gfc_show_constructor (gfc_constructor *c) ...@@ -290,6 +290,28 @@ gfc_show_constructor (gfc_constructor *c)
} }
static void
show_char_const (const char *c, int length)
{
int i;
gfc_status_char ('\'');
for (i = 0; i < length; i++)
{
if (c[i] == '\'')
gfc_status ("''");
else if (ISPRINT (c[i]))
gfc_status_char (c[i]);
else
{
gfc_status ("' // ACHAR(");
printf ("%d", c[i]);
gfc_status (") // '");
}
}
gfc_status_char ('\'');
}
/* Show an expression. */ /* Show an expression. */
void void
...@@ -307,16 +329,7 @@ gfc_show_expr (gfc_expr *p) ...@@ -307,16 +329,7 @@ gfc_show_expr (gfc_expr *p)
switch (p->expr_type) switch (p->expr_type)
{ {
case EXPR_SUBSTRING: case EXPR_SUBSTRING:
c = p->value.character.string; show_char_const (p->value.character.string, p->value.character.length);
for (i = 0; i < p->value.character.length; i++, c++)
{
if (*c == '\'')
gfc_status ("''");
else
gfc_status ("%c", *c);
}
gfc_show_ref (p->ref); gfc_show_ref (p->ref);
break; break;
...@@ -362,20 +375,8 @@ gfc_show_expr (gfc_expr *p) ...@@ -362,20 +375,8 @@ gfc_show_expr (gfc_expr *p)
break; break;
case BT_CHARACTER: case BT_CHARACTER:
c = p->value.character.string; show_char_const (p->value.character.string,
p->value.character.length);
gfc_status_char ('\'');
for (i = 0; i < p->value.character.length; i++, c++)
{
if (*c == '\'')
gfc_status ("''");
else
gfc_status_char (*c);
}
gfc_status_char ('\'');
break; break;
case BT_COMPLEX: case BT_COMPLEX:
......
...@@ -1329,6 +1329,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) ...@@ -1329,6 +1329,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
{ {
int end; int end;
int start; int start;
int length;
char *chr; char *chr;
if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT
...@@ -1336,13 +1337,16 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) ...@@ -1336,13 +1337,16 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
return FAILURE; return FAILURE;
*newp = gfc_copy_expr (p); *newp = gfc_copy_expr (p);
chr = p->value.character.string; gfc_free ((*newp)->value.character.string);
end = (int) mpz_get_ui (p->ref->u.ss.end->value.integer); end = (int) mpz_get_ui (p->ref->u.ss.end->value.integer);
start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer); start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer);
length = end - start + 1;
(*newp)->value.character.length = end - start + 1; chr = (*newp)->value.character.string = gfc_getmem (length + 1);
strncpy ((*newp)->value.character.string, &chr[start - 1], (*newp)->value.character.length = length;
(*newp)->value.character.length); memcpy (chr, &p->value.character.string[start - 1], length);
chr[length] = '\0';
return SUCCESS; return SUCCESS;
} }
......
2007-09-02 Tobias Schluter <tobi@gcc.gnu.org>
* gfortran.dg/substr_6.f90: New test.
2007-09-02 Paolo Carlini <pcarlini@suse.de> 2007-09-02 Paolo Carlini <pcarlini@suse.de>
PR c++/33208 PR c++/33208
! { dg-do run }
! Check that NULs don't mess up constant substring simplification
CHARACTER(5), parameter :: c0(1) = (/ "123" // ACHAR(0) // "5" /)
CHARACTER*5 c(1)
CHARACTER(1), parameter :: c1(5) = (/ "1", "2", "3", ACHAR(0), "5" /)
c = c0(1)(-5:-8)
if (c(1) /= " ") call abort()
c = (/ c0(1)(1:5) /)
do i=1,5
if (c(1)(i:i) /= c1(i)) call abort()
end do
print *, c(1)
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment