diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 56 |
1 files changed, 11 insertions, 45 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index df32a8a..d50ffdb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13846,31 +13846,11 @@ resolve_fl_derived (gfc_symbol *sym) } -/* Check for formatted read and write DTIO procedures. */ - -static bool -dtio_procs_present (gfc_symbol *sym) -{ - gfc_symbol *derived; - - if (sym->ts.type == BT_CLASS) - derived = CLASS_DATA (sym)->ts.u.derived; - else if (sym->ts.type == BT_DERIVED) - derived = sym->ts.u.derived; - else - return false; - - return gfc_find_specific_dtio_proc (derived, true, true) != NULL - && gfc_find_specific_dtio_proc (derived, false, true) != NULL; -} - - static bool resolve_fl_namelist (gfc_symbol *sym) { gfc_namelist *nl; gfc_symbol *nlsym; - bool dtio; for (nl = sym->namelist; nl; nl = nl->next) { @@ -13904,27 +13884,6 @@ resolve_fl_namelist (gfc_symbol *sym) sym->name, &sym->declared_at)) return false; - dtio = dtio_procs_present (nl->sym); - - if (nl->sym->ts.type == BT_CLASS && !dtio) - { - gfc_error ("NAMELIST object %qs in namelist %qs at %L is " - "polymorphic and requires a defined input/output " - "procedure", nl->sym->name, sym->name, &sym->declared_at); - return false; - } - - if (nl->sym->ts.type == BT_DERIVED - && (nl->sym->ts.u.derived->attr.alloc_comp - || nl->sym->ts.u.derived->attr.pointer_comp)) - { - if (!gfc_notify_std (GFC_STD_F2003, "NAMELIST object %qs in " - "namelist %qs at %L with ALLOCATABLE " - "or POINTER components", nl->sym->name, - sym->name, &sym->declared_at)) - return false; - return true; - } } /* Reject PRIVATE objects in a PUBLIC namelist. */ @@ -13942,10 +13901,17 @@ resolve_fl_namelist (gfc_symbol *sym) return false; } - /* If the derived type has specific DTIO procedures for both read and - write then namelist objects with private components are OK. */ - if (dtio_procs_present (nl->sym)) - continue; + if (nl->sym->ts.type == BT_DERIVED + && (nl->sym->ts.u.derived->attr.alloc_comp + || nl->sym->ts.u.derived->attr.pointer_comp)) + { + if (!gfc_notify_std (GFC_STD_F2003, "NAMELIST object %qs in " + "namelist %qs at %L with ALLOCATABLE " + "or POINTER components", nl->sym->name, + sym->name, &sym->declared_at)) + return false; + return true; + } /* Types with private components that came here by USE-association. */ if (nl->sym->ts.type == BT_DERIVED |