Parsing deferred type parameter

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

Here's a patch that does the parsing and some
error checking of deferred type parameter.
It is accomplished by adding a bool to gfc_typespec
to note when a deferred type parameter is encountered.
Currently, the patch does

1) Checks that a deferred type parameter does not appear
   in an array constructor, ie,
   s = [character(len=:) :: 'ab', 'cd']  ! Invalid.

2) Checks that a deferred type parameter does not appear
   in an allocate statement, ie,
   allocate(character(len=:) :: s)  ! Invalid.

3) Checks that a variable declared with a deferred type
   parameter has either the pointer or allocatable attribute.

4) Checks that a variable with a deferred type parameter
   does not appear in a specification or initialization 
   expression, ie,
   character(len=:), allocatable :: s
   integer, parameter :: n = len(s)

5) Prevents errors about assumed shaped arrays and assumed
   length characters when a deferred type parameter is 
   encountered.

For now, if a variable with a deferred type parameter is
used in a program gfortran issues an error that this 
feature is not implemented.

Two items are left:

1) Check for any restrictions with actual and dummy arguments.

2) Write the code for trans-* to actually make this feature
   work.  I suspect that I can use some help from others here;
   otherwise, it may take months (years?) to finish this up.

I have only written some limted tests, so I suspect that there
may be issues with things like components of derived types that
use deferred type parameters and function results.  

Anyway, to keep this patch from getting lost again in a dusty
corner of my hard drive, I thought I would post it here.

-- 
Steve

Attachment: deferred.log
Description: Text document

Index: gcc/testsuite/gfortran.dg/initialization_9.f90
===================================================================
--- gcc/testsuite/gfortran.dg/initialization_9.f90	(revision 163263)
+++ gcc/testsuite/gfortran.dg/initialization_9.f90	(working copy)
@@ -5,7 +5,7 @@
 
    integer function xstrcmp(s1)
      character*(*), intent(in) :: s1
-     integer :: n1 = len(s1)            ! { dg-error "Assumed character length variable" }
+     integer :: n1 = len(s1)  ! { dg-error "Assumed or deferred character length variable" }
      n1 = 1
      return
    end function xstrcmp
Index: gcc/testsuite/gfortran.dg/allocate_derived_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_derived_1.f90	(revision 163263)
+++ gcc/testsuite/gfortran.dg/allocate_derived_1.f90	(working copy)
@@ -32,7 +32,7 @@
  allocate(t1 :: x(2))
  allocate(t2 :: x(3))
  allocate(t3 :: x(4))
- allocate(tx :: x(5))  ! { dg-error "is not an accessible derived type" }
+ allocate(tx :: x(5))  ! { dg-error "not a nonprocedure pointer" }
  allocate(u0 :: x(6))  ! { dg-error "may not be ABSTRACT" }
  allocate(v1 :: x(7))  ! { dg-error "is type incompatible with typespec" }
 
Index: gcc/testsuite/gfortran.dg/initialization_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/initialization_1.f90	(revision 163263)
+++ gcc/testsuite/gfortran.dg/initialization_1.f90	(working copy)
@@ -24,7 +24,7 @@ contains
     real :: z(2, 2)
 
 ! However, this gives a warning because it is an initialization expression.
-    integer :: l1 = len (ch1)     ! { dg-warning "Assumed character length variable" }
+    integer :: l1 = len (ch1)     ! { dg-warning "Assumed or deferred character length variable" }
 
 ! These are warnings because they are gfortran extensions.
     integer :: m3 = size (x, 1)   ! { dg-error "Assumed size array" }
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 163263)
+++ gcc/fortran/decl.c	(working copy)
@@ -647,16 +647,27 @@ match_intent_spec (void)
 
 
 /* Matches a character length specification, which is either a
-   specification expression or a '*'.  */
+   specification expression, '*', or ':'.  */
 
 static match
-char_len_param_value (gfc_expr **expr)
+char_len_param_value (gfc_expr **expr, bool *deferred)
 {
   match m;
 
+  *expr = NULL;
+  *deferred = false;
+
   if (gfc_match_char ('*') == MATCH_YES)
+    return MATCH_YES;
+
+  if (gfc_match_char (':') == MATCH_YES)
     {
-      *expr = NULL;
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: deferred type "
+			  "parameter at %C") == FAILURE)
+	return MATCH_ERROR;
+
+      *deferred = true;
+
       return MATCH_YES;
     }
 
@@ -701,6 +712,7 @@ match_char_length (gfc_expr **expr)
 {
   int length;
   match m;
+  bool deferred = false;
 
   m = gfc_match_char ('*');
   if (m != MATCH_YES)
@@ -722,7 +734,7 @@ match_char_length (gfc_expr **expr)
   if (gfc_match_char ('(') == MATCH_NO)
     goto syntax;
 
-  m = char_len_param_value (expr);
+  m = char_len_param_value (expr, &deferred);
   if (m != MATCH_YES && gfc_matching_function)
     {
       gfc_undo_symbols ();
@@ -2246,11 +2258,13 @@ gfc_match_char_spec (gfc_typespec *ts)
   gfc_charlen *cl;
   gfc_expr *len;
   match m;
+  bool deferred;
 
   len = NULL;
   seen_length = 0;
   kind = 0;
   is_iso_c = 0;
+  deferred = false;
 
   /* Try the old-style specification first.  */
   old_char_selector = 0;
@@ -2284,7 +2298,7 @@ gfc_match_char_spec (gfc_typespec *ts)
       if (gfc_match (" , len =") == MATCH_NO)
 	goto rparen;
 
-      m = char_len_param_value (&len);
+      m = char_len_param_value (&len, &deferred);
       if (m == MATCH_NO)
 	goto syntax;
       if (m == MATCH_ERROR)
@@ -2297,7 +2311,7 @@ gfc_match_char_spec (gfc_typespec *ts)
   /* Try to match "LEN = <len-param>" or "LEN = <len-param>, KIND = <int>".  */
   if (gfc_match (" len =") == MATCH_YES)
     {
-      m = char_len_param_value (&len);
+      m = char_len_param_value (&len, &deferred);
       if (m == MATCH_NO)
 	goto syntax;
       if (m == MATCH_ERROR)
@@ -2317,7 +2331,7 @@ gfc_match_char_spec (gfc_typespec *ts)
     }
 
   /* Try to match ( <len-param> ) or ( <len-param> , [ KIND = ] <int> ).  */
-  m = char_len_param_value (&len);
+  m = char_len_param_value (&len, &deferred);
   if (m == MATCH_NO)
     goto syntax;
   if (m == MATCH_ERROR)
@@ -2376,6 +2390,7 @@ done:
 
   ts->u.cl = cl;
   ts->kind = kind == 0 ? gfc_default_character_kind : kind;
+  ts->deferred = deferred;
 
   /* We have to know if it was a c interoperable kind so we can
      do accurate type checking of bind(c) procs, etc.  */
@@ -2833,7 +2848,7 @@ gfc_match_implicit (void)
 
       /* Last chance -- check <TYPE> <SELECTOR> (<RANGE>).  */
       if (ts.type == BT_CHARACTER)
-	m = gfc_match_char_spec (&ts);
+	  m = gfc_match_char_spec (&ts);
       else
 	{
 	  m = gfc_match_kind_spec (&ts, false);
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c	(revision 163263)
+++ gcc/fortran/array.c	(working copy)
@@ -1043,6 +1043,13 @@ gfc_match_array_constructor (gfc_expr **
 	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
 			      "including type specification at %C") == FAILURE)
 	    goto cleanup;
+
+	  if (ts.deferred == true)
+	    {
+	      gfc_error ("Type-spec at %L cannot contain a deferred "
+			 "type parameter", &where);
+	      goto cleanup;
+	    }
 	}
     }
 
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 163263)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -860,7 +860,7 @@ typedef struct gfc_charlen
   struct gfc_charlen *next;
   bool length_from_typespec; /* Length from explicit array ctor typespec?  */
   tree backend_decl;
-  tree passed_length; /* Length argument explicitelly passed.  */
+  tree passed_length; /* Length argument explicitly passed.  */
 
   int resolved;
 }
@@ -885,6 +885,7 @@ typedef struct
   int is_c_interop;
   int is_iso_c;
   bt f90_type; 
+  bool deferred;
 }
 gfc_typespec;
 
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 163263)
+++ gcc/fortran/expr.c	(working copy)
@@ -2292,10 +2292,13 @@ check_inquiry (gfc_expr *e, int not_rest
 	   with LEN, as required by the standard.  */
 	if (i == 5 && not_restricted
 	    && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
-	    && ap->expr->symtree->n.sym->ts.u.cl->length == NULL)
+	    && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
+		|| ap->expr->symtree->n.sym->ts.deferred))
 	  {
-	    gfc_error ("Assumed character length variable '%s' in constant "
-		       "expression at %L", e->symtree->n.sym->name, &e->where);
+	    gfc_error ("Assumed or deferred character length variable '%s' "
+			" in constant expression at %L",
+			ap->expr->symtree->n.sym->name,
+			&ap->expr->where);
 	      return MATCH_ERROR;
 	  }
 	else if (not_restricted && check_init_expr (ap->expr) == FAILURE)
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 163263)
+++ gcc/fortran/resolve.c	(working copy)
@@ -9136,7 +9136,9 @@ resolve_index_expr (gfc_expr *e)
   return SUCCESS;
 }
 
-/* Resolve a charlen structure.  */
+
+/* Resolve a charlen structure.
+   FIXME: do we need to do anything here for deferred type parameters.  */
 
 static gfc_try
 resolve_charlen (gfc_charlen *cl)
@@ -9448,6 +9450,7 @@ apply_default_init_local (gfc_symbol *sy
   build_init_assign (sym, init);
 }
 
+
 /* Resolution of common features of flavors variable and procedure.  */
 
 static gfc_try
@@ -9458,7 +9461,8 @@ resolve_fl_var_and_proc (gfc_symbol *sym
     {
       if (sym->attr.allocatable)
 	{
-	  if (sym->attr.dimension)
+	  if (sym->attr.dimension
+	      && !(sym->ts.type == BT_CHARACTER && sym->ts.deferred))
 	    {
 	      gfc_error ("Allocatable array '%s' at %L must have "
 			 "a deferred shape", sym->name, &sym->declared_at);
@@ -9470,13 +9474,13 @@ resolve_fl_var_and_proc (gfc_symbol *sym
 	    return FAILURE;
 	}
 
-      if (sym->attr.pointer && sym->attr.dimension)
+      if (sym->attr.pointer && sym->attr.dimension
+	  && !(sym->ts.type == BT_CHARACTER && sym->ts.deferred))
 	{
 	  gfc_error ("Array pointer '%s' at %L must have a deferred shape",
 		     sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
-
     }
   else
     {
@@ -9610,12 +9614,23 @@ resolve_fl_variable (gfc_symbol *sym, in
       return FAILURE;
     }
 
+  /* Constraints on deferred type parameter.  */
+  if (sym->ts.type == BT_CHARACTER && sym->ts.deferred
+      && !(sym->attr.pointer || sym->attr.allocatable))
+    {
+      gfc_error ("Entity '%s' at %L has a deferred type parameter and "
+		 "requires either the pointer or allocatable attribute",
+		     sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
   if (sym->ts.type == BT_CHARACTER)
     {
       /* Make sure that character string variables with assumed length are
 	 dummy arguments.  */
       e = sym->ts.u.cl->length;
-      if (e == NULL && !sym->attr.dummy && !sym->attr.result)
+      if (e == NULL && !sym->attr.dummy && !sym->attr.result
+	  && !sym->ts.deferred)
 	{
 	  gfc_error ("Entity with assumed character length at %L must be a "
 		     "dummy argument or a PARAMETER", &sym->declared_at);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 163263)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -3267,6 +3267,10 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 	}
       else if (sym_has_alloc_comp)
 	gfc_trans_deferred_array (sym, block);
+      else if (sym->ts.type == BT_CHARACTER && sym->ts.deferred)
+	{
+	  gfc_fatal_error ("Deferred type parameter not supported");
+	}
       else if (sym->ts.type == BT_CHARACTER)
 	{
 	  gfc_get_backend_locus (&loc);
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 163263)
+++ gcc/fortran/match.c	(working copy)
@@ -2738,8 +2738,6 @@ match_type_spec (gfc_typespec *ts)
 	}
       return MATCH_YES;
     }
-  else if (m == MATCH_ERROR && gfc_match (" :: ") == MATCH_YES)
-    return MATCH_ERROR;
 
   gfc_current_locus = old_locus;
 
@@ -2774,7 +2772,10 @@ match_type_spec (gfc_typespec *ts)
   if (gfc_match ("character") == MATCH_YES)
     {
       ts->type = BT_CHARACTER;
-      goto char_selector;
+      m = gfc_match_char_spec (ts);
+      if (m == MATCH_NO)
+	m = MATCH_YES;		/* No kind specifier found.  */
+      return m;
     }
 
   if (gfc_match ("logical") == MATCH_YES)
@@ -2803,15 +2804,6 @@ kind_selector:
     m = MATCH_YES;		/* No kind specifier found.  */
 
   return m;
-
-char_selector:
-
-  m = gfc_match_char_spec (ts);
-
-  if (m == MATCH_NO)
-    m = MATCH_YES;		/* No kind specifier found.  */
-
-  return m;
 }
 
 
@@ -2825,12 +2817,12 @@ gfc_match_allocate (void)
   gfc_typespec ts;
   gfc_symbol *sym;
   match m;
-  locus old_locus;
-  bool saw_stat, saw_errmsg, saw_source, saw_mold, b1, b2, b3;
+  locus old_locus, deferred_locus;
+  bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3;
 
   head = tail = NULL;
   stat = errmsg = source = mold = tmp = NULL;
-  saw_stat = saw_errmsg = saw_source = saw_mold = false;
+  saw_stat = saw_errmsg = saw_source = saw_mold = saw_deferred = false;
 
   if (gfc_match_char ('(') != MATCH_YES)
     goto syntax;
@@ -2849,6 +2841,13 @@ gfc_match_allocate (void)
 	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: typespec in "
 			      "ALLOCATE at %L", &old_locus) == FAILURE)
 	    goto cleanup;
+
+	  if (ts.type == BT_CHARACTER && ts.deferred)
+	    {
+	      gfc_error ("Type-spec at %L cannot contain a deferred "
+			 "type parameter", &old_locus);
+	      goto cleanup;
+	    }
 	}
       else
 	{
@@ -2882,6 +2881,18 @@ gfc_match_allocate (void)
 	  goto cleanup;
 	}
 
+      /* FIXME: allocation of deferred type parameter entities is not 
+         currently implemented.  */
+      if (tail->expr->ts.deferred)
+	{
+	  saw_deferred = true;
+	  deferred_locus = tail->expr->where;
+
+	  gfc_error ("Entity with a deferred type parameter at %C currently "
+		     "not supported");
+	  goto cleanup;
+	}
+
       /* The ALLOCATE statement had an optional typespec.  Check the
 	 constraints.  */
       if (ts.type != BT_UNKNOWN)
@@ -3072,6 +3083,25 @@ alloc_opt_list:
 		  &mold->where, &source->where);
       goto cleanup;
     }
+
+  /* Check F03:C623,  */
+  if (saw_deferred)
+    {
+      if (ts.type == BT_UNKNOWN && !source)
+	{
+	  gfc_error ("Allocate-object at %L with a deferred type parameter "
+		     "requires either a type-spec or SOURCE tag",
+		     &deferred_locus);
+	  goto cleanup;
+	}
+
+      if (source && source->ts.type != BT_CHARACTER)
+	{
+	  gfc_error ("Types of SOURCE tag and allocate-object must "
+		     "be CHARACTER");
+	  goto cleanup;
+	}
+    }
   
   new_st.op = EXEC_ALLOCATE;
   new_st.expr1 = stat;
Index: gcc/fortran/misc.c
===================================================================
--- gcc/fortran/misc.c	(revision 163263)
+++ gcc/fortran/misc.c	(working copy)
@@ -77,6 +77,7 @@ gfc_clear_ts (gfc_typespec *ts)
   ts->f90_type = BT_UNKNOWN;
   /* flag that says whether it's from iso_c_binding or not */
   ts->is_iso_c = 0;
+  ts->deferred = false;
 }