diff options
| author | Tobias Burnus <burnus@net-b.de> | 2008-01-16 08:12:00 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2008-01-16 08:12:00 +0100 |
| commit | 6da0839af39d0d319e12dec89c1668549220799b (patch) | |
| tree | 3d6e8689ec77a9327690a7762e86387c72efb959 /gcc/fortran/interface.c | |
| parent | e6fbb140ba03f2fc058c9efdbb83ec00fac83881 (diff) | |
| download | gcc-6da0839af39d0d319e12dec89c1668549220799b.zip gcc-6da0839af39d0d319e12dec89c1668549220799b.tar.gz gcc-6da0839af39d0d319e12dec89c1668549220799b.tar.bz2 | |
re PR fortran/34796 (Too strict error checking for assumed-shaped array)
2008-01-16 Tobias Burnus <burnus@net-b.de>
PR fortran/34796
* interface.c (compare_parameter): Allow AS_DEFERRED array
elements and reject attr.pointer array elemenents.
(get_expr_storage_size): Return storage size of elements of
assumed-shape and pointer arrays.
2008-01-16 Tobias Burnus <burnus@net-b.de>
PR fortran/34796
* gfortran.dg/argument_checking_13.f90: New.
* gfortran.dg/argument_checking_14.f90: New.
From-SVN: r131566
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 25 |
1 files changed, 22 insertions, 3 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9057ef9..e0e3ff6 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1520,7 +1520,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, && (ref == NULL || (actual->expr_type == EXPR_VARIABLE && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE - || actual->symtree->n.sym->as->type == AS_DEFERRED)))) + || actual->symtree->n.sym->attr.pointer)))) { if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0) { @@ -1546,7 +1546,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (actual->expr_type == EXPR_VARIABLE && actual->symtree->n.sym->as && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE - || actual->symtree->n.sym->as->type == AS_DEFERRED)) + || actual->symtree->n.sym->attr.pointer)) { if (where) gfc_error ("Element of assumed-shaped array passed to dummy " @@ -1638,6 +1638,7 @@ get_expr_storage_size (gfc_expr *e) { int i; long int strlen, elements; + long int substrlen = 0; gfc_ref *ref; if (e == NULL) @@ -1672,6 +1673,16 @@ get_expr_storage_size (gfc_expr *e) for (ref = e->ref; ref; ref = ref->next) { + if (ref->type == REF_SUBSTRING && ref->u.ss.start + && ref->u.ss.start->expr_type == EXPR_CONSTANT) + { + int len = strlen; + if (ref->u.ss.end && ref->u.ss.end->expr_type == EXPR_CONSTANT) + len = mpz_get_ui (ref->u.ss.end->value.integer); + substrlen = len - mpz_get_ui (ref->u.ss.start->value.integer) + 1; + continue; + } + if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION && ref->u.ar.start && ref->u.ar.end && ref->u.ar.stride && ref->u.ar.as->upper) @@ -1729,13 +1740,21 @@ get_expr_storage_size (gfc_expr *e) else return 0; } + else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT + && e->expr_type == EXPR_VARIABLE + && (e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE + || e->symtree->n.sym->attr.pointer)) + elements = 1; else /* TODO: Determine the number of remaining elements in the element - sequence for array element designators. + sequence for array element designators. See PR 32616. See also get_array_index in data.c. */ return 0; } + if (substrlen) + return elements*substrlen; + return elements*strlen; } |