2007-11-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 18 Nov 2007 20:53:16 +0000 (20:53 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 18 Nov 2007 20:53:16 +0000 (20:53 +0000)
* 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.

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

gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/fortran/iresolve.c
gcc/fortran/resolve.c
gcc/fortran/trans-expr.c
gcc/fortran/trans-intrinsic.c

index 0155ed1..8e35536 100644 (file)
@@ -1,3 +1,16 @@
+2007-11-18  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-18  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/31608
index 96ddfcd..511dce6 100644 (file)
@@ -315,13 +315,6 @@ dim_check (gfc_expr *dim, int n, bool optional)
   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_expr *shift, gfc_expr *dim)
       /* 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_expr *shift, gfc_expr *boundary,
       /* 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 4a54963..9b6337a 100644 (file)
@@ -583,13 +583,10 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
       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_expr *array, gfc_expr *shift,
       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 0d5e36e..6c9856d 100644 (file)
@@ -3445,11 +3445,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 ec5a73a..69031fb 100644 (file)
@@ -152,11 +152,21 @@ gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts)
   tree tmp;
 
   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)
+    {
+      tmp = gfc_get_int_type (gfc_default_integer_kind);
+      tmp = fold_convert (tmp, 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 * 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 bd4607d..23c94f6 100644 (file)
@@ -210,7 +210,7 @@ gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
 
       /* 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)