From d9b3f26bfd2dcda4c60d6317ac42db8d348b398d Mon Sep 17 00:00:00 2001
From: pbrook <pbrook@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Tue, 18 May 2004 00:48:05 +0000
Subject: 	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. testsuite/
 	* gfortran.fortran-torture/execute/der_init_4.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81966 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/resolve.c | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 47 insertions(+)

(limited to 'gcc/fortran/resolve.c')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3530ee1c07e..ca9208f4caf 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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)
-- 
cgit v1.2.3