From 49e4d5803eefeeb9d791af1900877831ce94481a Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Sat, 11 Dec 2004 12:06:31 +0100 Subject: [PATCH] re PR fortran/17175 (set_exponent breaks with integer*8 exponent) 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. From-SVN: r92029 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/iresolve.c | 36 ++++++++++++++++++++++----- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/scale_1.f90 | 35 ++++++++++++++++++++++++++ 4 files changed, 77 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/scale_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 052e7bfcc90..8fbd01a0859 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2004-12-10 Tobias Schlueter + + 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 * intrinsic.c (gfc_convert_type_warn): Propagate the input shape diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 687421b0b6c..7a4602872f1 100644 --- 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 c4d3759bae2..5fb65ed0111 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2004-12-11 Tobias Schlueter + + PR fortran/17175 + * gfortran.dg/scale_1.f90: New test. + 2004-12-10 Andrew Pinski 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 index 00000000000..498c858e9ce --- /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 -- 2.30.2