* move handling of Concat to tinlinenode so that it can be easily extended for dynamic arrays

+ added test

git-svn-id: trunk@37429 -

.gitattributes

@@ -11411,6 +11411,7 @@ tests/tbs/tb0630.pp svneol=native#text/pascal
 tests/tbs/tb0631.pp svneol=native#text/pascal
 tests/tbs/tb0632.pp svneol=native#text/pascal
 tests/tbs/tb0633.pp svneol=native#text/pascal
+tests/tbs/tb0634.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain

compiler/ninl.pas

@@ -107,6 +107,7 @@ interface
           function handle_unbox: tnode;
           function handle_insert:tnode;
           function handle_delete:tnode;
+          function handle_concat:tnode;
        end;
        tinlinenodeclass = class of tinlinenode;
 
@@ -3589,6 +3590,10 @@ implementation
                 begin
                   result:=handle_insert;
                 end;
+              in_concat_x:
+                begin
+                  result:=handle_concat;
+                end;
               else
                 internalerror(8);
             end;
@@ -4828,6 +4833,52 @@ implementation
        end;
 
 
+     function tinlinenode.handle_concat:tnode;
+
+       procedure do_error;
+         begin
+           CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Concat');
+           MessagePos1(fileinfo,sym_e_param_list,'Concat(String[;String;...])');
+         end;
+
+       var
+         cpn : tcallparanode;
+       begin
+         if not assigned(left) then
+           begin
+             do_error;
+             exit(cerrornode.create);
+           end;
+         result:=nil;
+         { the arguments are right to left, but we need them left to right
+           with the correct nesting }
+         cpn:=tcallparanode(left);
+         while assigned(cpn) do
+           begin
+             if assigned(result) then
+               begin
+                 if result.nodetype=addn then
+                   taddnode(result).left:=caddnode.create(addn,cpn.left,taddnode(result).left)
+                 else
+                   result:=caddnode.create(addn,cpn.left,result);
+               end
+             else
+               begin
+                 result:=cpn.left;
+                 { Force string type if it isn't yet }
+                 if not(
+                        (result.resultdef.typ=stringdef) or
+                        is_chararray(result.resultdef) or
+                        is_char(result.resultdef)
+                       ) then
+                   inserttypeconv(result,cshortstringtype);
+               end;
+             cpn.left:=nil;
+             cpn:=tcallparanode(cpn.right);
+           end;
+       end;
+
+
      function tinlinenode.first_pack_unpack: tnode;
        var
          loopstatement    : tstatementnode;

compiler/pexpr.pas

@@ -714,29 +714,7 @@ implementation
 
           in_concat_x :
             begin
-              consume(_LKLAMMER);
-              in_args:=true;
-              { Translate to x:=x+y[+z]. The addnode will do the
-                type checking }
-              p2:=nil;
-              repeat
-                p1:=comp_expr([ef_accept_equal]);
-                if p2<>nil then
-                  p2:=caddnode.create(addn,p2,p1)
-                else
-                  begin
-                    { Force string type if it isn't yet }
-                    if not(
-                           (p1.resultdef.typ=stringdef) or
-                           is_chararray(p1.resultdef) or
-                           is_char(p1.resultdef)
-                          ) then
-                      inserttypeconv(p1,cshortstringtype);
-                    p2:=p1;
-                  end;
-              until not try_to_consume(_COMMA);
-              consume(_RKLAMMER);
-              statement_syssym:=p2;
+              statement_syssym:=inline_concat;
             end;
 
           in_read_x,

compiler/pinline.pas

@@ -40,6 +40,7 @@ interface
     function inline_copy : tnode;
     function inline_insert : tnode;
     function inline_delete : tnode;
+    function inline_concat : tnode;
 
 
 implementation
@@ -670,4 +671,10 @@ implementation
       end;
 
 
+    function inline_concat: tnode;
+      begin
+        result:=inline_copy_insert_delete(in_concat_x,'Concat',false);
+      end;
+
+
 end.

tests/tbs/tb0634.pp

@@ -0,0 +1,20 @@
+program tb0634;
+
+var
+  s, s1, s2, s3, s4: String;
+begin
+  s := Concat('Hello', ' ', 'World');
+  if s <> 'Hello World' then
+    Halt(1);
+  s := Concat('Hello');
+  if s <> 'Hello' then
+    Halt(2);
+  s1 := 'Hello';
+  s2 := 'Free';
+  s3 := 'Pascal';
+  s4 := 'World';
+  s := Concat(s1, ' ', s2, ' ', s3, ' ', s4);
+  if s <> 'Hello Free Pascal World' then
+    Halt(3);
+  Writeln('ok');
+end.