diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 70 |
1 files changed, 47 insertions, 23 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9f0d675..a4a77ac 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11726,40 +11726,64 @@ resolve_fl_namelist (gfc_symbol *sym) for (nl = sym->namelist; nl; nl = nl->next) { - /* Reject namelist arrays of assumed shape. */ + /* Check again, the check in match only works if NAMELIST comes + after the decl. */ + if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SIZE) + { + gfc_error ("Assumed size array '%s' in namelist '%s' at %L is not " + "allowed", nl->sym->name, sym->name, &sym->declared_at); + return FAILURE; + } + if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE - && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' " - "must not have assumed shape in namelist " + && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST array " + "object '%s' with assumed shape in namelist " "'%s' at %L", nl->sym->name, sym->name, &sym->declared_at) == FAILURE) - return FAILURE; + return FAILURE; - /* Reject namelist arrays that are not constant shape. */ - if (is_non_constant_shape_array (nl->sym)) - { - gfc_error ("NAMELIST array object '%s' must have constant " - "shape in namelist '%s' at %L", nl->sym->name, - sym->name, &sym->declared_at); - return FAILURE; - } + if (is_non_constant_shape_array (nl->sym) + && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST array " + "object '%s' with nonconstant shape in namelist " + "'%s' at %L", nl->sym->name, sym->name, + &sym->declared_at) == FAILURE) + return FAILURE; - /* Namelist objects cannot have allocatable or pointer components. */ - if (nl->sym->ts.type != BT_DERIVED) - continue; + if (nl->sym->ts.type == BT_CHARACTER + && (nl->sym->ts.u.cl->length == NULL + || !gfc_is_constant_expr (nl->sym->ts.u.cl->length)) + && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST object " + "'%s' with nonconstant character length in " + "namelist '%s' at %L", nl->sym->name, sym->name, + &sym->declared_at) == FAILURE) + return FAILURE; - if (nl->sym->ts.u.derived->attr.alloc_comp) + /* FIXME: Once UDDTIO is implemented, the following can be + removed. */ + if (nl->sym->ts.type == BT_CLASS) { - gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot " - "have ALLOCATABLE components", - nl->sym->name, sym->name, &sym->declared_at); + gfc_error ("NAMELIST object '%s' in namelist '%s' at %L is " + "polymorphic and requires a defined input/output " + "procedure", nl->sym->name, sym->name, &sym->declared_at); return FAILURE; } - if (nl->sym->ts.u.derived->attr.pointer_comp) + if (nl->sym->ts.type == BT_DERIVED + && (nl->sym->ts.u.derived->attr.alloc_comp + || nl->sym->ts.u.derived->attr.pointer_comp)) { - gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot " - "have POINTER components", - nl->sym->name, sym->name, &sym->declared_at); + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST object " + "'%s' in namelist '%s' at %L with ALLOCATABLE " + "or POINTER components", nl->sym->name, + sym->name, &sym->declared_at) == FAILURE) + return FAILURE; + + /* FIXME: Once UDDTIO is implemented, the following can be + removed. */ + gfc_error ("NAMELIST object '%s' in namelist '%s' at %L has " + "ALLOCATABLE or POINTER components and thus requires " + "a defined input/output procedure", nl->sym->name, + sym->name, &sym->declared_at); return FAILURE; } } |