mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 23:49:45 +02:00
Merged revision(s) 39802, 39816-39817 from trunk:
* fix for Mantis #34332: allow 2 parameter form of Copy also for ShortString variables + added test ........ * have the fpc_*_copy compiler intrinsics reference the intrinsic symbol they belong to ........ * fix for Mantis #34333: improve error output for incorrect calls to Copy() ........ git-svn-id: branches/fixes_3_2@47586 -
This commit is contained in:
svenbarth
parent
92877826e9
commit
7988446f1a
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -17599,6 +17599,7 @@ tests/webtbs/tw34239.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw34287.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3429.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3433.pp svneol=native#text/plain
|
||||
tests/webtbs/tw34332.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3435.pp svneol=native#text/plain
|
||||
tests/webtbs/tw34380.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3441.pp svneol=native#text/plain
|
||||
|
||||
@ -1790,12 +1790,49 @@ implementation
|
||||
|
||||
|
||||
function tinlinenode.handle_copy: tnode;
|
||||
|
||||
procedure do_error(typemismatch:boolean;func:string;fi:tfileposinfo);
|
||||
|
||||
procedure write_dynarray_copy;
|
||||
begin
|
||||
MessagePos1(fileinfo,sym_e_param_list,'Copy(Dynamic Array;'+sizesinttype.typename+'=`<low>`;'+sizesinttype.typename+'=`<length>`);');
|
||||
end;
|
||||
|
||||
begin
|
||||
if typemismatch then
|
||||
CGMessagePos(fi,type_e_mismatch)
|
||||
else
|
||||
CGMessagePos1(fi,parser_e_wrong_parameter_size,'Copy');
|
||||
if func='' then
|
||||
begin
|
||||
write_system_parameter_lists('fpc_shortstr_copy');
|
||||
write_system_parameter_lists('fpc_char_copy');
|
||||
write_system_parameter_lists('fpc_unicodestr_copy');
|
||||
if tf_winlikewidestring in target_info.flags then
|
||||
write_system_parameter_lists('fpc_widestr_copy');
|
||||
write_system_parameter_lists('fpc_ansistr_copy');
|
||||
write_dynarray_copy;
|
||||
end
|
||||
else if func='fpc_dynarray_copy' then
|
||||
write_dynarray_copy
|
||||
else
|
||||
write_system_parameter_lists(func);
|
||||
end;
|
||||
|
||||
var
|
||||
paras : tnode;
|
||||
ppn : tcallparanode;
|
||||
paradef : tdef;
|
||||
counter : integer;
|
||||
minargs,
|
||||
maxargs : longint;
|
||||
func : string;
|
||||
begin
|
||||
if not assigned(left) then
|
||||
begin
|
||||
do_error(false,'',fileinfo);
|
||||
exit(cerrornode.create);
|
||||
end;
|
||||
result:=nil;
|
||||
{ determine copy function to use based on the first argument,
|
||||
also count the number of arguments in this loop }
|
||||
@ -1810,44 +1847,63 @@ implementation
|
||||
end;
|
||||
set_varstate(ppn.left,vs_read,[vsf_must_be_valid]);
|
||||
paradef:=ppn.left.resultdef;
|
||||
{ the string variants all require 2 or 3 args, only the array one allows less }
|
||||
minargs:=2;
|
||||
maxargs:=3;
|
||||
if is_ansistring(paradef) then
|
||||
// set resultdef to argument def
|
||||
resultdef:=paradef
|
||||
begin
|
||||
// set resultdef to argument def
|
||||
resultdef:=paradef;
|
||||
func:='fpc_ansistr_copy';
|
||||
end
|
||||
else if (is_chararray(paradef) and (paradef.size>255)) or
|
||||
((cs_refcountedstrings in current_settings.localswitches) and is_pchar(paradef)) then
|
||||
// set resultdef to ansistring type since result will be in ansistring codepage
|
||||
resultdef:=getansistringdef
|
||||
else
|
||||
if is_widestring(paradef) then
|
||||
resultdef:=cwidestringtype
|
||||
else
|
||||
if is_unicodestring(paradef) or
|
||||
begin
|
||||
// set resultdef to ansistring type since result will be in ansistring codepage
|
||||
resultdef:=getansistringdef;
|
||||
func:='fpc_ansistr_copy';
|
||||
end
|
||||
else if is_widestring(paradef) then
|
||||
begin
|
||||
resultdef:=cwidestringtype;
|
||||
func:='fpc_widestr_copy';
|
||||
end
|
||||
else if is_unicodestring(paradef) or
|
||||
is_widechararray(paradef) or
|
||||
is_pwidechar(paradef) then
|
||||
resultdef:=cunicodestringtype
|
||||
begin
|
||||
resultdef:=cunicodestringtype;
|
||||
func:='fpc_unicodestr_copy';
|
||||
end
|
||||
else
|
||||
if is_char(paradef) then
|
||||
resultdef:=cshortstringtype
|
||||
begin
|
||||
resultdef:=cshortstringtype;
|
||||
func:='fpc_char_copy';
|
||||
end
|
||||
else
|
||||
if is_dynamic_array(paradef) then
|
||||
begin
|
||||
{ Only allow 1 or 3 arguments }
|
||||
if not(counter in [1..3]) then
|
||||
begin
|
||||
CGMessage1(parser_e_wrong_parameter_size,'Copy');
|
||||
exit;
|
||||
end;
|
||||
minargs:=1;
|
||||
resultdef:=paradef;
|
||||
func:='fpc_dynarray_copy';
|
||||
end
|
||||
else if counter in [2..3] then
|
||||
begin
|
||||
resultdef:=cshortstringtype;
|
||||
func:='fpc_shortstr_copy';
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ generic fallback that will give an error if a wrong
|
||||
type is passed }
|
||||
if (counter=3) then
|
||||
resultdef:=cshortstringtype
|
||||
else
|
||||
CGMessagePos(ppn.left.fileinfo,type_e_mismatch);
|
||||
end;
|
||||
begin
|
||||
do_error(true,'',ppn.left.fileinfo);
|
||||
exit(cerrornode.create);
|
||||
end;
|
||||
|
||||
if (counter<minargs) or (counter>maxargs) then
|
||||
begin
|
||||
do_error(false,func,fileinfo);
|
||||
exit(cerrornode.create);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$maxfpuregisters 0}
|
||||
|
||||
@ -682,7 +682,7 @@ implementation
|
||||
|
||||
function inline_copy: tnode;
|
||||
begin
|
||||
result:=inline_copy_insert_delete(in_copy_x,'Copy',true);
|
||||
result:=inline_copy_insert_delete(in_copy_x,'Copy',false);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -58,8 +58,8 @@ function fpc_pwidechar_length(p:pwidechar):sizeint; compilerproc;
|
||||
procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true); compilerproc;
|
||||
procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
|
||||
|
||||
Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
|
||||
function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
|
||||
Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};
|
||||
function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};
|
||||
{$ifndef VER3_0}
|
||||
Procedure fpc_shortstr_delete(var s:shortstring;index:SizeInt;count:SizeInt); compilerproc:fpc_in_delete_x_y_z;
|
||||
Procedure fpc_shortstr_insert(const source:shortstring;var s:shortstring;index:SizeInt); compilerproc:fpc_in_insert_x_y_z;
|
||||
@ -318,7 +318,7 @@ Function fpc_AnsiStr_Compare_equal(const S1,S2 : RawByteString): SizeInt; compil
|
||||
Procedure fpc_AnsiStr_RangeCheck(p : Pointer; index : SizeInt); compilerproc;
|
||||
|
||||
Procedure fpc_AnsiStr_SetLength (Var S : RawByteString; l : SizeInt{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
|
||||
Function fpc_ansistr_Copy (Const S : RawByteString; Index,Size : SizeInt): RawByteString;compilerproc;
|
||||
Function fpc_ansistr_Copy (Const S : RawByteString; Index,Size : SizeInt): RawByteString;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};
|
||||
{$ifndef VER3_0}
|
||||
Procedure fpc_ansistr_insert (const Source : RawByteString; var S : RawByteString; Index : SizeInt); compilerproc:fpc_in_insert_x_y_z; rtlproc;
|
||||
Procedure fpc_ansistr_delete (var S : RawByteString; Index,Size: SizeInt); compilerproc:fpc_in_delete_x_y_z; rtlproc;
|
||||
@ -357,7 +357,7 @@ Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerp
|
||||
Procedure fpc_WideStr_RangeCheck(p: Pointer; index : SizeInt); compilerproc;
|
||||
|
||||
Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt); compilerproc;
|
||||
Function fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
|
||||
Function fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};
|
||||
{$ifndef VER3_0}
|
||||
Procedure fpc_widestr_insert (Const Source : WideString; Var S : WideString; Index : SizeInt); compilerproc:fpc_in_insert_x_y_z;
|
||||
Procedure fpc_widestr_delete (Var S : WideString; Index,Size: SizeInt); compilerproc:fpc_in_delete_x_y_z;
|
||||
@ -405,7 +405,7 @@ Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; com
|
||||
Procedure fpc_UnicodeStr_RangeCheck(p: Pointer; index : SizeInt); compilerproc;
|
||||
|
||||
Procedure fpc_UnicodeStr_SetLength (Var S : UnicodeString; l : SizeInt); compilerproc;
|
||||
Function fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc;
|
||||
Function fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};
|
||||
{$ifndef VER3_0}
|
||||
Procedure fpc_unicodestr_insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt); compilerproc:fpc_in_insert_x_y_z;
|
||||
Procedure fpc_unicodestr_delete (Var S : UnicodeString; Index,Size: SizeInt); compilerproc:fpc_in_delete_x_y_z;
|
||||
|
||||
14
tests/webtbs/tw34332.pp
Normal file
14
tests/webtbs/tw34332.pp
Normal file
@ -0,0 +1,14 @@
|
||||
{ %NORUN }
|
||||
|
||||
program tw34332;
|
||||
|
||||
{$mode objfpc}{$h+}
|
||||
|
||||
var
|
||||
SS: ShortString;
|
||||
S: String;
|
||||
begin
|
||||
SS := Copy(SS, 1); // << project1.lpr(9,14) Error: Type mismatch
|
||||
S := Copy(S, 1); // << OK
|
||||
SS := Copy(SS, 1, 1); // << OK
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user