OSDN Git Service

PR fortran/32357
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 14 Jul 2007 23:11:04 +0000 (23:11 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 14 Jul 2007 23:11:04 +0000 (23:11 +0000)
* 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
gcc/fortran/iresolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/mvbits_2.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/intrinsics/mvbits.c

index 90a9d75..1493c65 100644 (file)
@@ -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
index 66a3c2f..22de74d 100644 (file)
@@ -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);
 }
 
index d016ec0..61b2924 100644 (file)
@@ -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 (file)
index 0000000..885002a
--- /dev/null
@@ -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
index 25b5d4c..7f4a815 100644 (file)
@@ -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
index a452fc9..8e5813c 100644 (file)
@@ -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;