* fixed web bug #4768 + test

git-svn-id: trunk@2479 -

.gitattributes

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

compiler/i386/popt386.pas

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

tests/webtbs/tw4768.pp

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