re PR fortran/41582 ([OOP] Allocation of abstract types requires a type spec or a SOURCE)

2009-10-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41582
        * decl.c (encapsulate_class_symbol): Save attr.abstract.
        * resolve.c (resolve_allocate_expr): Reject class allocate
        without typespec or source=.
        * trans-stmt.c (gfc_trans_allocate): Change gfc_warning
        into gfc_error for "not yet implemented".

2009-10-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41582
        * gfortran.dg/class_allocate_1.f03: Modify code such that
        it compiles with the gfc_warning->gfc_error change.
        * gfortran.dg/class_allocate_1.f03: New test.

From-SVN: r152601

4 files changed, 29 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c54639a..899673d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2009-10-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41582
+	* decl.c (encapsulate_class_symbol): Save attr.abstract.
+	* resolve.c (resolve_allocate_expr): Reject class allocate
+	without typespec or source=.
+	* trans-stmt.c (gfc_trans_allocate): Change gfc_warning
+	into gfc_error for "not yet implemented".
+
 2009-10-09  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/41579
@@ -49,8 +58,8 @@
 
 2009-10-07  Paul Thomas <pault@gcc.gnu.org>
 
-        PR fortran/41613
-        * resolve.c (check_class_members): Reset compcall.assign.
+	PR fortran/41613
+	* resolve.c (check_class_members): Reset compcall.assign.
 
 2009-10-05  Paul Thomas  <pault@gcc.gnu.org>
 
@@ -373,7 +382,6 @@
 	* parse.c (next_free): Improve error locus printing.
 	(next_fixed): Change gfc_warn to gfc_warning_now, and improve
 	locus reporting.
- 
 
 2009-09-16  Michael Matz  <matz@suse.de>
 
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 82442042..2c378fb 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1077,6 +1077,7 @@ encapsulate_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       c->attr.pointer = attr->pointer || attr->dummy;
       c->attr.allocatable = attr->allocatable;
       c->attr.dimension = attr->dimension;
+      c->attr.abstract = ts->u.derived->attr.abstract;
       c->as = (*as);
       c->initializer = gfc_get_expr ();
       c->initializer->expr_type = EXPR_NULL;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1aee540..5ea41c9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5840,7 +5840,7 @@ gfc_expr_to_initialize (gfc_expr *e)
 static gfc_try
 resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 {
-  int i, pointer, allocatable, dimension, check_intent_in;
+  int i, pointer, allocatable, dimension, check_intent_in, is_abstract;
   symbol_attribute attr;
   gfc_ref *ref, *ref2;
   gfc_array_ref *ar;
@@ -5862,6 +5862,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
   if (e->symtree)
     sym = e->symtree->n.sym;
 
+  /* Check whether ultimate component is abstract and CLASS.  */
+  is_abstract = 0;
+
   if (e->expr_type != EXPR_VARIABLE)
     {
       allocatable = 0;
@@ -5876,6 +5879,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 	  allocatable = sym->ts.u.derived->components->attr.allocatable;
 	  pointer = sym->ts.u.derived->components->attr.pointer;
 	  dimension = sym->ts.u.derived->components->attr.dimension;
+	  is_abstract = sym->ts.u.derived->components->attr.abstract;
 	}
       else
 	{
@@ -5903,12 +5907,14 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 		    allocatable = c->ts.u.derived->components->attr.allocatable;
 		    pointer = c->ts.u.derived->components->attr.pointer;
 		    dimension = c->ts.u.derived->components->attr.dimension;
+		    is_abstract = c->ts.u.derived->components->attr.abstract;
 		  }
 		else
 		  {
 		    allocatable = c->attr.allocatable;
 		    pointer = c->attr.pointer;
 		    dimension = c->attr.dimension;
+		    is_abstract = c->attr.abstract;
 		  }
 		break;
 
@@ -5927,6 +5933,14 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
       return FAILURE;
     }
 
+  if (is_abstract && !code->expr3 && code->ext.alloc.ts.type == BT_UNKNOWN)
+    {
+      gcc_assert (e->ts.type == BT_CLASS);
+      gfc_error ("Allocating %s of ABSTRACT base type at %L requires a "
+		 "type-spec or SOURCE=", sym->name, &e->where);
+      return FAILURE;
+    }
+
   if (check_intent_in && sym->attr.intent == INTENT_IN)
     {
       gfc_error ("Cannot allocate INTENT(IN) variable '%s' at %L",
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 05ed23e..110534d 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4025,8 +4025,8 @@ gfc_trans_allocate (gfc_code * code)
 	      gfc_typespec *ts;
 	      /* TODO: Size must be determined at run time, since it must equal
 		 the size of the dynamic type of SOURCE, not the declared type.  */
-	      gfc_warning ("Dynamic size allocation at %L not supported yet, "
-			   "using size of declared type", &code->loc);
+	      gfc_error ("Using SOURCE= with a class variable at %L not "
+			 "supported yet", &code->loc);
 	      ts = &code->expr3->ts.u.derived->components->ts;
 	      tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts));
 	    }