From f3e122bd997ea033ce776a5c0ec564349951abb3 Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Wed, 20 Jun 2007 17:35:04 -0400 Subject: [PATCH] backport: re PR fortran/32002 (insufficient conformance check when assigning the result of an elemental function to an array) gcc/fortran: 2007-07-20 Daniel Franke Backport from trunk: PR fortran/32002 * resolve.c (resolve_actual_arglist): Resolve actual argument after being identified as variable. gcc/testsuite: 2007-06-20 Daniel Franke Backport from trunk: PR fortran/32002 * gfortran.dg/compliant_elemental_intrinsics_2.f90: New test. From-SVN: r125898 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/resolve.c | 7 +++ gcc/testsuite/ChangeLog | 6 +++ .../compliant_elemental_intrinsics_2.f90 | 44 +++++++++++++++++++ 4 files changed, 64 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cd46f928982b..385dfd422c80 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-07-20 Daniel Franke + + Backport from trunk: + PR fortran/32002 + * resolve.c (resolve_actual_arglist): Resolve actual argument after + being identified as variable. + 2007-06-20 Paul Thomas PR fortran/32302 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 78bd4dc3b048..ab375b34fd81 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1006,6 +1006,13 @@ resolve_actual_arglist (gfc_actual_arglist * arg, procedure_type ptype) e->ref->u.ar.as = sym->as; } + /* Expressions are assigned a default ts.type of BT_PROCEDURE in + primary.c (match_actual_arg). If above code determines that it + is a variable instead, it needs to be resolved as it was not + done at the beginning of this function. */ + if (gfc_resolve_expr (e) != SUCCESS) + return FAILURE; + argument_list: /* Check argument list functions %VAL, %LOC and %REF. There is nothing to do for %REF. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ae449dc3e0e8..265e8aa083d9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-06-20 Daniel Franke + + Backport from trunk: + PR fortran/32002 + * gfortran.dg/compliant_elemental_intrinsics_2.f90: New test. + 2007-06-20 Jakub Jelinek PR inline-asm/32109 diff --git a/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 new file mode 100644 index 000000000000..ab5607f1dbc6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 @@ -0,0 +1,44 @@ +! { dg-compile } +! +! Testcases from PR32002. +! +PROGRAM test_pr32002 + + CALL test_1() ! scalar/vector + CALL test_2() ! vector/vector + CALL test_3() ! matrix/vector + CALL test_4() ! matrix/matrix + +CONTAINS + ELEMENTAL FUNCTION f(x) + INTEGER, INTENT(in) :: x + INTEGER :: f + f = x + END FUNCTION + + SUBROUTINE test_1() + INTEGER :: a = 0, b(2) = 0 + a = f(b) ! { dg-error "Incompatible ranks" } + b = f(a) ! ok, set all array elements to f(a) + END SUBROUTINE + + SUBROUTINE test_2() + INTEGER :: a(2) = 0, b(3) = 0 + a = f(b) ! { dg-error "different shape" } + a = f(b(1:2)) ! ok, slice, stride 1 + a = f(b(1:3:2)) ! ok, slice, stride 2 + END SUBROUTINE + + SUBROUTINE test_3() + INTEGER :: a(4) = 0, b(2,2) = 0 + a = f(b) ! { dg-error "Incompatible ranks" } + a = f(RESHAPE(b, (/ 4 /))) ! ok, same shape + END SUBROUTINE + + SUBROUTINE test_4() + INTEGER :: a(2,2) = 0, b(3,3) = 0 + a = f(b) ! { dg-error "different shape" } + a = f(b(1:3, 1:2)) ! { dg-error "different shape" } + a = f(b(1:3:2, 1:3:2)) ! ok, same shape + END SUBROUTINE +END PROGRAM