From c8df3e9ccbe09ae750aa04482db2dfa8a6687cea Mon Sep 17 00:00:00 2001 From: pault Date: Sun, 6 Nov 2005 20:05:12 +0000 Subject: 2005-11-06 Paul Thomas 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 Paul Thomas 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106567 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/expr.c | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'gcc/fortran/expr.c') 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; } -- cgit v1.2.3