2010-02-20 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/36932
	PR fortran/36933
	PR fortran/43072
	PR fortran/43111
	* dependency.c (gfc_check_argument_var_dependency): Use enum
	value instead of arithmetic vaue for 'elemental'.
	(check_data_pointer_types): New function.
	(gfc_check_dependency): Call check_data_pointer_types.
	* trans-array.h : Change fourth argument of
	gfc_conv_array_parameter to boolean.
	* trans-array.c (gfc_conv_array_parameter): A contiguous array
	can be a dummy but it must not be assumed shape or deferred.
	Change fourth argument to boolean. Array constructor exprs will
	always be contiguous and do not need packing and unpacking.
	* trans-expr.c (gfc_conv_procedure_call): Clean up some white
	space and change fourth argument of gfc_conv_array_parameter
	to boolean.
	(gfc_trans_arrayfunc_assign): Change fourth argument of
	gfc_conv_array_parameter to boolean.
	* trans-io.c (gfc_convert_array_to_string): The same.
	* trans-intrinsic.c (gfc_conv_intrinsic_loc): The same.

2010-02-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/36932
	PR fortran/36933
	* gfortran.dg/dependency_26.f90: New test.

	PR fortran/43072
	* gfortran.dg/internal_pack_7.f90: New test.

	PR fortran/43111
	* gfortran.dg/internal_pack_8.f90: New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156926 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 80 insertions, 2 deletions

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index f597e6ece63..1f3d0eddd31 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -467,7 +467,7 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
       /* In case of elemental subroutines, there is no dependency 
          between two same-range array references.  */
       if (gfc_ref_needs_temporary_p (expr->ref)
-	  || gfc_check_dependency (var, expr, !elemental))
+	  || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL))
 	{
 	  if (elemental == ELEM_DONT_CHECK_VARIABLE)
 	    {
@@ -677,6 +677,78 @@ gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
 }
 
 
+/* Return true if there is no possibility of aliasing because of a type
+   mismatch between all the possible pointer references and the
+   potential target.  Note that this function is asymmetric in the
+   arguments and so must be called twice with the arguments exchanged.  */
+
+static bool
+check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
+{
+  gfc_component *cm1;
+  gfc_symbol *sym1;
+  gfc_symbol *sym2;
+  gfc_ref *ref1;
+  bool seen_component_ref;
+
+  if (expr1->expr_type != EXPR_VARIABLE
+	|| expr1->expr_type != EXPR_VARIABLE)
+    return false;
+
+  sym1 = expr1->symtree->n.sym;
+  sym2 = expr2->symtree->n.sym;
+
+  /* Keep it simple for now.  */
+  if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
+    return false;
+
+  if (sym1->attr.pointer)
+    {
+      if (gfc_compare_types (&sym1->ts, &sym2->ts))
+	return false;
+    }
+
+  /* This is a conservative check on the components of the derived type
+     if no component references have been seen.  Since we will not dig
+     into the components of derived type components, we play it safe by
+     returning false.  First we check the reference chain and then, if
+     no component references have been seen, the components.  */
+  seen_component_ref = false;
+  if (sym1->ts.type == BT_DERIVED)
+    {
+      for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
+	{
+	  if (ref1->type != REF_COMPONENT)
+	    continue;
+
+	  if (ref1->u.c.component->ts.type == BT_DERIVED)
+	    return false;
+
+	  if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
+		&& gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
+	    return false;
+
+	  seen_component_ref = true;
+	}
+    }
+
+  if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
+    {
+      for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
+	{
+	  if (cm1->ts.type == BT_DERIVED)
+	    return false;
+
+	  if ((sym2->attr.pointer || cm1->attr.pointer)
+		&& gfc_compare_types (&cm1->ts, &sym2->ts))
+	    return false;
+	}
+    }
+
+  return true;
+}
+
+
 /* Return true if the statement body redefines the condition.  Returns
    true if expr2 depends on expr1.  expr1 should be a single term
    suitable for the lhs of an assignment.  The IDENTICAL flag indicates
@@ -726,7 +798,13 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
 	  /* If either variable is a pointer, assume the worst.  */
 	  /* TODO: -fassume-no-pointer-aliasing */
 	  if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
-	    return 1;
+	    {
+	      if (check_data_pointer_types (expr1, expr2)
+		    && check_data_pointer_types (expr2, expr1))
+		return 0;
+
+	      return 1;
+	    }
 
 	  /* Otherwise distinct symbols have no dependencies.  */
 	  return 0;