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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c54639a..899673d 100644 (file)
--- 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 8244204..2c378fb 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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));
            }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 537f11f..ce6dcc2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.
+
 2009-10-09  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/41579
@@ -448,7 +455,7 @@
 
 2009-10-02  Jack Howarth  <howarth@bromo.med.uc.edu>
 
-        * gcc.dg/guality/guality.exp: Disable on darwin.
+       * gcc.dg/guality/guality.exp: Disable on darwin.
 
 2009-10-02  Janis Johnson  <janis187@us.ibm.com>
 
@@ -5543,7 +5550,7 @@
 2009-05-12  David Billinghurst <billingd@gcc.gnu.org>
 
        * lib/target-supports.exp (check_profiling_available): Return
-       false for -p on *-*-cygwin* targets.
+       false for -p on *-*-cygwin* targets.
 
 2009-05-11  H.J. Lu  <hongjiu.lu@intel.com>
 

diff --git a/gcc/testsuite/gfortran.dg/class_allocate_1.f03 b/gcc/testsuite/gfortran.dg/class_allocate_1.f03
index 844e144..719d90c 100644 (file)
--- a/gcc/testsuite/gfortran.dg/class_allocate_1.f03
+++ b/gcc/testsuite/gfortran.dg/class_allocate_1.f03
@@ -20,6 +20,7 @@
  end type
 
  class(t1),pointer :: cp, cp2
+ type(t2),pointer :: cp3
  type(t3) :: x
  integer :: i
 
@@ -67,7 +68,10 @@
 
  i = 0
  allocate(t2 :: cp2)
- allocate(cp, source = cp2)  ! { dg-warning "not supported yet" }
+! FIXME: Not yet supported: source=<class>
+! allocate(cp, source = cp2)
+ allocate(t2 :: cp3)
+ allocate(cp, source=cp3)
  select type (cp)
  type is (t1)
    i = 1

diff --git a/gcc/testsuite/gfortran.dg/class_allocate_2.f03 b/gcc/testsuite/gfortran.dg/class_allocate_2.f03
new file mode 100644 (file)
index 0000000..d6a5d78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_2.f03
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/41582
+!
+subroutine test()
+type :: t
+end type t
+class(t), allocatable :: c,d
+allocate(t :: d)
+allocate(c,source=d) ! { dg-error "not supported yet" }
+end
+
+type, abstract :: t
+end type t
+type t2
+  class(t), pointer :: t
+end type t2
+
+class(t), allocatable :: a,c,d
+type(t2) :: b
+allocate(a) ! { dg-error "requires a type-spec or SOURCE" }
+allocate(b%t) ! { dg-error "requires a type-spec or SOURCE" }
+end