diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-04-11 21:44:20 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-04-12 11:08:59 +0200 |
| commit | 2273fd5a6fdbe8f7da2c0e217c279bcbaaa7df9e (patch) | |
| tree | c05ecfb6ca5f331aa0d68229c84e817cecaf1615 /gcc/fortran/resolve.cc | |
| parent | c482995cc5bac4a2168ea0049041e712544e474b (diff) | |
| download | gcc-2273fd5a6fdbe8f7da2c0e217c279bcbaaa7df9e.zip gcc-2273fd5a6fdbe8f7da2c0e217c279bcbaaa7df9e.tar.gz gcc-2273fd5a6fdbe8f7da2c0e217c279bcbaaa7df9e.tar.bz2 | |
Fortran: fix functions with entry and pointer/allocatable result [PR104312]
gcc/fortran/ChangeLog:
PR fortran/104312
* resolve.cc (resolve_entries): Handle functions with ENTRY and
ALLOCATABLE results.
* trans-expr.cc (gfc_conv_procedure_call): Functions with a result
with the POINTER or ALLOCATABLE attribute shall not get any special
treatment with -ff2c, as they cannot be written in Fortran 77.
* trans-types.cc (gfc_return_by_reference): Likewise.
(gfc_get_function_type): Likewise.
gcc/testsuite/ChangeLog:
PR fortran/104312
* gfortran.dg/entry_26.f90: New test.
* gfortran.dg/entry_27.f90: New test.
Diffstat (limited to 'gcc/fortran/resolve.cc')
| -rw-r--r-- | gcc/fortran/resolve.cc | 19 |
1 files changed, 18 insertions, 1 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 6e42397..58013d4 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -702,7 +702,8 @@ resolve_entries (gfc_namespace *ns) gfc_code *c; gfc_symbol *proc; gfc_entry_list *el; - char name[GFC_MAX_SYMBOL_LEN + 1]; + /* Provide sufficient space to hold "master.%d.%s". */ + char name[GFC_MAX_SYMBOL_LEN + 1 + 18]; static int master_count = 0; if (ns->proc_name == NULL) @@ -827,6 +828,9 @@ resolve_entries (gfc_namespace *ns) "entries returning variables of different " "string lengths", ns->entries->sym->name, &ns->entries->sym->declared_at); + else if (el->sym->result->attr.allocatable + != ns->entries->sym->result->attr.allocatable) + break; } if (el == NULL) @@ -838,6 +842,8 @@ resolve_entries (gfc_namespace *ns) gfc_set_array_spec (proc, gfc_copy_array_spec (sym->as), NULL); if (sym->attr.pointer) gfc_add_pointer (&proc->attr, NULL); + if (sym->attr.allocatable) + gfc_add_allocatable (&proc->attr, NULL); } else { @@ -869,6 +875,17 @@ resolve_entries (gfc_namespace *ns) "FUNCTION %s at %L", sym->name, ns->entries->sym->name, &sym->declared_at); } + else if (sym->attr.allocatable) + { + if (el == ns->entries) + gfc_error ("FUNCTION result %s cannot be ALLOCATABLE in " + "FUNCTION %s at %L", sym->name, + ns->entries->sym->name, &sym->declared_at); + else + gfc_error ("ENTRY result %s cannot be ALLOCATABLE in " + "FUNCTION %s at %L", sym->name, + ns->entries->sym->name, &sym->declared_at); + } else { ts = &sym->ts; |