fpc/rtl/objpas/classes/collect.inc
michael 93400f276c Merged revisions 9263-10571 via svnmerge from
svn+ssh://svn.freepascal.org/FPC/svn/fpc/branches/cleanroom

................
  r9269 | michael | 2007-11-17 13:58:31 +0100 (Sat, 17 Nov 2007) | 1 line
  
  * Cleaned initial list of tained routines
................
  r9270 | michael | 2007-11-17 14:00:25 +0100 (Sat, 17 Nov 2007) | 1 line
  
  * Test routines for cleanroom implementation
................
  r9271 | michael | 2007-11-17 14:04:43 +0100 (Sat, 17 Nov 2007) | 1 line
  
  DoVarClearArray also tainted
................
  r9272 | michael | 2007-11-17 15:25:04 +0100 (Sat, 17 Nov 2007) | 1 line
  
  * Removed possibly tainted code
................
  r9276 | Almindor | 2007-11-17 21:29:16 +0100 (Sat, 17 Nov 2007) | 2 lines
  
  * initial cleanroom implementation of TStringList.Find
................
  r9277 | Almindor | 2007-11-17 21:32:44 +0100 (Sat, 17 Nov 2007) | 2 lines
  
  * also commit forgotten part for "where would it instert" in case of sorted stringlist
................
  r9295 | michael | 2007-11-19 21:07:10 +0100 (Mon, 19 Nov 2007) | 1 line
  
  * More tests
................
  r9307 | michael | 2007-11-21 08:43:56 +0100 (Wed, 21 Nov 2007) | 1 line
  
  * More tests and reorganization per unit
................
  r9308 | michael | 2007-11-21 08:47:58 +0100 (Wed, 21 Nov 2007) | 1 line
  
  * More reorganization of files
................
  r9310 | michael | 2007-11-21 21:05:40 +0100 (Wed, 21 Nov 2007) | 1 line
  
  * Completed tccollection tests
................
  r9322 | marco | 2007-11-24 15:40:18 +0100 (Sat, 24 Nov 2007) | 1 line
  
   * getnamepath first version. Tests not run yet (fpcunit)
................
  r9337 | michael | 2007-11-27 09:21:31 +0100 (Tue, 27 Nov 2007) | 1 line
  
  * Removed TFPlist.Assign and TFPList.Extract
................
  r9340 | michael | 2007-11-27 22:33:07 +0100 (Tue, 27 Nov 2007) | 1 line
  
  Removed HandleSafeCallException 
................
  r9343 | Almindor | 2007-11-28 11:23:00 +0100 (Wed, 28 Nov 2007) | 2 lines
  
  * add cleanroom quicksort implementation [tested very little]
................
  r9344 | Almindor | 2007-11-28 11:25:54 +0100 (Wed, 28 Nov 2007) | 2 lines
  
  * update quicksort to use ExchangeItems instead of manual swap
................
  r9359 | vincents | 2007-11-30 20:10:03 +0100 (Fri, 30 Nov 2007) | 1 line
  
  + clean room implementation of HandleSafeCallException; compiles, but not tested.
................
  r9387 | michael | 2007-12-03 14:24:32 +0100 (Mon, 03 Dec 2007) | 1 line
  
  * Clean-room implementation of TParser by Giulio Bernardi
................
  r9396 | michael | 2007-12-05 21:36:41 +0100 (Wed, 05 Dec 2007) | 5 lines
  
  * Patch from Giulio Bernardi:
   - Fixes token positioning after HexToBinary 
   - Support for certain malformed negative integer values
................
  r9399 | michael | 2007-12-06 16:53:41 +0100 (Thu, 06 Dec 2007) | 1 line
  
  * More tests for classes unit
................
  r9401 | michael | 2007-12-06 21:58:16 +0100 (Thu, 06 Dec 2007) | 1 line
  
  * Added additional tests for collection streaming. Restructured
................
  r9402 | michael | 2007-12-06 22:35:56 +0100 (Thu, 06 Dec 2007) | 1 line
  
  * All compiles again, resolving references not quite yet done
................
  r9434 | michael | 2007-12-12 21:24:57 +0100 (Wed, 12 Dec 2007) | 1 line
  
  * New FindNestedComponent routine
................
  r9466 | michael | 2007-12-15 23:44:41 +0100 (Sat, 15 Dec 2007) | 1 line
  
  * Fixed all tests
................
  r9468 | michael | 2007-12-16 01:00:01 +0100 (Sun, 16 Dec 2007) | 1 line
  
  * Fixed reader fixup of references
................
  r9491 | joost | 2007-12-18 21:46:54 +0100 (Tue, 18 Dec 2007) | 3 lines
  
   * Implemented TWriter.WriteComponent
   * Implemented TWriter.WriteComponentData
   * Implemented TWriter.WriteDescendent
................
  r9492 | joost | 2007-12-18 21:56:32 +0100 (Tue, 18 Dec 2007) | 1 line
  
   * The BinaryObjectWriter of fpc stores TValueTypes as a byte, fixed the test for that
................
  r9566 | michael | 2007-12-29 15:53:32 +0100 (Sat, 29 Dec 2007) | 1 line
  
  * Clean (and complete) implementation of T(FP)List.Assign
................
  r9567 | michael | 2007-12-29 16:02:19 +0100 (Sat, 29 Dec 2007) | 1 line
  
  * Additional tests for reference resolving and TList.Assign
................
  r9568 | michael | 2007-12-29 16:12:33 +0100 (Sat, 29 Dec 2007) | 1 line
  
  * Cleanroom implementation of extract
................
  r9750 | yury | 2008-01-14 13:07:17 +0100 (Mon, 14 Jan 2008) | 1 line
  
  * My cleanroom implementation of DoVarClearArray.
................
  r10271 | michael | 2008-02-10 15:52:37 +0100 (Sun, 10 Feb 2008) | 1 line
  
  * Correct implementation committed
................
  r10273 | michael | 2008-02-10 17:08:59 +0100 (Sun, 10 Feb 2008) | 1 line
  
  * Added DecodeSoundexInt
................
  r10352 | vincents | 2008-02-18 08:23:18 +0100 (Mon, 18 Feb 2008) | 1 line
  
  + TStringList.Grow, used algorithm from TFPList.Expand
................
  r10353 | vincents | 2008-02-18 10:21:58 +0100 (Mon, 18 Feb 2008) | 1 line
  
  * use new TStringList.Grow implementation from trunk
................
  r10354 | vincents | 2008-02-18 10:23:07 +0100 (Mon, 18 Feb 2008) | 1 line
  
  * fixed TList tests
................
  r10355 | vincents | 2008-02-18 16:43:35 +0100 (Mon, 18 Feb 2008) | 1 line
  
  * fixed hint in test and removed session information from lpi
................
  r10356 | vincents | 2008-02-18 21:58:29 +0100 (Mon, 18 Feb 2008) | 1 line
  
  + implemented TStringList.Find
................
  r10358 | vincents | 2008-02-19 15:02:17 +0100 (Tue, 19 Feb 2008) | 1 line
  
  * fixed TTestTComponentNotifies test
................
  r10359 | vincents | 2008-02-19 15:48:43 +0100 (Tue, 19 Feb 2008) | 1 line
  
  * fixed memleak in TWriter.WriteProperties
................
  r10360 | vincents | 2008-02-19 15:49:20 +0100 (Tue, 19 Feb 2008) | 1 line
  
  + initial implementation of TReader.ReadCollection (needs further testing)
................
  r10364 | vincents | 2008-02-19 23:05:49 +0100 (Tue, 19 Feb 2008) | 1 line
  
  + TDataset.SetFieldValues (untested)
................
  r10365 | vincents | 2008-02-20 09:03:16 +0100 (Wed, 20 Feb 2008) | 1 line
  
  * initilize critical section used by resolving references
................
  r10366 | vincents | 2008-02-20 09:38:03 +0100 (Wed, 20 Feb 2008) | 2 lines
  
  * fixed resolve references test
  * removed unused variable
................
  r10369 | vincents | 2008-02-20 17:04:51 +0100 (Wed, 20 Feb 2008) | 1 line
  
  + initial version of TReader.FindComponentClass, works with a simple LCL application
................
  r10370 | michael | 2008-02-20 20:48:36 +0100 (Wed, 20 Feb 2008) | 1 line
  
  * Added tcollection stream read tests
................
  r10373 | vincents | 2008-02-21 00:33:10 +0100 (Thu, 21 Feb 2008) | 1 line
  
  * TReader.FindComponentClass: also search in FieldTables of parent classes.
................
  r10374 | michael | 2008-02-21 11:00:04 +0100 (Thu, 21 Feb 2008) | 1 line
  
  * Fix voor ResolveReferences
................
  r10376 | vincents | 2008-02-21 19:37:55 +0100 (Thu, 21 Feb 2008) | 1 line
  
  * reduced hints
................
  r10377 | vincents | 2008-02-22 14:56:22 +0100 (Fri, 22 Feb 2008) | 1 line
  
  * add check for valid NewIndex in TFPList.Move, so that an invalid NewIndex doesn't lead to memleak
................
  r10378 | vincents | 2008-02-22 15:16:56 +0100 (Fri, 22 Feb 2008) | 1 line
  
  * fixed TReader.ReadCollection in case more than one property was streamed
................
  r10379 | vincents | 2008-02-22 15:35:44 +0100 (Fri, 22 Feb 2008) | 3 lines
  
  + added another test for writing collections (shows how it should be written and thus read
  + added a test for a writing an enum with default value 
................
  r10380 | vincents | 2008-02-22 15:36:14 +0100 (Fri, 22 Feb 2008) | 1 line
  
  * fixed memleak
................
  r10381 | vincents | 2008-02-23 20:03:00 +0100 (Sat, 23 Feb 2008) | 1 line
  
  * fixed AV when streaming a component without published properties
................
  r10390 | michael | 2008-02-25 21:34:10 +0100 (Mon, 25 Feb 2008) | 1 line
  
  * Clean version of searchbuf inserted
................
  r10393 | vincents | 2008-02-26 23:06:14 +0100 (Tue, 26 Feb 2008) | 1 line
  
  * fixed TDataset.SetFieldValues
................
  r10398 | michael | 2008-02-27 21:58:49 +0100 (Wed, 27 Feb 2008) | 1 line
  
  * Added test for streaming 2 components
................
  r10400 | vincents | 2008-02-28 00:51:08 +0100 (Thu, 28 Feb 2008) | 1 line
  
  * improved tests for streaming components with owned subcomponents
................
  r10403 | vincents | 2008-02-28 22:19:32 +0100 (Thu, 28 Feb 2008) | 1 line
  
  * fixed writing child components
................
  r10441 | florian | 2008-03-04 20:11:46 +0100 (Tue, 04 Mar 2008) | 3 lines
  
  Initialized merge tracking via "svnmerge" with revisions "1-9261" from 
  http://svn.freepascal.org/svn/fpc/trunk
................
  r10444 | joost | 2008-03-05 11:31:07 +0100 (Wed, 05 Mar 2008) | 30 lines
  
  Merged revisions 9783,9786,9788,9814,9822,9825,9837-9850,9852,9854-9856,9863-9864,9867,9885,9895 via svnmerge from 
  svn+ssh://joost@svn.freepascal.org/FPC/svn/fpc/trunk
  
  ........
    r9783 | joost | 2008-01-18 23:52:13 +0100 (Fri, 18 Jan 2008) | 1 line
    
     * DigestTestREport makes it possible to write the unittest results to a testsuite-digest
  ........
    r9786 | joost | 2008-01-19 00:40:44 +0100 (Sat, 19 Jan 2008) | 1 line
    
     * Added dependency on paszlib to fcl-fpcunit
  ........
    r9788 | jonas | 2008-01-19 01:20:49 +0100 (Sat, 19 Jan 2008) | 2 lines
    
      + also add fpc-unit dependency on paszlib to build dependencies
  ........
    r9854 | joost | 2008-01-21 17:26:20 +0100 (Mon, 21 Jan 2008) | 2 lines
    
     * Added Comment and Category properties to TDigestResultsWriter
     * Write Comment and Category to digest.cfg
  ........
    r9885 | joost | 2008-01-23 22:56:34 +0100 (Wed, 23 Jan 2008) | 1 line
    
     * Write RelSrcDir to digest.cfg
  ........
    r9895 | joost | 2008-01-24 18:02:47 +0100 (Thu, 24 Jan 2008) | 1 line
    
     * Add dash between hostname and date in digest-tarfile
  ........
................
  r10445 | joost | 2008-03-05 11:47:26 +0100 (Wed, 05 Mar 2008) | 9 lines
  
  Merged revisions 10431 via svnmerge from 
  svn+ssh://joost@svn.freepascal.org/FPC/svn/fpc/trunk
  
  ........
    r10431 | joost | 2008-03-02 18:08:16 +0100 (Sun, 02 Mar 2008) | 1 line
    
     * Set Modified to false when te state of a dataset changes
  ........
................
  r10446 | joost | 2008-03-05 15:34:38 +0100 (Wed, 05 Mar 2008) | 9 lines
  
  Merged revisions 10350 via svnmerge from 
  svn+ssh://joost@svn.freepascal.org/FPC/svn/fpc/trunk
  
  ........
    r10350 | joost | 2008-02-17 22:14:26 +0100 (Sun, 17 Feb 2008) | 1 line
    
     * Fixed bug #8464
  ........
................
  r10490 | Almindor | 2008-03-15 11:18:42 +0100 (Sat, 15 Mar 2008) | 3 lines
  
  * add TDataLink.CalcFirstRecord cleanroom implementation (blind)
  * add TField.RefreshLookupList cleanroom implementation (blind)
................
  r10491 | Almindor | 2008-03-15 11:29:54 +0100 (Sat, 15 Mar 2008) | 2 lines
  
  * fix compilation of the TField.RefreshLookuplist;
................
  r10510 | Almindor | 2008-03-20 18:57:22 +0100 (Thu, 20 Mar 2008) | 2 lines
  
  * implement cleanroom TDataset.CalculateFields
................
  r10511 | Almindor | 2008-03-20 19:16:55 +0100 (Thu, 20 Mar 2008) | 2 lines
  
  * add TDataSet.EnableControls cleanroom implementation
................
  r10512 | Almindor | 2008-03-20 19:27:27 +0100 (Thu, 20 Mar 2008) | 2 lines
  
  * add TField.CalcLookupValue cleanroom implementation
................
  r10513 | Almindor | 2008-03-20 19:30:23 +0100 (Thu, 20 Mar 2008) | 2 lines
  
  * fix potential bug in cleanroom TField.RefreshLookupList
................
  r10514 | Almindor | 2008-03-20 19:33:13 +0100 (Thu, 20 Mar 2008) | 2 lines
  
  * add forgotten function call in TDataset.CalculateFields
................
  r10515 | Almindor | 2008-03-20 19:37:19 +0100 (Thu, 20 Mar 2008) | 2 lines
  
  * fix potential bug in cleanroom TDataLink.CalcFirstRecord
................
  r10531 | Almindor | 2008-03-22 10:57:40 +0100 (Sat, 22 Mar 2008) | 2 lines
  
  * implement cleanroom TDataSet.DataEvent
................
  r10534 | Almindor | 2008-03-22 21:30:02 +0100 (Sat, 22 Mar 2008) | 2 lines
  
  * fix cleanroom TDataset.DataEvent, make it call all connected datasources
................
  r10537 | michael | 2008-03-23 11:19:05 +0100 (Sun, 23 Mar 2008) | 6 lines
  
  * Fixed some issues:
    - Memleak in TReader.ReadPropValue. FFixups was re-allocated in beginreferences !
    - FPC behaves different from Delphi if no Default value is declared, it assumes a
      default of ord(TEnum)=0, same for sets.
    - Fixed MemLeak when a reference was resolved, Removed item was not freed.
................
  r10547 | Almindor | 2008-03-24 10:57:28 +0100 (Mon, 24 Mar 2008) | 2 lines
  
  * first fix to cleanroom TDataSet.DataEvent only 6 tests fail now :)
................
  r10553 | joost | 2008-03-24 19:58:33 +0100 (Mon, 24 Mar 2008) | 9 lines
  
  Merged revisions 10470 via svnmerge from 
  svn+ssh://joost@svn.freepascal.org/FPC/svn/fpc/trunk
  
  ........
    r10470 | joost | 2008-03-09 21:11:17 +0100 (Sun, 09 Mar 2008) | 1 line
    
     * Set TDataSet.InternalCalcFields if there are InternalCalcFields
  ........
................
  r10555 | joost | 2008-03-25 12:06:12 +0100 (Tue, 25 Mar 2008) | 9 lines
  
  Merged revisions 10519 via svnmerge from 
  svn+ssh://joost@svn.freepascal.org/FPC/svn/fpc/trunk
  
  ........
    r10519 | joost | 2008-03-21 14:38:44 +0100 (Fri, 21 Mar 2008) | 1 line
    
     * Fix for ValueOfKey for multiple-fields keys
  ........
................
  r10565 | Almindor | 2008-03-25 18:28:58 +0100 (Tue, 25 Mar 2008) | 2 lines
  
  * fix cleanroom TDataLink.CalcFirstRecord (passes tests now)
................

git-svn-id: trunk@10572 -
2008-03-27 20:15:57 +00:00

356 lines
6.4 KiB
PHP

{
This file is part of the Free Component Library (FCL)
Copyright (c) 1999-2000 by the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{****************************************************************************}
{* TCollectionItem *}
{****************************************************************************}
function TCollectionItem.GetIndex: Integer;
begin
if FCollection<>nil then
Result:=FCollection.FItems.IndexOf(Pointer(Self))
else
Result:=-1;
end;
procedure TCollectionItem.SetCollection(Value: TCollection);
begin
IF Value<>FCollection then
begin
If FCollection<>Nil then FCollection.RemoveItem(Self);
if Value<>Nil then Value.InsertItem(Self);
FCollection:=Value;
end;
end;
procedure TCollectionItem.Changed(AllItems: Boolean);
begin
If (FCollection<>Nil) then
begin
If AllItems then
FCollection.Update(Nil)
else
FCollection.Update(Self);
end;
end;
function TCollectionItem.GetNamePath: string;
begin
If FCollection<>Nil then
Result:=FCollection.GetNamePath+'['+IntToStr(Index)+']'
else
Result:=ClassName;
end;
function TCollectionItem.GetOwner: TPersistent;
begin
Result:=FCollection;
end;
function TCollectionItem.GetDisplayName: string;
begin
Result:=ClassName;
end;
procedure TCollectionItem.SetIndex(Value: Integer);
Var Temp : Longint;
begin
Temp:=GetIndex;
If (Temp>-1) and (Temp<>Value) then
begin
FCollection.FItems.Move(Temp,Value);
Changed(True);
end;
end;
procedure TCollectionItem.SetDisplayName(const Value: string);
begin
Changed(False);
end;
constructor TCollectionItem.Create(ACollection: TCollection);
begin
Inherited Create;
SetCollection(ACollection);
end;
destructor TCollectionItem.Destroy;
begin
SetCollection(Nil);
Inherited Destroy;
end;
{****************************************************************************}
{* TCollection *}
{****************************************************************************}
function TCollection.Owner: TPersistent;
begin
result:=getowner;
end;
function TCollection.GetCount: Integer;
begin
If Assigned(FItems) Then
Result:=FItems.Count
else
Result:=0;
end;
Procedure TCollection.SetPropName;
begin
//!! Should be replaced by the proper routines.
FPropName:='';
end;
function TCollection.GetPropName: string;
Var TheOWner : TPersistent;
begin
Result:=FPropNAme;
TheOWner:=GetOwner;
If (Result<>'') or (TheOwner=Nil) Or (TheOwner.Classinfo=Nil) then exit;
SetPropName;
Result:=FPropName;
end;
procedure TCollection.InsertItem(Item: TCollectionItem);
begin
If Not(Item Is FitemClass) then
exit;
FItems.add(Pointer(Item));
Item.FID:=FNextID;
inc(FNextID);
SetItemName(Item);
Notify(Item,cnAdded);
Changed;
end;
procedure TCollection.RemoveItem(Item: TCollectionItem);
begin
Notify(Item,cnExtracting);
FItems.Remove(Pointer(Item));
Item.FCollection:=Nil;
Changed;
end;
function TCollection.GetAttrCount: Integer;
begin
Result:=0;
end;
function TCollection.GetAttr(Index: Integer): string;
begin
Result:='';
end;
function TCollection.GetItemAttr(Index, ItemIndex: Integer): string;
begin
Result:=TCollectionItem(FItems.Items[ItemIndex]).DisplayName;
end;
function TCollection.GetNamePath: string;
var o : TObject;
begin
o:=getowner;
if assigned(o) and (propname<>'') and (o IS TPersistent) then
result:=TPersistent(o).getnamepath+'.'+propname
else
result:=classname;
end;
procedure TCollection.Changed;
begin
if FUpdateCount=0 then
Update(Nil);
end;
function TCollection.GetItem(Index: Integer): TCollectionItem;
begin
Result:=TCollectionItem(FItems.Items[Index]);
end;
procedure TCollection.SetItem(Index: Integer; Value: TCollectionItem);
begin
TCollectionItem(FItems.items[Index]).Assign(Value);
end;
procedure TCollection.SetItemName(Item: TCollectionItem);
begin
end;
procedure TCollection.Update(Item: TCollectionItem);
begin
end;
constructor TCollection.Create(AItemClass: TCollectionItemClass);
begin
inherited create;
FItemClass:=AItemClass;
FItems:=TList.Create;
end;
destructor TCollection.Destroy;
begin
If Assigned(FItems) Then Clear;
FItems.Free;
Inherited Destroy;
end;
function TCollection.Add: TCollectionItem;
begin
Result:=FItemClass.Create(Self);
end;
procedure TCollection.Assign(Source: TPersistent);
Var I : Longint;
begin
If Source is TCollection then
begin
Clear;
For I:=0 To TCollection(Source).Count-1 do
Add.Assign(TCollection(Source).Items[I]);
exit;
end
else
Inherited Assign(Source);
end;
procedure TCollection.BeginUpdate;
begin
inc(FUpdateCount);
end;
procedure TCollection.Clear;
begin
If Assigned(FItems) then
While FItems.Count>0 do TCollectionItem(FItems.Last).Free;
end;
procedure TCollection.EndUpdate;
begin
dec(FUpdateCount);
if FUpdateCount=0 then
Changed;
end;
function TCollection.FindItemID(ID: Integer): TCollectionItem;
Var
I : Longint;
begin
Result:=Nil;
For I:=0 to Fitems.Count-1 do
begin
Result:=TCollectionItem(FItems.items[I]);
If Result.Id=Id then
exit;
end;
end;
procedure TCollection.Delete(Index: Integer);
begin
Notify(TCollectionItem(FItems[Index]),cnDeleting);
TCollectionItem(FItems[Index]).Free;
end;
function TCollection.Insert(Index: Integer): TCollectionItem;
begin
Result:=Add;
Result.Index:=Index;
end;
procedure TCollection.Notify(Item: TCollectionItem;Action: TCollectionNotification);
begin
end;
{****************************************************************************}
{* TOwnedCollection *}
{****************************************************************************}
Constructor TOwnedCollection.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
Begin
FOwner := AOwner;
inherited Create(AItemClass);
end;
Function TOwnedCollection.GetOwner: TPersistent;
begin
Result:=FOwner;
end;