This is the mail archive of the
fortran@sources.redhat.com
mailing list for the Fortran 95 project.
[g77] patch for PR 17541
- From: Bud Davis <bdavis9659 at comcast dot net>
- To: gfortran <fortran at gcc dot gnu dot org>, "gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>, Toon Moene <toon at moene dot indiv dot nluug dot nl>
- Date: Sun, 19 Sep 2004 01:09:36 -0500
- Subject: [g77] patch for PR 17541
below patch fixes the PR, which is broken data statements with
double precision constants.
this is a regression introduced into 3.4.2 by a previous patch
of mine. this regression was not detectable with the g77 test suite
or the NIST F77 compiler validation suite.
the test below verifies the problem in the PR, as well as checks
for this problem with all data types and sizes.
tested on i686/gnu/linux with no failures on test suite.
--bud davis
program test
! check all types of data statements
! pr 17541
real r
double precision s
integer*1 ib
integer*2 ih
integer*4 iw
integer*8 id
logical*1 lb(2)
logical*2 lh(2)
logical*4 lw(2)
logical*8 ld(2)
character*1 a
character*5 b
complex c1
complex*8 c2
data r,s,ib,ih,iw,id,a,b / 1.0,2.d0,1,2,4,8,'a','xyz'/
data c1,c2 /(1.0,2.0),(1.d0,2.d0)/
data lb / .TRUE.,.FALSE. /
data lh / .TRUE.,.FALSE. /
data lw / .TRUE.,.FALSE. /
data ld / .TRUE.,.FALSE. /
logical dbug
data dbug /.FALSE./
! check the reals first
if (r.ne.1.0) then
if (dbug) print*,r, ' should be 1.0 '
call abort
endif
if (s.ne.2.d0) then
if (dbug) print*,s, ' should be 2.d0 '
call abort
endif
! now the integers
if (ib.ne.1) then
if (dbug) print*,ib, ' should be 1 '
call abort
endif
if (ih.ne.2) then
if (dbug) print*,ih, ' should be 2 '
call abort
endif
if (iw.ne.4) then
if (dbug) print*,iw, ' should be 4 '
call abort
endif
if (id.ne.8) then
if (dbug) print*,id, ' should be 8 '
call abort
endif
! complex
if (c1.ne.(1.0,2.0)) then
if (dbug) print*,c1, ' should be (1.0,2.0) '
call abort
endif
if (c2.ne.(1.d0,2.d0)) then
if (dbug) print*,c2, ' should be (1.0,2.0) '
call abort
endif
! character
if (a.ne.'a') then
if (dbug) print*,a, ' should be a '
call abort
endif
if (b.ne.'xyz') then
if (dbug) print*,b, ' should be xyz '
call abort
endif
!logicals
if (.NOT.lb(1)) then
if (dbug) print*,lb(1), ' should be .T. '
call abort
endif
if (lb(2)) then
if (dbug) print*,lb(2), ' should be .F. '
call abort
endif
if (.NOT.lh(1)) then
if (dbug) print*,lh(1), ' should be .T. '
call abort
endif
if (lh(2)) then
if (dbug) print*,lh(2), ' should be .F. '
call abort
endif
if (.NOT.lw(1)) then
if (dbug) print*,lw(1), ' should be .T. '
call abort
endif
if (lw(2)) then
if (dbug) print*,lw(2), ' should be .F. '
call abort
endif
if (.NOT.ld(1)) then
if (dbug) print*,ld(1), ' should be .T. '
call abort
endif
if (ld(2)) then
if (dbug) print*,ld(2), ' should be .F. '
call abort
endif
end
Index: gcc/gcc/f/bld.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/f/Attic/bld.c,v
retrieving revision 1.16.14.1
diff -c -3 -p -r1.16.14.1 bld.c
*** gcc/gcc/f/bld.c 12 Jul 2004 17:58:36 -0000 1.16.14.1
--- gcc/gcc/f/bld.c 19 Sep 2004 05:59:37 -0000
*************** ffebld_constant_new_real2_val (ffetarget
*** 1333,1339 ****
nc = malloc_new_kp (ffebld_constant_pool(),
"FFEBLD_constREAL2",
sizeof (*nc));
! nc->consttype = FFEBLD_constREAL1;
nc->u.real2 = val;
nc->hook = FFECOM_constantNULL;
nc->llink = NULL;
--- 1333,1339 ----
nc = malloc_new_kp (ffebld_constant_pool(),
"FFEBLD_constREAL2",
sizeof (*nc));
! nc->consttype = FFEBLD_constREAL2;
nc->u.real2 = val;
nc->hook = FFECOM_constantNULL;
nc->llink = NULL;