fortran/

PR fortran/17175
* iresolve.c (gfc_resolve_scale): Convert 'I' argument if not of
same kind as C's 'int'.
(gfc_resolve_set_eponent): Convert 'I' argument if not of kind 4.

testsuite/
PR fortran/17175
* gfortran.dg/scale_1.f90: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 052e7bf..8fbd01a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2004-12-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/17175
+       * iresolve.c (gfc_resolve_scale): Convert 'I' argument if not of
+       same kind as C's 'int'.
+       (gfc_resolve_set_eponent): Convert 'I' argument if not of kind 4.
+
 2004-12-08  Richard Henderson  <rth@redhat.com>
 
        * intrinsic.c (gfc_convert_type_warn): Propagate the input shape

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 687421b..7a46028 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1196,13 +1196,24 @@ gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
 
 
 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);
+
+  /* The implementation calls scalbn which takes an int as the
+     second argument.  */
+  if (i->ts.kind != gfc_c_int_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);
 }
 
 
@@ -1223,8 +1234,21 @@ gfc_resolve_set_exponent (gfc_expr * f, gfc_expr * x, gfc_expr * i)
 {
 
   f->ts = x->ts;
-  f->value.function.name =
-    gfc_get_string ("__set_exponent_%d_%d", x->ts.kind, i->ts.kind);
+
+  /* The library implementation uses GFC_INTEGER_4 unconditionally,
+     convert type so we don't have to implment all possible
+     permutations.  */
+  if (i->ts.kind != 4)
+    {
+      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);
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c4d3759..5fb65ed 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2004-12-11  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/17175
+       * gfortran.dg/scale_1.f90: New test.
+
 2004-12-10  Andrew Pinski  <pinskia@physics.uc.edu>
 
        PR middle-end/18903

diff --git a/gcc/testsuite/gfortran.dg/scale_1.f90 b/gcc/testsuite/gfortran.dg/scale_1.f90
new file mode 100644 (file)
index 0000000..498c858
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scale_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! inspired by PR17175
+REAL X
+DOUBLE PRECISION Y
+
+INTEGER, PARAMETER :: DP = KIND(Y)
+
+INTEGER*1 I1
+INTEGER*2 I2
+INTEGER*4 I4
+INTEGER*8 I8
+
+X = 1.
+Y = 1._DP
+
+I1 = 10
+I2 = -10
+I4 = 20
+I8 = -20
+
+X = SCALE (X, I1)
+X = SCALE (X, I2)
+IF (X.NE.1.) CALL ABORT()
+X = SCALE (X, I4)
+X = SCALE (X, I8)
+IF (X.NE.1.) CALL ABORT()
+
+Y = SCALE (Y, I1)
+Y = SCALE (Y, I2)
+IF (Y.NE.1._DP) CALL ABORT()
+Y = SCALE (Y, I4)
+Y = SCALE (Y, I8)
+IF (Y.NE.1._DP) CALL ABORT()
+
+END