diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 24 | ||||
| -rw-r--r-- | gcc/fortran/dependency.c | 82 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 38 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 34 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-io.c | 2 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dependency_26.f90 | 53 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/internal_pack_7.f90 | 35 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/internal_pack_8.f90 | 33 |
11 files changed, 289 insertions, 28 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8776bd5..9efaf38 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,27 @@ +2010-02-20 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/36932 + PR fortran/36933 + PR fortran/43072 + PR fortran/43111 + * dependency.c (gfc_check_argument_var_dependency): Use enum + value instead of arithmetic vaue for 'elemental'. + (check_data_pointer_types): New function. + (gfc_check_dependency): Call check_data_pointer_types. + * trans-array.h : Change fourth argument of + gfc_conv_array_parameter to boolean. + * trans-array.c (gfc_conv_array_parameter): A contiguous array + can be a dummy but it must not be assumed shape or deferred. + Change fourth argument to boolean. Array constructor exprs will + always be contiguous and do not need packing and unpacking. + * trans-expr.c (gfc_conv_procedure_call): Clean up some white + space and change fourth argument of gfc_conv_array_parameter + to boolean. + (gfc_trans_arrayfunc_assign): Change fourth argument of + gfc_conv_array_parameter to boolean. + * trans-io.c (gfc_convert_array_to_string): The same. + * trans-intrinsic.c (gfc_conv_intrinsic_loc): The same. + 2010-02-20 Tobias Burnus <burnus@net-b.de> PR fortran/42958 diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index f597e6e..1f3d0ed 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -467,7 +467,7 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent, /* In case of elemental subroutines, there is no dependency between two same-range array references. */ if (gfc_ref_needs_temporary_p (expr->ref) - || gfc_check_dependency (var, expr, !elemental)) + || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL)) { if (elemental == ELEM_DONT_CHECK_VARIABLE) { @@ -677,6 +677,78 @@ gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2) } +/* Return true if there is no possibility of aliasing because of a type + mismatch between all the possible pointer references and the + potential target. Note that this function is asymmetric in the + arguments and so must be called twice with the arguments exchanged. */ + +static bool +check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2) +{ + gfc_component *cm1; + gfc_symbol *sym1; + gfc_symbol *sym2; + gfc_ref *ref1; + bool seen_component_ref; + + if (expr1->expr_type != EXPR_VARIABLE + || expr1->expr_type != EXPR_VARIABLE) + return false; + + sym1 = expr1->symtree->n.sym; + sym2 = expr2->symtree->n.sym; + + /* Keep it simple for now. */ + if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED) + return false; + + if (sym1->attr.pointer) + { + if (gfc_compare_types (&sym1->ts, &sym2->ts)) + return false; + } + + /* This is a conservative check on the components of the derived type + if no component references have been seen. Since we will not dig + into the components of derived type components, we play it safe by + returning false. First we check the reference chain and then, if + no component references have been seen, the components. */ + seen_component_ref = false; + if (sym1->ts.type == BT_DERIVED) + { + for (ref1 = expr1->ref; ref1; ref1 = ref1->next) + { + if (ref1->type != REF_COMPONENT) + continue; + + if (ref1->u.c.component->ts.type == BT_DERIVED) + return false; + + if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer) + && gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts)) + return false; + + seen_component_ref = true; + } + } + + if (sym1->ts.type == BT_DERIVED && !seen_component_ref) + { + for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next) + { + if (cm1->ts.type == BT_DERIVED) + return false; + + if ((sym2->attr.pointer || cm1->attr.pointer) + && gfc_compare_types (&cm1->ts, &sym2->ts)) + return false; + } + } + + return true; +} + + /* Return true if the statement body redefines the condition. Returns true if expr2 depends on expr1. expr1 should be a single term suitable for the lhs of an assignment. The IDENTICAL flag indicates @@ -726,7 +798,13 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical) /* If either variable is a pointer, assume the worst. */ /* TODO: -fassume-no-pointer-aliasing */ if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2)) - return 1; + { + if (check_data_pointer_types (expr1, expr2) + && check_data_pointer_types (expr2, expr1)) + return 0; + + return 1; + } /* Otherwise distinct symbols have no dependencies. */ return 0; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index ae39aed..2ea978d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5459,7 +5459,7 @@ array_parameter_size (tree desc, gfc_expr *expr, tree *size) /* TODO: Optimize passing g77 arrays. */ void -gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, +gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77, const gfc_symbol *fsym, const char *proc_name, tree *size) { @@ -5471,6 +5471,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, bool full_array_var; bool this_array_result; bool contiguous; + bool no_pack; gfc_symbol *sym; stmtblock_t block; gfc_ref *ref; @@ -5519,8 +5520,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, return; } - if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE - && !sym->attr.allocatable) + if (!sym->attr.pointer + && sym->as + && sym->as->type != AS_ASSUMED_SHAPE + && !sym->attr.allocatable) { /* Some variables are declared directly, others are declared as pointers and allocated on the heap. */ @@ -5547,8 +5550,32 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, } } - if (contiguous && g77 && !this_array_result - && !expr->symtree->n.sym->attr.dummy) + /* There is no need to pack and unpack the array, if it is an array + constructor or contiguous and not deferred or assumed shape. */ + no_pack = ((sym && sym->as + && !sym->attr.pointer + && sym->as->type != AS_DEFERRED + && sym->as->type != AS_ASSUMED_SHAPE) + || + (ref && ref->u.ar.as + && ref->u.ar.as->type != AS_DEFERRED + && ref->u.ar.as->type != AS_ASSUMED_SHAPE)); + + no_pack = g77 && !this_array_result + && (expr->expr_type == EXPR_ARRAY || (contiguous && no_pack)); + + if (no_pack) + { + gfc_conv_expr_descriptor (se, expr, ss); + if (expr->ts.type == BT_CHARACTER) + se->string_length = expr->ts.u.cl->backend_decl; + if (size) + array_parameter_size (se->expr, expr, size); + se->expr = gfc_conv_array_data (se->expr); + return; + } + + if (expr->expr_type == EXPR_ARRAY && g77) { gfc_conv_expr_descriptor (se, expr, ss); if (expr->ts.type == BT_CHARACTER) @@ -5601,7 +5628,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, { desc = se->expr; /* Repack the array. */ - if (gfc_option.warn_array_temp) { if (fsym) diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 6807fcb..2a6d272 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -111,7 +111,7 @@ void gfc_conv_tmp_ref (gfc_se *); /* Evaluate an array expression. */ void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *, gfc_ss *); /* Convert an array for passing as an actual function parameter. */ -void gfc_conv_array_parameter (gfc_se *, gfc_expr *, gfc_ss *, int, +void gfc_conv_array_parameter (gfc_se *, gfc_expr *, gfc_ss *, bool, const gfc_symbol *, const char *, tree *); /* Evaluate and transpose a matrix expression. */ void gfc_conv_array_transpose (gfc_se *, gfc_expr *); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 5c3aa85..276e645 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2827,18 +2827,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (!sym->attr.elemental) { gcc_assert (se->ss->type == GFC_SS_FUNCTION); - if (se->ss->useflags) - { + if (se->ss->useflags) + { gcc_assert ((!comp && gfc_return_by_reference (sym) && sym->result->attr.dimension) || (comp && comp->attr.dimension)); - gcc_assert (se->loop != NULL); + gcc_assert (se->loop != NULL); - /* Access the previously obtained result. */ - gfc_conv_tmp_array_ref (se); - gfc_advance_se_ss_chain (se); - return 0; - } + /* Access the previously obtained result. */ + gfc_conv_tmp_array_ref (se); + gfc_advance_se_ss_chain (se); + return 0; + } } info = &se->ss->data.info; } @@ -2872,9 +2872,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, e = arg->expr; fsym = formal ? formal->sym : NULL; parm_kind = MISSING; + if (e == NULL) { - if (se->ignore_optional) { /* Some intrinsics have already been resolved to the correct @@ -2883,15 +2883,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } else if (arg->label) { - has_alternate_specifier = 1; - continue; + has_alternate_specifier = 1; + continue; } else { /* Pass a NULL pointer for an absent arg. */ gfc_init_se (&parmse, NULL); parmse.expr = null_pointer_node; - if (arg->missing_arg_type == BT_CHARACTER) + if (arg->missing_arg_type == BT_CHARACTER) parmse.string_length = build_int_cst (gfc_charlen_type_node, 0); } } @@ -2906,8 +2906,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else if (se->ss && se->ss->useflags) { /* An elemental function inside a scalarized loop. */ - gfc_init_se (&parmse, se); - gfc_conv_expr_reference (&parmse, e); + gfc_init_se (&parmse, se); + gfc_conv_expr_reference (&parmse, e); parm_kind = ELEMENTAL; } else @@ -2917,7 +2917,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, argss = gfc_walk_expr (e); if (argss == gfc_ss_terminator) - { + { if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.cray_pointee && fsym && fsym->attr.flavor == FL_PROCEDURE) @@ -3028,7 +3028,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ALLOCATABLE or assumed shape, we do not use g77's calling convention, and pass the address of the array descriptor instead. Otherwise we use g77's calling convention. */ - int f; + bool f; f = (fsym != NULL) && !(fsym->attr.pointer || fsym->attr.allocatable) && fsym->as->type != AS_ASSUMED_SHAPE; @@ -5036,7 +5036,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) gfc_start_block (&se.pre); se.want_pointer = 1; - gfc_conv_array_parameter (&se, expr1, ss, 0, NULL, NULL, NULL); + gfc_conv_array_parameter (&se, expr1, ss, false, NULL, NULL, NULL); if (expr1->ts.type == BT_DERIVED && expr1->ts.u.derived->attr.alloc_comp) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 62bf146..ae60eb1 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4997,7 +4997,7 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr) if (ss == gfc_ss_terminator) gfc_conv_expr_reference (se, arg_expr); else - gfc_conv_array_parameter (se, arg_expr, ss, 1, NULL, NULL, NULL); + gfc_conv_array_parameter (se, arg_expr, ss, true, NULL, NULL, NULL); se->expr= convert (gfc_get_int_type (gfc_index_integer_kind), se->expr); /* Create a temporary variable for loc return value. Without this, diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index fd8a806..b0d0556 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -620,7 +620,7 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e) return; } - gfc_conv_array_parameter (se, e, gfc_walk_expr (e), 1, NULL, NULL, &size); + gfc_conv_array_parameter (se, e, gfc_walk_expr (e), true, NULL, NULL, &size); se->string_length = fold_convert (gfc_charlen_type_node, size); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0684638..226c755 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,15 @@ +2010-02-20 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/36932 + PR fortran/36933 + * gfortran.dg/dependency_26.f90: New test. + + PR fortran/43072 + * gfortran.dg/internal_pack_7.f90: New test. + + PR fortran/43111 + * gfortran.dg/internal_pack_8.f90: New test. + 2010-02-20 Manuel López-Ibáñez <manu@gcc.gnu.org> PR 43128 diff --git a/gcc/testsuite/gfortran.dg/dependency_26.f90 b/gcc/testsuite/gfortran.dg/dependency_26.f90 new file mode 100644 index 0000000..df909b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dependency_26.f90 @@ -0,0 +1,53 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR36932 and PR36933, in which unnecessary +! temporaries were being generated. The module m2 tests the +! additional testcase in comment #3 of PR36932. +! +! Contributed by Joost VandeVondele <jv244@cam.ac.uk> +! +MODULE M2 + IMPLICIT NONE + TYPE particle + REAL :: r(3) + END TYPE +CONTAINS + SUBROUTINE S1(p) + TYPE(particle), POINTER, DIMENSION(:) :: p + REAL :: b(3) + INTEGER :: i + b=pbc(p(i)%r) + END SUBROUTINE S1 + FUNCTION pbc(b) + REAL :: b(3) + REAL :: pbc(3) + pbc=b + END FUNCTION +END MODULE M2 + +MODULE M1 + IMPLICIT NONE + TYPE cell_type + REAL :: h(3,3) + END TYPE +CONTAINS + SUBROUTINE S1(cell) + TYPE(cell_type), POINTER :: cell + REAL :: a(3) + REAL :: b(3) = [1, 2, 3] + a=MATMUL(cell%h,b) + if (ANY (INT (a) .ne. [30, 36, 42])) call abort + END SUBROUTINE S1 +END MODULE M1 + + use M1 + TYPE(cell_type), POINTER :: cell + allocate (cell) + cell%h = reshape ([(real(i), i = 1, 9)], [3, 3]) + call s1 (cell) +end +! { dg-final { cleanup-modules "M1" } } +! { dg-final { scan-tree-dump-times "&a" 1 "original" } } +! { dg-final { scan-tree-dump-times "pack" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_7.f90 b/gcc/testsuite/gfortran.dg/internal_pack_7.f90 new file mode 100644 index 0000000..0bc30e5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_7.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR43072, in which unnecessary calls to +! internal PACK/UNPACK were being generated. +! +! Contributed by Joost VandeVondele <jv244@cam.ac.uk> +! +MODULE M1 + PRIVATE + REAL, PARAMETER :: c(2)=(/(i,i=1,2)/) +CONTAINS + ! WAS OK + SUBROUTINE S0 + real :: r + r=0 + r=S2(c) + r=S2((/(real(i),i=1,2)/)) ! See comment #1 of the PR + END SUBROUTINE S0 + ! WAS NOT OK + SUBROUTINE S1 + real :: r + r=0 + r=r+S2(c) + r=r+S2((/(real(i),i=1,2)/)) ! See comment #1 of the PR + END SUBROUTINE S1 + + FUNCTION S2(c) + REAL, INTENT(IN) :: c(2) + s2=0 + END FUNCTION S2 +END MODULE M1 +! { dg-final { cleanup-modules "M1" } } +! { dg-final { scan-tree-dump-times "pack" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_8.f90 b/gcc/testsuite/gfortran.dg/internal_pack_8.f90 new file mode 100644 index 0000000..91d6a66 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_8.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! +! Test the fix for PR43111, in which necessary calls to +! internal PACK/UNPACK were not being generated because +! of an over agressive fix to PR41113/7. +! +! Contributed by Joost VandeVondele <jv244@cam.ac.uk> +! +SUBROUTINE S2(I) + INTEGER :: I(4) + !write(6,*) I + IF (ANY(I.NE.(/3,5,7,9/))) CALL ABORT() +END SUBROUTINE S2 + +MODULE M1 + TYPE T1 + INTEGER, POINTER, DIMENSION(:) :: data + END TYPE T1 +CONTAINS + SUBROUTINE S1() + TYPE(T1) :: d + INTEGER, TARGET, DIMENSION(10) :: scratch=(/(i,i=1,10)/) + INTEGER :: i=2 + d%data=>scratch(1:9:2) +! write(6,*) d%data(i:) + CALL S2(d%data(i:)) + END SUBROUTINE S1 +END MODULE M1 + +USE M1 +CALL S1 +END +! { dg-final { cleanup-modules "M1" } } |