Commit 59be8071 by Tobias Burnus

re PR fortran/32323 (Accepts invalid vector subscript actual argument for…

re PR fortran/32323 (Accepts invalid vector subscript actual argument for intent(out) dummy argument)

2007-06-13  Tobias Burnus  <burnus@net-b.de>

	PR fortran/32323
	* interface.c (has_vector_section): New.
	(compare_actual_formal): Check for array sections with vector subscript.

2007-06-13  Tobias Burnus  <burnus@net-b.de>

	PR fortran/32323
	* gfortran.dg/actual_array_vect_1.f90: New.

From-SVN: r125684
parent ddb4f387
2007-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/32323
* interface.c (has_vector_section): New.
(compare_actual_formal): Check for array sections with vector subscript.
2007-06-12 Dirk Mueller <dmueller@suse.de> 2007-06-12 Dirk Mueller <dmueller@suse.de>
* trans-stmt.c (gfc_trans_call): fix gcc_assert to * trans-stmt.c (gfc_trans_call): fix gcc_assert to
......
...@@ -1261,6 +1261,29 @@ compare_parameter_protected (gfc_symbol *formal, gfc_expr *actual) ...@@ -1261,6 +1261,29 @@ compare_parameter_protected (gfc_symbol *formal, gfc_expr *actual)
} }
/* Given an expression, check whether it is an array section
which has a vector subscript. If it has, one is returned,
otherwise zero. */
static int
has_vector_subscript (gfc_expr *e)
{
int i;
gfc_ref *ref;
if (e == NULL || e->rank == 0 || e->expr_type != EXPR_VARIABLE)
return 0;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
for (i = 0; i < ref->u.ar.dimen; i++)
if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
return 1;
return 0;
}
/* Given formal and actual argument lists, see if they are compatible. /* Given formal and actual argument lists, see if they are compatible.
If they are compatible, the actual argument list is sorted to If they are compatible, the actual argument list is sorted to
correspond with the formal list, and elements for missing optional correspond with the formal list, and elements for missing optional
...@@ -1471,6 +1494,19 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, ...@@ -1471,6 +1494,19 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
return 0; return 0;
} }
if ((f->sym->attr.intent == INTENT_OUT
|| f->sym->attr.intent == INTENT_INOUT
|| f->sym->attr.volatile_)
&& has_vector_subscript (a->expr))
{
if (where)
gfc_error ("Array-section actual argument with vector subscripts "
"at %L is incompatible with INTENT(IN), INTENT(INOUT) "
"or VOLATILE attribute of the dummy argument '%s'",
&a->expr->where, f->sym->name);
return 0;
}
/* C1232 (R1221) For an actual argument which is an array section or /* C1232 (R1221) For an actual argument which is an array section or
an assumed-shape array, the dummy argument shall be an assumed- an assumed-shape array, the dummy argument shall be an assumed-
shape array, if the dummy argument has the VOLATILE attribute. */ shape array, if the dummy argument has the VOLATILE attribute. */
......
2007-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/32323
* gfortran.dg/actual_array_vect_1.f90: New.
2007-06-13 Eric Botcazou <ebotcazou@libertysurf.fr> 2007-06-13 Eric Botcazou <ebotcazou@libertysurf.fr>
* gcc.target/sparc/mfpu.c: New test. * gcc.target/sparc/mfpu.c: New test.
! { dg-do compile }
! PR fortran/32323
! Array sections with vector subscripts are not allowed
! with dummy arguments which have VOLATILE or INTENT OUT/INOUT
!
! Contributed by terry@chem.gu.se
!
module mod
implicit none
contains
subroutine aa(v)
integer,dimension(:),volatile::v
write(*,*)size(v)
v=0
end subroutine aa
subroutine bb(v)
integer,dimension(:),intent(out)::v
write(*,*)size(v)
v=0
end subroutine bb
end module mod
program ff
use mod
implicit none
integer,dimension(10)::w
w=1
call aa(w(2:4))
call aa(w((/3,2,1/))) ! { dg-error "vector subscript" }
call bb(w(2:4))
call bb(w((/3,2,1/))) ! { dg-error "vector subscript" }
write(*,*)w
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment