aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJanus Weil <janus@gcc.gnu.org>2010-05-15 15:52:33 +0200
committerJanus Weil <janus@gcc.gnu.org>2010-05-15 15:52:33 +0200
commitf8dde8af6f4bf8d16fcb12544caef0aad3da56f2 (patch)
treea70032d51f8a223474b6f5114ee467e48b7758f9 /gcc
parent46c3001944a778ddd079de47697c092bfd82419a (diff)
downloadgcc-f8dde8af6f4bf8d16fcb12544caef0aad3da56f2.zip
gcc-f8dde8af6f4bf8d16fcb12544caef0aad3da56f2.tar.gz
gcc-f8dde8af6f4bf8d16fcb12544caef0aad3da56f2.tar.bz2
re PR fortran/43207 ([OOP] invalid (pointer) assignment to and from abstract non-polymorphic expressions)
2010-05-15 Janus Weil <janus@gcc.gnu.org> PR fortran/43207 PR fortran/43969 * gfortran.h (gfc_class_null_initializer): New prototype. * expr.c (gfc_class_null_initializer): New function to build a NULL initializer for CLASS pointers. * symbol.c (gfc_build_class_symbol): Modify internal naming of class containers. Remove default NULL initialization of $data component. * trans.c (gfc_allocate_array_with_status): Fix wording of an error message. * trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign): Use new function 'gfc_class_null_initializer'. * trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar class variables. 2010-05-15 Janus Weil <janus@gcc.gnu.org> PR fortran/43207 PR fortran/43969 * gfortran.dg/class_18.f03: New. * gfortran.dg/class_19.f03: New. From-SVN: r159431
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog16
-rw-r--r--gcc/fortran/expr.c26
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/symbol.c12
-rw-r--r--gcc/fortran/trans-expr.c7
-rw-r--r--gcc/fortran/trans-intrinsic.c2
-rw-r--r--gcc/fortran/trans.c6
-rw-r--r--gcc/testsuite/ChangeLog7
-rw-r--r--gcc/testsuite/gfortran.dg/class_18.f0318
-rw-r--r--gcc/testsuite/gfortran.dg/class_19.f0341
10 files changed, 125 insertions, 11 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a95d16d..dd6d23f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2010-05-15 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/43207
+ PR fortran/43969
+ * gfortran.h (gfc_class_null_initializer): New prototype.
+ * expr.c (gfc_class_null_initializer): New function to build a NULL
+ initializer for CLASS pointers.
+ * symbol.c (gfc_build_class_symbol): Modify internal naming of class
+ containers. Remove default NULL initialization of $data component.
+ * trans.c (gfc_allocate_array_with_status): Fix wording of an error
+ message.
+ * trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign):
+ Use new function 'gfc_class_null_initializer'.
+ * trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar
+ class variables.
+
2010-05-14 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/44135
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 8230b46..382d1fe 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3628,6 +3628,32 @@ gfc_default_initializer (gfc_typespec *ts)
}
+/* Build a NULL initializer for CLASS pointers,
+ initializing the $data and $vptr components to zero. */
+
+gfc_expr *
+gfc_class_null_initializer (gfc_typespec *ts)
+{
+ gfc_expr *init;
+ gfc_component *comp;
+
+ init = gfc_get_structure_constructor_expr (ts->type, ts->kind,
+ &ts->u.derived->declared_at);
+ init->ts = *ts;
+
+ for (comp = ts->u.derived->components; comp; comp = comp->next)
+ {
+ gfc_constructor *ctor = gfc_constructor_get();
+ ctor->expr = gfc_get_expr ();
+ ctor->expr->expr_type = EXPR_NULL;
+ ctor->expr->ts = comp->ts;
+ gfc_constructor_append (&init->value.constructor, ctor);
+ }
+
+ return init;
+}
+
+
/* Given a symbol, create an expression node with that symbol as a
variable. If the symbol is array valued, setup a reference of the
whole array. */
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 91c8b80..96acaa4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2630,6 +2630,7 @@ gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
gfc_expr *gfc_default_initializer (gfc_typespec *);
+gfc_expr *gfc_class_null_initializer (gfc_typespec *);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 8403578..ceb45bf 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4717,15 +4717,15 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
/* Determine the name of the encapsulating type. */
if ((*as) && (*as)->rank && attr->allocatable)
- sprintf (name, ".class.%s.%d.a", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "class$%s_%d_a", ts->u.derived->name, (*as)->rank);
else if ((*as) && (*as)->rank)
- sprintf (name, ".class.%s.%d", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "class$%s_%d", ts->u.derived->name, (*as)->rank);
else if (attr->pointer)
- sprintf (name, ".class.%s.p", ts->u.derived->name);
+ sprintf (name, "class$%s_p", ts->u.derived->name);
else if (attr->allocatable)
- sprintf (name, ".class.%s.a", ts->u.derived->name);
+ sprintf (name, "class$%s_a", ts->u.derived->name);
else
- sprintf (name, ".class.%s", ts->u.derived->name);
+ sprintf (name, "class$%s", ts->u.derived->name);
gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
if (fclass == NULL)
@@ -4759,7 +4759,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
c->attr.codimension = attr->codimension;
c->attr.abstract = ts->u.derived->attr.abstract;
c->as = (*as);
- c->initializer = gfc_get_null_expr (NULL);
+ c->initializer = NULL;
/* Add component '$vptr'. */
if (gfc_add_component (fclass, "$vptr", &c) == FAILURE)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 47883e2..4d48c05 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3894,7 +3894,10 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
case BT_DERIVED:
case BT_CLASS:
gfc_init_se (&se, NULL);
- gfc_conv_structure (&se, expr, 1);
+ if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL)
+ gfc_conv_structure (&se, gfc_class_null_initializer(ts), 1);
+ else
+ gfc_conv_structure (&se, expr, 1);
return se.expr;
case BT_CHARACTER:
@@ -4202,7 +4205,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
{
/* NULL initialization for CLASS components. */
tmp = gfc_trans_structure_assign (dest,
- gfc_default_initializer (&cm->ts));
+ gfc_class_null_initializer (&cm->ts));
gfc_add_expr_to_block (&block, tmp);
}
else if (cm->attr.dimension)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 1ffe284..257b684 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -4529,6 +4529,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
{
/* Allocatable scalar. */
arg1se.want_pointer = 1;
+ if (arg1->expr->ts.type == BT_CLASS)
+ gfc_add_component_ref (arg1->expr, "$data");
gfc_conv_expr (&arg1se, arg1->expr);
tmp = arg1se.expr;
}
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 8acccf8..3a25bcc 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -704,7 +704,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
return mem;
}
else
- runtime_error ("Attempting to allocate already allocated array");
+ runtime_error ("Attempting to allocate already allocated variable");
}
}
@@ -743,13 +743,13 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
error = gfc_trans_runtime_error (true, &expr->where,
"Attempting to allocate already"
- " allocated array '%s'",
+ " allocated variable '%s'",
varname);
}
else
error = gfc_trans_runtime_error (true, NULL,
"Attempting to allocate already allocated"
- "array");
+ "variable");
if (status != NULL_TREE && !integer_zerop (status))
{
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a813121..1e3d9c7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2010-05-15 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/43207
+ PR fortran/43969
+ * gfortran.dg/class_18.f03: New.
+ * gfortran.dg/class_19.f03: New.
+
2010-05-14 Jakub Jelinek <jakub@redhat.com>
PR debug/44112
diff --git a/gcc/testsuite/gfortran.dg/class_18.f03 b/gcc/testsuite/gfortran.dg/class_18.f03
new file mode 100644
index 0000000..576f931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_18.f03
@@ -0,0 +1,18 @@
+! { dg-do run }
+!
+! PR 43207: [OOP] ICE for class pointer => null() initialization
+!
+! Original test case by Tobias Burnus <burnus@gcc.gnu.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+ implicit none
+ type :: parent
+ end type
+ type(parent), target :: t
+ class(parent), pointer :: cp => null()
+
+ if (associated(cp)) call abort()
+ cp => t
+ if (.not. associated(cp)) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_19.f03 b/gcc/testsuite/gfortran.dg/class_19.f03
new file mode 100644
index 0000000..ffc3de3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_19.f03
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR 43969: [OOP] ALLOCATED() with polymorphic variables
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+
+module foo_mod
+ type foo_inner
+ integer, allocatable :: v(:)
+ end type foo_inner
+ type foo_outer
+ class(foo_inner), allocatable :: int
+ end type foo_outer
+contains
+subroutine foo_checkit()
+ implicit none
+ type(foo_outer) :: try
+ type(foo_outer),allocatable :: try2
+ class(foo_outer), allocatable :: try3
+
+ if (allocated(try%int)) call abort()
+ allocate(foo_outer :: try3)
+ if (allocated(try3%int)) call abort()
+ allocate(try2)
+ if (allocated(try2%int)) call abort()
+
+end subroutine foo_checkit
+end module foo_mod
+
+
+program main
+
+ use foo_mod
+ implicit none
+
+ call foo_checkit()
+
+end program main
+
+! { dg-final { cleanup-modules "foo_mod" } }