[patch, fortran] PR33317 CSHIFT/EOSHIFT: Rejects optional dummy for DIM=

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This patch resolves the issues found by Dominique on PowerPC and Darwin 
platforms.  The problem was a matter of getting the correct type for conversion 
of DIM communicated to trans_expr.c

To do this, I use the representation structure in gfc_expr to pass a kind value 
forward from the resolve stage to the translation stage.  This seems consistent 
with the intended use of this structure from reading the comments in gfortran.h.

Regression tested on x86-64 and ppc.

OK for trunk?

Jerry

2007-11-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/33317
	* trans.h: Modify prototype for gfc_conv_missing_dummy.
	* trans-expr.c (gfc_conv_missing_dummy): Modify to pass an integer kind
	parameter in.  Set the type of the dummy to the kind given.
	(gfc_conv_function_call): Pass representation.length to
	gfc_conv_missing_dummy.
	* iresolve.c (gfc_resolve_cshift): Determine the correct kind to use and
	if appropriate set representation.length to this kind value.
	(gfc_resolve_eoshift): Likewise.
	* check.c (gfc_check_cshift): Enable dim_check to allow DIM as an
	optional argument. (gfc_check_eoshift): Likewise.
	* trans_intrinsic.c (gfc_conv_intrinsic_function_args): Update call to
	gfc_conv_missing_dummy.

Index: trans-expr.c
===================================================================
--- trans-expr.c	(revision 130376)
+++ trans-expr.c	(working copy)
@@ -146,7 +146,7 @@ gfc_conv_expr_present (gfc_symbol * sym)
 /* Converts a missing, dummy argument into a null or zero.  */
 
 void
-gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts)
+gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind)
 {
   tree present;
   tree tmp;
@@ -154,9 +154,16 @@ gfc_conv_missing_dummy (gfc_se * se, gfc
   present = gfc_conv_expr_present (arg->symtree->n.sym);
 
   tmp = build3 (COND_EXPR, TREE_TYPE (se->expr), present, se->expr,
-		fold_convert (TREE_TYPE (se->expr), integer_zero_node));
-
+		  fold_convert (TREE_TYPE (se->expr), integer_zero_node));
   tmp = gfc_evaluate_now (tmp, &se->pre);
+
+  if (kind > 0)
+    {
+      tmp = gfc_get_int_type (kind);
+      tmp = fold_convert (tmp, se->expr);
+      tmp = gfc_evaluate_now (tmp, &se->pre); 
+    }
+
   se->expr = tmp;
 
   if (ts.type == BT_CHARACTER)
@@ -2324,7 +2331,8 @@ gfc_conv_function_call (gfc_se * se, gfc
 	     check its presence and substitute a null if absent.  */
 	  if (e->expr_type == EXPR_VARIABLE
 	      && e->symtree->n.sym->attr.optional)
-	    gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts);
+	    gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts,
+				    e->representation.length);
 	}
 
       if (fsym && e)
Index: trans.h
===================================================================
--- trans.h	(revision 130376)
+++ trans.h	(working copy)
@@ -332,7 +332,7 @@ void gfc_conv_structure (gfc_se *, gfc_e
 /* Return an expression which determines if a dummy parameter is present.  */
 tree gfc_conv_expr_present (gfc_symbol *);
 /* Convert a missing, dummy argument into a null or zero.  */
-void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec);
+void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int);
 
 /* Generate code to allocate a string temporary.  */
 tree gfc_conv_string_tmp (gfc_se *, tree, tree);
Index: iresolve.c
===================================================================
--- iresolve.c	(revision 130376)
+++ iresolve.c	(working copy)
@@ -559,7 +559,7 @@ void
 gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 		    gfc_expr *dim)
 {
-  int n;
+  int n, m;
 
   if (array->ts.type == BT_CHARACTER && array->ref)
     gfc_resolve_substring_charlen (array);
@@ -573,22 +573,35 @@ gfc_resolve_cshift (gfc_expr *f, gfc_exp
   else
     n = 0;
 
-  /* Convert shift to at least gfc_default_integer_kind, so we don't need
-     kind=1 and kind=2 versions of the library functions.  */
-  if (shift->ts.kind < gfc_default_integer_kind)
+  /* If dim kind is greater than default integer we need to use the larger.  */
+  m = gfc_default_integer_kind;
+  if (dim != NULL)
+    m = m < dim->ts.kind ? dim->ts.kind : m;
+  
+  /* Convert shift to at least m, so we don't need
+      kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < m)
     {
       gfc_typespec ts;
       ts.type = BT_INTEGER;
-      ts.kind = gfc_default_integer_kind;
+      ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
-
+ 
   if (dim != NULL)
     {
-      gfc_resolve_dim_arg (dim);
-      /* Convert dim to shift's kind, so we don't need so many variations.  */
-      if (dim->ts.kind != shift->ts.kind)
-	gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+      if (dim->expr_type != EXPR_CONSTANT)
+	{
+	  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+	  dim->representation.length = shift->ts.kind;
+	}
+      else
+	{
+	  gfc_resolve_dim_arg (dim);
+	  /* Convert dim to shift's kind to reduce variations.  */
+	  if (dim->ts.kind != shift->ts.kind)
+	    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+        }
     }
 
   f->value.function.name
@@ -683,7 +696,7 @@ void
 gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 		     gfc_expr *boundary, gfc_expr *dim)
 {
-  int n;
+  int n, m;
 
   if (array->ts.type == BT_CHARACTER && array->ref)
     gfc_resolve_substring_charlen (array);
@@ -698,22 +711,35 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_ex
   if (boundary && boundary->rank > 0)
     n = n | 2;
 
-  /* Convert shift to at least gfc_default_integer_kind, so we don't need
-     kind=1 and kind=2 versions of the library functions.  */
-  if (shift->ts.kind < gfc_default_integer_kind)
+  /* If dim kind is greater than default integer we need to use the larger.  */
+  m = gfc_default_integer_kind;
+  if (dim != NULL)
+    m = m < dim->ts.kind ? dim->ts.kind : m;
+  
+  /* Convert shift to at least m, so we don't need
+      kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < m)
     {
       gfc_typespec ts;
       ts.type = BT_INTEGER;
-      ts.kind = gfc_default_integer_kind;
+      ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
-
+ 
   if (dim != NULL)
     {
-      gfc_resolve_dim_arg (dim);
-      /* Convert dim to shift's kind, so we don't need so many variations.  */
-      if (dim->ts.kind != shift->ts.kind)
-	gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+      if (dim->expr_type != EXPR_CONSTANT)
+	{
+	  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+	  dim->representation.length = shift->ts.kind;
+	}
+      else
+	{
+	  gfc_resolve_dim_arg (dim);
+	  /* Convert dim to shift's kind to reduce variations.  */
+	  if (dim->ts.kind != shift->ts.kind)
+	    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+        }
     }
 
   f->value.function.name
Index: check.c
===================================================================
--- check.c	(revision 130376)
+++ check.c	(working copy)
@@ -863,8 +863,7 @@ gfc_check_cshift (gfc_expr *array, gfc_e
       /* TODO: more requirements on shift parameter.  */
     }
 
-  /* FIXME (PR33317): Allow optional DIM=.  */
-  if (dim_check (dim, 2, false) == FAILURE)
+  if (dim_check (dim, 2, true) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -1033,8 +1032,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_
       /* TODO: more restrictions on boundary.  */
     }
 
-  /* FIXME (PR33317): Allow optional DIM=.  */
-  if (dim_check (dim, 4, false) == FAILURE)
+  if (dim_check (dim, 4, true) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
Index: trans-intrinsic.c
===================================================================
--- trans-intrinsic.c	(revision 130376)
+++ trans-intrinsic.c	(working copy)
@@ -214,7 +214,7 @@ gfc_conv_intrinsic_function_args (gfc_se
 	    && e->symtree->n.sym->attr.optional
 	    && formal
 	    && formal->optional)
-	gfc_conv_missing_dummy (&argse, e, formal->ts);
+	gfc_conv_missing_dummy (&argse, e, formal->ts, 0);
 
       gfc_add_block_to_block (&se->pre, &argse.pre);
       gfc_add_block_to_block (&se->post, &argse.post);

! { dg-do run }
! PR33317 CSHIFT/EOSHIFT: Rejects optional dummy for DIM=
! Test case submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
program test
 implicit none
 call sub(bound=.false., dimmy=1_8)
 call sub()
contains
 subroutine sub(bound, dimmy)
   integer(kind=8), optional :: dimmy
   logical, optional :: bound
   logical :: lotto(4)
   character(20) :: testbuf
   lotto = .false.
   lotto = cshift((/.true.,.false.,.true.,.false./),1,dim=dimmy)
   write(testbuf,*) lotto
   if (trim(testbuf).ne." F T F T") call abort
   lotto = .false.
   lotto = eoshift((/.true.,.true.,.true.,.true./),1,boundary=bound,dim=dimmy)
   lotto = eoshift(lotto,1,dim=dimmy)
   write(testbuf,*) lotto
   if (trim(testbuf).ne." T T F F") print *, testbuf
 end subroutine
end program test