diff options
| author | Tobias Burnus <burnus@gcc.gnu.org> | 2007-06-13 22:12:40 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2007-06-13 22:12:40 +0200 |
| commit | 59be80716a573cde48aadcfeabefde101bdd4a26 (patch) | |
| tree | 8d629a99edebd9a72e01d1870806ca5ee9f3876a /gcc/fortran | |
| parent | ddb4f387ee60618b1cb04d2143b47f808f9c9e02 (diff) | |
| download | gcc-59be80716a573cde48aadcfeabefde101bdd4a26.zip gcc-59be80716a573cde48aadcfeabefde101bdd4a26.tar.gz gcc-59be80716a573cde48aadcfeabefde101bdd4a26.tar.bz2 | |
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
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 36 |
2 files changed, 42 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c6397e4..43fcc43 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +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> * trans-stmt.c (gfc_trans_call): fix gcc_assert to diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index c30b4d6..591e46e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -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. If they are compatible, the actual argument list is sorted to 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, 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 an assumed-shape array, the dummy argument shall be an assumed- shape array, if the dummy argument has the VOLATILE attribute. */ |