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

* fixed web bug #4768 + test

Browse Source 
git-svn-id: trunk@2479 -
This commit is contained in:
Jonas Maebe 2006-02-08 19:22:26 +00:00
parent 513cbb1c6e
commit a68ca7eb2a
3 changed files with 73 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6714,6 +6714,7 @@ tests/webtbs/tw4640.pp svneol=native#text/plain
tests/webtbs/tw4669.pp svneol=native#text/plain
tests/webtbs/tw4675.pp svneol=native#text/plain
tests/webtbs/tw4700.pp svneol=native#text/plain
tests/webtbs/tw4768.pp -text
tests/webtbs/tw4781a.pp svneol=native#text/plain
tests/webtbs/tw4781b.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain

18
compiler/i386/popt386.pas
View File

@ -1986,11 +1986,20 @@ See test/tgadint64 in the test suite.
begin
if OpsEqual(taicpu(p).oper[0]^,taicpu(p).oper[1]^) then
if GetLastInstruction(p, hp1) and
(tai(hp1).typ = ait_instruction) then
(tai(hp1).typ = ait_instruction) and
GetNextInstruction(hp1,hp2) and
(hp2.typ = ait_instruction) and
((taicpu(hp2).opcode = A_SETcc) or
(taicpu(hp2).opcode = A_Jcc)) then
case taicpu(hp1).opcode Of
A_ADD, A_SUB, A_OR, A_XOR, A_AND{, A_SHL, A_SHR}:
begin
if OpsEqual(taicpu(hp1).oper[1]^,taicpu(p).oper[0]^) then
if OpsEqual(taicpu(hp1).oper[1]^,taicpu(p).oper[0]^) and
{ does not work in case of overflow for G(E)/L(E)/C_O/C_NO }
{ and in case of carry for A(E)/B(E)/C/NC }
((taicpu(hp2).condition in [C_Z,C_NZ,C_E,C_NE]) or
((taicpu(hp1).opcode <> A_ADD) and
(taicpu(hp1).opcode <> A_SUB))) then
begin
hp1 := tai(p.next);
asml.remove(p);
@ -2001,7 +2010,10 @@ See test/tgadint64 in the test suite.
end;
A_DEC, A_INC, A_NEG:
begin
if OpsEqual(taicpu(hp1).oper[0]^,taicpu(p).oper[0]^) then
if OpsEqual(taicpu(hp1).oper[0]^,taicpu(p).oper[0]^) and
{ does not work in case of overflow for G(E)/L(E)/C_O/C_NO }
{ and in case of carry for A(E)/B(E)/C/NC }
(taicpu(hp2).condition in [C_Z,C_NZ,C_E,C_NE]) then
begin
case taicpu(hp1).opcode Of
A_DEC, A_INC:

57
tests/webtbs/tw4768.pp Normal file
View File

@ -0,0 +1,57 @@
{ %OPT=-O1 }
{ Source provided for Free Pascal Bug Report 4768 }
{ Submitted by "Martin Schreiber" on 2006-02-04 }
{ e-mail: }
program project1;
{$ifdef FPC}{$mode objfpc}{$h+}{$INTERFACES CORBA}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
uses
sysutils;
function later(ref,act: cardinal): boolean;
begin
result:= not(integer(act-ref) < 0);
end;
function later1(ref,act: cardinal): boolean;
begin
result:= integer(act-ref) >= 0;
end;
function later2(ref,act: cardinal): boolean;
var
ca1: cardinal;
begin
ca1:= act-ref;
writeln(integer(ca1));
result:= integer(ca1) >= 0;
end;
function later3(ref,act: cardinal): boolean;
begin
result:= not(cardinal(ref+act) < 0);
end;
function later4(ref,act: cardinal): boolean;
begin
result:= cardinal(act+ref) >= 0;
end;
var
ca1,ca2: cardinal;
begin
ca1:= $7fffffff;
ca2:= $80000001;
if not(later(ca1,ca2)) then
halt(1);
if not(later1(ca1,ca2)) then
halt(1);
if not(later2(ca1,ca2)) then
halt(1);
if not(later3(ca1,ca2)) then
halt(1);
if not(later4(ca1,ca2)) then
halt(1);
end.