Fix for bug report 38549 about wrong code generation

  for mips/mipsel and riscv32/riscv64 CPUs for
  set operators '<=' and '>='.
  New tests for this bug report.
  tw38549.pp, main source, also included
  by tw38549a.pp, tw38549b.pp, tw38459c.pp and tw38459d.pp
  with explicit {$packset X}, with X=1,2,4, or 8 added.

git-svn-id: trunk@48874 -
(cherry picked from commit 01a351f804430a1c8ed701bbb945736c3750b88f)

compiler/mips/ncpuadd.pas

@@ -36,7 +36,7 @@ type
   private
     procedure cmp64_lt(left_reg, right_reg: TRegister64;unsigned:boolean);
     procedure cmp64_le(left_reg, right_reg: TRegister64;unsigned:boolean);
-    procedure second_generic_cmp32(unsigned: boolean);
+    procedure second_generic_cmp32(unsigned,is_smallset: boolean);
     procedure second_mul64bit;
   protected
     procedure second_addfloat; override;
@@ -72,18 +72,31 @@ uses
                                tmipsaddnode
 *****************************************************************************}
 
-procedure tmipsaddnode.second_generic_cmp32(unsigned: boolean);
+procedure tmipsaddnode.second_generic_cmp32(unsigned,is_smallset: boolean);
 var
   cond: TOpCmp;
+  allow_constant : boolean;
+  dreg : tregister;
 begin
   pass_left_right;
-  force_reg_left_right(True, True);
+  allow_constant:=(not is_smallset) or not (nodetype in [lten,gten]);
+  force_reg_left_right(True, allow_constant);
   location_reset(location,LOC_FLAGS,OS_NO);
 
   cond:=cmpnode2topcmp(unsigned);
   if nf_swapped in flags then
     cond:=swap_opcmp(cond);
 
+  if is_smallset and (nodetype in [lten,gten]) then
+    begin
+      if ((nodetype=lten) and not (nf_swapped in flags)) or
+         ((nodetype=gten) and (nf_swapped in flags)) then
+        dreg:=right.location.register
+      else
+        dreg:=left.location.register;
+      current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_AND,dreg,right.location.register,left.location.register));
+      cond:=OC_EQ;
+    end;
   location.resflags.cond:=cond;
   location.resflags.reg1:=left.location.register;
   location.resflags.use_const:=(right.location.loc=LOC_CONSTANT);
@@ -300,13 +313,13 @@ end;
 
 procedure tmipsaddnode.second_cmpboolean;
 begin
-  second_generic_cmp32(true);
+  second_generic_cmp32(true,false);
 end;
 
 
 procedure tmipsaddnode.second_cmpsmallset;
 begin
-  second_generic_cmp32(true);
+  second_generic_cmp32(true,true);
 end;
 
 
@@ -315,7 +328,7 @@ var
   unsigned: boolean;
 begin
   unsigned := not (is_signed(left.resultdef)) or not (is_signed(right.resultdef));
-  second_generic_cmp32(unsigned);
+  second_generic_cmp32(unsigned,false);
 end;
 
 

tests/webtbs/tw38549.pp

@@ -0,0 +1,226 @@
+type
+
+{$ifdef SET_39}
+  {$define SET_31}
+{$endif}
+{$ifdef SET_31}
+  {$define SET_25}
+{$endif}
+{$ifdef SET_25}
+  {$define SET_23}
+{$endif}
+{$ifdef SET_23}
+  {$define SET_17}
+{$endif}
+{$ifdef SET_17}
+  {$define SET_15}
+{$endif}
+{$ifdef SET_15}
+  {$define SET_9}
+{$endif}
+
+  { options for symtables }
+  tsymtableoption = (
+    sto_has_helper,       { contains at least one helper symbol }
+    sto_has_generic,      { contains at least one generic symbol }
+    sto_has_operator,     { contains at least one operator overload }
+    sto_needs_init_final, { the symtable needs initialization and/or
+                            finalization of variables/constants }
+    sto_has_non_trivial_init, { contains at least on managed type that is not
+                               initialized to zero (e.g. a record with management
+                               operators }
+    sto_above
+{$ifdef SET_9}
+    ,sto_6
+    ,sto_7
+    ,sto_8
+    ,sto_9
+{$endif}
+{$ifdef SET_15}
+    ,sto_10
+    ,sto_11
+    ,sto_12
+    ,sto_13
+    ,sto_14
+    ,sto_15
+{$endif}
+{$ifdef SET_17}
+    ,sto_16
+    ,sto_17
+{$endif}
+{$ifdef SET_23}
+    ,sto_18
+    ,sto_19
+    ,sto_20
+    ,sto_21
+    ,sto_22
+    ,sto_23
+{$endif}
+{$ifdef SET_25}
+    ,sto_24
+    ,sto_25
+{$endif}
+{$ifdef SET_31}
+    ,sto_26
+    ,sto_27
+    ,sto_28
+    ,sto_29
+    ,sto_30
+    ,sto_31
+{$endif}
+{$ifdef SET_39}
+    ,sto_32
+    ,sto_33
+    ,sto_34
+    ,sto_35
+    ,sto_36
+    ,sto_37
+    ,sto_38
+    ,sto_39
+{$endif}
+  );
+  tsymtableoptions = set of tsymtableoption;
+
+const
+  ok_count : longint = 0;
+  error_count : longint = 0;
+
+procedure add_error;
+begin
+  writeln('New error');
+  inc(error_count);
+end; 
+
+procedure test(tableoptions : tsymtableoptions; expected : boolean);
+begin
+ if [sto_needs_init_final,sto_has_non_trivial_init] <= tableoptions then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end;
+ if tableoptions >= [sto_needs_init_final,sto_has_non_trivial_init] then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+end;
+
+procedure test2(tableoptions1, tableoptions2 : tsymtableoptions; expected : boolean);
+begin
+ if tableoptions1 <= tableoptions2 then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+end;
+
+var
+  tableoptions1, tableoptions2 : tsymtableoptions;
+
+begin
+  tableoptions1:=[];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_has_helper];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_has_non_trivial_init];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init,sto_above];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_has_non_trivial_init,sto_above];
+  test(tableoptions1,false);
+
+  tableoptions1:=[];
+  tableoptions2:=[];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,true);
+
+  tableoptions2:=[sto_has_helper];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_has_helper];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+  test2(tableoptions1,tableoptions1,true);
+  test2(tableoptions2,tableoptions2,true);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_above];
+  test2(tableoptions1,tableoptions2,false);
+  test2(tableoptions2,tableoptions1,false);
+
+  writeln('Test for sets of size : ',sizeof(tableoptions1));
+  if error_count > 0 then
+    begin
+      writeln(error_count,' test(s) failed');
+      writeln(ok_count,' test(s) OK');
+      halt(1);
+    end
+  else
+    writeln('Test OK: ',ok_count);
+end.
+

tests/webtbs/tw38549a.pp

@@ -0,0 +1,5 @@
+
+{$packset 1}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549b.pp

@@ -0,0 +1,5 @@
+
+{$packset 2}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549c.pp

@@ -0,0 +1,5 @@
+
+{$packset 4}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549d.pp

@@ -0,0 +1,5 @@
+
+{$packset 8}
+
+{$i tw38549.pp}
+