OSDN Git Service

* intrinsic.c (gfc_convert_type_warn): Propagate the input shape
authorrth <rth@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 8 Dec 2004 21:17:18 +0000 (21:17 +0000)
committerrth <rth@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 8 Dec 2004 21:17:18 +0000 (21:17 +0000)
        to the output expression.
        * iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift): Suppress
        warning conversion.
        (gfc_resolve_reshape): Force convert SHAPE and ORDER parameters
        to index kind.

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

gcc/fortran/ChangeLog
gcc/fortran/intrinsic.c
gcc/fortran/iresolve.c

index 0118549..052e7bf 100644 (file)
@@ -1,3 +1,12 @@
+2004-12-08  Richard Henderson  <rth@redhat.com>
+
+       * intrinsic.c (gfc_convert_type_warn): Propagate the input shape
+       to the output expression.
+       * iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift): Suppress
+       warning conversion.
+       (gfc_resolve_reshape): Force convert SHAPE and ORDER parameters
+       to index kind.
+
 2004-12-08  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
        PR fortran/18826
index ebf40ce..a079e86 100644 (file)
@@ -3014,6 +3014,7 @@ gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
   locus old_where;
   gfc_expr *new;
   int rank;
+  mpz_t *shape;
 
   from_ts = expr->ts;          /* expr->ts gets clobbered */
 
@@ -3050,6 +3051,8 @@ gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
   /* Insert a pre-resolved function call to the right function.  */
   old_where = expr->where;
   rank = expr->rank;
+  shape = expr->shape;
+
   new = gfc_get_expr ();
   *new = *expr;
 
@@ -3058,6 +3061,7 @@ gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
   new->value.function.isym = sym;
   new->where = old_where;
   new->rank = rank;
+  new->shape = gfc_copy_shape (shape, rank);
 
   *expr = *new;
 
index 7516875..687421b 100644 (file)
@@ -421,7 +421,7 @@ gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
       gfc_resolve_index (dim, 1);
       /* Convert dim to shift's kind, so we don't need so many variations.  */
       if (dim->ts.kind != shift->ts.kind)
-       gfc_convert_type (dim, &shift->ts, 2);
+       gfc_convert_type_warn (dim, &shift->ts, 2, 0);
     }
   f->value.function.name =
     gfc_get_string ("__cshift%d_%d", n, shift->ts.kind);
@@ -510,7 +510,7 @@ gfc_resolve_eoshift (gfc_expr * f, gfc_expr * array,
   /* Convert dim to the same type as shift, so we don't need quite so many
      variations.  */
   if (dim != NULL && dim->ts.kind != shift->ts.kind)
-    gfc_convert_type (dim, &shift->ts, 2);
+    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
 
   f->value.function.name =
     gfc_get_string ("__eoshift%d_%d", n, shift->ts.kind);
@@ -1172,6 +1172,17 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
          c = c->next;
        }
     }
+
+  /* Force-convert both SHAPE and ORDER to index_kind so that we don't need
+     so many runtime variations.  */
+  if (shape->ts.kind != gfc_index_integer_kind)
+    {
+      gfc_typespec ts = shape->ts;
+      ts.kind = gfc_index_integer_kind;
+      gfc_convert_type_warn (shape, &ts, 2, 0);
+    }
+  if (order && order->ts.kind != gfc_index_integer_kind)
+    gfc_convert_type_warn (order, &shape->ts, 2, 0);
 }