+2016-10-27 Fritz Reese <fritzoreese@gmail.com>
+
+ * expr.c (generate_union_initializer, get_union_initializer): New.
+ * expr.c (component_initializer): Consider BT_UNION specially.
+ * resolve.c (resolve_structure_cons): Hack for BT_UNION.
+ * trans-expr.c (gfc_trans_subcomponent_assign): Ditto.
+ * trans-expr.c (gfc_conv_union_initializer): New.
+ * trans-expr.c (gfc_conv_structure): Replace UNION handling code with
+ new function gfc_conv_union_initializer.
+
2016-10-26 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/78092
}
+/*
+ Generate an initializer expression which initializes the entirety of a union.
+ A normal structure constructor is insufficient without undue effort, because
+ components of maps may be oddly aligned/overlapped. (For example if a
+ character is initialized from one map overtop a real from the other, only one
+ byte of the real is actually initialized.) Unfortunately we don't know the
+ size of the union right now, so we can't generate a proper initializer, but
+ we use a NULL expr as a placeholder and do the right thing later in
+ gfc_trans_subcomponent_assign.
+ */
+static gfc_expr *
+generate_union_initializer (gfc_component *un)
+{
+ if (un == NULL || un->ts.type != BT_UNION)
+ return NULL;
+
+ gfc_expr *placeholder = gfc_get_null_expr (&un->loc);
+ placeholder->ts = un->ts;
+ return placeholder;
+}
+
+
+/* Get the user-specified initializer for a union, if any. This means the user
+ has said to initialize component(s) of a map. For simplicity's sake we
+ only allow the user to initialize the first map. We don't have to worry
+ about overlapping initializers as they are released early in resolution (see
+ resolve_fl_struct). */
+
+static gfc_expr *
+get_union_initializer (gfc_symbol *union_type, gfc_component **map_p)
+{
+ gfc_component *map;
+ gfc_expr *init=NULL;
+
+ if (!union_type || union_type->attr.flavor != FL_UNION)
+ return NULL;
+
+ for (map = union_type->components; map; map = map->next)
+ {
+ if (gfc_has_default_initializer (map->ts.u.derived))
+ {
+ init = gfc_default_initializer (&map->ts);
+ if (map_p)
+ *map_p = map;
+ break;
+ }
+ }
+
+ if (map_p && !init)
+ *map_p = NULL;
+
+ return init;
+}
+
/* Fetch or generate an initializer for the given component.
Only generate an initializer if generate is true. */
if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
init = gfc_generate_initializer (&c->ts, true);
+ else if (c->ts.type == BT_UNION && c->ts.u.derived->components)
+ {
+ gfc_component *map = NULL;
+ gfc_constructor *ctor;
+ gfc_expr *user_init;
+
+ /* If we don't have a user initializer and we aren't generating one, this
+ union has no initializer. */
+ user_init = get_union_initializer (c->ts.u.derived, &map);
+ if (!user_init && !generate)
+ return NULL;
+
+ /* Otherwise use a structure constructor. */
+ init = gfc_get_structure_constructor_expr (c->ts.type, c->ts.kind,
+ &c->loc);
+ init->ts = c->ts;
+
+ /* If we are to generate an initializer for the union, add a constructor
+ which initializes the whole union first. */
+ if (generate)
+ {
+ ctor = gfc_constructor_get ();
+ ctor->expr = generate_union_initializer (c);
+ gfc_constructor_append (&init->value.constructor, ctor);
+ }
+
+ /* If we found an initializer in one of our maps, apply it. Note this
+ is applied _after_ the entire-union initializer above if any. */
+ if (user_init)
+ {
+ ctor = gfc_constructor_get ();
+ ctor->expr = user_init;
+ ctor->n.component = map;
+ gfc_constructor_append (&init->value.constructor, ctor);
+ }
+ }
+
/* Treat simple components like locals. */
else
{
if (!cons->expr)
continue;
+ /* Unions use an EXPR_NULL contrived expression to tell the translation
+ phase to generate an initializer of the appropriate length.
+ Ignore it here. */
+ if (cons->expr->ts.type == BT_UNION && cons->expr->expr_type == EXPR_NULL)
+ continue;
+
if (!gfc_resolve_expr (cons->expr))
{
t = false;
fold_convert (TREE_TYPE (tmp), se.expr));
gfc_add_block_to_block (&block, &se.post);
}
- else if (gfc_bt_struct (expr->ts.type) && expr->ts.f90_type != BT_VOID)
+ else if (expr->ts.type == BT_UNION)
+ {
+ tree tmp;
+ gfc_constructor *c = gfc_constructor_first (expr->value.constructor);
+ /* We mark that the entire union should be initialized with a contrived
+ EXPR_NULL expression at the beginning. */
+ if (c->n.component == NULL && c->expr->expr_type == EXPR_NULL)
+ {
+ tmp = build2_loc (input_location, MODIFY_EXPR, void_type_node,
+ dest, build_constructor (TREE_TYPE (dest), NULL));
+ gfc_add_expr_to_block (&block, tmp);
+ c = gfc_constructor_next (c);
+ }
+ /* The following constructor expression, if any, represents a specific
+ map intializer, as given by the user. */
+ if (c != NULL && c->expr != NULL)
+ {
+ gcc_assert (expr->expr_type == EXPR_STRUCTURE);
+ tmp = gfc_trans_structure_assign (dest, expr, expr->symtree != NULL);
+ gfc_add_expr_to_block (&block, tmp);
+ }
+ }
+ else if (expr->ts.type == BT_DERIVED && expr->ts.f90_type != BT_VOID)
{
if (expr->expr_type != EXPR_STRUCTURE)
{
return gfc_finish_block (&block);
}
+void
+gfc_conv_union_initializer (vec<constructor_elt, va_gc> *v,
+ gfc_component *un, gfc_expr *init)
+{
+ gfc_constructor *ctor;
+
+ if (un->ts.type != BT_UNION || un == NULL || init == NULL)
+ return;
+
+ ctor = gfc_constructor_first (init->value.constructor);
+
+ if (ctor == NULL || ctor->expr == NULL)
+ return;
+
+ gcc_assert (init->expr_type == EXPR_STRUCTURE);
+
+ /* If we have an 'initialize all' constructor, do it first. */
+ if (ctor->expr->expr_type == EXPR_NULL)
+ {
+ tree union_type = TREE_TYPE (un->backend_decl);
+ tree val = build_constructor (union_type, NULL);
+ CONSTRUCTOR_APPEND_ELT (v, un->backend_decl, val);
+ ctor = gfc_constructor_next (ctor);
+ }
+
+ /* Add the map initializer on top. */
+ if (ctor != NULL && ctor->expr != NULL)
+ {
+ gcc_assert (ctor->expr->expr_type == EXPR_STRUCTURE);
+ tree val = gfc_conv_initializer (ctor->expr, &un->ts,
+ TREE_TYPE (un->backend_decl),
+ un->attr.dimension, un->attr.pointer,
+ un->attr.proc_pointer);
+ CONSTRUCTOR_APPEND_ELT (v, un->backend_decl, val);
+ }
+}
+
/* Build an expression for a constructor. If init is nonzero then
this is part of a static variable initializer. */
return;
}
- /* Though unions appear to have multiple map components, they must only
- have a single initializer since each map overlaps. TODO: squash map
- constructors? */
- if (expr->ts.type == BT_UNION)
- {
- c = gfc_constructor_first (expr->value.constructor);
- cm = c->n.component;
- val = gfc_conv_initializer (c->expr, &expr->ts,
- TREE_TYPE (cm->backend_decl),
- cm->attr.dimension, cm->attr.pointer,
- cm->attr.proc_pointer);
- val = unshare_expr_without_location (val);
-
- /* Append it to the constructor list. */
- CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
- goto finish;
- }
-
cm = expr->ts.u.derived->components;
for (c = gfc_constructor_first (expr->value.constructor);
CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl,
fold_convert (TREE_TYPE (cm->backend_decl),
integer_zero_node));
+ else if (cm->ts.type == BT_UNION)
+ gfc_conv_union_initializer (v, cm, c->expr);
else
{
val = gfc_conv_initializer (c->expr, &cm->ts,
CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
}
}
-finish:
+
se->expr = build_constructor (type, v);
if (init)
TREE_CONSTANT (se->expr) = 1;
+2016-10-27 Fritz Reese <fritzoreese@gmail.com>
+
+ * gfortran.dg/dec_init_1.f90: Remove -fdump-tree-original.
+ * gfortran.dg/dec_init_2.f90: Likewise.
+ * gfortran.dg/dec_init_3.f90: New test.
+ * gfortran.dg/dec_init_4.f90: Likewise.
+
2016-10-27 Bin Cheng <bin.cheng@arm.com>
* gcc.dg/fold-narrowbopcst-1.c: New test.
! { dg-do run }
-! { dg-options "-fdec-structure -finit-derived -finit-local-zero -fdump-tree-original" }
+! { dg-options "-fdec-structure -finit-derived -finit-local-zero" }
!
! Test -finit-derived with DEC structure and union.
!
! { dg-do run }
-! { dg-options "-fdec-structure -finit-derived -finit-integer=42 -finit-real=nan -finit-logical=true -finit-character=32 -fdump-tree-original" }
+! { dg-options "-fdec-structure -finit-derived -finit-integer=42 -finit-real=nan -finit-logical=true -finit-character=32" }
! { dg-add-options ieee }
!
! Test -finit-derived with DEC structure and union.
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec-structure -finit-derived -finit-local-zero" }
+!
+! Test -finit-derived with DEC structure and union.
+!
+
+subroutine dummy(i1,r1,c1,l1,i2,r2,c2,l2)
+ implicit none
+ integer, intent(in) :: i1
+ real, intent(in) :: r1
+ character, intent(in) :: c1
+ logical, intent(in) :: l1
+ integer, intent(inout) :: i2
+ real, intent(inout) :: r2
+ character, intent(inout) :: c2
+ logical, intent(inout) :: l2
+ print *, i1, i2, l1, l2, c1, c2, r1, r2
+ if ( i1 .ne. 0 .or. i2 .ne. 0 ) call abort()
+ if ( l1 .or. l2 ) call abort()
+ if ( c1 .ne. achar(0) .or. c2 .ne. achar(0) ) call abort()
+ if ( r1 .ne. 0.0 .or. r2 .ne. 0.0 ) call abort()
+end subroutine
+
+subroutine sub
+ structure /s1/
+ integer i
+ end structure
+
+ structure /s2/
+ union
+ map
+ integer m11
+ real m12
+ character m13
+ logical m14
+ end map
+ map
+ logical m21
+ character m22
+ real m23
+ integer m24
+ end map
+ map
+ character(32) s
+ record /s1/ r
+ end map
+ end union
+ end structure
+ record /s2/ x
+ call dummy (x.m11, x.m12, x.m13, x.m14, x.m24, x.m23, x.m22, x.m21)
+ print *, x.r.i
+ if ( x.r.i .ne. 0 ) then
+ call abort ()
+ endif
+end subroutine
+
+call sub
+
+end
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec-structure -finit-derived -finit-local-zero" }
+!
+! Test a UNION with explicit initialization and -finit-derived.
+!
+
+subroutine sub
+ structure /s2/
+ integer(4) :: i = 8
+ union ! U7
+ map
+ integer(4) :: x = 1600
+ integer(4) :: y = 1800
+ end map
+ map
+ integer(2) a, b, c, d, e, f, g, h
+ end map
+ end union
+ end structure
+ record /s2/ r2
+
+ ! Initialized unions
+ if ( r2.i .ne. 8 ) then
+ print *, 'structure init'
+ call abort()
+ endif
+
+ ! Explicit initializations
+ if ( r2.x .ne. 1600 .or. r2.y .ne. 1800) then
+ r2.x = r2.y
+ print *, 'union explicit init'
+ call abort()
+ endif
+
+ ! Initialization from -finit-derived
+ if ( r2.h .ne. 0 ) then
+ r2.h = 135
+ print *, 'union default init'
+ call abort()
+ endif
+
+end subroutine
+
+! Initialization expressions
+structure /s3/
+ integer(4) :: i = 8
+ union ! U7
+ map
+ integer(4) :: x = 1600
+ integer(4) :: y = 1800
+ end map
+ map
+ integer(2) a, b, c, d, e
+ end map
+ end union
+end structure
+
+record /s3/ r3
+
+! Initialized unions
+if ( r3.i .ne. 8 ) then
+ print *, 'structure init'
+ call abort()
+endif
+
+! Explicit initializations
+if ( r3.x .ne. 1600 .or. r3.y .ne. 1800) then
+ r3.x = r3.y
+ print *, 'union explicit init'
+ call abort()
+endif
+
+! Initialization from -finit-derived
+if ( r3.e .ne. 0 ) then
+ r3.e = 135
+ print *, 'union default init'
+ call abort()
+endif
+
+end
projects / gcc.git / commitdiff