diff options
| -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 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 17 | ||||
| -rwxr-xr-x | gcc/testsuite/gfortran.dg/arrayio_0.f90 | 19 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/data_constraints_1.f90 | 30 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/data_constraints_2.f90 | 15 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/data_initialized.f90 | 10 | ||||
| -rwxr-xr-x | gcc/testsuite/gfortran.dg/pointer_assign_1.f90 | 17 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/private_type_2.f90 | 13 |
15 files changed, 209 insertions, 21 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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 212f2328295..0dca65ba811 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,20 @@ +2005-11-06 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/24534 + gfortran.dg/private_type_2.f90: Modified to check that case with + PRIVATE declaration within derived type is accepted. + + PR fortran/20838 + gfortran.dg/pointer_assign_1.f90: New test. + + PR fortran/20840 + * gfortran.dg/arrayio_0.f90: New test. + + PR fortran/17737 + gfortran.dg/data_initialized.f90: New test. + gfortran.dg/data_constraints_1.f90: New test. + gfortran.dg/data_constraints_2.f90: New test. + 2005-11-06 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/24174 diff --git a/gcc/testsuite/gfortran.dg/arrayio_0.f90 b/gcc/testsuite/gfortran.dg/arrayio_0.f90 new file mode 100755 index 00000000000..1331cf2edda --- /dev/null +++ b/gcc/testsuite/gfortran.dg/arrayio_0.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! Tests fix for PR20840 - would ICE with vector subscript in +! internal unit. +! +! Contributed by Paul Thomas <pault@gcc.gnu.org> +! + character(len=12), dimension(4) :: iu, buff + character(len=48), dimension(2) :: iue + equivalence (iu, iue) + integer, dimension(4) :: v = (/2,1,4,3/) + iu = (/"Vector","subscripts","not","allowed!"/) + read (iu, '(a12/)') buff + read (iue(1), '(4a12)') buff + read (iu(4:1:-1), '(a12/)') buff + read (iu(v), '(a12/)') buff ! { dg-error "with vector subscript" } + read (iu((/2,4,3,1/)), '(a12/)') buff ! { dg-error "with vector subscript" } + print *, buff + end + diff --git a/gcc/testsuite/gfortran.dg/data_constraints_1.f90 b/gcc/testsuite/gfortran.dg/data_constraints_1.f90 new file mode 100644 index 00000000000..5f11ffdbaea --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_constraints_1.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } +! Tests standard indepedendent constraints for variables in a data statement +! +! Contributed by Paul Thomas <pault@gcc.gnu.org> +! + module global + integer n + end module global + + use global + integer q + data n /0/ ! { dg-error "Cannot change attributes" } + n = 1 + n = foo (n) +contains + function foo (m) result (bar) + integer p (m), bar + integer, allocatable :: l(:) + allocate (l(1)) + data l /42/ ! { dg-error "conflicts with ALLOCATABLE" } + data p(1) /1/ ! { dg-error "non-constant array in DATA" } + data q /1/ ! { dg-error "Host associated variable" } + data m /1/ ! { dg-error "conflicts with DUMMY attribute" } + data bar /99/ ! { dg-error "conflicts with RESULT" } + end function foo + function foobar () + integer foobar + data foobar /0/ ! { dg-error "conflicts with FUNCTION" } + end function foobar +end diff --git a/gcc/testsuite/gfortran.dg/data_constraints_2.f90 b/gcc/testsuite/gfortran.dg/data_constraints_2.f90 new file mode 100644 index 00000000000..46de3c81434 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_constraints_2.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! { dg-options "-std=f95" } +! Tests constraints for variables in a data statement that are commonly +! relaxed. +! +! Contributed by Paul Thomas <pault@gcc.gnu.org> +! + common // a + common /b/ c + integer d + data a /1/ ! { dg-error "common block variable" } + data c /2/ ! { dg-error "common block variable" } + data d /3/ + data d /4/ ! { dg-error " re-initialization" } +end diff --git a/gcc/testsuite/gfortran.dg/data_initialized.f90 b/gcc/testsuite/gfortran.dg/data_initialized.f90 new file mode 100644 index 00000000000..56cf059ae36 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_initialized.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! { dg-options "-std=f95" } +! Tests fix for PR17737 - already initialized variable cannot appear +! in data statement + integer :: i, j = 1 + data i/0/ + data i/0/ ! { dg-error "Extension: re-initialization" } + data j/2/ ! { dg-error "Extension: re-initialization" } + end + diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_1.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_1.f90 new file mode 100755 index 00000000000..cfe8ad17006 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_assign_1.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! Tests fix for PR20838 - would ICE with vector subscript in +! pointer assignment. +! +! Contributed by Paul Thomas <pault@gcc.gnu.org> +! + integer, parameter, dimension(3) :: i = (/2,1,3/) + integer, dimension(3), target :: tar + integer, dimension(2, 3), target :: tar2 + integer, dimension(:), pointer :: ptr + ptr => tar + ptr => tar(3:1:-1) + ptr => tar(i) ! { dg-error "with vector subscript" } + ptr => tar2(1, :) + ptr => tar2(2, i) ! { dg-error "with vector subscript" } + end + diff --git a/gcc/testsuite/gfortran.dg/private_type_2.f90 b/gcc/testsuite/gfortran.dg/private_type_2.f90 index 6078293743f..9cb0b380703 100644 --- a/gcc/testsuite/gfortran.dg/private_type_2.f90 +++ b/gcc/testsuite/gfortran.dg/private_type_2.f90 @@ -1,5 +1,9 @@ ! { dg-do compile } -! PR16404 test 6 - A public type cannot have private-type components. +! PR16404 test 6 - 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. +! Modified on 20051105 to test PR24534. +! ! Contributed by Joost VandeVondele <jv244@cam.ac.uk> MODULE TEST PRIVATE @@ -9,7 +13,12 @@ MODULE TEST TYPE :: all_type! { dg-error "PRIVATE type and cannot be a component" } TYPE(info_type) :: info END TYPE - public all_type + TYPE :: any_type! This is OK because of the PRIVATE statement. + PRIVATE + TYPE(info_type) :: info + END TYPE + public all_type, any_type END MODULE END + |