paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-23 09:29:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fix for Mantis #32412: correctly handle an incorrect parameter count for Delete() and Insert() intrinsics

Browse Source 
+ added tests

git-svn-id: trunk@37342 -
This commit is contained in:
svenbarth 2017-09-27 21:15:00 +00:00
parent a1c910d892
commit c5b33f51f9
5 changed files with 77 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -14199,6 +14199,9 @@ tests/webtbf/tw3186.pp svneol=native#text/plain
tests/webtbf/tw31973.pp svneol=native#text/pascal
tests/webtbf/tw3218.pp svneol=native#text/plain
tests/webtbf/tw3241.pp svneol=native#text/plain
tests/webtbf/tw32412a.pp svneol=native#text/pascal
tests/webtbf/tw32412b.pp svneol=native#text/pascal
tests/webtbf/tw32412c.pp svneol=native#text/pascal
tests/webtbf/tw3253.pp svneol=native#text/plain
tests/webtbf/tw3267.pp svneol=native#text/plain
tests/webtbf/tw3275.pp svneol=native#text/plain

56
compiler/ninl.pas
View File

@ -4628,6 +4628,18 @@ implementation
end;
function tinlinenode.handle_insert: tnode;
procedure do_error;
begin
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Insert');
write_system_parameter_lists('fpc_shortstr_insert');
write_system_parameter_lists('fpc_shortstr_insert_char');
write_system_parameter_lists('fpc_unicodestr_insert');
if tf_winlikewidestring in target_info.flags then
write_system_parameter_lists('fpc_widestr_insert');
write_system_parameter_lists('fpc_ansistr_insert');
end;
var
procname : String;
c : longint;
@ -4646,6 +4658,14 @@ implementation
insertblock : tblocknode;
insertstatement : tstatementnode;
begin
if not assigned(left) or
not assigned(tcallparanode(left).right) or
not assigned(tcallparanode(tcallparanode(left).right).right) or
assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
begin
do_error;
exit(cerrornode.create);
end;
{ determine the correct function based on the second parameter }
firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
first:=firstn.resultdef;
@ -4733,13 +4753,7 @@ implementation
procname:='fpc_ansistr_insert'
else
begin
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Insert');
write_system_parameter_lists('fpc_shortstr_insert');
write_system_parameter_lists('fpc_shortstr_insert_char');
write_system_parameter_lists('fpc_unicodestr_insert');
if tf_winlikewidestring in target_info.flags then
write_system_parameter_lists('fpc_widestr_insert');
write_system_parameter_lists('fpc_ansistr_insert');
do_error;
exit(cerrornode.create);
end;
result:=ccallnode.createintern(procname,left);
@ -4747,12 +4761,32 @@ implementation
end;
function tinlinenode.handle_delete: tnode;
procedure do_error;
begin
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Delete');
write_system_parameter_lists('fpc_shortstr_delete');
write_system_parameter_lists('fpc_unicodestr_delete');
if tf_winlikewidestring in target_info.flags then
write_system_parameter_lists('fpc_widestr_delete');
write_system_parameter_lists('fpc_ansistr_delete');
MessagePos1(fileinfo,sym_e_param_list,'Delete(var Dynamic Array;'+sinttype.typename+';'+sinttype.typename+');');
end;
var
procname : String;
first : tdef;
firstn,
newn : tnode;
begin
if not assigned(left) or
not assigned(tcallparanode(left).right) or
not assigned(tcallparanode(tcallparanode(left).right).right) or
assigned(tcallparanode(tcallparanode(tcallparanode(left).right).right).right) then
begin
do_error;
exit(cerrornode.create);
end;
{ determine the correct function based on the first parameter }
firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
first:=firstn.resultdef;
@ -4784,13 +4818,7 @@ implementation
procname:='fpc_ansistr_delete'
else
begin
CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Delete');
write_system_parameter_lists('fpc_shortstr_delete');
write_system_parameter_lists('fpc_unicodestr_delete');
if tf_winlikewidestring in target_info.flags then
write_system_parameter_lists('fpc_widestr_delete');
write_system_parameter_lists('fpc_ansistr_delete');
MessagePos1(fileinfo,sym_e_param_list,'Delete(var Dynamic Array;'+sinttype.typename+';'+sinttype.typename+');');
do_error;
exit(cerrornode.create);
end;
result:=ccallnode.createintern(procname,left);

14
tests/webtbf/tw32412a.pp Normal file
View File

@ -0,0 +1,14 @@
{ %FAIL }
program tw32412;
var
p: Pointer;
begin
Delete();
Delete(p);
Delete(p, 1);
Insert();
Insert(p);
Insert(p, 1);
end.

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

@ -0,0 +1,9 @@
{ %FAIL }
program tw32412b;
var
p: Pointer;
begin
Insert('', p, 1, 2);
end.

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

@ -0,0 +1,9 @@
{ %FAIL }
program tw32412c;
var
p: Pointer;
begin
Delete(p, 1, 2, 3);
end.