Request for comment: Character substring lengths

[Tobias Burnus]

Hello,

currently, we do -- if we have a substring -- the following (primary.c's
match_varspec):

  if (substring)
    primary->ts.cl = NULL;

Besides all the cause crashes this causes if one access ts.cl->length
without checking ts.cl, this also disables a lot of checks.

The patch at the bottom seems to somewhat work (it seems to fix both
PR31821  and PR31197), but I think it is a bit ugly.

Has anyone a better idea?

Should one add the following or is this not needed?
  if (ref->u.ss.length->length < 0)
    ref->u.ss.length->length = 0; 

POST SCRIPTUM: The patch is wrong, but it may give some ideas how to
proceed.

It is wrong because:

    character (len=4), target :: s1
    character (len=2), pointer :: p1
    s1 = 'abcd'
    p1 => s1(1:2)
    print *,s1
    print *,p1
  end

prints twice "ab" instead of once "abcd" and once "ab".

Tobias

Index: primary.c
===================================================================
--- primary.c   (revision 124441)
+++ primary.c   (working copy)
@@ -1758,7 +1758,11 @@ check_substring:
          if (primary->expr_type == EXPR_CONSTANT)
            primary->expr_type = EXPR_SUBSTRING;

-         if (substring)
+         /* If the substring has EXPR_CONSTANT size, the substring
+            length is set in resolve_substring.  */
+         if (substring
+             && !substring->u.ss.start->expr_type == EXPR_CONSTANT
+             && !substring->u.ss.end->expr_type == EXPR_CONSTANT)
            primary->ts.cl = NULL;

          break;
Index: resolve.c
===================================================================
--- resolve.c   (revision 124441)
+++ resolve.c   (working copy)
@@ -2896,6 +2896,16 @@ resolve_substring (gfc_ref *ref)
        }
     }

+    /* Set the length to the substring length, if known at compile time.  */
+    if (ref->u.ss.start->expr_type == EXPR_CONSTANT
+       && ref->u.ss.end->expr_type == EXPR_CONSTANT)
+      {
+       mpz_sub (ref->u.ss.length->length->value.integer,
+                ref->u.ss.end->value.integer,
+                ref->u.ss.start->value.integer);
+       mpz_add_ui (ref->u.ss.length->length->value.integer,
+                   ref->u.ss.length->length->value.integer, 1);
+      }
   return SUCCESS;
 }