This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]