OSDN Git Service

fortran/
authortobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 2 Sep 2007 15:04:11 +0000 (15:04 +0000)
committertobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 2 Sep 2007 15:04:11 +0000 (15:04 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128027 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/dump-parse-tree.c
gcc/fortran/expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/substr_6.f90 [new file with mode: 0644]

index 00f798a..d6c5e09 100644 (file)
@@ -1,3 +1,10 @@
+2007-09-02  Tobias Schlüuter  <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>
 
        PR fortran/33276
index d9fbbfa..ce46e35 100644 (file)
@@ -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.  */
 
 void
@@ -307,16 +329,7 @@ gfc_show_expr (gfc_expr *p)
   switch (p->expr_type)
     {
     case EXPR_SUBSTRING:
-      c = p->value.character.string;
-
-      for (i = 0; i < p->value.character.length; i++, c++)
-       {
-         if (*c == '\'')
-           gfc_status ("''");
-         else
-           gfc_status ("%c", *c);
-       }
-
+      show_char_const (p->value.character.string, p->value.character.length);
       gfc_show_ref (p->ref);
       break;
 
@@ -362,20 +375,8 @@ gfc_show_expr (gfc_expr *p)
          break;
 
        case BT_CHARACTER:
-         c = p->value.character.string;
-
-         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 ('\'');
-
+         show_char_const (p->value.character.string, 
+                          p->value.character.length);
          break;
 
        case BT_COMPLEX:
index 8c44028..ebed1f2 100644 (file)
@@ -1329,6 +1329,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
 {
   int end;
   int start;
+  int length;
   char *chr;
 
   if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT
@@ -1336,13 +1337,16 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
     return FAILURE;
 
   *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);
   start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer);
+  length = end - start + 1;
 
-  (*newp)->value.character.length = end - start + 1;
-  strncpy ((*newp)->value.character.string, &chr[start - 1],
-          (*newp)->value.character.length);
+  chr = (*newp)->value.character.string = gfc_getmem (length + 1);
+  (*newp)->value.character.length = length;
+  memcpy (chr, &p->value.character.string[start - 1], length);
+  chr[length] = '\0';
   return SUCCESS;
 }
 
index 9508d1a..63b0967 100644 (file)
@@ -1,3 +1,7 @@
+2007-09-02  Tobias Schlüuter  <tobi@gcc.gnu.org>
+
+       * gfortran.dg/substr_6.f90: New test.
+
 2007-09-02  Paolo Carlini  <pcarlini@suse.de>
 
        PR c++/33208
diff --git a/gcc/testsuite/gfortran.dg/substr_6.f90 b/gcc/testsuite/gfortran.dg/substr_6.f90
new file mode 100644 (file)
index 0000000..ee0eae4
--- /dev/null
@@ -0,0 +1,14 @@
+! { 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