fortran/

	PR fortran/18990
	* gfortran.h (gfc_charlen): Add resolved field.
	* expr.c (gfc_specification_expr): Accept NULL argument.
	* resolve.c (gfc_resolve_charlen, gfc_resolve_derived): New.
	(gfc_resolve_symbol): Resolve derived type definitions.  Use
	resolve_charlen to resolve character lengths.
testsuite/
	PR fortran/18990
	* gfortran.dg/der_charlen_1.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108946 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 31f1f82..fa5bb4f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2005-12-22  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/18990
+       * gfortran.h (gfc_charlen): Add resolved field.
+       * expr.c (gfc_specification_expr): Accept NULL argument.
+       * resolve.c (gfc_resolve_charlen, gfc_resolve_derived): New.
+       (gfc_resolve_symbol): Resolve derived type definitions.  Use
+       resolve_charlen to resolve character lengths.
+
 2005-12-22  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/20889

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index c1451e3..c55b142 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1768,6 +1768,8 @@ check_restricted (gfc_expr * e)
 try
 gfc_specification_expr (gfc_expr * e)
 {
+  if (e == NULL)
+    return SUCCESS;
 
   if (e->ts.type != BT_INTEGER)
     {

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 475b0ca..e160e00 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -571,6 +571,8 @@ typedef struct gfc_charlen
   struct gfc_expr *length;
   struct gfc_charlen *next;
   tree backend_decl;
+
+  int resolved;
 }
 gfc_charlen;
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5ba4c8e..5f5ce56 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4328,6 +4328,60 @@ resolve_values (gfc_symbol * sym)
 }
 
 
+/* Resolve a charlen structure.  */
+
+static try
+resolve_charlen (gfc_charlen *cl)
+{
+  if (cl->resolved)
+    return SUCCESS;
+
+  cl->resolved = 1;
+
+  if (gfc_resolve_expr (cl->length) == FAILURE)
+    return FAILURE;
+
+  if (gfc_simplify_expr (cl->length, 0) == FAILURE)
+    return FAILURE;
+
+  if (gfc_specification_expr (cl->length) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Resolve the components of a derived type.  */
+
+static try
+resolve_derived (gfc_symbol *sym)
+{
+  gfc_component *c;
+
+  for (c = sym->components; c != NULL; c = c->next)
+    {
+      if (c->ts.type == BT_CHARACTER)
+       {
+         if (resolve_charlen (c->ts.cl) == FAILURE)
+          return FAILURE;
+        
+        if (c->ts.cl->length == NULL
+            || !gfc_is_constant_expr (c->ts.cl->length))
+          {
+            gfc_error ("Character length of component '%s' needs to "
+                       "be a constant specification expression at %L.",
+                       c->name,
+                       c->ts.cl->length ? &c->ts.cl->length->where : &c->loc);
+            return FAILURE;
+          }
+       }
+
+      /* TODO: Anything else that should be done here?  */
+    }
+
+  return SUCCESS;
+}
+
 /* Do anything necessary to resolve a symbol.  Right now, we just
    assume that an otherwise unknown symbol is a variable.  This sort
    of thing commonly happens for symbols in module.  */
@@ -4380,6 +4434,9 @@ resolve_symbol (gfc_symbol * sym)
        }
     }
 
+  if (sym->attr.flavor == FL_DERIVED && resolve_derived (sym) == FAILURE)
+    return;
+
   /* Symbols that are module procedures with results (functions) have
      the types and array specification copied for type checking in
      procedures that call them, as well as for saving to a module
@@ -5588,16 +5645,7 @@ gfc_resolve (gfc_namespace * ns)
   gfc_check_interfaces (ns);
 
   for (cl = ns->cl_list; cl; cl = cl->next)
-    {
-      if (cl->length == NULL || gfc_resolve_expr (cl->length) == FAILURE)
-       continue;
-
-      if (gfc_simplify_expr (cl->length, 0) == FAILURE)
-       continue;
-
-      if (gfc_specification_expr (cl->length) == FAILURE)
-       continue;
-    }
+    resolve_charlen (cl);
 
   gfc_traverse_ns (ns, resolve_values);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d7eb3eb..4734f81 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2005-12-22  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/18990
+       * gfortran.dg/der_charlen_1.f90: New.
+
 2005-12-22  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/20889

diff --git a/gcc/testsuite/gfortran.dg/der_charlen_1.f90 b/gcc/testsuite/gfortran.dg/der_charlen_1.f90
new file mode 100644 (file)
index 0000000..9f394c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_charlen_1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! PR 18990
+! we used to ICE on these examples
+module core
+  type, public  :: T
+     character(len=I)  :: str ! { dg-error "needs to be a constant specification expression" }
+  end type T
+  private
+CONTAINS
+  subroutine FOO(X)
+    type(T), intent(in)          :: X
+  end subroutine
+end module core
+
+module another_core
+  type :: T
+     character(len=*)  :: s ! { dg-error "needs to be a constant specification expr" }
+  end type T
+  private
+CONTAINS
+  subroutine FOO(X)
+    type(T), intent(in)          :: X
+  end subroutine
+end module another_core