diff options
Diffstat (limited to 'gcc/fortran/io.c')
| -rw-r--r-- | gcc/fortran/io.c | 43 |
1 files changed, 30 insertions, 13 deletions
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index eb0e3ae..c902257 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1,5 +1,5 @@ /* Deal with I/O statements & related stuff. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -1234,8 +1234,11 @@ resolve_tag_format (const gfc_expr *e) /* If e's rank is zero and e is not an element of an array, it should be of integer or character type. The integer variable should be ASSIGNED. */ - if (e->symtree == NULL || e->symtree->n.sym->as == NULL - || e->symtree->n.sym->as->rank == 0) + if (e->rank == 0 + && (e->expr_type != EXPR_VARIABLE + || e->symtree == NULL + || e->symtree->n.sym->as == NULL + || e->symtree->n.sym->as->rank == 0)) { if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER) { @@ -1266,20 +1269,34 @@ resolve_tag_format (const gfc_expr *e) return SUCCESS; } - /* If rank is nonzero, we allow the type to be character under GFC_STD_GNU - and other type under GFC_STD_LEGACY. It may be assigned an Hollerith - constant. */ - if (e->ts.type == BT_CHARACTER) - { - if (gfc_notify_std (GFC_STD_GNU, "Extension: Character array " - "in FORMAT tag at %L", &e->where) == FAILURE) - return FAILURE; - } - else + /* If rank is nonzero and type is not character, we allow it under GFC_STD_LEGACY. + It may be assigned an Hollerith constant. */ + if (e->ts.type != BT_CHARACTER) { if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Non-character " "in FORMAT tag at %L", &e->where) == FAILURE) return FAILURE; + + if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE) + { + gfc_error ("Non-character assumed shape array element in FORMAT" + " tag at %L", &e->where); + return FAILURE; + } + + if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE) + { + gfc_error ("Non-character assumed size array element in FORMAT" + " tag at %L", &e->where); + return FAILURE; + } + + if (e->rank == 0 && e->symtree->n.sym->attr.pointer) + { + gfc_error ("Non-character pointer array element in FORMAT tag at %L", + &e->where); + return FAILURE; + } } return SUCCESS; |