paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 02:48:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ test for already fixed mantis #30948

Browse Source 
git-svn-id: trunk@34928 -
This commit is contained in:
Jonas Maebe 2016-11-20 11:44:25 +00:00
parent 10132bfafa
commit a89a4d905f
2 changed files with 48 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -15264,6 +15264,7 @@ tests/webtbs/tw30936.pp svneol=native#text/pascal
tests/webtbs/tw30936a.pp svneol=native#text/pascal
tests/webtbs/tw30936b.pp svneol=native#text/pascal
tests/webtbs/tw30936c.pp svneol=native#text/pascal
tests/webtbs/tw30948.pp svneol=native#text/plain
tests/webtbs/tw3101.pp svneol=native#text/plain
tests/webtbs/tw3104.pp svneol=native#text/plain
tests/webtbs/tw3109.pp svneol=native#text/plain

47
tests/webtbs/tw30948.pp Normal file
View File

@ -0,0 +1,47 @@
{$mode objfpc}
program BugInline;
uses
sysutils;
procedure Add64x2(HA,LA,HB,LB: QWord; out HR,LR: QWord); inline;
begin
Inc(LA,LB);
LR := LA;
HR := HA + HB + Ord(LA < LB);
end;
procedure test;
var XHA, XLA, XLB, HA1, LA1, LB1, HA2, LA2, LB2 : QWord;
begin
XHA := QWord((Random($100000000) shl 32) or Random($100000000));
XLA := QWord((Random($100000000) shl 32) or Random($100000000));
XLB := QWord((Random($100000000) shl 32) or Random($100000000));
// the bug appears only when the sum "XLA + XLB" produces a carry
XLA := XLA or QWord($8000000000000000);
XLB := XLB or QWord($8000000000000000);
HA1 := XHA;
LA1 := XLA;
LB1 := XLB;
Add64x2(HA1,LA1,0,LB1,HA1,LA1);
Writeln('LA1:HA1 = $' + IntToHex(LA1,16) + ':$' + IntToHex(HA1,16)); // OK
HA2 := XHA;
LA2 := XLA;
LB2 := XLB;
Add64x2(HA2,LB2,0,LA2,HA2,LA2);
Writeln('LA2:HA2 = $' + IntToHex(LA2,16) + ':$' + IntToHex(HA2,16)); // wrong
if HA1 <> HA2 then
begin
Writeln('HA1 and HA2 are not equal!');
halt(1);
end;
end;
begin
test;
end.