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 -

.gitattributes

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

compiler/ninl.pas

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

compiler/pinline.pas

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

rtl/inc/compproc.inc

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

tests/webtbs/tw34332.pp

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