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

* fixed bug #4737 (check for potential range errors in for-loop

Browse Source 
assignment, report correct column for potential range errors of
    call parameters)
  * refactored code to check potential range check errors (check_ranges
    in htypechk)

git-svn-id: trunk@2501 -
This commit is contained in:
Jonas Maebe 2006-02-09 17:39:22 +00:00
parent 5e84d37b2d
commit 765fe2b2ab
6 changed files with 53 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5987,6 +5987,7 @@ tests/webtbf/tw4619b.pp svneol=native#text/plain
tests/webtbf/tw4647.pp svneol=native#text/plain
tests/webtbf/tw4651.pp svneol=native#text/plain
tests/webtbf/tw4695.pp svneol=native#text/plain
tests/webtbf/tw4737.pp svneol=native#text/plain
tests/webtbf/tw4757.pp svneol=native#text/plain
tests/webtbf/tw4764.pp svneol=native#text/plain
tests/webtbf/tw4777.pp svneol=native#text/plain

49
compiler/htypechk.pas
View File

@ -27,7 +27,7 @@ interface
uses
tokens,cpuinfo,
node,
node,globals,
symconst,symtype,symdef,symsym,symbase;
type
@ -151,11 +151,13 @@ interface
procedure check_hints(const srsym: tsym; const symoptions: tsymoptions);
procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
implementation
uses
globtype,systems,
cutils,verbose,globals,
cutils,verbose,
symtable,
defutil,defcmp,
nbas,ncnv,nld,nmem,ncal,nmat,ninl,nutils,
@ -2204,16 +2206,39 @@ implementation
procedure check_hints(const srsym: tsym; const symoptions: tsymoptions);
begin
if not assigned(srsym) then
internalerror(200602051);
if sp_hint_deprecated in symoptions then
Message1(sym_w_deprecated_symbol,srsym.realname);
if sp_hint_platform in symoptions then
Message1(sym_w_non_portable_symbol,srsym.realname);
if sp_hint_unimplemented in symoptions then
Message1(sym_w_non_implemented_symbol,srsym.realname);
end;
begin
if not assigned(srsym) then
internalerror(200602051);
if sp_hint_deprecated in symoptions then
Message1(sym_w_deprecated_symbol,srsym.realname);
if sp_hint_platform in symoptions then
Message1(sym_w_non_portable_symbol,srsym.realname);
if sp_hint_unimplemented in symoptions then
Message1(sym_w_non_implemented_symbol,srsym.realname);
end;
procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
begin
{ check if the assignment may cause a range check error }
{ if its not explicit, and only if the values are }
{ ordinals, enumdef and floatdef }
if assigned(destdef) and
(destdef.deftype in [enumdef,orddef,floatdef]) and
not is_boolean(destdef) and
assigned(source.resulttype.def) and
(source.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
not is_boolean(source.resulttype.def) then
begin
if (destdef.size < source.resulttype.def.size) then
begin
if (cs_check_range in aktlocalswitches) then
MessagePos(location,type_w_smaller_possible_range_check)
else
MessagePos(location,type_h_smaller_possible_range_check);
end;
end;
end;
end.

15
compiler/ncal.pas
View File

@ -632,20 +632,7 @@ type
end
else
begin
{ for ordinals, floats and enums, verify if we might cause
some range-check errors. }
if (parasym.vartype.def.deftype in [enumdef,orddef,floatdef]) and
(left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
(left.nodetype in [vecn,loadn,calln]) then
begin
if (left.resulttype.def.size>parasym.vartype.def.size) then
begin
if (cs_check_range in aktlocalswitches) then
Message(type_w_smaller_possible_range_check)
else
Message(type_h_smaller_possible_range_check);
end;
end;
check_ranges(left.fileinfo,left,parasym.vartype.def);
inserttypeconv(left,parasym.vartype);
end;
if codegenerror then

3
compiler/nflw.pas
View File

@ -730,7 +730,10 @@ implementation
{ Make sure that the loop var and the
from and to values are compatible types }
check_ranges(right.fileinfo,right,left.resulttype.def);
inserttypeconv(right,left.resulttype);
check_ranges(t1.fileinfo,t1,left.resulttype.def);
inserttypeconv(t1,left.resulttype);
if assigned(t2) then

30
compiler/nld.pas
View File

@ -481,11 +481,9 @@ implementation
var
hp : tnode;
useshelper : boolean;
original_size : longint;
begin
result:=nil;
resulttype:=voidtype;
original_size := 0;
{ must be made unique }
set_unique(left);
@ -630,35 +628,11 @@ implementation
end
else
begin
{ get the size before the type conversion - check for all nodes }
if assigned(right.resulttype.def) and
(right.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
(right.nodetype in [loadn,vecn,calln]) then
original_size := right.resulttype.def.size;
{ check if the assignment may cause a range check error }
check_ranges(fileinfo,right,left.resulttype.def);
inserttypeconv(right,left.resulttype);
end;
{ check if the assignment may cause a range check error }
{ if its not explicit, and only if the values are }
{ ordinals, enumdef and floatdef }
if (right.nodetype = typeconvn) and
not (nf_explicit in ttypeconvnode(right).flags) then
begin
if assigned(left.resulttype.def) and
(left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
not is_boolean(left.resulttype.def) then
begin
if (original_size <> 0) and
(left.resulttype.def.size < original_size) then
begin
if (cs_check_range in aktlocalswitches) then
Message(type_w_smaller_possible_range_check)
else
Message(type_h_smaller_possible_range_check);
end;
end;
end;
{ call helpers for interface }
if is_interfacecom(left.resulttype.def) then
begin

9
tests/webtbf/tw4737.pp Normal file
View File

@ -0,0 +1,9 @@
{ %fail }
{ %OPT=-Seh -vh}
var a:int64;
i:integer;
begin
a:=0;
for i:=a to 10 do;
end.