Browse Source

* optimized copy(<dyn. array> ...) by checking if the elements are really ref. counted

git-svn-id: trunk@15228 -
florian 15 years ago
parent
commit
e01e4e5719
5 changed files with 65 additions and 33 deletions
  1. 1 0
      .gitattributes
  2. 6 3
      rtl/inc/dynarr.inc
  3. 1 30
      rtl/inc/rtti.inc
  4. 37 0
      rtl/inc/system.inc
  5. 20 0
      tests/tbs/tb0572.pp

+ 1 - 0
.gitattributes

@@ -8310,6 +8310,7 @@ tests/tbs/tb0568.pp svneol=native#text/plain
 tests/tbs/tb0569.pp svneol=native#text/pascal
 tests/tbs/tb0570.pp svneol=native#text/plain
 tests/tbs/tb0571.pas svneol=native#text/plain
+tests/tbs/tb0572.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain

+ 6 - 3
rtl/inc/dynarr.inc

@@ -325,9 +325,12 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
      { fill new refcount }
      realpdest^.refcount:=1;
      realpdest^.high:=cnt-1;
-     { increment ref. count of members }
-     for i:= 0 to cnt-1 do
-       int_addref(pointer(pdest+elesize*i),eletype);
+
+     { increment ref. count of members? }
+     if PByte(eletype)^ in tkManagedTypes then
+       for i:= 0 to cnt-1 do
+         int_addref(pointer(pdest+elesize*i),eletype);
+
      result:=pdest;
   end;
 

+ 1 - 30
rtl/inc/rtti.inc

@@ -14,36 +14,7 @@
 
 { Run-Time type information routines }
 
-{ The RTTI is implemented through a series of constants : }
-
-Const
-       tkUnknown       = 0;
-       tkInteger       = 1;
-       tkChar          = 2;
-       tkEnumeration   = 3;
-       tkFloat         = 4;
-       tkSet           = 5;
-       tkMethod        = 6;
-       tkSString       = 7;
-       tkString        = tkSString;
-       tkLString       = 8;
-       tkAString       = 9;
-       tkWString       = 10;
-       tkVariant       = 11;
-       tkArray         = 12;
-       tkRecord        = 13;
-       tkInterface     = 14;
-       tkClass         = 15;
-       tkObject        = 16;
-       tkWChar         = 17;
-       tkBool          = 18;
-       tkInt64         = 19;
-       tkQWord         = 20;
-       tkDynArray      = 21;
-       tkInterfaceCorba = 22;
-       tkProcVar       = 23;
-       tkUString       = 24;
-
+{ the tk* constants are now declared in system.inc }
 
 type
   TRTTIProc=procedure(Data,TypeInfo:Pointer);

+ 37 - 0
rtl/inc/system.inc

@@ -12,6 +12,43 @@
 
  **********************************************************************}
 
+
+{ The RTTI is implemented through a series of constants : }
+
+Const
+   // please update tkManagedTypes below if you add new
+   // values
+   tkUnknown       = 0;
+   tkInteger       = 1;
+   tkChar          = 2;
+   tkEnumeration   = 3;
+   tkFloat         = 4;
+   tkSet           = 5;
+   tkMethod        = 6;
+   tkSString       = 7;
+   tkString        = tkSString;
+   tkLString       = 8;
+   tkAString       = 9;
+   tkWString       = 10;
+   tkVariant       = 11;
+   tkArray         = 12;
+   tkRecord        = 13;
+   tkInterface     = 14;
+   tkClass         = 15;
+   tkObject        = 16;
+   tkWChar         = 17;
+   tkBool          = 18;
+   tkInt64         = 19;
+   tkQWord         = 20;
+   tkDynArray      = 21;
+   tkInterfaceCorba = 22;
+   tkProcVar       = 23;
+   tkUString       = 24;
+
+  // all potentially managed types
+  tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,
+                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
+
 {****************************************************************************
                                 Local types
 ****************************************************************************}

+ 20 - 0
tests/tbs/tb0572.pp

@@ -0,0 +1,20 @@
+{ test copy optimization of dyn. arrays }
+uses
+  Sysutils;
+var
+  a,b,c : array of ansistring;
+  i : longint;
+
+begin
+  SetLength(a,1000);
+  SetLength(c,1000);
+  for i:=low(a) to high(a) do
+    a[i]:=IntToStr(random(10000));
+  b:=copy(a);
+  c:=copy(a);
+  a:=nil;
+  for i:=low(b) to high(b) do
+    if b[i]<>c[i] then
+      halt(1);
+  writeln('ok');
+end.