فهرست منبع

+ support extra parameter for initialize() that indicates how many elements
should be initialised, similar to how this was already allowed for
finalize() (mantis #17998)

git-svn-id: trunk@16407 -

Jonas Maebe 14 سال پیش
والد
کامیت
749991ec02
4فایلهای تغییر یافته به همراه82 افزوده شده و 52 حذف شده
  1. 1 0
      .gitattributes
  2. 32 52
      compiler/pinline.pas
  3. 11 0
      rtl/inc/rtti.inc
  4. 38 0
      tests/webtbs/tw17998.pp

+ 1 - 0
.gitattributes

@@ -10755,6 +10755,7 @@ tests/webtbs/tw1792a.pp svneol=native#text/plain
 tests/webtbs/tw17945.pp svneol=native#text/pascal
 tests/webtbs/tw17950.pp svneol=native#text/pascal
 tests/webtbs/tw1798.pp svneol=native#text/plain
+tests/webtbs/tw17998.pp svneol=native#text/plain
 tests/webtbs/tw18013.pp svneol=native#text/plain
 tests/webtbs/tw1820.pp svneol=native#text/plain
 tests/webtbs/tw1825.pp svneol=native#text/plain

+ 32 - 52
compiler/pinline.pas

@@ -588,43 +588,7 @@ implementation
       end;
 
 
-    function inline_initialize : tnode;
-      var
-        newblock,
-        paras   : tnode;
-        ppn     : tcallparanode;
-      begin
-        { for easy exiting if something goes wrong }
-        result := cerrornode.create;
-
-        consume(_LKLAMMER);
-        paras:=parse_paras(false,false,_RKLAMMER);
-        consume(_RKLAMMER);
-        if not assigned(paras) then
-         begin
-           CGMessage1(parser_e_wrong_parameter_size,'Initialize');
-           exit;
-         end;
-
-        ppn:=tcallparanode(paras);
-        { 2 arguments? }
-        if assigned(ppn.right) then
-         begin
-           CGMessage1(parser_e_wrong_parameter_size,'Initialize');
-           paras.free;
-           exit;
-         end;
-
-        newblock:=initialize_data_node(ppn.left);
-        ppn.left:=nil;
-
-        paras.free;
-        result.free;
-        result:=newblock;
-      end;
-
-
-    function inline_finalize : tnode;
+    function inline_initfinal(isinit: boolean): tnode;
       var
         newblock,
         paras   : tnode;
@@ -638,25 +602,24 @@ implementation
         consume(_LKLAMMER);
         paras:=parse_paras(false,false,_RKLAMMER);
         consume(_RKLAMMER);
-        if not assigned(paras) then
+        ppn:=tcallparanode(paras);
+
+        if not assigned(paras) or
+           (assigned(ppn.right) and
+            assigned(tcallparanode(ppn.right).right)) then
          begin
-           CGMessage1(parser_e_wrong_parameter_size,'Finalize');
+           if isinit then
+             CGMessage1(parser_e_wrong_parameter_size,'Initialize')
+           else
+             CGMessage1(parser_e_wrong_parameter_size,'Finalize');
            exit;
          end;
 
-        ppn:=tcallparanode(paras);
         { 2 arguments? }
         if assigned(ppn.right) then
          begin
            destppn:=tcallparanode(ppn.right);
-           { 3 arguments is invalid }
-           if assigned(destppn.right) then
-            begin
-              CGMessage1(parser_e_wrong_parameter_size,'Finalize');
-              paras.free;
-              exit;
-            end;
-           { create call to fpc_finalize_array }
+           { create call to fpc_initialize/finalize_array }
            npara:=ccallparanode.create(cordconstnode.create
                      (destppn.left.resultdef.size,s32inttype,true),
                   ccallparanode.create(ctypeconvnode.create
@@ -665,21 +628,38 @@ implementation
                      (crttinode.create(tstoreddef(destppn.left.resultdef),initrtti,rdt_normal)),
                   ccallparanode.create(caddrnode.create_internal
                      (destppn.left),nil))));
-           newblock:=ccallnode.createintern('fpc_finalize_array',npara);
+           if isinit then
+             newblock:=ccallnode.createintern('fpc_initialize_array',npara)
+           else
+             newblock:=ccallnode.createintern('fpc_finalize_array',npara);
            destppn.left:=nil;
-           ppn.left:=nil;
          end
         else
          begin
-           newblock:=finalize_data_node(ppn.left);
-           ppn.left:=nil;
+           if isinit then
+             newblock:=initialize_data_node(ppn.left)
+           else
+             newblock:=finalize_data_node(ppn.left);
          end;
+        ppn.left:=nil;
         paras.free;
         result.free;
         result:=newblock;
       end;
 
 
+    function inline_initialize : tnode;
+      begin
+        result:=inline_initfinal(true);
+      end;
+
+
+    function inline_finalize : tnode;
+      begin
+        result:=inline_initfinal(false);
+      end;
+
+
     function inline_copy : tnode;
       var
         copynode,

+ 11 - 0
rtl/inc/rtti.inc

@@ -392,6 +392,17 @@ begin
 end;
 
 
+procedure fpc_initialize_array(data,typeinfo : pointer;count,size : SizeInt); compilerproc;
+  var
+     i : SizeInt;
+  begin
+     if not(PByte(typeinfo)^ in [tkInteger,tkChar,tkEnumeration,tkFloat,tkSet,
+       tkMethod,tkSString,tkLString,tkWChar,tkBool,tkInt64,tkQWord]) then
+       for i:=0 to count-1 do
+         int_initialize(data+size*i,typeinfo);
+  end;
+
+
 procedure fpc_finalize_array(data,typeinfo : pointer;count,size : SizeInt); [Public,Alias:'FPC_FINALIZEARRAY'];  compilerproc;
   var
      i : SizeInt;

+ 38 - 0
tests/webtbs/tw17998.pp

@@ -0,0 +1,38 @@
+{ %opt=-gh }
+
+{$mode objfpc}
+
+program test;
+type
+  tr = record
+    b: byte;
+    str: ansistring;
+    b2,b3: byte;
+  end;
+  pr = ^tr;
+var
+  A: pr;
+begin
+  HaltOnNotReleased:=true;
+  getmem(a,sizeof(tr)*4);
+  Initialize(a^, 4);
+  a[0].str:='test';
+  a[0].str:=a[0].str+'ab';
+  a[1].str:='test';
+  a[1].str:=a[1].str+'ab';
+  a[2].str:='test';
+  a[2].str:=a[2].str+'ab';
+  a[3].str:='test';
+  a[3].str:=a[3].str+'ab';
+  Finalize(A[1], 2);
+  if (a[0].str<>'testab') then
+    halt(1);
+  if (a[1].str<>'') then
+    halt(2);
+  if (a[2].str<>'') then
+    halt(3);
+  if (a[3].str<>'testab') then
+    halt(4);
+  Finalize(a^,4);
+  freemem(a);
+end.