re PR fortran/25746 (Elemental assignment gives wrong result)

2006-05-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25746
	* interface.c (gfc_extend_assign): Use new code EXEC_ASSIGN_CALL.
	* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
	* trans-stmt.c (gfc_conv_elemental_dependencies): New function.
	(gfc_trans_call): Call it.  Add new boolian argument to flag
	need for dependency checking. Assert intent OUT and IN for arg1
	and arg2.
	(gfc_trans_forall_1): Use new code EXEC_ASSIGN_CALL.
	trans-stmt.h : Modify prototype of gfc_trans_call.
	trans.c (gfc_trans_code): Add call for EXEC_ASSIGN_CALL.
	st.c (gfc_free_statement): Free actual for EXEC_ASSIGN_CALL.
	* dependency.c (gfc_check_fncall_dependency): Don't check other
	against itself.

	PR fortran/25090
	* resolve.c : Remove resolving_index_expr.
	(entry_parameter): Remove.
	(gfc_resolve_expr, resolve_charlen, resolve_fl_variable): Remove
	calls to entry_parameter and references to resolving_index_expr.

	PR fortran/27584
	* check.c (gfc_check_associated): Replace NULL assert with an
	error message, since it is possible to generate bad code that
	has us fall through to here..

	PR fortran/19015
	* iresolve.c (maxloc, minloc): If DIM is not present, pass the
	rank of ARRAY as the shape of the result.  Otherwise, pass the
	shape of ARRAY, less the dimension DIM.
	(maxval, minval): The same, when DIM is present, otherwise no
	change.

2006-05-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25746
	* gfortran.dg/elemental_subroutine_3.f90: New test.

	PR fortran/25090
	* gfortran.dg/entry_dummy_ref_1.f90: Remove.

	PR fortran/27584
	* gfortran.dg/associated_target_1.f90: New test.

	PR fortran/19015
	* gfortran.dg/maxloc_shape_1.f90: New test.

From-SVN: r113949

1 files changed, 60 insertions, 2 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecb1448..3cf84db 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1081,16 +1081,32 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
-    f->rank = 1;
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }
   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)
@@ -1125,6 +1141,7 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts = array->ts;
 
@@ -1132,6 +1149,18 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)
@@ -1188,16 +1217,32 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
-    f->rank = 1;
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }
   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)
@@ -1232,6 +1277,7 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts = array->ts;
 
@@ -1239,6 +1285,18 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)