This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gfortran] Fix PR 15557: Substring references in DATA
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: GCC Fortran mailing list <fortran at gcc dot gnu dot org>,patch <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 31 May 2004 18:54:00 +0200
- Subject: [gfortran] Fix PR 15557: Substring references in DATA
Hi, below patch fixes PR 15557, which dealt with a todo-error, when we
encounter something like
CHARACTER*50 a
DATA a(5:10) /'affe'/
The fix is straightforward, but I have a style-related question: I have
opened a new scope inside the REF_SUBSTRING case. Should I split this
code out to a new function, or should I add the scope's variables to the
function, or is this ok as is?
Compiled and regtested on i686-pc-linux-gnu, I attached a testcase which
I will commit alongside the patch. Ok?
- Tobi
2004-05-31 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/15557
* data.c (gfc_assign_data_value): Handle substring reference.
Index: data.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/data.c,v
retrieving revision 1.3
diff -u -p -r1.3 data.c
--- data.c 14 May 2004 13:00:04 -0000 1.3
+++ data.c 31 May 2004 16:47:06 -0000
@@ -200,7 +200,60 @@ gfc_assign_data_value (gfc_expr * lvalue
break;
case REF_SUBSTRING:
- gfc_todo_error ("Substring reference in DATA statement");
+ {
+ int len, i;
+ int start, end;
+ char *c, *d;
+
+ assert (symbol->ts.cl->length->expr_type == EXPR_CONSTANT);
+ assert (symbol->ts.cl->length->ts.type == BT_INTEGER);
+ assert (symbol->ts.kind == 1);
+
+ gfc_extract_int (symbol->ts.cl->length, &len);
+
+ if (init == NULL)
+ {
+ expr->expr_type = EXPR_CONSTANT;
+ expr->ts.type = BT_CHARACTER;
+ expr->ts.kind = 1;
+
+ expr->value.character.length = len;
+ expr->value.character.string = gfc_getmem (len);
+ memset (expr->value.character.string, ' ', len);
+
+ symbol->value = expr;
+ }
+
+ /* Now that we have allocated the memory for the string,
+ fill in the initialized places, truncating the
+ intialization string if necessary, i.e.
+ DATA a(1:2) /'123'/
+ doesn't initialize a(3:3). */
+
+ gfc_extract_int (ref->u.ss.start, &start);
+ gfc_extract_int (ref->u.ss.end, &end);
+
+ assert (start >= 1);
+ assert (end <= len);
+
+ len = rvalue->value.character.length;
+ c = rvalue->value.character.string;
+ d = &expr->value.character.string[start - 1];
+ for (i = 0; i <= end - start && i < len; i++)
+ d[i] = c[i];
+
+ /* Pad with spaces. I.e.
+ DATA a(1:2) /'a'/
+ intializes a(1:2) to 'a ' per the rules for assignment.
+ If init == NULL we don't need to do this, as we have
+ intialized the whole string to blanks above. */
+
+ if (init != NULL)
+ for (; i < len; i++)
+ d[i] = ' ';
+
+ return;
+ }
default:
abort ();
! Check initialization of character variables via the DATA statement
CHARACTER*4 a
CHARACTER*6 b
CHARACTER*2 c
CHARACTER*4 d(2)
DATA a(1:2) /'aa'/
DATA a(3:4) /'b '/
DATA b(2:6), c /'AAA', '12345'/
!DATA d /2*'1234'/
IF (a.NE.'aab ') CALL abort()
IF (b.NE.' AAA ') CALL abort()
IF (c.NE.'12') CALL abort()
!IF (d(1).NE.d(2) .OR. d(1).NE.'1234') CALL abort()
END