paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-26 14:50:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ test for previous fix

Browse Source 
git-svn-id: trunk@8134 -
This commit is contained in:
florian 2007-07-22 16:42:41 +00:00
parent 447276c5bb
commit a07bbc8d5f
2 changed files with 47 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8352,6 +8352,7 @@ tests/webtbs/tw9190.pp svneol=native#text/plain
tests/webtbs/tw9209.pp svneol=native#text/plain tests/webtbs/tw9209.pp svneol=native#text/plain
tests/webtbs/tw9221.pp svneol=native#text/plain tests/webtbs/tw9221.pp svneol=native#text/plain
tests/webtbs/tw9261.pp svneol=native#text/x-pascal tests/webtbs/tw9261.pp svneol=native#text/x-pascal
tests/webtbs/tw9278.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain tests/webtbs/uw0555.pp svneol=native#text/plain

46
tests/webtbs/tw9278.pp Normal file
View File

@ -0,0 +1,46 @@
{ %opt=-Co -Cr -O2 }
program ddbug;
{$mode objfpc}
const datedelta=693594;
procedure DecodeDate(Date:double; out Year, Month, Day: word);
var
ly,ld,lm,j : cardinal;
begin
if Date <= -datedelta then // If Date is before 1-1-1 then return 0-0-0
begin
Year := 0;
Month := 0;
Day := 0;
end
else
begin
j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
ly:= j DIV 146097;
j:= j - 146097 * cardinal(ly);
ld := j SHR 2;
j:=(ld SHL 2 + 3) DIV 1461;
ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
lm:=(5 * ld-3) DIV 153;
ld:= (5 * ld +2 - 153*lm) DIV 5;
ly:= 100 * cardinal(ly) + j;
if lm < 10 then
inc(lm,3)
else
begin
dec(lm,9);
inc(ly);
end;
year:=ly;
month:=lm;
day:=ld;
end;
end;
var y,m,d:word;
begin
decodedate(3.826203881944445E+004,y,m,d);
end.