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

--- Merging r43347 into '.':

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2019-11-16 15:18:43 +00:00
parent 375d21b29f
commit 858bf743ef
14 changed files with 153 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

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

25
compiler/defutil.pas
View File

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

15
compiler/nadd.pas
View File

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

4
compiler/ncnv.pas
View File

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

2
compiler/ncon.pas
View File

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

6
compiler/ngtcon.pas
View File

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

14
compiler/ninl.pas
View File

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

87
compiler/nmat.pas
View File

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

6
compiler/nutils.pas
View File

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

8
compiler/pstatmnt.pas
View File

@ -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
tests/test/tinlrange1.pp Normal file
View File

@ -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
tests/test/tinlrange2.pp Normal file
View File

@ -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
tests/test/tinlrange3.pp Normal file
View File

@ -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
tests/test/tinlrange4.pp Normal file
View File

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