Bladeren bron

* fixed non short boolean evaluation of <64 bit bool> and/or <64 bit bool> on non-64 bit cpus
* extended test for new pas boolean types

git-svn-id: branches/pasboolxx@17841 -

florian 14 jaren geleden
bovenliggende
commit
990add9272
2 gewijzigde bestanden met toevoegingen van 487 en 12 verwijderingen
  1. 23 8
      compiler/ncgadd.pas
  2. 464 4
      tests/test/cg/taddbool.pp

+ 23 - 8
compiler/ncgadd.pas

@@ -463,15 +463,30 @@ interface
               else
                  internalerror(200203247);
             end;
-
-            if right.location.loc <> LOC_CONSTANT then
-              cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
-                 left.location.register,right.location.register,
-                 location.register)
+{$ifndef cpu64bitalu}
+            if right.location.size in [OS_64,OS_S64] then
+              begin
+                if right.location.loc <> LOC_CONSTANT then
+                  cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
+                     left.location.register64,right.location.register64,
+                     location.register64)
+                else
+                  cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
+                     right.location.value,left.location.register64,
+                     location.register64);
+              end
             else
-              cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
-                 right.location.value,left.location.register,
-                 location.register);
+{$endif cpu64bitalu}
+              begin
+                if right.location.loc <> LOC_CONSTANT then
+                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
+                     left.location.register,right.location.register,
+                     location.register)
+                else
+                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
+                     right.location.value,left.location.register,
+                     location.register);
+              end;
          end;
       end;
 

+ 464 - 4
tests/test/cg/taddbool.pp

@@ -26,6 +26,9 @@ end;
 procedure BoolTestAnd;
 var
  b1, b2: boolean;
+ b161, b162: boolean16;
+ b321, b322: boolean32;
+ b641, b642: boolean64;
  bb1, bb2: bytebool;
  wb1, wb2: wordbool;
  lb1, lb2: longbool;
@@ -62,6 +65,96 @@ begin
  else
    Fail;
 
+ { BOOLEAN16 AND BOOLEAN16 }
+ Write('boolean16 AND boolean16 test...');
+ b161 := true;
+ b162 := false;
+ if b161 and b162 then
+   result := false;
+ if b162 then
+   result := false;
+ b161 := false;
+ b162 := false;
+ if b161 and b162 then
+   result := false;
+
+ b161 := b161 and b162;
+ if b161 then
+   result := false;
+ if b161 and FALSE then
+   result := false;
+ b161 := true;
+ b162 := true;
+ if b161 and b162 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BOOLEAN32 AND BOOLEAN32 }
+ Write('boolean32 AND boolean32 test...');
+ b321 := true;
+ b322 := false;
+ if b321 and b322 then
+   result := false;
+ if b322 then
+   result := false;
+ b321 := false;
+ b322 := false;
+ if b321 and b322 then
+   result := false;
+
+ b321 := b321 and b322;
+ if b321 then
+   result := false;
+ if b321 and FALSE then
+   result := false;
+ b321 := true;
+ b322 := true;
+ if b321 and b322 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BOOLEAN64 AND BOOLEAN64 }
+ Write('boolean64 AND boolean64 test...');
+ b641 := true;
+ b642 := false;
+ if b641 and b642 then
+   result := false;
+ if b642 then
+   result := false;
+ b641 := false;
+ b642 := false;
+ if b641 and b642 then
+   result := false;
+
+ b641 := b641 and b642;
+ if b641 then
+   result := false;
+ if b641 and FALSE then
+   result := false;
+ b641 := true;
+ b642 := true;
+ if b641 and b642 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
  { BYTEBOOL AND BYTEBOOL }
  Write('bytebool AND bytebool test...');
  bb1 := true;
@@ -161,13 +254,16 @@ end;
 procedure BoolTestOr;
 var
  b1, b2: boolean;
+ b161, b162: boolean16;
+ b321, b322: boolean32;
+ b641, b642: boolean64;
  bb1, bb2: bytebool;
  wb1, wb2: wordbool;
  lb1, lb2: longbool;
  result : boolean;
 begin
  result := false;
- { BOOLEAN AND BOOLEAN }
+ { BOOLEAN OR BOOLEAN }
  Write('boolean OR boolean test...');
  b1 := true;
  b2 := false;
@@ -197,7 +293,97 @@ begin
  else
    Fail;
 
- { BYTEBOOL AND BYTEBOOL }
+ { BOOLEAN16 OR BOOLEAN16 }
+ Write('boolean16 OR boolean16 test...');
+ b161 := true;
+ b162 := false;
+ if b161 or b162 then
+   result := true;
+ b161 := false;
+ b162 := false;
+ if b161 or b162 then
+   result := false;
+
+ b161 := b161 or b162;
+ if b161 then
+   result := false;
+ if b161 or FALSE then
+   result := false;
+
+
+ b161 := true;
+ b162 := true;
+ if b161 or b162 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BOOLEAN32 OR BOOLEAN32 }
+ Write('boolean32 OR boolean32 test...');
+ b321 := true;
+ b322 := false;
+ if b321 or b322 then
+   result := true;
+ b321 := false;
+ b322 := false;
+ if b321 or b322 then
+   result := false;
+
+ b321 := b321 or b322;
+ if b321 then
+   result := false;
+ if b321 or FALSE then
+   result := false;
+
+
+ b321 := true;
+ b322 := true;
+ if b321 or b322 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BOOLEAN64 OR BOOLEAN64 }
+ Write('boolean64 OR boolean64 test...');
+ b641 := true;
+ b642 := false;
+ if b641 or b642 then
+   result := true;
+ b641 := false;
+ b642 := false;
+ if b641 or b642 then
+   result := false;
+
+ b641 := b641 or b642;
+ if b641 then
+   result := false;
+ if b641 or FALSE then
+   result := false;
+
+
+ b641 := true;
+ b642 := true;
+ if b641 or b642 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BYTEBOOL OR BYTEBOOL }
  Write('bytebool OR bytebool test...');
  bb1 := true;
  bb2 := false;
@@ -227,7 +413,7 @@ begin
  else
    Fail;
 
- { WORDBOOL AND WORDBOOL }
+ { WORDBOOL OR WORDBOOL }
  result := false;
  Write('wordbool OR wordbool test...');
  wb1 := true;
@@ -257,7 +443,7 @@ begin
  else
    Fail;
 
- { LONGBOOL AND LONGBOOL }
+ { LONGBOOL OR LONGBOOL }
  result := false;
  Write('longbool OR longbool test...');
  lb1 := true;
@@ -294,6 +480,9 @@ end;
 Procedure BoolTestXor;
 var
  b1, b2: boolean;
+ b161, b162: boolean16;
+ b321, b322: boolean32;
+ b641, b642: boolean64;
  bb1, bb2: bytebool;
  wb1, wb2: wordbool;
  lb1, lb2: longbool;
@@ -332,6 +521,102 @@ begin
       Fail;
   end;
 
+  { BOOLEAN16 XOR BOOLEAN16 }
+  Write('boolean16 XOR boolean16 test...');
+  b161 := true;
+  b162 := false;
+  if b161 xor b162 then
+    result := true;
+  b161 := false;
+  b162 := false;
+  if b161 xor b162 then
+    result := false;
+
+  b161 := b161 xor b162;
+  if b161 then
+    result := false;
+  if b161 xor FALSE then
+    result := false;
+
+
+  b161 := true;
+  b162 := true;
+  if b161 xor b162 then
+   begin
+      Fail;
+   end
+  else
+   begin
+     if result then
+       WriteLn('Success.')
+     else
+       Fail;
+   end;
+
+  { BOOLEAN32 XOR BOOLEAN32 }
+  Write('boolean32 XOR boolean32 test...');
+  b321 := true;
+  b322 := false;
+  if b321 xor b322 then
+    result := true;
+  b321 := false;
+  b322 := false;
+  if b321 xor b322 then
+    result := false;
+
+  b321 := b321 xor b322;
+  if b321 then
+    result := false;
+  if b321 xor FALSE then
+    result := false;
+
+
+  b321 := true;
+  b322 := true;
+  if b321 xor b322 then
+   begin
+      Fail;
+   end
+  else
+   begin
+     if result then
+       WriteLn('Success.')
+     else
+       Fail;
+   end;
+
+  { BOOLEAN64 XOR BOOLEAN64 }
+  Write('boolean64 XOR boolean64 test...');
+  b641 := true;
+  b642 := false;
+  if b641 xor b642 then
+    result := true;
+  b641 := false;
+  b642 := false;
+  if b641 xor b642 then
+    result := false;
+
+  b641 := b641 xor b642;
+  if b641 then
+    result := false;
+  if b641 xor FALSE then
+    result := false;
+
+
+  b641 := true;
+  b642 := true;
+  if b641 xor b642 then
+   begin
+      Fail;
+   end
+  else
+   begin
+     if result then
+       WriteLn('Success.')
+     else
+       Fail;
+   end;
+
  { BYTEBOOL XOR BYTEBOOL }
  Write('bytebool XOR bytebool test...');
  bb1 := true;
@@ -434,6 +719,9 @@ end;
 Procedure BoolTestEqual;
 var
  b1, b2, b3: boolean;
+ b161, b162, b163: boolean16;
+ b321, b322, b323: boolean32;
+ b641, b642, b643: boolean64;
  bb1, bb2, bb3: bytebool;
  wb1, wb2, wb3: wordbool;
  lb1, lb2, lb3: longbool;
@@ -441,6 +729,7 @@ var
  values : longint;
 Begin
  values := $02020202;
+
  { BOOLEAN = BOOLEAN }
  result := true;
  Write('boolean = boolean test...');
@@ -465,6 +754,82 @@ Begin
   end
  else
    Fail;
+
+ { BOOLEAN16 = BOOLEAN16 }
+ result := true;
+ Write('boolean16 = boolean16 test...');
+ b161 := true;
+ b162 := true;
+ b163 := false;
+ b161 := (b161 = b162) and (b162 and false);
+ if b161 then
+   result := false;
+ b161 := true;
+ b162 := true;
+ b163 := false;
+ b161 := (b161 = b162) and (b162 and true);
+ if not b161 then
+   result := false;
+ if b161 = b162 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BOOLEAN32 = BOOLEAN32 }
+ result := true;
+ Write('boolean32 = boolean32 test...');
+ b321 := true;
+ b322 := true;
+ b323 := false;
+ b321 := (b321 = b322) and (b322 and false);
+ if b321 then
+   result := false;
+ b321 := true;
+ b322 := true;
+ b323 := false;
+ b321 := (b321 = b322) and (b322 and true);
+ if not b321 then
+   result := false;
+ if b321 = b322 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BOOLEAN64 = BOOLEAN64 }
+ result := true;
+ Write('boolean64 = boolean64 test...');
+ b641 := true;
+ b642 := true;
+ b643 := false;
+ b641 := (b641 = b642) and (b642 and false);
+ if b641 then
+   result := false;
+ b641 := true;
+ b642 := true;
+ b643 := false;
+ b641 := (b641 = b642) and (b642 and true);
+ if not b641 then
+   result := false;
+ if b641 = b642 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
  { BYTEBOOL = BYTEBOOL }
  result := true;
  Write('bytebool = bytebool test...');
@@ -489,6 +854,7 @@ Begin
   end
  else
    Fail;
+
  { WORDBOOL = WORDBOOL }
  result := true;
  Write('wordbool = wordbool test...');
@@ -522,6 +888,7 @@ Begin
     WriteLn('Success.')
  else
     Fail;
+
  { LONGBOOL = LONGBOOL }
  result := true;
  Write('longbool = longbool test...');
@@ -561,6 +928,9 @@ end;
 Procedure BoolTestNotEqual;
 var
  b1, b2, b3: boolean;
+ b161, b162, b163: boolean16;
+ b321, b322, b323: boolean32;
+ b641, b642, b643: boolean64;
  bb1, bb2, bb3: bytebool;
  wb1, wb2, wb3: wordbool;
  lb1, lb2, lb3: longbool;
@@ -594,6 +964,94 @@ Begin
    else
      Fail;
   end;
+
+ { BOOLEAN16 <> BOOLEAN16 }
+ result := true;
+ Write('boolean16 <> boolean16 test...');
+ b161 := true;
+ b162 := true;
+ b163 := false;
+ b161 := (b161 <> b162) and (b162 <> false);
+ if b161 then
+   result := false;
+ b161 := true;
+ b162 := true;
+ b163 := false;
+ b161 := (b161 <> b162) and (b162 <> true);
+ if b161 then
+   result := false;
+ b161 := false;
+ b162 := false;
+ if b161 <> b162 then
+  begin
+      Fail;
+  end
+ else
+  begin
+   if result then
+     WriteLn('Success.')
+   else
+     Fail;
+  end;
+
+ { BOOLEAN32 <> BOOLEAN32 }
+ result := true;
+ Write('boolean32 <> boolean32 test...');
+ b321 := true;
+ b322 := true;
+ b323 := false;
+ b321 := (b321 <> b322) and (b322 <> false);
+ if b321 then
+   result := false;
+ b321 := true;
+ b322 := true;
+ b323 := false;
+ b321 := (b321 <> b322) and (b322 <> true);
+ if b321 then
+   result := false;
+ b321 := false;
+ b322 := false;
+ if b321 <> b322 then
+  begin
+      Fail;
+  end
+ else
+  begin
+   if result then
+     WriteLn('Success.')
+   else
+     Fail;
+  end;
+
+ { BOOLEAN64 <> BOOLEAN64 }
+ result := true;
+ Write('boolean64 <> boolean64 test...');
+ b641 := true;
+ b642 := true;
+ b643 := false;
+ b641 := (b641 <> b642) and (b642 <> false);
+ if b641 then
+   result := false;
+ b641 := true;
+ b642 := true;
+ b643 := false;
+ b641 := (b641 <> b642) and (b642 <> true);
+ if b641 then
+   result := false;
+ b641 := false;
+ b642 := false;
+ if b641 <> b642 then
+  begin
+      Fail;
+  end
+ else
+  begin
+   if result then
+     WriteLn('Success.')
+   else
+     Fail;
+  end;
+
  { BYTEBOOL <> BYTEBOOL }
  result := true;
  Write('bytebool <> bytebool test...');
@@ -622,6 +1080,7 @@ Begin
    else
      Fail;
   end;
+
  { WORDBOOL <> WORDBOOL }
  result := true;
  Write('wordbool <> wordbool test...');
@@ -650,6 +1109,7 @@ Begin
    else
      Fail;
   end;
+
  { LONGBOOL <> LONGBOOL }
  result := true;
  Write('longbool <> longbool test...');