diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 25 | ||||
| -rw-r--r-- | gcc/fortran/data.c | 15 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 23 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 24 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/io.c | 7 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 8 |
8 files changed, 90 insertions, 19 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d7da455b3d4..60b20b76970 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,28 @@ +2005-11-06 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/24534 + * resolve.c (resolve_symbol): Exclude case of PRIVATE declared + within derived type from error associated with PRIVATE type + components within derived type. + + PR fortran/20838 + PR fortran/20840 + * gfortran.h: Add prototype for gfc_has_vector_index. + * io.c (gfc_resolve_dt): Error if internal unit has a vector index. + * expr.c (gfc_has_vector_index): New function to check if any of + the array references of an expression have vector inidices. + (gfc_check_pointer_assign): Error if internal unit has a vector index. + + PR fortran/17737 + * data.c (gfc_assign_data_value): Remove gcc_assert that caused the ICE + and replace by a standard dependent warning/error if overwriting an + existing initialization. + * decl.c (gfc_data_variable): Remove old error for already initialized + variable and the unused error check for common block variables. Add + error for hots associated variable and standard dependent error for + common block variables, outside of blockdata. + * symbol.c (check_conflict): Add constraints for DATA statement. + 2005-11-06 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/24174 diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index d614db4a084..fdb98569c7a 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -315,8 +315,19 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index) expr = create_character_intializer (init, last_ts, ref, rvalue); else { - /* We should never be overwriting an existing initializer. */ - gcc_assert (!init); + /* Overwriting an existing initializer is non-standard but usually only + provokes a warning from other compilers. */ + if (init != NULL) + { + /* Order in which the expressions arrive here depends on whether they + are from data statements or F95 style declarations. Therefore, + check which is the most recent. */ + expr = (init->where.lb->linenum > rvalue->where.lb->linenum) ? + init : rvalue; + gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization " + "of '%s' at %L", symbol->name, &expr->where); + return; + } expr = gfc_copy_expr (rvalue); if (!gfc_compare_types (&lvalue->ts, &expr->ts)) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index aaad320971b..8352c527461 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -203,24 +203,19 @@ var_element (gfc_data_variable * new) sym = new->expr->symtree->n.sym; - if(sym->value != NULL) + if (!sym->attr.function && gfc_current_ns->parent && gfc_current_ns->parent == sym->ns) { - gfc_error ("Variable '%s' at %C already has an initialization", - sym->name); + gfc_error ("Host associated variable '%s' may not be in the DATA " + "statement at %C.", sym->name); return MATCH_ERROR; } -#if 0 /* TODO: Find out where to move this message */ - if (sym->attr.in_common) - /* See if sym is in the blank common block. */ - for (t = &sym->ns->blank_common; t; t = t->common_next) - if (sym == t->head) - { - gfc_error ("DATA statement at %C may not initialize variable " - "'%s' from blank COMMON", sym->name); - return MATCH_ERROR; - } -#endif + if (gfc_current_state () != COMP_BLOCK_DATA + && sym->attr.in_common + && gfc_notify_std (GFC_STD_GNU, "Extension: initialization of " + "common block variable '%s' in DATA statement at %C", + sym->name) == FAILURE) + return MATCH_ERROR; if (gfc_add_data (&sym->attr, sym->name, &new->expr->where) == FAILURE) return MATCH_ERROR; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 80099df5ad4..1ceec01eae0 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -311,6 +311,23 @@ copy_ref (gfc_ref * src) } +/* Detect whether an expression has any vector index array + references. */ + +int +gfc_has_vector_index (gfc_expr *e) +{ + gfc_ref * ref; + int i; + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + for (i = 0; i < ref->u.ar.dimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR) + return 1; + return 0; +} + + /* Copy a shape array. */ mpz_t * @@ -1962,6 +1979,13 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) return FAILURE; } + if (gfc_has_vector_index (rvalue)) + { + gfc_error ("Pointer assignment with vector subscript " + "on rhs at %L", &rvalue->where); + return FAILURE; + } + return SUCCESS; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 96bd38666ba..5626cc986a7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1790,6 +1790,7 @@ void gfc_free_ref_list (gfc_ref *); void gfc_type_convert_binary (gfc_expr *); int gfc_is_constant_expr (gfc_expr *); try gfc_simplify_expr (gfc_expr *, int); +int gfc_has_vector_index (gfc_expr *); gfc_expr *gfc_get_expr (void); void gfc_free_expr (gfc_expr *); diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 9f459c68363..183948e5788 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1787,6 +1787,13 @@ gfc_resolve_dt (gfc_dt * dt) /* Sanity checks on data transfer statements. */ if (e->ts.type == BT_CHARACTER) { + if (gfc_has_vector_index (e)) + { + gfc_error ("Internal unit with vector subscript at %L", + &e->where); + return FAILURE; + } + if (dt->rec != NULL) { gfc_error ("REC tag at %L is incompatible with internal file", diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6db0f1e6a44..50d22b0ea83 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4358,9 +4358,11 @@ resolve_symbol (gfc_symbol * sym) return; } - /* Ensure that derived type components of a public derived type - are not of a private type. */ + /* If a component of a derived type is of a type declared to be private, + either the derived type definition must contain the PRIVATE statement, + or the derived type must be private. (4.4.1 just after R427) */ if (sym->attr.flavor == FL_DERIVED + && sym->component_access != ACCESS_PRIVATE && gfc_check_access(sym->attr.access, sym->ns->default_access)) { for (c = sym->components; c; c = c->next) diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 43209e4ccae..20fb7470dff 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -264,7 +264,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where) *function = "FUNCTION", *subroutine = "SUBROUTINE", *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE", *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER", - *cray_pointee = "CRAY POINTEE"; + *cray_pointee = "CRAY POINTEE", *data = "DATA"; const char *a1, *a2; @@ -373,6 +373,12 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where) conf (cray_pointee, in_common); conf (cray_pointee, in_equivalence); + conf (data, dummy); + conf (data, function); + conf (data, result); + conf (data, allocatable); + conf (data, use_assoc); + a1 = gfc_code2string (flavors, attr->flavor); if (attr->in_namelist |
