2019-09-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/91726
* resolve.c (gfc_expr_to_initialize): Bail out with a copy of
the original expression if the array ref is a scalar and the
array_spec has corank.
* trans-array.c (gfc_conv_array_ref): Such expressions are OK
even if the array ref codimen is zero.
* trans-expr.c (gfc_get_class_from_expr): New function taken
from gfc_get_vptr_from_expr.
(gfc_get_vptr_from_expr): Call new function.
* trans-stmt.c (trans_associate_var): If one of these is a
target expression, extract the class expression from the target
and copy its fields to a new target variable.
* trans.h : Add prototype for gfc_get_class_from_expr.
2019-09-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/91726
* gfortran.dg/coarray_poly_9.f90 : New test.
From-SVN: r276269
+2019-09-29 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/91726
+ * resolve.c (gfc_expr_to_initialize): Bail out with a copy of
+ the original expression if the array ref is a scalar and the
+ array_spec has corank.
+ * trans-array.c (gfc_conv_array_ref): Such expressions are OK
+ even if the array ref codimen is zero.
+ * trans-expr.c (gfc_get_class_from_expr): New function taken
+ from gfc_get_vptr_from_expr.
+ (gfc_get_vptr_from_expr): Call new function.
+ * trans-stmt.c (trans_associate_var): If one of these is a
+ target expression, extract the class expression from the target
+ and copy its fields to a new target variable.
+ * trans.h : Add prototype for gfc_get_class_from_expr.
+
2019-09-28 Jerry DeLisle <jvdelisle@gcc.ngu.org>
PR fortran/91802
PR fortran/91864
* gcc/fortran/io.c (match_io_element): An inquiry parameter cannot be
read into.
- * gcc/fortran/match.c (gfc_match_allocate): An inquiry parameter
+ * gcc/fortran/match.c (gfc_match_allocate): An inquiry parameter
can be neither an allocate-object nor stat variable.
(gfc_match_deallocate): An inquiry parameter cannot be deallocated.
for (ref = result->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->next == NULL)
{
+ if (ref->u.ar.dimen == 0
+ && ref->u.ar.as && ref->u.ar.as->corank)
+ return result;
+
ref->u.ar.type = AR_FULL;
for (i = 0; i < ref->u.ar.dimen; i++)
if (ar->dimen == 0)
{
- gcc_assert (ar->codimen || sym->attr.select_rank_temporary);
+ gcc_assert (ar->codimen || sym->attr.select_rank_temporary
+ || (ar->as && ar->as->corank));
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr));
}
-/* Obtain the vptr of the last class reference in an expression.
+/* Obtain the last class reference in an expression.
Return NULL_TREE if no class reference is found. */
tree
-gfc_get_vptr_from_expr (tree expr)
+gfc_get_class_from_expr (tree expr)
{
tree tmp;
tree type;
while (type)
{
if (GFC_CLASS_TYPE_P (type))
- return gfc_class_vptr_get (tmp);
+ return tmp;
if (type != TYPE_CANONICAL (type))
type = TYPE_CANONICAL (type);
else
tmp = build_fold_indirect_ref_loc (input_location, tmp);
if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
+ return tmp;
+
+ return NULL_TREE;
+}
+
+
+/* Obtain the vptr of the last class reference in an expression.
+ Return NULL_TREE if no class reference is found. */
+
+tree
+gfc_get_vptr_from_expr (tree expr)
+{
+ tree tmp;
+
+ tmp = gfc_get_class_from_expr (expr);
+
+ if (tmp != NULL_TREE)
return gfc_class_vptr_get (tmp);
return NULL_TREE;
}
else
{
+ tree ctree = gfc_get_class_from_expr (se.expr);
tmp = TREE_TYPE (sym->backend_decl);
+
+ /* Coarray scalar component expressions can emerge from
+ the front end as array elements of the _data field. */
+ if (sym->ts.type == BT_CLASS
+ && e->ts.type == BT_CLASS && e->rank == 0
+ && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)) && ctree)
+ {
+ tree stmp;
+ tree dtmp;
+
+ se.expr = ctree;
+ dtmp = TREE_TYPE (TREE_TYPE (sym->backend_decl));
+ ctree = gfc_create_var (dtmp, "class");
+
+ stmp = gfc_class_data_get (se.expr);
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)));
+
+ /* Set the fields of the target class variable. */
+ stmp = gfc_conv_descriptor_data_get (stmp);
+ dtmp = gfc_class_data_get (ctree);
+ stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ gfc_add_modify (&se.pre, dtmp, stmp);
+ stmp = gfc_class_vptr_get (se.expr);
+ dtmp = gfc_class_vptr_get (ctree);
+ stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ gfc_add_modify (&se.pre, dtmp, stmp);
+ if (UNLIMITED_POLY (sym))
+ {
+ stmp = gfc_class_len_get (se.expr);
+ dtmp = gfc_class_len_get (ctree);
+ stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ gfc_add_modify (&se.pre, dtmp, stmp);
+ }
+ se.expr = ctree;
+ }
tmp = gfc_build_addr_expr (tmp, se.expr);
}
tree gfc_vptr_deallocate_get (tree);
void gfc_reset_vptr (stmtblock_t *, gfc_expr *);
void gfc_reset_len (stmtblock_t *, gfc_expr *);
+tree gfc_get_class_from_expr (tree);
tree gfc_get_vptr_from_expr (tree);
tree gfc_get_class_array_ref (tree, tree, tree, bool);
tree gfc_copy_class_to_class (tree, tree, tree, bool);
+2019-09-29 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/91726
+ * gfortran.dg/coarray_poly_9.f90 : New test.
+
2019-09-29 Kewen Lin <linkw@gcc.gnu.org>
* gcc.target/powerpc/conv-vectorize-1.c: New test.
--- /dev/null
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Test the fix for PR91726.
+!
+! Contributed by Gerhardt Steinmetz <gscfq@t-online.de>
+!
+module m
+ type s
+ class(*), allocatable :: a[:] ! This ICEd
+ end type
+ type t
+ class(*), allocatable :: a(:)[:] ! This was OK
+ end type
+end
+
+ use m
+ call foo
+ call bar
+contains
+ subroutine foo
+ type (s) :: a
+ integer(4) :: i = 42_4
+ allocate (a%a[*], source = i) ! This caused runtime segfaults
+ select type (z => a%a) ! ditto
+ type is (integer(4))
+ if (z .ne. 42_4) stop 1
+ end select
+ end subroutine
+ subroutine bar ! Arrays always worked
+ type (t) :: a
+ allocate (a%a(3)[*], source = [1_4, 2_4, 3_4])
+ select type (z => a%a)
+ type is (integer(4))
+ if (any (z .ne. [1_4, 2_4, 3_4])) stop 2
+ end select
+ end subroutine
+end
projects / gcc.git / commitdiff