+ test for already fixed mantis #30948

git-svn-id: trunk@34928 -

.gitattributes

@@ -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

tests/webtbs/tw30948.pp

@@ -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.
+