From: Fritz Reese Date: Thu, 27 Oct 2016 17:21:46 +0000 (+0000) Subject: Fix initialization of UNIONs with -finit-derived. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f8da53e09357859d707925e770348636b19206a7;p=gcc.git 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a4bfb0a14f0..085fd0d925e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2016-10-27 Fritz Reese + + * 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 PR fortran/78092 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index ed639a7a7e4..bb183d411e6 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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 { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fe966aa537d..f9d11be5997 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 689ea7e4ef3..7159b172eea 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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 *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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 72f669cfcf7..6cff3e2eb26 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2016-10-27 Fritz Reese + + * 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 * gcc.dg/fold-narrowbopcst-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/dec_init_1.f90 b/gcc/testsuite/gfortran.dg/dec_init_1.f90 index 91f16f85294..03ada9c1022 100644 --- a/gcc/testsuite/gfortran.dg/dec_init_1.f90 +++ b/gcc/testsuite/gfortran.dg/dec_init_1.f90 @@ -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. ! diff --git a/gcc/testsuite/gfortran.dg/dec_init_2.f90 b/gcc/testsuite/gfortran.dg/dec_init_2.f90 index 7636dd993b0..41deac90413 100644 --- a/gcc/testsuite/gfortran.dg/dec_init_2.f90 +++ b/gcc/testsuite/gfortran.dg/dec_init_2.f90 @@ -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. diff --git a/gcc/testsuite/gfortran.dg/dec_init_3.f90 b/gcc/testsuite/gfortran.dg/dec_init_3.f90 new file mode 100644 index 00000000000..6c1161a4903 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_init_3.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/dec_init_4.f90 b/gcc/testsuite/gfortran.dg/dec_init_4.f90 new file mode 100644 index 00000000000..dc5995cbd12 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_init_4.f90 @@ -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