mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-03 05:10:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/33231 (Reject for -std=f* calls to elementar functions where array and scalar are mixed)

Browse Source 
2007-09-18  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33231
	* resolve.c (resolve_elemental_actual): Check for conformance
	of intent out/inout dummies.

2007-09-18  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33231
	* gfortran.dg/elemental_optional_args_1.f90: Make valid Fortran.
	* gfortran.dg/elemental_subroutine_1.f90: Ditto.
	* gfortran.dg/elemental_subroutine_5.f90: New.

From-SVN: r128570
This commit is contained in:
Tobias Burnus 2007-09-18 08:34:30 +02:00 committed by Tobias Burnus
parent 0e01499666
commit 4a96582796
6 changed files with 64 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2007-09-18 Tobias Burnus <burnus@net-b.de>
PR fortran/33231
* resolve.c (resolve_elemental_actual): Check for conformance
of intent out/inout dummies.
2007-09-17 Tobias Burnus <burnus@net-b.de>
PR fortran/33106

16
gcc/fortran/resolve.c
View File

@ -1286,6 +1286,22 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
e = arg->expr;
}
/* INTENT(OUT) is only allowed for subroutines; if any actual argument
is an array, the intent inout/out variable needs to be also an array. */
if (rank > 0 && esym && expr == NULL)
for (eformal = esym->formal, arg = arg0; arg && eformal;
arg = arg->next, eformal = eformal->next)
if ((eformal->sym->attr.intent == INTENT_OUT
|| eformal->sym->attr.intent == INTENT_INOUT)
&& arg->expr && arg->expr->rank == 0)
{
gfc_error ("Actual argument at %L for INTENT(%s) dummy '%s' of "
"ELEMENTAL subroutine '%s' is a scalar, but another "
"actual argument is an array", &arg->expr->where,
(eformal->sym->attr.intent == INTENT_OUT) ? "OUT"
: "INOUT", eformal->sym->name, esym->name);
return FAILURE;
}
return SUCCESS;
}

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2007-09-18 Tobias Burnus <burnus@net-b.de>
PR fortran/33231
* gfortran.dg/elemental_optional_args_1.f90: Make valid Fortran.
* gfortran.dg/elemental_subroutine_1.f90: Ditto.
* gfortran.dg/elemental_subroutine_5.f90: New.
2007-09-18 Richard Sandiford <rsandifo@nildram.co.uk>
* lib/target-supports.exp (check_profiling_available): Extend

8
gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
View File

@ -11,7 +11,7 @@
CALL T1(1,2)
CONTAINS
SUBROUTINE T1(A1,A2,A3)
INTEGER :: A1,A2, A4(2)
INTEGER :: A1,A2, A4(2), A5(2)
INTEGER, OPTIONAL :: A3(2)
interface
elemental function efoo (B1,B2,B3) result(bar)
@ -34,9 +34,9 @@ CONTAINS
write(6,*) efoo(A1,A3,A2)
write(6,*) efoo(A1,A4,A3)
! check an elemental subroutine
call foobar (A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
call foobar (A1,A2,A4)
call foobar (A1,A4,A4)
call foobar (A5,A2,A3) ! { dg-warning "array and OPTIONAL" }
call foobar (A5,A2,A4)
call foobar (A5,A4,A4)
END SUBROUTINE
elemental function foo (B1,B2,B3) result(bar)
INTEGER, intent(in) :: B1, B2

6
gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90
View File

@ -41,10 +41,12 @@ end module pr22146
call foobar (u, v)
if (v.ne.-42.0) call abort ()
call foobar (x, v)
if (v.ne.-2.0) call abort ()
v = 2.0
call foobar (v, x)
if (any(x /= -2.0)) call abort ()
! Test an expression in the INTENT(IN) argument
x = (/1.0, 2.0/)
call foobar (cos (x) + u, y)
if (any(abs (y + cos (x) + u) .gt. 2.0e-6)) call abort ()

27
gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90 Normal file
View File

@ -0,0 +1,27 @@
! { dg-do compile }
!
! PR fortran/33231
!
! Elemental function:
! Intent OUT/INOUT dummy: Actual needs to be an array
! if any actual is an array
!
program prog
implicit none
integer :: i, j(2)
call sub(i,1,2) ! OK, only scalar
call sub(j,1,2) ! OK, scalar IN, array OUT
call sub(j,[1,2],3) ! OK, scalar & array IN, array OUT
call sub(j,[1,2],[1,2]) ! OK, all arrays
call sub(i,1,2) ! OK, only scalar
call sub(i,[1,2],3) ! { dg-error "is a scalar" }
call sub(i,[1,2],[1,2]) ! { dg-error "is a scalar" }
contains
elemental subroutine sub(a,b,c)
integer :: func, a, b, c
intent(in) :: b,c
intent(out) :: a
a = b +c
end subroutine sub
end program prog