FETCH bug with decimal values
Having just received 4GL release 4.12UE1, I was briefly delighted
to see a number of problems disappear. Specifically bug #15976
and other unknown problems (suspect memory allocation) that have
left my executables in a core dumpy mode.
In less than 4 hours after 28 hours of recompliation and linking-
one set of problems was traded for another; the worst of which so
far is attached.
I am really in a bitchy mood today.
What else is going to come out of this pandora's box?
Does anybody else feel frustrated with this?
# 4.12UE1 & 6.0 release specific
#
# STATUS variable NOT set to notfound when
# fetching a row containing decimal columns
#
# workaround: remove decimal columns from select statement
# or
# don't use FETCH
#
# The Pentium defense. . .
# "The average user would probably only see
# this problem once every 27,000 years!"
#
database lib
main
define
ans char(1)
create temp table bug_test (code char(10), amount money(6,2))
insert into bug_test values ("first", 15.46)
insert into bug_test values ("second", 21.32)
insert into bug_test values ("third", 10.23)
prompt "TEST> (R)etch, (F)oreach:" for ans
if upshift(ans) = "R" then
call good_fetch()
call bad_fetch()
else
call good_foreach()
call bad_foreach()
end if
end main
function good_fetch()
define
str char(500),
wCode char(10),
wAmount money(6,2),
ans char(1),
fetchStatus integer,
testOk integer
let str = "select code from bug_test where 1=1 order by code"
prepare Gfetchid from str
declare Gfetchcur cursor for Gfetchid
open Gfetchcur
let testOk = FALSE
let wAmount = null
while not testOK
fetch Gfetchcur into wCode
let fetchStatus = status
display "status(", fetchStatus using "-<<<<&", ") ",
wCode clipped, ":", wAmount using "<<<&.&&"
prompt "GOOD FETCH - hit return" for ans
if fetchStatus = notfound then
exit while
end if
end while
prompt "DONE GOOD FETCH - hit return" for ans
end function
function bad_fetch()
define
str char(500),
wCode char(10),
wAmount money(6,2),
ans char(1),
fetchStatus integer,
testOk integer
let str = "select code, amount from bug_test where 1=1 order by code"
prepare Bfetchid from str
declare Bfetchcur cursor for Bfetchid
open Bfetchcur
let testOk = FALSE
let wAmount = null
while not testOK
fetch Bfetchcur into wCode, wAmount
let fetchStatus = status
display "status(", fetchStatus using "-<<<<&", ") ",
wCode clipped, ":", wAmount using "<<<&.&&"
prompt "BAD FETCH - hit return. . .FOREVER or INTERRUPT when tired" for ans
if fetchStatus = notfound then
exit while
end if
end while
end function
function good_foreach()
define
wCode char(10),
wAmount money(6,2),
ans char(1)
declare Gforeachcur cursor for
select code from bug_test where 1=1 order by code
let wAmount = null
foreach Gforeachcur into wCode
display "status(", status using "-<<<<&", ") ",
wCode clipped, ":", wAmount using "<<<&.&&"
prompt "GOOD FOREACH - hit return" for ans
end foreach
display "status(", status using "-<<<<&", ") "
prompt "DONE - GOOD FOREACH - hit return" for ans
end function
function bad_foreach()
define
wCode char(10),
wAmount money(6,2),
ans char(1)
declare Bforeachcur cursor for
select code, amount from bug_test where 1=1 order by code
foreach Bforeachcur into wCode, wAmount
display "status(", status using "-<<<<&", ") ",
wCode clipped, ":", wAmount using "<<<&.&&"
prompt "BAD FOREACH - hit return. . .FOREVER" for ans
end foreach
display "status(", status using "-<<<<&", ") "
prompt "DONE - FOREACH ISN'T BAD - hit return" for ans
end function
--
Michael J. Kuhn Consultant phone:410-254-7060
Email: kuhn@rhlab.com or kuhn%rhlab@uunet.uu.net or uunet!rhlab!kuhn
c/o Baltimore Rh Typing Laboratory, Inc. phone:410-225-9595