diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 19 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/mvbits_2.f90 | 16 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 6 | ||||
| -rw-r--r-- | libgfortran/intrinsics/mvbits.c | 8 |
6 files changed, 53 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 90a9d75..1493c65 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/32357 + * iresolve.c (gfc_resolve_mvbits): Convert FROMPOS, LEN and TOPOS + to C int. + 2007-07-14 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/32731 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 66a3c2f..22de74d 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 d016ec0..61b2924 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/32357 + * gfortran.dg/mvbits_2.f90: New test. + 2007-07-14 Thomas Koenig <tkoenig@gcc.gnu.org> 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 0000000..885002ad --- /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 25b5d4c..7f4a815 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/32357 + * intrinsics/mvbits.c: Change prototype so that FROMPOS, LEN and + TOPOS arguments are C int. + 2007-07-09 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/32702 diff --git a/libgfortran/intrinsics/mvbits.c b/libgfortran/intrinsics/mvbits.c index a452fc9..8e5813c2 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; |