This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC 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 PR13930


The patch below fixes PR13930 (derived type with intent(in) attribute not 
accepted).

It also corrects and extends the previous patch for for PR15393/15370.

The following code compile again:

 real, dimension(:), pointer :: bar=>NULL()

Tested on i686-linux, and applied.

Paul

2004-05-18  Paul Brook  <paul@codesourcery.com>

	PR fortran/13930
	* decl.c (add_init_expr_to_sym): Remove incorrect check.
	(default_initializer): Move to expr.c.
	(variable_decl): Don't assign default initializer to variables.
	* expr.c (gfc_default_initializer): Move to here.
	* gfortran.h (gfc_default_initializer): Add prototype.
	* resolve.c (resolve_symbol): Check for illegal initializers.
	Assign default initializer.
libgfortran/
	* gfortran.fortran-torture/execute/der_init_4.f90: New test.

Index: decl.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/decl.c,v
retrieving revision 1.6
diff -u -p -r1.6 decl.c
--- a/decl.c	15 May 2004 20:29:06 -0000	1.6
+++ b/decl.c	18 May 2004 00:02:48 -0000
@@ -254,7 +254,6 @@ static try
 add_init_expr_to_sym (const char *name, gfc_expr ** initp,
 		      locus * var_locus)
 {
-  int i;
   symbol_attribute attr;
   gfc_symbol *sym;
   gfc_expr *init;
@@ -311,19 +310,6 @@ add_init_expr_to_sym (const char *name, 
 	  && gfc_check_assign_symbol (sym, init) == FAILURE)
 	return FAILURE;
 
-      for (i = 0; i < sym->attr.dimension; i++)
-	{
-	  if (sym->as->lower[i] == NULL
-	      || sym->as->lower[i]->expr_type != EXPR_CONSTANT
-	      || sym->as->upper[i] == NULL
-	      || sym->as->upper[i]->expr_type != EXPR_CONSTANT)
-	    {
-	      gfc_error ("Array '%s' at %C cannot have initializer",
-			 sym->name);
-	      return FAILURE;
-	    }
-	}
-
       /* Add initializer.  Make sure we keep the ranks sane.  */
       if (sym->attr.dimension && init->rank == 0)
 	init->rank = sym->as->rank;
@@ -447,47 +433,6 @@ gfc_match_null (gfc_expr ** result)
 }
 
 
-/* Get an expression for a default initializer.  */
-static gfc_expr *
-default_initializer (void)
-{
-  gfc_constructor *tail;
-  gfc_expr *init;
-  gfc_component *c;
-
-  init = NULL;
-
-  /* First see if we have a default initializer.  */
-  for (c = current_ts.derived->components; c; c = c->next)
-    {
-      if (c->initializer && init == NULL)
-        init = gfc_get_expr ();
-    }
-
-  if (init == NULL)
-    return NULL;
-
-  init->expr_type = EXPR_STRUCTURE;
-  init->ts = current_ts;
-  init->where = current_ts.derived->declared_at;
-  tail = NULL;
-  for (c = current_ts.derived->components; c; c = c->next)
-    {
-      if (tail == NULL)
-        init->value.constructor = tail = gfc_get_constructor ();
-      else
-        {
-          tail->next = gfc_get_constructor ();
-          tail = tail->next;
-        }
-
-      if (c->initializer)
-        tail->expr = gfc_copy_expr (c->initializer);
-    }
-  return init;
-}
-
-
 /* Match a variable name with an optional initializer.  When this
    subroutine is called, a variable is expected to be parsed next.
    Depending on what is happening at the moment, updates either the
@@ -644,18 +589,17 @@ variable_decl (void)
 	}
     }
 
-  if (current_ts.type == BT_DERIVED && !initializer)
-    {
-      initializer = default_initializer ();
-    }
-
-  /* Add the initializer.  Note that it is fine if &initializer is
+  /* Add the initializer.  Note that it is fine if initializer is
      NULL here, because we sometimes also need to check if a
      declaration *must* have an initialization expression.  */
   if (gfc_current_state () != COMP_DERIVED)
     t = add_init_expr_to_sym (name, &initializer, &var_locus);
   else
-    t = build_struct (name, cl, &initializer, &as);
+    {
+      if (current_ts.type == BT_DERIVED && !initializer)
+	initializer = gfc_default_initializer (&current_ts);
+      t = build_struct (name, cl, &initializer, &as);
+    }
 
   m = (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
 
Index: expr.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/expr.c,v
retrieving revision 1.3
diff -u -p -r1.3 expr.c
--- a/expr.c	14 May 2004 13:00:04 -0000	1.3
+++ b/expr.c	18 May 2004 00:05:15 -0000
@@ -1953,3 +1953,46 @@ gfc_check_assign_symbol (gfc_symbol * sy
 
   return r;
 }
+
+
+/* Get an expression for a default initializer.  */
+
+gfc_expr *
+gfc_default_initializer (gfc_typespec *ts)
+{
+  gfc_constructor *tail;
+  gfc_expr *init;
+  gfc_component *c;
+
+  init = NULL;
+
+  /* See if we have a default initializer.  */
+  for (c = ts->derived->components; c; c = c->next)
+    {
+      if (c->initializer && init == NULL)
+        init = gfc_get_expr ();
+    }
+
+  if (init == NULL)
+    return NULL;
+
+  /* Build the constructor.  */
+  init->expr_type = EXPR_STRUCTURE;
+  init->ts = *ts;
+  init->where = ts->derived->declared_at;
+  tail = NULL;
+  for (c = ts->derived->components; c; c = c->next)
+    {
+      if (tail == NULL)
+        init->value.constructor = tail = gfc_get_constructor ();
+      else
+        {
+          tail->next = gfc_get_constructor ();
+          tail = tail->next;
+        }
+
+      if (c->initializer)
+        tail->expr = gfc_copy_expr (c->initializer);
+    }
+  return init;
+}
Index: gfortran.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.4
diff -u -p -r1.4 gfortran.h
--- a/gfortran.h	15 May 2004 17:31:32 -0000	1.4
+++ b/gfortran.h	18 May 2004 00:04:10 -0000
@@ -1545,6 +1545,8 @@ try gfc_check_assign (gfc_expr *, gfc_ex
 try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
 try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
 
+gfc_expr *gfc_default_initializer (gfc_typespec *);
+
 /* st.c */
 extern gfc_code new_st;
 
Index: resolve.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.3
diff -u -p -r1.3 resolve.c
--- a/resolve.c	14 May 2004 13:00:04 -0000	1.3
+++ b/resolve.c	18 May 2004 00:06:43 -0000
@@ -3687,6 +3687,9 @@ resolve_symbol (gfc_symbol * sym)
   /* Zero if we are checking a formal namespace.  */
   static int formal_ns_flag = 1;
   int formal_ns_save, check_constant, mp_flag;
+  int i;
+  const char *whynot;
+
 
   if (sym->attr.flavor == FL_UNKNOWN)
     {
@@ -3835,6 +3838,50 @@ resolve_symbol (gfc_symbol * sym)
 	}
     }
 
+  if (sym->attr.flavor == FL_VARIABLE)
+    {
+      /* Can the sybol have an initializer?  */
+      whynot = NULL;
+      if (sym->attr.allocatable)
+	whynot = "Allocatable";
+      else if (sym->attr.external)
+	whynot = "External";
+      else if (sym->attr.dummy)
+	whynot = "Dummy";
+      else if (sym->attr.intrinsic)
+	whynot = "Intrinsic";
+      else if (sym->attr.result)
+	whynot = "Function Result";
+      else if (sym->attr.dimension && !sym->attr.pointer)
+	{
+	  /* Don't allow initialization of automatic arrays.  */
+	  for (i = 0; i < sym->as->rank; i++)
+	    {
+	      if (sym->as->lower[i] == NULL
+		  || sym->as->lower[i]->expr_type != EXPR_CONSTANT
+		  || sym->as->upper[i] == NULL
+		  || sym->as->upper[i]->expr_type != EXPR_CONSTANT)
+		{
+		  whynot = "Automatic array";
+		  break;
+		}
+	    }
+	}
+
+      /* Reject illegal initializers.  */
+      if (sym->value && whynot)
+	{
+	  gfc_error ("%s '%s' at %L cannot have an initializer",
+		     whynot, sym->name, &sym->declared_at);
+	  return;
+	}
+
+      /* Assign default initializer.  */
+      if (sym->ts.type == BT_DERIVED && !(sym->value || whynot))
+	sym->value = gfc_default_initializer (&sym->ts);
+    }
+
+
   /* Make sure that intrinsic exist */
   if (sym->attr.intrinsic
       && ! gfc_intrinsic_name(sym->name, 0)


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