From 1b35264faba71c070736b4e5ac148b0ea5c910c0 Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Mon, 21 May 2007 18:24:55 -0400 Subject: [PATCH] re PR fortran/32002 (insufficient conformance check when assigning the result of an elemental function to an array) gcc/fortran: 2005-05-21 Jerry DeLisle Daniel Franke PR fortran/32002 * resolve.c (resolve_actual_arglist): Resolve actual argument after being identified as variable. gcc/testsuite: 2005-05-21 Daniel Franke PR fortran/32002 * gfortran.dg/compliant_elemental_intrinsics_2.f90: New test. From-SVN: r124924 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/resolve.c | 7 +++ gcc/testsuite/ChangeLog | 5 +++ .../compliant_elemental_intrinsics_2.f90 | 44 +++++++++++++++++++ 4 files changed, 63 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ab99113b8f6..10bcc08f9b4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2005-05-21 Jerry DeLisle + Daniel Franke + + PR fortran/32002 + * resolve.c (resolve_actual_arglist): Resolve actual argument after + being identified as variable. + 2007-05-21 Francois-Xavier Coudert PR fortran/32027 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b6d1f3b9732..746d41b3315 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1013,6 +1013,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 6de884bd588..c08db442f70 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-05-21 Daniel Franke + + PR fortran/32002 + * gfortran.dg/compliant_elemental_intrinsics_2.f90: New test. + 2007-05-21 Francois-Xavier Coudert PR fortran/32027 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 00000000000..ab5607f1dbc --- /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 -- 2.30.2