re PR libfortran/25577 (gfortran routine mvbits returns wrong answer.)
libgfortran/ 2006-02-07 Dale Ranta <dir@lanl.gov> PR fortran/25577 * intrinsics/mvbits.c: Shift '(TYPE)1' type when building 'lenmask'. testsuite/ 2006-02-07 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de> PR fortran/25577 * gfortran.dg/mvbits_1.f90: New. Also fixed Dirk Mueller's preceding ChangeLog entry. From-SVN: r110728
This commit is contained in:
parent
23fca1f587
commit
43ff4e9aa3
4 changed files with 53 additions and 4 deletions
|
@ -1,7 +1,12 @@
|
|||
2006-02-07 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
PR fortran/25577
|
||||
* gfortran.dg/mvbits_1.f90: New.
|
||||
|
||||
2006-02-07 Dirk Mueller <dmueller@suse.com>
|
||||
|
||||
g++.dg/warn/Wdiv-by-zero.C: New test.
|
||||
g++.dg/warn/Wno-div-by-zero.C: New.
|
||||
* g++.dg/warn/Wdiv-by-zero.C: New test.
|
||||
* g++.dg/warn/Wno-div-by-zero.C: New.
|
||||
|
||||
2006-02-07 Jeff Law <law@redhat.com>
|
||||
|
||||
|
|
39
gcc/testsuite/gfortran.dg/mvbits_1.f90
Normal file
39
gcc/testsuite/gfortran.dg/mvbits_1.f90
Normal file
|
@ -0,0 +1,39 @@
|
|||
! PR 25577
|
||||
! MVBITS didn't work correctly for integer types wider than a C int
|
||||
! The testcase is based on the one Dale Ranta posted in the bug report
|
||||
implicit none
|
||||
integer(1) i1,j1
|
||||
integer(2) i2,j2
|
||||
integer(4) i4,j4
|
||||
integer(8) i8,j8
|
||||
integer ibits,n
|
||||
|
||||
ibits=bit_size(1_1)
|
||||
do n=1,ibits
|
||||
i1=-1
|
||||
call mvbits(1_1, 0,n,i1,0)
|
||||
j1=-1-2_1**n+2
|
||||
if(i1.ne.j1)call abort
|
||||
enddo
|
||||
ibits=bit_size(1_2)
|
||||
do n=1,ibits
|
||||
i2=-1
|
||||
call mvbits(1_2, 0,n,i2,0)
|
||||
j2=-1-2_2**n+2
|
||||
if(i2.ne.j2)call abort
|
||||
enddo
|
||||
ibits=bit_size(1_4)
|
||||
do n=1,ibits
|
||||
i4=-1
|
||||
call mvbits(1_4, 0,n,i4,0)
|
||||
j4=-1-2_4**n+2
|
||||
if(i4.ne.j4)call abort
|
||||
enddo
|
||||
ibits=bit_size(1_8)
|
||||
do n=1,ibits
|
||||
i8=-1
|
||||
call mvbits(1_8, 0,n,i8,0)
|
||||
j8=-1-2_8**n+2
|
||||
if(i8.ne.j8)call abort
|
||||
enddo
|
||||
end
|
|
@ -1,3 +1,8 @@
|
|||
2006-02-07 Dale Ranta <dir@lanl.gov>
|
||||
|
||||
PR fortran/25577
|
||||
* intrinsics/mvbits.c: Shift '(TYPE)1' type when building 'lenmask'.
|
||||
|
||||
2006-02-07 Rainer Emrich <r.emrich@de.tecosim.com>
|
||||
|
||||
* intrinsics/c99_functions.c: Work around incompatible
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
/* Implementation of the MVBITS intrinsic
|
||||
Copyright (C) 2004 Free Software Foundation, Inc.
|
||||
Copyright (C) 2004, 2006 Free Software Foundation, Inc.
|
||||
Contributed by Tobias Schlüter
|
||||
|
||||
This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
||||
|
@ -48,7 +48,7 @@ SUB_NAME (const TYPE *from, const GFC_INTEGER_4 *frompos,
|
|||
{
|
||||
TYPE oldbits, newbits, lenmask;
|
||||
|
||||
lenmask = (*len == sizeof (TYPE)*8) ? ~(TYPE)0 : (1 << *len) - 1;
|
||||
lenmask = (*len == sizeof (TYPE)*8) ? ~(TYPE)0 : ((TYPE)1 << *len) - 1;
|
||||
newbits = (((UTYPE)(*from) >> *frompos) & lenmask) << *topos;
|
||||
oldbits = *to & (~(lenmask << *topos));
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue