diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 48 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/simplify_argN_1.f90 | 26 |
4 files changed, 69 insertions, 18 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 160d602..12afa21 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2008-04-06 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/35780 + * expr.c (scalarize_intrinsic_call): Identify which argument is + an array and use that as the template. + (check_init_expr): Remove tests that first argument is an array + in the call to scalarize_intrinsic_call. + 2008-04-06 Tobias Schlüter <tobi@gcc.gnu.org> PR fortran/35832 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 329bc72..12e88a0 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1702,17 +1702,34 @@ scalarize_intrinsic_call (gfc_expr *e) gfc_actual_arglist *a, *b; gfc_constructor *args[5], *ctor, *new_ctor; gfc_expr *expr, *old; - int n, i, rank[5]; + int n, i, rank[5], array_arg; old = gfc_copy_expr (e); -/* Assume that the old expression carries the type information and - that the first arg carries all the shape information. */ - expr = gfc_copy_expr (old->value.function.actual->expr); + + /* Find which, if any, arguments are arrays. Assume that the old + expression carries the type information and that the first arg + that is an array expression carries all the shape information.*/ + n = array_arg = 0; + a = old->value.function.actual; + for (; a; a = a->next) + { + n++; + if (a->expr->expr_type != EXPR_ARRAY) + continue; + array_arg = n; + expr = gfc_copy_expr (a->expr); + break; + } + + if (!array_arg) + goto cleanup; + gfc_free_constructor (expr->value.constructor); expr->value.constructor = NULL; expr->ts = old->ts; + expr->where = old->where; expr->expr_type = EXPR_ARRAY; /* Copy the array argument constructors into an array, with nulls @@ -1745,14 +1762,11 @@ scalarize_intrinsic_call (gfc_expr *e) n++; } - for (i = 1; i < n; i++) - if (rank[i] && rank[i] != rank[0]) - goto compliance; /* Using the first argument as the master, step through the array calling the function for each element and advancing the array constructors together. */ - ctor = args[0]; + ctor = args[array_arg - 1]; new_ctor = NULL; for (; ctor; ctor = ctor->next) { @@ -1786,17 +1800,18 @@ scalarize_intrinsic_call (gfc_expr *e) b = b->next; } - /* Simplify the function calls. */ - if (gfc_simplify_expr (new_ctor->expr, 0) == FAILURE) - goto cleanup; + /* Simplify the function calls. If the simplification fails, the + error will be flagged up down-stream or the library will deal + with it. */ + gfc_simplify_expr (new_ctor->expr, 0); for (i = 0; i < n; i++) if (args[i]) args[i] = args[i]->next; for (i = 1; i < n; i++) - if (rank[i] && ((args[i] != NULL && args[0] == NULL) - || (args[i] == NULL && args[0] != NULL))) + if (rank[i] && ((args[i] != NULL && args[array_arg - 1] == NULL) + || (args[i] == NULL && args[array_arg - 1] != NULL))) goto compliance; } @@ -2187,11 +2202,8 @@ check_init_expr (gfc_expr *e) array argument. */ isym = gfc_find_function (e->symtree->n.sym->name); if (isym && isym->elemental - && e->value.function.actual->expr->expr_type == EXPR_ARRAY) - { - if ((t = scalarize_intrinsic_call (e)) == SUCCESS) - break; - } + && (t = scalarize_intrinsic_call (e)) == SUCCESS) + break; } if (m == MATCH_YES) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9f9caa6..b5b2155 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-04-06 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/35780 + * gfortran.dg/simplify_argN_1.f90: New test. + 2008-04-06 Tobias Schlüter <tobi@gcc.gnu.org> PR fortran/35832 diff --git a/gcc/testsuite/gfortran.dg/simplify_argN_1.f90 b/gcc/testsuite/gfortran.dg/simplify_argN_1.f90 new file mode 100644 index 0000000..933b1f3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/simplify_argN_1.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! Tests the fix for PR35780, in which the assignment for C was not +! scalarized in expr.c. +! +! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com> +! +MODULE MODS + integer, parameter :: N = 10 + INTEGER, PARAMETER, DIMENSION(N) :: A = [(i, i = 1, N)] + INTEGER, PARAMETER, DIMENSION(N) :: B = [(i - 5, i = 1, N)] + INTEGER, PARAMETER, DIMENSION(N) :: C = ISHFTC(3, B, 5) !ICE + INTEGER, PARAMETER, DIMENSION(N) :: D = ISHFTC(A, 3, 5) ! OK + INTEGER, PARAMETER, DIMENSION(N) :: E = ISHFTC(A, B, 5) ! OK + +END MODULE MODS + + use mods + integer, dimension(N) :: X = A + integer, dimension(N) :: Y = B + +! Check the simplifed expressions against the library + if (any (ISHFTC(3, Y, 5) /= C)) call abort () + if (any (ISHFTC(X, 3, 5) /= D)) call abort () + if (any (ISHFTC(X, Y, 5) /= E)) call abort () +end +! { dg-final { cleanup-modules "mods" } } |