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

git-svn-id: trunk@15228 -
This commit is contained in:
florian 2010-05-05 13:49:06 +00:00
parent 257145c6c8
commit e01e4e5719
5 changed files with 65 additions and 33 deletions

1
.gitattributes vendored
View File

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

View File

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

View File

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

View File

@ -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
tests/tbs/tb0572.pp Normal file
View File

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