From 4ccd5f95f19d90935dbb048430cbc0b1fc75203f Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Sat, 14 Jul 2007 23:11:04 +0000 Subject: [PATCH] PR fortran/32357 * iresolve.c (gfc_resolve_mvbits): Convert FROMPOS, LEN and TOPOS to C int. * intrinsics/mvbits.c: Change prototype so that FROMPOS, LEN and TOPOS arguments are C int. * gfortran.dg/mvbits_2.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126646 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/iresolve.c | 19 ++++++++++++++++--- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/mvbits_2.f90 | 16 ++++++++++++++++ libgfortran/ChangeLog | 6 ++++++ libgfortran/intrinsics/mvbits.c | 8 ++++---- 6 files changed, 53 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/mvbits_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 90a9d75904b..1493c65ec4d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-07-15 Francois-Xavier Coudert + + PR fortran/32357 + * iresolve.c (gfc_resolve_mvbits): Convert FROMPOS, LEN and TOPOS + to C int. + 2007-07-14 Thomas Koenig PR libfortran/32731 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 66a3c2f52e5..22de74d49c4 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -2443,9 +2443,22 @@ void gfc_resolve_mvbits (gfc_code *c) { const char *name; - int kind; - kind = c->ext.actual->expr->ts.kind; - name = gfc_get_string (PREFIX ("mvbits_i%d"), kind); + gfc_typespec ts; + + /* FROMPOS, LEN and TOPOS are restricted to small values. As such, + they will be converted so that they fit into a C int. */ + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + if (c->ext.actual->next->expr->ts.kind != gfc_c_int_kind) + gfc_convert_type (c->ext.actual->next->expr, &ts, 2); + if (c->ext.actual->next->next->expr->ts.kind != gfc_c_int_kind) + gfc_convert_type (c->ext.actual->next->next->expr, &ts, 2); + if (c->ext.actual->next->next->next->next->expr->ts.kind != gfc_c_int_kind) + gfc_convert_type (c->ext.actual->next->next->next->next->expr, &ts, 2); + + /* TO and FROM are guaranteed to have the same kind parameter. */ + name = gfc_get_string (PREFIX ("mvbits_i%d"), + c->ext.actual->expr->ts.kind); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d016ec010dd..61b29245548 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-07-15 Francois-Xavier Coudert + + PR fortran/32357 + * gfortran.dg/mvbits_2.f90: New test. + 2007-07-14 Thomas Koenig PR libfortran/32731 diff --git a/gcc/testsuite/gfortran.dg/mvbits_2.f90 b/gcc/testsuite/gfortran.dg/mvbits_2.f90 new file mode 100644 index 00000000000..885002ad6f2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/mvbits_2.f90 @@ -0,0 +1,16 @@ +! Test for the MVBITS subroutine +! This used to fail on big-endian architectures (PR 32357) +! { dg-do run } + integer(kind=8) :: i8 = 0 + integer(kind=4) :: i4 = 0 + integer(kind=2) :: i2 = 0 + integer(kind=1) :: i1 = 0 + call mvbits (1_1, 0, 8, i1, 0) + if (i1 /= 1) call abort + call mvbits (1_2, 0, 16, i2, 0) + if (i2 /= 1) call abort + call mvbits (1_4, 0, 16, i4, 0) + if (i4 /= 1) call abort + call mvbits (1_8, 0, 16, i8, 0) + if (i8 /= 1) call abort + end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 25b5d4ca227..7f4a815a6b9 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2007-07-15 Francois-Xavier Coudert + + PR fortran/32357 + * intrinsics/mvbits.c: Change prototype so that FROMPOS, LEN and + TOPOS arguments are C int. + 2007-07-09 Jerry DeLisle PR libgfortran/32702 diff --git a/libgfortran/intrinsics/mvbits.c b/libgfortran/intrinsics/mvbits.c index a452fc98b3f..8e5813c2362 100644 --- a/libgfortran/intrinsics/mvbits.c +++ b/libgfortran/intrinsics/mvbits.c @@ -38,13 +38,13 @@ Boston, MA 02110-1301, USA. */ /* MVBITS copies LEN bits starting at bit position FROMPOS from FROM into TO, starting at bit position TOPOS. */ -extern void SUB_NAME (const TYPE *, const GFC_INTEGER_4 *, - const GFC_INTEGER_4 *, TYPE *, const GFC_INTEGER_4 *); +extern void SUB_NAME (const TYPE *, const int *, const int *, TYPE *, + const int *); export_proto(SUB_NAME); void -SUB_NAME (const TYPE *from, const GFC_INTEGER_4 *frompos, - const GFC_INTEGER_4 *len, TYPE *to, const GFC_INTEGER_4 *topos) +SUB_NAME (const TYPE *from, const int *frompos, const int *len, TYPE *to, + const int *topos) { TYPE oldbits, newbits, lenmask; -- 2.11.0