Browse Source

--- Merging r43347 into '.':
C compiler/nmat.pas
--- Recording mergeinfo for merge of r43347 into '.':
G .
--- Merging r43436 into '.':
U compiler/defutil.pas
U compiler/nadd.pas
U compiler/ncnv.pas
U compiler/ncon.pas
U compiler/ngtcon.pas
U compiler/ninl.pas
G compiler/nmat.pas
U compiler/nutils.pas
U compiler/pstatmnt.pas
--- Recording mergeinfo for merge of r43436 into '.':
G .
--- Merging r43438 into '.':
A tests/test/tinlrange1.pp
A tests/test/tinlrange2.pp
A tests/test/tinlrange3.pp
--- Recording mergeinfo for merge of r43438 into '.':
G .
--- Merging r43451 into '.':
U tests/test/tinlrange1.pp
--- Recording mergeinfo for merge of r43451 into '.':
G .
--- Merging r43497 into '.':
C compiler/nmat.pas
A tests/test/tinlrange4.pp
--- Recording mergeinfo for merge of r43497 into '.':
G .

git-svn-id: branches/fixes_3_2@43498 -

Jonas Maebe 5 years ago
parent
commit
858bf743ef

+ 4 - 0
.gitattributes

@@ -13398,6 +13398,10 @@ tests/test/tinline6.pp svneol=native#text/plain
 tests/test/tinline7.pp svneol=native#text/plain
 tests/test/tinline8.pp svneol=native#text/plain
 tests/test/tinline9.pp svneol=native#text/plain
+tests/test/tinlrange1.pp svneol=native#text/plain
+tests/test/tinlrange2.pp svneol=native#text/plain
+tests/test/tinlrange3.pp svneol=native#text/plain
+tests/test/tinlrange4.pp svneol=native#text/plain
 tests/test/tint2str1.pp svneol=native#text/plain
 tests/test/tint2str2.pp svneol=native#text/plain
 tests/test/tint641.pp svneol=native#text/plain

+ 13 - 12
compiler/defutil.pas

@@ -288,17 +288,17 @@ interface
 
   type
     tperformrangecheck = (
-      rc_internal,  { never at all, internal conversion }
-      rc_explicit,  { no, but this is a user conversion and hence can still give warnings in some cases }
-      rc_default,   { only if range checking is enabled }
-      rc_always     { always }
+      rc_internal,  { nothing, internal conversion }
+      rc_explicit,  { no, but this is an explcit user conversion and hence can still give warnings in some cases (or errors in case of enums) }
+      rc_implicit,  { no, but this is an implicit conversion and hence can still give warnings/errors in some cases }
+      rc_yes        { yes }
     );
     {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range
     }
     procedure adaptrange(todef : tdef;var l : tconstexprint; rangecheck: tperformrangecheck);
-    { for when used with nf_explicit/nf_internal nodeflags }
-    procedure adaptrange(todef : tdef;var l : tconstexprint; internal, explicit: boolean);
+    { for when used with nf_explicit/nf_internal/cs_check_range nodeflags }
+    procedure adaptrange(todef : tdef;var l : tconstexprint; internal, explicit, rangecheckstate: boolean);
 
     {# Returns the range of def, where @var(l) is the low-range and @var(h) is
       the high-range.
@@ -1089,11 +1089,10 @@ implementation
          if (l<lv) or (l>hv) then
            begin
              warned:=false;
-             if rangecheck in [rc_default,rc_always] then
+             if rangecheck in [rc_implicit,rc_yes] then
                begin
-                 if (rangecheck=rc_always) or
-                    (todef.typ=enumdef) or
-                    (cs_check_range in current_settings.localswitches) then
+                 if (rangecheck=rc_yes) or
+                    (todef.typ=enumdef) then
                    Message3(type_e_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv))
                  else
                    Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));
@@ -1147,14 +1146,16 @@ implementation
       end;
 
 
-    procedure adaptrange(todef: tdef; var l: tconstexprint; internal, explicit: boolean);
+    procedure adaptrange(todef: tdef; var l: tconstexprint; internal, explicit, rangecheckstate: boolean);
       begin
         if internal then
           adaptrange(todef, l, rc_internal)
         else if explicit then
           adaptrange(todef, l, rc_explicit)
+        else if not rangecheckstate then
+          adaptrange(todef, l, rc_implicit)
         else
-          adaptrange(todef, l, rc_default)
+          adaptrange(todef, l, rc_yes)
       end;
 
 

+ 8 - 7
compiler/nadd.pas

@@ -491,7 +491,7 @@ implementation
                      t := cpointerconstnode.create(qword(v),resultdef)
                    else
                      if is_integer(ld) then
-                       t := create_simplified_ord_const(v,resultdef,forinline)
+                       t := create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
                      else
                        t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
                  end;
@@ -516,7 +516,7 @@ implementation
                        t := cpointerconstnode.create(qword(v),resultdef)
                    else
                      if is_integer(ld) then
-                       t := create_simplified_ord_const(v,resultdef,forinline)
+                       t := create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
                      else
                        t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
                  end;
@@ -530,21 +530,21 @@ implementation
                        t:=genintconstnode(0)
                      end
                    else
-                     t := create_simplified_ord_const(v,resultdef,forinline)
+                     t := create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
                  end;
                xorn :
                  if is_integer(ld) then
-                   t := create_simplified_ord_const(lv xor rv,resultdef,forinline)
+                   t := create_simplified_ord_const(lv xor rv,resultdef,forinline,false)
                  else
                    t:=cordconstnode.create(lv xor rv,resultdef,true);
                orn :
                  if is_integer(ld) then
-                   t:=create_simplified_ord_const(lv or rv,resultdef,forinline)
+                   t:=create_simplified_ord_const(lv or rv,resultdef,forinline,false)
                  else
                    t:=cordconstnode.create(lv or rv,resultdef,true);
                andn :
                  if is_integer(ld) then
-                   t:=create_simplified_ord_const(lv and rv,resultdef,forinline)
+                   t:=create_simplified_ord_const(lv and rv,resultdef,forinline,false)
                  else
                    t:=cordconstnode.create(lv and rv,resultdef,true);
                ltn :
@@ -569,7 +569,8 @@ implementation
                else
                  internalerror(2008022101);
              end;
-             include(t.flags,nf_internal);
+             if not forinline then
+               include(t.flags,nf_internal);
              result:=t;
              exit;
           end

+ 2 - 2
compiler/ncnv.pas

@@ -1458,7 +1458,7 @@ implementation
                     v:=v div 10000;
                  end
                else if (resultdef.typ in [orddef,enumdef]) then
-                 adaptrange(resultdef,v,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags);
+                 adaptrange(resultdef,v,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags,cs_check_range in localswitches);
                result:=cordconstnode.create(v,resultdef,false);
              end;
          end
@@ -3052,7 +3052,7 @@ implementation
                        { for constant values on absolute variables, swapping is required }
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,tordconstnode(left).resultdef.size);
-                       adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags);
+                       adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags,cs_check_range in localswitches);
                        { swap value back, but according to new type }
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,resultdef.size);

+ 1 - 1
compiler/ncon.pas

@@ -568,7 +568,7 @@ implementation
         { only do range checking when explicitly asked for it
           and if the type can be range checked, see tests/tbs/tb0539.pp }
         if (resultdef.typ in [orddef,enumdef]) then
-          adaptrange(resultdef,value,nf_internal in flags, not rangecheck)
+          adaptrange(resultdef,value,nf_internal in flags,not rangecheck,rangecheck)
       end;
 
     function tordconstnode.pass_1 : tnode;

+ 3 - 3
compiler/ngtcon.pas

@@ -625,7 +625,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
              begin
                 if is_constboolnode(node) then
                   begin
-                    adaptrange(def,tordconstnode(node).value,rc_default);
+                    adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
                     ftcb.emit_ord_const(tordconstnode(node).value.svalue,def)
                   end
                 else
@@ -659,7 +659,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
              begin
                 if is_constintnode(node) then
                   begin
-                    adaptrange(def,tordconstnode(node).value,rc_default);
+                    adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
                     ftcb.emit_ord_const(tordconstnode(node).value.svalue,def);
                   end
                 else
@@ -1074,7 +1074,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
             if equal_defs(node.resultdef,def) or
                is_subequal(node.resultdef,def) then
               begin
-                adaptrange(def,tordconstnode(node).value,rc_default);
+                adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
                 case longint(node.resultdef.size) of
                   1 : ftcb.emit_tai(Tai_const.Create_8bit(Byte(tordconstnode(node).value.svalue)),def);
                   2 : ftcb.emit_tai(Tai_const.Create_16bit(Word(tordconstnode(node).value.svalue)),def);

+ 7 - 7
compiler/ninl.pas

@@ -2210,14 +2210,14 @@ implementation
                case inlinenumber of
                  in_const_abs :
                    if vl.signed then
-                     hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline)
+                     hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline,false)
                    else
-                     hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline);
+                     hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline,false);
                  in_const_sqr:
                    if vl.signed then
-                     hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline)
+                     hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline,false)
                    else
-                     hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline);
+                     hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline,false);
                  in_const_odd :
                    hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool1type,true);
                  in_const_swap_word :
@@ -2434,7 +2434,7 @@ implementation
                           { the type of the original integer constant is irrelevant,
                             it should be automatically adapted to the new value
                             (except when inlining) }
-                          result:=create_simplified_ord_const(vl,resultdef,forinline)
+                          result:=create_simplified_ord_const(vl,resultdef,forinline,cs_check_range in localswitches)
                         else
                           { check the range for enums, chars, booleans }
                           result:=cordconstnode.create(vl,left.resultdef,not(nf_internal in flags));
@@ -2776,9 +2776,9 @@ implementation
                  (index.left.nodetype = ordconstn) and
                  not is_special_array(unpackedarraydef) then
                 begin
-                  adaptrange(unpackedarraydef,tordconstnode(index.left).value,rc_default);
+                  adaptrange(unpackedarraydef,tordconstnode(index.left).value,false,false,cs_check_range in current_settings.localswitches);
                   tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
-                  adaptrange(unpackedarraydef,tempindex,rc_default);
+                  adaptrange(unpackedarraydef,tempindex,false,false,cs_check_range in current_settings.localswitches);
                 end;
             end;
 

+ 39 - 48
compiler/nmat.pas

@@ -162,17 +162,17 @@ implementation
                 if nf_isomod in flags then
                   begin
                     if lv>=0 then
-                      result:=create_simplified_ord_const(lv mod rv,resultdef,forinline)
+                      result:=create_simplified_ord_const(lv mod rv,resultdef,forinline,false)
                     else
                       if ((-lv) mod rv)=0 then
-                        result:=create_simplified_ord_const((-lv) mod rv,resultdef,forinline)
+                        result:=create_simplified_ord_const((-lv) mod rv,resultdef,forinline,false)
                       else
-                        result:=create_simplified_ord_const(rv-((-lv) mod rv),resultdef,forinline);
+                        result:=create_simplified_ord_const(rv-((-lv) mod rv),resultdef,forinline,false);
                   end
                 else
-                  result:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
+                  result:=create_simplified_ord_const(lv mod rv,resultdef,forinline,false);
               divn:
-                result:=create_simplified_ord_const(lv div rv,resultdef,forinline);
+                result:=create_simplified_ord_const(lv div rv,resultdef,forinline,cs_check_overflow in localswitches);
             end;
          end;
       end;
@@ -705,30 +705,32 @@ implementation
               rvalue:=tordconstnode(right).value;
             if is_constintnode(left) then
                begin
+                 lvalue:=tordconstnode(left).value;
+                 case nodetype of
+                    shrn:
+                      lvalue:=tordconstnode(left).value shr rvalue;
+                    shln:
+                      lvalue:=tordconstnode(left).value shl rvalue;
+                    else
+                      internalerror(2019050517);
+                 end;
                  if forinline then
                    begin
                      { shl/shr are unsigned operations, so cut off upper bits }
                      case resultdef.size of
                        1:
-                         lvalue:=tordconstnode(left).value and byte($ff);
+                         lvalue:=lvalue and byte($ff);
                        2:
-                         lvalue:=tordconstnode(left).value and word($ffff);
+                         lvalue:=lvalue and word($ffff);
                        4:
-                         lvalue:=tordconstnode(left).value and dword($ffffffff);
+                         lvalue:=lvalue and dword($ffffffff);
                        8:
-                         lvalue:=tordconstnode(left).value and qword($ffffffffffffffff);
+                         lvalue:=lvalue and qword($ffffffffffffffff);
                        else
                          internalerror(2013122301);
                      end;
-                   end
-                 else
-                   lvalue:=tordconstnode(left).value;
-                 case nodetype of
-                    shrn:
-                      result:=create_simplified_ord_const(lvalue shr rvalue,resultdef,forinline);
-                    shln:
-                      result:=create_simplified_ord_const(lvalue shl rvalue,resultdef,forinline);
-                 end;
+                   end;
+                 result:=create_simplified_ord_const(lvalue,resultdef,forinline,false);
                end
             else if rvalue=0 then
               begin
@@ -739,19 +741,22 @@ implementation
         else if is_constintnode(left) then
           begin
             lvalue:=tordconstnode(left).value;
-            { shl/shr are unsigned operations, so cut off upper bits }
-            case resultdef.size of
-              1:
-                lvalue:=tordconstnode(left).value and byte($ff);
-              2:
-                lvalue:=tordconstnode(left).value and word($ffff);
-              4:
-                lvalue:=tordconstnode(left).value and dword($ffffffff);
-              8:
-                lvalue:=tordconstnode(left).value and qword($ffffffffffffffff);
-              else
-                internalerror(2013122301);
-            end;
+            if forinline then
+              begin
+                { shl/shr are unsigned operations, so cut off upper bits }
+                case resultdef.size of
+                  1:
+                    lvalue:=tordconstnode(left).value and byte($ff);
+                  2:
+                    lvalue:=tordconstnode(left).value and word($ffff);
+                  4:
+                    lvalue:=tordconstnode(left).value and dword($ffffffff);
+                  8:
+                    lvalue:=tordconstnode(left).value and qword($ffffffffffffffff);
+                  else
+                    internalerror(2013122301);
+                end;
+              end;
             { '0 shl x' and '0 shr x' are 0 }
             if (lvalue=0) and
                ((cs_opt_level4 in current_settings.optimizerswitches) or
@@ -878,8 +883,6 @@ implementation
 
 
     function tshlshrnode.pass_1 : tnode;
-      var
-         regs : longint;
       begin
          result:=nil;
          firstpass(left);
@@ -888,23 +891,11 @@ implementation
            exit;
 
 {$ifndef cpu64bitalu}
+         expectloc:=LOC_REGISTER;
          { 64 bit ints have their own shift handling }
          if is_64bit(left.resultdef) then
-           begin
-             result := first_shlshr64bitint;
-             if assigned(result) then
-               exit;
-             regs:=2;
-           end
-         else
+           result := first_shlshr64bitint;
 {$endif not cpu64bitalu}
-           begin
-             regs:=1
-           end;
-
-         if (right.nodetype<>ordconstn) then
-           inc(regs);
-         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -924,7 +915,7 @@ implementation
         { constant folding }
         if is_constintnode(left) then
           begin
-             result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline);
+             result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline,cs_check_overflow in localswitches);
              exit;
           end;
         if is_constrealnode(left) then

+ 3 - 3
compiler/nutils.pas

@@ -93,7 +93,7 @@ interface
       which was determined during an earlier typecheck pass (because the value
       may e.g. be a parameter to a call, which needs to be of the declared
       parameter type) }
-    function create_simplified_ord_const(const value: tconstexprint; def: tdef; forinline: boolean): tnode;
+    function create_simplified_ord_const(const value: tconstexprint; def: tdef; forinline, rangecheck: boolean): tnode;
 
     { returns true if n is only a tree of administrative nodes
       containing no code }
@@ -1090,12 +1090,12 @@ implementation
       end;
 
 
-    function create_simplified_ord_const(const value: tconstexprint; def: tdef; forinline: boolean): tnode;
+    function create_simplified_ord_const(const value: tconstexprint; def: tdef; forinline, rangecheck: boolean): tnode;
       begin
         if not forinline then
           result:=genintconstnode(value)
         else
-          result:=cordconstnode.create(value,def,cs_check_range in current_settings.localswitches);
+          result:=cordconstnode.create(value,def,rangecheck);
       end;
 
 

+ 4 - 4
compiler/pstatmnt.pas

@@ -221,8 +221,8 @@ implementation
                        CGMessage(parser_e_case_lower_less_than_upper_bound);
                      if not casedeferror then
                        begin
-                         adaptrange(casedef,hl1,rc_default);
-                         adaptrange(casedef,hl2,rc_default);
+                         adaptrange(casedef,hl1,false,false,cs_check_range in current_settings.localswitches);
+                         adaptrange(casedef,hl2,false,false,cs_check_range in current_settings.localswitches);
                        end;
                    end
                  else
@@ -250,7 +250,7 @@ implementation
                    begin
                      hl1:=get_ordinal_value(p);
                      if not casedeferror then
-                       adaptrange(casedef,hl1,rc_default);
+                       adaptrange(casedef,hl1,false,false,cs_check_range in current_settings.localswitches);
                      casenode.addlabel(blockid,hl1,hl1);
                    end;
                end;
@@ -360,7 +360,7 @@ implementation
           begin
             if (hp.nodetype=ordconstn) and
                (fordef.typ<>errordef) then
-              adaptrange(fordef,tordconstnode(hp).value,rc_always);
+              adaptrange(fordef,tordconstnode(hp).value,false,false,true);
           end;
 
         function for_loop_create(hloopvar: tnode): tnode;

+ 24 - 0
tests/test/tinlrange1.pp

@@ -0,0 +1,24 @@
+{ %fail }
+
+{$mode objfpc}
+
+{$ifdef cpu64}
+{$r+}
+{$else}
+{$q+}
+{$endif}
+
+function test(l1, l2: longint): longint; inline;
+begin
+  result:=l1+l2;
+end;
+
+{ range checking state at caller site should not influence inline evaluation }
+{$ifdef cpu64}
+{$r-}
+{$else}
+{$q-}
+{$endif}
+begin
+  test(high(longint), 1);
+end.

+ 15 - 0
tests/test/tinlrange2.pp

@@ -0,0 +1,15 @@
+{ %norun }
+
+{$mode objfpc}
+
+{$r-}
+function test(l1, l2: longint): longint; inline;
+begin
+  result:=l1+l2;
+end;
+
+{ range checking state at caller site should not influence inline evaluation }
+{$r+}
+begin
+  test(high(longint), 1);
+end.

+ 15 - 0
tests/test/tinlrange3.pp

@@ -0,0 +1,15 @@
+{ %fail }
+
+{$mode objfpc}
+{$q+}
+
+function test(l1, l2: int64): int64; inline;
+begin
+  result:=l1+l2;
+end;
+
+{$q-}
+
+begin
+  test(high(int64), 1);
+end.

+ 15 - 0
tests/test/tinlrange4.pp

@@ -0,0 +1,15 @@
+{ %norun }
+{ %opt=-Sew }
+
+{$r+}
+{$warnings on}
+
+const
+  MH_MAGIC = $feedface;
+
+var
+  c: cardinal;
+begin
+  c:= NToBE(MH_MAGIC);
+end.
+