[gfortran] Fix PR15175: Type mismatch with SCALE and SET_EXPONENT

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

SCALE and SET_EXPONENT didn't work correctly if their second rgument of
non-default integer kinds, since we would call the same function irregardless
of the kind of the actual argument.  The bug doesn't trigger on i686 due to
the fact that this architecture is high endian, and the lower word of the
argument would be read which contains the correct value.  This patch fixes
this by converting the second argument to default integer, which is harmless
as the result is undefined if the result overflows, and because default
integer is always wide enough to accomodate the whole exponent range.

Built and tested, I also verified the generated assembly in several cases.
The case of set_exponent is already tested in the testsuite, and I will add an
appropriate test for SCALE to the testsuite.

Ok?

- Tobi

Index: iresolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.23
diff -u -p -r1.23 iresolve.c
--- iresolve.c  2 Dec 2004 04:10:24 -0000       1.23
+++ iresolve.c  10 Dec 2004 14:42:58 -0000
@@ -1185,13 +1185,22 @@ gfc_resolve_rrspacing (gfc_expr * f, gfc


 void
-gfc_resolve_scale (gfc_expr * f, gfc_expr * x,
-                  gfc_expr * y ATTRIBUTE_UNUSED)
+gfc_resolve_scale (gfc_expr * f, gfc_expr * x, gfc_expr * i)
 {

   f->ts = x->ts;
-  f->value.function.name = gfc_get_string ("__scale_%d_%d", x->ts.kind,
-                                          x->ts.kind);
+
+  if (i->ts.kind != gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+
+      gfc_convert_type_warn (i, &ts, 2, 0);
+    }
+
+  f->value.function.name = gfc_get_string ("__scale_%d", x->ts.kind);
 }


@@ -1212,8 +1221,18 @@ gfc_resolve_set_exponent (gfc_expr * f,
 {

   f->ts = x->ts;
-  f->value.function.name =
-    gfc_get_string ("__set_exponent_%d_%d", x->ts.kind, i->ts.kind);
+
+  if (i->ts.kind != gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+
+      gfc_convert_type_warn (i, &ts, 2, 0);
+    }
+
+  f->value.function.name = gfc_get_string ("__set_exponent_%d", x->ts.kind);
 }