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

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This patch fixes this bug by enabling the DIM argument for these two functions 
in their respective check routines.

Then in resolve.c, the DIM argument is marked so that later in 
trans-intrinsic.c, the type can be cast to the default integer size so that it 
matches with the respective runtime library function.

The previous insertion of the type conversion was messing up the translation 
causing a segfault when a NULL (DIM argument not present) in the calling routine 
optional argument was not present.  See test case for example.

Also fixed up some white space problems found along the way.

Regression tested on x86-64.  OK for trunk?

Jerry

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

	* trans-expr.c (gfc_conv_missing_dummy): Set the type of the dummy
	argument to default integer if flagged to do so. Fix typo in comment.
	* resolve.c (gfc_resolve_dim_arg): Whitespace cleanup.
	* iresolve.c (gfc_resolve_cshift): Do not convert type, mark attribute
	for converting the DIM type appropriately in trans-expr.c.
	(gfc_resolve_eoshift): Likewise.
	* check.c (dim_check): Remove pre-existing dead code.
	(gfc_check_cshift): Enable dim_check to allow DIM as an optional.
	(gfc_check_eoshift): Likewise.
	* trans_intrinsic.c (gfc_conv_intrinsic_function_args): Fix whitespace.

Index: trans-expr.c
===================================================================
--- trans-expr.c	(revision 130266)
+++ trans-expr.c	(working copy)
@@ -149,14 +149,24 @@ void
 gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts)
 {
   tree present;
-  tree tmp;
+  tree tmp, gfc_default_int_type_node;
 
   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));
+
+  /* Make sure the type is at least default integer kind to match certain
+     runtime library functions. (ie cshift and eoshift).  */
+  if (ts.type == BT_INTEGER && arg->symtree->n.sym->attr.untyped)
+    {
+      gfc_default_int_type_node = gfc_get_int_type (gfc_default_integer_kind);
+      tmp = fold_convert (gfc_default_int_type_node, se->expr);
+    }
+  else
+    tmp = build3 (COND_EXPR, TREE_TYPE (se->expr), present, se->expr,
+		  fold_convert (TREE_TYPE (se->expr), integer_zero_node));
 
   tmp = gfc_evaluate_now (tmp, &se->pre);
   se->expr = tmp;
+
   if (ts.type == BT_CHARACTER)
     {
       tmp = build_int_cst (gfc_charlen_type_node, 0);
@@ -3400,7 +3410,7 @@ gfc_conv_expr_val (gfc_se * se, gfc_expr
     }
 }
 
-/* Helper to translate and expression and convert it to a particular type.  */
+/* Helper to translate an expression and convert it to a particular type.  */
 void
 gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree type)
 {
Index: ChangeLog
===================================================================
--- ChangeLog	(revision 130266)
+++ ChangeLog	(working copy)
@@ -1,3 +1,16 @@
+2007-11-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* trans-expr.c (gfc_conv_missing_dummy): Set the type of the dummy
+	argument to default integer if flagged to do so. Fix typo in comment.
+	* resolve.c (gfc_resolve_dim_arg): Whitespace cleanup.
+	* iresolve.c (gfc_resolve_cshift): Do not convert type, mark attribute
+	for converting the DIM type appropriately in trans-expr.c.
+	(gfc_resolve_eoshift): Likewise.
+	* check.c (dim_check): Remove pre-existing dead code.
+	(gfc_check_cshift): Enable dim_check to allow DIM as an optional.
+	(gfc_check_eoshift): Likewise.
+	* trans_intrinsic.c (gfc_conv_intrinsic_function_args): Fix whitespace.
+
 2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	* trans-types.c (gfc_init_types): Use wider buffer.
Index: resolve.c
===================================================================
--- resolve.c	(revision 130266)
+++ resolve.c	(working copy)
@@ -3443,11 +3443,13 @@ gfc_resolve_dim_arg (gfc_expr *dim)
       return FAILURE;
 
     }
+
   if (dim->ts.type != BT_INTEGER)
     {
       gfc_error ("Argument dim at %L must be of INTEGER type", &dim->where);
       return FAILURE;
     }
+
   if (dim->ts.kind != gfc_index_integer_kind)
     {
       gfc_typespec ts;
Index: iresolve.c
===================================================================
--- iresolve.c	(revision 130266)
+++ iresolve.c	(working copy)
@@ -583,13 +583,10 @@ gfc_resolve_cshift (gfc_expr *f, gfc_exp
       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);
-    }
+  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+  if (dim != NULL && dim->symtree != NULL)
+    dim->symtree->n.sym->attr.untyped = 1;
+
   f->value.function.name
     = gfc_get_string (PREFIX ("cshift%d_%d%s"), n, shift->ts.kind,
 		      array->ts.type == BT_CHARACTER ? "_char" : "");
@@ -707,13 +704,9 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_ex
       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);
-    }
+  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+  if (dim != NULL && dim->symtree != NULL)
+    dim->symtree->n.sym->attr.untyped = 1;
 
   f->value.function.name
     = gfc_get_string (PREFIX ("eoshift%d_%d%s"), n, shift->ts.kind,
Index: trans-decl.c
===================================================================
--- trans-decl.c	(revision 130266)
+++ trans-decl.c	(working copy)
@@ -886,8 +886,9 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   int byref;
 
   gcc_assert (sym->attr.referenced
-		|| sym->attr.use_assoc
-		|| sym->ns->proc_name->attr.if_source == IFSRC_IFBODY);
+	      || sym->attr.use_assoc
+	      || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY
+	      || sym->attr.if_source == IFSRC_IFBODY);
 
   if (sym->ns && sym->ns->proc_name->attr.function)
     byref = gfc_return_by_reference (sym->ns->proc_name);
Index: check.c
===================================================================
--- check.c	(revision 130266)
+++ check.c	(working copy)
@@ -315,13 +315,6 @@ dim_check (gfc_expr *dim, int n, bool op
   if (dim == NULL)
     return SUCCESS;
 
-  if (dim == NULL)
-    {
-      gfc_error ("Missing DIM parameter in intrinsic '%s' at %L",
-		 gfc_current_intrinsic, gfc_current_intrinsic_where);
-      return FAILURE;
-    }
-
   if (type_check (dim, n, BT_INTEGER) == FAILURE)
     return FAILURE;
 
@@ -870,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;
@@ -1040,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 130266)
+++ trans-intrinsic.c	(working copy)
@@ -210,7 +210,7 @@ gfc_conv_intrinsic_function_args (gfc_se
 
       /* If an optional argument is itself an optional dummy argument,
 	 check its presence and substitute a null if absent.  */
-      if (e->expr_type ==EXPR_VARIABLE
+      if (e->expr_type == EXPR_VARIABLE
 	    && e->symtree->n.sym->attr.optional
 	    && formal
 	    && formal->optional)

! { 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.,.true.,.true.,.true./), dimmy=1_8)
 call sub()
contains
 subroutine sub(bound, dimmy)
   integer(kind=8), optional :: dimmy
   logical, optional :: bound(4)
   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