diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-12-23 18:17:08 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-12-23 18:17:08 +0000 |
| commit | 407c9b8065621fef4502342c7ccf774271f9feb6 (patch) | |
| tree | 6d94f9d12e63cdb537bbdf4ef60b0ba7f3f36654 /gcc/fortran/resolve.c | |
| parent | 5c6d2374f58e4e2944643b231a90a85c19b296aa (diff) | |
| download | ppe42-gcc-407c9b8065621fef4502342c7ccf774271f9feb6.tar.gz ppe42-gcc-407c9b8065621fef4502342c7ccf774271f9feb6.zip | |
2007-12-23 Tobias Burnus <burnus@net-b.de>
PR fortran/34421
* resolve.c (resolve_entries): Add standard error for functions
returning characters with different length.
2007-12-23 Tobias Burnus <burnus@net-b.de>
PR fortran/34421
* gfortran.dg/entry_17.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131150 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6289d5d18d6..8fc679d9145 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -488,11 +488,28 @@ resolve_entries (gfc_namespace *ns) || (el->sym->result->attr.pointer != ns->entries->sym->result->attr.pointer)) break; - else if (as && fas && gfc_compare_array_spec (as, fas) == 0) - gfc_error ("Procedure %s at %L has entries with mismatched " + gfc_error ("Function %s at %L has entries with mismatched " "array specifications", ns->entries->sym->name, &ns->entries->sym->declared_at); + /* The characteristics need to match and thus both need to have + the same string length, i.e. both len=*, or both len=4. + Having both len=<variable> is also possible, but difficult to + check at compile time. */ + else if (ts->type == BT_CHARACTER && ts->cl && fts->cl + && (((ts->cl->length && !fts->cl->length) + ||(!ts->cl->length && fts->cl->length)) + || (ts->cl->length + && ts->cl->length->expr_type + != fts->cl->length->expr_type) + || (ts->cl->length + && ts->cl->length->expr_type == EXPR_CONSTANT + && mpz_cmp (ts->cl->length->value.integer, + fts->cl->length->value.integer) != 0))) + gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with " + "entries returning variables of different " + "string lengths", ns->entries->sym->name, + &ns->entries->sym->declared_at); } if (el == NULL) |
