re PR fortran/24534 (PUBLIC derived types with private components)

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  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.

From-SVN: r106567

1 files changed, 24 insertions, 0 deletions

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;
 }