From 765fe2b2ab5f725e8e1bd014f103770a537f6753 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Thu, 9 Feb 2006 17:39:22 +0000 Subject: [PATCH] * fixed bug #4737 (check for potential range errors in for-loop 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 - --- .gitattributes | 1 + compiler/htypechk.pas | 49 +++++++++++++++++++++++++++++++----------- compiler/ncal.pas | 15 +------------ compiler/nflw.pas | 3 +++ compiler/nld.pas | 30 ++------------------------ tests/webtbf/tw4737.pp | 9 ++++++++ 6 files changed, 53 insertions(+), 54 deletions(-) create mode 100644 tests/webtbf/tw4737.pp diff --git a/.gitattributes b/.gitattributes index e5e929f9c9..edc7f0f72f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index e987558b26..b6484e7728 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -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. diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 91945e4bdc..987ca6e0cf 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -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 diff --git a/compiler/nflw.pas b/compiler/nflw.pas index fbf512a521..f031f16ae5 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -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 diff --git a/compiler/nld.pas b/compiler/nld.pas index 80e7a3c247..3a5173ec0b 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -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 diff --git a/tests/webtbf/tw4737.pp b/tests/webtbf/tw4737.pp new file mode 100644 index 0000000000..f01261f8a6 --- /dev/null +++ b/tests/webtbf/tw4737.pp @@ -0,0 +1,9 @@ +{ %fail } +{ %OPT=-Seh -vh} + +var a:int64; +i:integer; +begin +a:=0; +for i:=a to 10 do; +end.