From: Paul Thomas Date: Sat, 19 Apr 2008 21:55:24 +0000 (+0000) Subject: re PR target/35944 (wrong result for MOD with kind=10 for some array argument values) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f40eccb026f46cb33f5f1b7751b0c3b452881a0b;p=gcc.git re PR target/35944 (wrong result for MOD with kind=10 for some array argument values) 2008-04-19 Paul Thomas PR fortran/35944 PR fortran/35946 PR fortran/35947 * trans_array.c (gfc_trans_array_constructor): Temporarily realign loop, if loop->from is not zero, before creating the temporary array and provide an offset. PR fortran/35959 * trans-decl.c (gfc_init_default_dt): Add gfc_ prefix to name and allow for NULL body. Change all references from init_default_dt to gfc_init_default_dt. * trans.h : Add prototype for gfc_init_default_dt. * trans-array.c (gfc_trans_deferred_vars): After nullification call gfc_init_default_dt for derived types with allocatable components. 2008-04-19 Paul Thomas PR fortran/35944 PR fortran/35946 PR fortran/35947 * gfortran.dg/array_constructor_23.f: New test. PR fortran/35959 * gfortran.dg/alloc_comp_default_init_2.f90: New test. * gfortran.dg/alloc_comp_basics_1.f90: Change occurrences of "builtin_free" to 27. * gfortran.dg/alloc_comp_constructor_1.f90: Change occurrences of "builtin_free" to 21. From-SVN: r134472 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 763e2f2d754..abcc336e4d1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2008-04-19 Paul Thomas + + PR fortran/35944 + PR fortran/35946 + PR fortran/35947 + * trans_array.c (gfc_trans_array_constructor): Temporarily + realign loop, if loop->from is not zero, before creating + the temporary array and provide an offset. + + PR fortran/35959 + * trans-decl.c (gfc_init_default_dt): Add gfc_ prefix to name + and allow for NULL body. Change all references from + init_default_dt to gfc_init_default_dt. + * trans.h : Add prototype for gfc_init_default_dt. + * trans-array.c (gfc_trans_deferred_vars): After nullification + call gfc_init_default_dt for derived types with allocatable + components. + 2008-04-18 Jerry DeLisle PR fortran/35892 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3de1fb71f20..7bac68dd650 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1679,6 +1679,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) tree offsetvar; tree desc; tree type; + tree loopfrom; bool dynamic; if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER) @@ -1757,9 +1758,34 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) } } + /* Temporarily reset the loop variables, so that the returned temporary + has the right size and bounds. This seems only to be necessary for + 1D arrays. */ + if (!integer_zerop (loop->from[0]) && loop->dimen == 1) + { + loopfrom = loop->from[0]; + loop->from[0] = gfc_index_zero_node; + loop->to[0] = fold_build2 (MINUS_EXPR, gfc_array_index_type, + loop->to[0], loopfrom); + } + else + loopfrom = NULL_TREE; + gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info, type, dynamic, true, false); + if (loopfrom != NULL_TREE) + { + loop->from[0] = loopfrom; + loop->to[0] = fold_build2 (PLUS_EXPR, gfc_array_index_type, + loop->to[0], loopfrom); + /* In the case of a non-zero from, the temporary needs an offset + so that subsequent indexing is correct. */ + ss->data.info.offset = fold_build1 (NEGATE_EXPR, + gfc_array_index_type, + loop->from[0]); + } + desc = ss->data.info.descriptor; offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); @@ -5569,6 +5595,11 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) rank = sym->as ? sym->as->rank : 0; tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank); gfc_add_expr_to_block (&fnblock, tmp); + if (sym->value) + { + tmp = gfc_init_default_dt (sym, NULL); + gfc_add_expr_to_block (&fnblock, tmp); + } } } else if (!GFC_DESCRIPTOR_TYPE_P (type)) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6f430cbc7a6..e693f729ba4 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -512,9 +512,6 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) SAVE_EXPLICIT. */ if (!sym->attr.use_assoc && (sym->attr.save != SAVE_NONE || sym->attr.data - || (sym->ts.type == BT_DERIVED - && sym->ts.derived->attr.alloc_comp - && sym->value) || (sym->value && sym->ns->proc_name->attr.is_main_program))) TREE_STATIC (decl) = 1; @@ -2532,8 +2529,8 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body) /* Initialize a derived type by building an lvalue from the symbol and using trans_assignment to do the work. */ -static tree -init_default_dt (gfc_symbol * sym, tree body) +tree +gfc_init_default_dt (gfc_symbol * sym, tree body) { stmtblock_t fnblock; gfc_expr *e; @@ -2553,7 +2550,8 @@ init_default_dt (gfc_symbol * sym, tree body) } gfc_add_expr_to_block (&fnblock, tmp); gfc_free_expr (e); - gfc_add_expr_to_block (&fnblock, body); + if (body) + gfc_add_expr_to_block (&fnblock, body); return gfc_finish_block (&fnblock); } @@ -2571,7 +2569,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) && f->sym->ts.type == BT_DERIVED && !f->sym->ts.derived->attr.alloc_comp && f->sym->value) - body = init_default_dt (f->sym, body); + body = gfc_init_default_dt (f->sym, body); gfc_add_expr_to_block (&fnblock, body); return gfc_finish_block (&fnblock); @@ -2672,7 +2670,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) && sym->value && !sym->attr.data && sym->attr.save == SAVE_NONE) - fnbody = init_default_dt (sym, fnbody); + fnbody = gfc_init_default_dt (sym, fnbody); gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); @@ -2732,7 +2730,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) && sym->value && !sym->attr.data && sym->attr.save == SAVE_NONE) - fnbody = init_default_dt (sym, fnbody); + fnbody = gfc_init_default_dt (sym, fnbody); else gcc_unreachable (); } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 413433641c1..1dfb0a59dab 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -405,6 +405,9 @@ tree gfc_get_symbol_decl (gfc_symbol *); /* Build a static initializer. */ tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool); +/* Assign a default initializer to a derived type. */ +tree gfc_init_default_dt (gfc_symbol *, tree); + /* Substitute a temporary variable in place of the real one. */ void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 22da23b4b4c..2d3ab1903f3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,17 @@ +2008-04-19 Paul Thomas + + PR fortran/35944 + PR fortran/35946 + PR fortran/35947 + * gfortran.dg/array_constructor_23.f: New test. + + PR fortran/35959 + * gfortran.dg/alloc_comp_default_init_2.f90: New test. + * gfortran.dg/alloc_comp_basics_1.f90: Change occurrences of + "builtin_free" to 27. + * gfortran.dg/alloc_comp_constructor_1.f90: Change occurrences + of "builtin_free" to 21. + 2008-04-18 Jerry DeLisle PR fortran/35892 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 index fc58bf44830..11f655e320b 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 @@ -139,6 +139,6 @@ contains end subroutine check_alloc2 end program alloc -! { dg-final { scan-tree-dump-times "builtin_free" 24 "original" } } +! { dg-final { scan-tree-dump-times "builtin_free" 27 "original" } } ! { dg-final { cleanup-tree-dump "original" } } ! { dg-final { cleanup-modules "alloc_m" } } diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90 index 969e703094c..91145e7c246 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90 @@ -104,5 +104,5 @@ contains end function blaha end program test_constructor -! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } } +! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } } ! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90 new file mode 100644 index 00000000000..db106ccee91 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! Tests the fix for PR35959, in which the structure subpattern was declared static +! so that this test faied on the second recursive call. +! +! Contributed by Michaël Baudin +! +program testprog + type :: t_type + integer, dimension(:), allocatable :: chars + end type t_type + integer, save :: callnb = 0 + type(t_type) :: this + allocate ( this % chars ( 4)) + if (.not.recursivefunc (this) .or. (callnb .ne. 10)) call abort () +contains + recursive function recursivefunc ( this ) result ( match ) + type(t_type), intent(in) :: this + type(t_type) :: subpattern + logical :: match + callnb = callnb + 1 + match = (callnb == 10) + if ((.NOT. allocated (this % chars)) .OR. match) return + allocate ( subpattern % chars ( 4 ) ) + match = recursivefunc ( subpattern ) + end function recursivefunc +end program testprog diff --git a/gcc/testsuite/gfortran.dg/array_constructor_23.f b/gcc/testsuite/gfortran.dg/array_constructor_23.f new file mode 100644 index 00000000000..3eeedbabd58 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_23.f @@ -0,0 +1,47 @@ +! { dg-do run } +! Tests the fix for PR35944/6/7, in which the variable array constructors below +! were incorrectly translated and wrong code was produced. +! +! Contributed by Dick Hendrickson +! + program try_fa6013 + call fa6013 (10, 1, -1) + call fa6077 (10, 1, -1, (/1,2,3,4,5,6,7,8,9,10/)) + call fa2083 + end program + + subroutine FA6013 (nf10, nf1, mf1) + integer, parameter :: kv = 4 + REAL(KV) DDA1(10) + REAL(KV) DDA2(10) + REAL(KV) DDA(10), dval + dda = (/1,2,3,4,5,6,7,8,9,10/) + DDA1 = ATAN2 ((/(REAL(J1,KV),J1=1,10)/), + $ REAL((/(J1,J1=nf10,nf1,mf1)/), KV)) !fails + DDA2 = ATAN2 (DDA, DDA(10:1:-1)) + if (any (DDA1 .ne. DDA2)) call abort () + END + + subroutine FA6077 (nf10,nf1,mf1, ida) + INTEGER IDA1(10) + INTEGER IDA2(10), ida(10) + IDA1 = IEOR((/1,2,3,4,5,6,7,8,9,10/), + $ (/(IDA(J1),J1=10,1,-1)/) ) + IDA2 = IEOR ((/1,2,3,4,5,6,7,8,9,10/), (/10,9,8,7,6,5,4,3,2,1/) ) + if (any (ida1 .ne. ida2)) call abort () + END SUBROUTINE + + subroutine fa2083 + implicit none + integer j1,k + parameter (k=10) !failed + REAL(k) QDA1(10) + REAL(k) QDA(10), qval + qda = (/ 1,2,3,4,5,6,7,8,9,10 /) + QDA1 = MOD ( 1.1_k*( QDA(1) -5.0_k), P=( QDA -2.5_k)) + DO J1 = 1,10 + QVAL = MOD(1.1_k*(QDA(1)-5.0_k),P=(QDA(J1)-2.5_k)) + if (qval .ne. qda1(j1)) call abort () + ENDDO + END +