Fortran: fix parsing of type parameter inquiries of substrings [PR101735]

Handling of type parameter inquiries of substrings failed to due either
parsing issues or not following or handling reference chains properly.

	PR fortran/101735

gcc/fortran/ChangeLog:

	* expr.cc (find_inquiry_ref): If an inquiry reference applies to
	a substring, use that, and calculate substring length if needed.
	* primary.cc (extend_ref): Also handle attaching to end of
	reference chain for appending.
	(gfc_match_varspec): Discrimate between arrays of character and
	substrings of them.  If a substring is taken from a character
	component of a derived type, get the proper typespec so that
	inquiry references work correctly.
	(gfc_match_rvalue): Handle corner case where we hit a seemingly
	dangling '%' and missed an inquiry reference. Try another match.

gcc/testsuite/ChangeLog:

	* gfortran.dg/inquiry_type_ref_7.f90: New test.

3 files changed, 142 insertions, 6 deletions

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 92a9ebd..bf858ea 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1846,6 +1846,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
   gfc_ref *ref;
   gfc_ref *inquiry = NULL;
   gfc_ref *inquiry_head;
+  gfc_ref *ref_ss = NULL;
   gfc_expr *tmp;
 
   tmp = gfc_copy_expr (p);
@@ -1862,6 +1863,9 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 	  {
 	    inquiry = ref->next;
 	    ref->next = NULL;
+	    if (ref->type == REF_SUBSTRING)
+	      ref_ss = ref;
+	    break;
 	  }
     }
 
@@ -1891,6 +1895,28 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 	  if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
 	    goto cleanup;
 
+	  /* Inquire length of substring?  */
+	  if (ref_ss)
+	    {
+	      if (ref_ss->u.ss.start->expr_type == EXPR_CONSTANT
+		  && ref_ss->u.ss.end->expr_type == EXPR_CONSTANT)
+		{
+		  HOST_WIDE_INT istart, iend, length;
+		  istart = gfc_mpz_get_hwi (ref_ss->u.ss.start->value.integer);
+		  iend = gfc_mpz_get_hwi (ref_ss->u.ss.end->value.integer);
+
+		  if (istart <= iend)
+		    length = iend - istart + 1;
+		  else
+		    length = 0;
+		  *newp = gfc_get_int_expr (gfc_default_integer_kind,
+					    NULL, length);
+		  break;
+		}
+	      else
+		goto cleanup;
+	    }
+
 	  if (tmp->ts.u.cl->length
 	      && tmp->ts.u.cl->length->expr_type == EXPR_CONSTANT)
 	    *newp = gfc_copy_expr (tmp->ts.u.cl->length);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index ec4e135..426c994 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2102,10 +2102,18 @@ extend_ref (gfc_expr *primary, gfc_ref *tail)
 {
   if (primary->ref == NULL)
     primary->ref = tail = gfc_get_ref ();
+  else if (tail == NULL)
+    {
+      /* Set tail to end of reference chain.  */
+      for (gfc_ref *ref = primary->ref; ref; ref = ref->next)
+	if (ref->next == NULL)
+	  {
+	    tail = ref;
+	    break;
+	  }
+    }
   else
     {
-      if (tail == NULL)
-	gfc_internal_error ("extend_ref(): Bad tail");
       tail->next = gfc_get_ref ();
       tail = tail->next;
     }
@@ -2302,9 +2310,22 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
       gfc_array_spec *as;
       bool coarray_only = sym->attr.codimension && !sym->attr.dimension
 			  && sym->ts.type == BT_CHARACTER;
+      gfc_ref *ref, *strarr = NULL;
 
       tail = extend_ref (primary, tail);
-      tail->type = REF_ARRAY;
+      if (sym->ts.type == BT_CHARACTER && tail->type == REF_SUBSTRING)
+	{
+	  gcc_assert (sym->attr.dimension);
+	  /* Find array reference for substrings of character arrays.  */
+	  for (ref = primary->ref; ref && ref->next; ref = ref->next)
+	    if (ref->type == REF_ARRAY && ref->next->type == REF_SUBSTRING)
+	      {
+		strarr = ref;
+		break;
+	      }
+	}
+      else
+	tail->type = REF_ARRAY;
 
       /* In EQUIVALENCE, we don't know yet whether we are seeing
 	 an array, character variable or array of character
@@ -2317,7 +2338,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
       else
 	as = sym->as;
 
-      m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank : 0,
+      ref = strarr ? strarr : tail;
+      m = gfc_match_array_ref (&ref->u.ar, as, equiv_flag, as ? as->corank : 0,
 			       coarray_only);
       if (m != MATCH_YES)
 	return m;
@@ -2483,6 +2505,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
     {
       bool t;
       gfc_symtree *tbp;
+      gfc_typespec *ts = &primary->ts;
 
       m = gfc_match_name (name);
       if (m == MATCH_NO)
@@ -2490,8 +2513,18 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
       if (m != MATCH_YES)
 	return MATCH_ERROR;
 
+      /* For derived type components find typespec of ultimate component.  */
+      if (ts->type == BT_DERIVED && primary->ref)
+	{
+	  for (gfc_ref *ref = primary->ref; ref; ref = ref->next)
+	    {
+	      if (ref->type == REF_COMPONENT && ref->u.c.component)
+		ts = &ref->u.c.component->ts;
+	    }
+	}
+
       intrinsic = false;
-      if (primary->ts.type != BT_CLASS && primary->ts.type != BT_DERIVED)
+      if (ts->type != BT_CLASS && ts->type != BT_DERIVED)
 	{
 	  inquiry = is_inquiry_ref (name, &tmp);
 	  if (inquiry)
@@ -2564,7 +2597,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 			return MATCH_ERROR;
 		    }
 		  else if (tmp->u.i == INQUIRY_LEN
-			   && primary->ts.type != BT_CHARACTER)
+			   && ts->type != BT_CHARACTER)
 		    {
 			gfc_error ("The LEN part_ref at %C must be applied "
 				   "to a CHARACTER expression");
@@ -2653,6 +2686,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
       else if (component == NULL && !inquiry)
 	return MATCH_ERROR;
 
+      /* Find end of reference chain if inquiry reference and tail not set.  */
+      if (tail == NULL && inquiry && tmp)
+	tail = extend_ref (primary, tail);
+
       /* Extend the reference chain determined by gfc_find_component or
 	 is_inquiry_ref.  */
       if (primary->ref == NULL)
@@ -2828,6 +2865,7 @@ check_substring:
 	  if (substring)
 	    primary->ts.u.cl = NULL;
 
+	  gfc_gobble_whitespace ();
 	  if (gfc_peek_ascii_char () == '(')
 	    {
 	      gfc_error_now ("Unexpected array/substring ref at %C");
@@ -4271,6 +4309,16 @@ gfc_match_rvalue (gfc_expr **result)
       return MATCH_ERROR;
     }
 
+  /* Scan for possible inquiry references.  */
+  if (m == MATCH_YES
+      && e->expr_type == EXPR_VARIABLE
+      && gfc_peek_ascii_char () == '%')
+      {
+	m = gfc_match_varspec (e, 0, false, false);
+	if (m == MATCH_NO)
+	  m = MATCH_YES;
+      }
+
   if (m == MATCH_YES)
     {
       e->where = where;
diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90
new file mode 100644
index 0000000..534225a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/101735 - substrings and parsing of type parameter inquiries
+
+program p
+  implicit none
+  integer, parameter :: ck = 4
+  character(len=5)         :: str  = ""
+  character(len=5)         :: str2(4)
+  character(len=5,kind=ck) :: str4 = ck_""
+  type t
+     character(len=5) :: str(4)
+  end type t
+  type(t) :: var
+  integer :: x, y 
+
+  integer, parameter :: i1 = kind (str(1:3))
+  integer, parameter :: j1 = str (1:3) % kind
+  integer, parameter :: k1 = (str(1:3) % kind)
+  integer, parameter :: kk = str (1:3) % kind % kind
+
+  integer, parameter :: i4 = kind (str4(1:3))
+  integer, parameter :: j4 = str4 (1:3) % kind
+  integer, parameter :: ll = str4 (1:3) % len
+
+  integer, parameter :: i2 = len (str(1:3))
+  integer, parameter :: j2 = str (1:3) % len
+  integer, parameter :: k2 = (str(1:3) % len)
+  integer, parameter :: lk = str (1:3) % len  % kind
+
+  integer, parameter :: l4 = str2      (:) (2:3) % len
+  integer, parameter :: l5 = var % str (:) (2:4) % len
+  integer, parameter :: k4 = str2      (:) (2:3) % kind
+  integer, parameter :: k5 = var % str (:) (2:4) % kind
+  integer, parameter :: k6 = str2      (:) (2:3) % len % kind
+  integer, parameter :: k7 = var % str (:) (2:4) % len % kind
+
+  if (i1 /= 1) stop 1
+  if (j1 /= 1) stop 2
+  if (k1 /= 1) stop 3
+
+  if (i4 /= ck) stop 4
+  if (j4 /= ck) stop 5
+  if (ll /= 3)  stop 6
+
+  if (kk /= 4) stop 7
+  if (lk /= 4) stop 8
+
+  if (i2 /= 3) stop 9
+  if (j2 /= 3) stop 10
+  if (k2 /= 3) stop 11
+
+  if (l4 /= 2) stop 12
+  if (l5 /= 3) stop 13
+  if (k4 /= 1) stop 14
+  if (k5 /= 1) stop 15
+  if (k6 /= 4) stop 16
+  if (k7 /= 4) stop 17
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }