OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix initialization of UNIONs with -finit-derived. 

gcc/fortran/
	* 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.

	gcc/testsuite/gfortran.dg/
	* dec_init_1.f90, dec_init_2.f90: Remove -fdump-tree-original.
	* dec_init_3.f90, dec_init_4.f90: New tests.

From-SVN: r241626
This commit is contained in:
Fritz Reese 2016-10-27 17:21:46 +00:00 committed by Fritz Reese
parent 959c1e2045
commit f8da53e093
9 changed files with 318 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
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

91
gcc/fortran/expr.c
View File

@ -4160,6 +4160,60 @@ gfc_has_default_initializer (gfc_symbol *der)
}
/*
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. */
@ -4177,6 +4231,43 @@ component_initializer (gfc_typespec *ts, gfc_component *c, bool generate)
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
{

6
gcc/fortran/resolve.c
View File

@ -1158,6 +1158,12 @@ resolve_structure_cons (gfc_expr *expr, int init)
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;

83
gcc/fortran/trans-expr.c
View File

@ -7315,7 +7315,29 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
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)
{
@ -7457,6 +7479,43 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
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. */
@ -7485,24 +7544,6 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
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);
@ -7537,6 +7578,8 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
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,
@ -7549,7 +7592,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
}
}
finish:
se->expr = build_constructor (type, v);
if (init)
TREE_CONSTANT (se->expr) = 1;

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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.

2
gcc/testsuite/gfortran.dg/dec_init_1.f90
View File

@ -1,5 +1,5 @@
! { 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.
!

2
gcc/testsuite/gfortran.dg/dec_init_2.f90
View File

@ -1,5 +1,5 @@
! { 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.

59
gcc/testsuite/gfortran.dg/dec_init_3.f90 Normal file
View File

@ -0,0 +1,59 @@
! { 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

80
gcc/testsuite/gfortran.dg/dec_init_4.f90 Normal file
View File

@ -0,0 +1,80 @@
! { 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