Browse Source

--- Merging r20570 into '.':
U rtl/objpas/classes/stringl.inc
U rtl/objpas/classes/classesh.inc
--- Merging r20574 into '.':
U rtl/objpas/classes/persist.inc

# revisions: 20570,20574
------------------------------------------------------------------------
r20570 | michael | 2012-03-22 13:10:06 +0100 (Thu, 22 Mar 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/classesh.inc
M /trunk/rtl/objpas/classes/stringl.inc

* Applied patch from Luiz Amerigo to have Delphi compatible behaviour when freeing a stringlist (bug 21529)
------------------------------------------------------------------------
------------------------------------------------------------------------
r20574 | michael | 2012-03-22 15:49:43 +0100 (Thu, 22 Mar 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/persist.inc

* Call getOwner only once in several TPersistent methods (Patch from Luiz Americo, bug #21531)
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20582 -

marco 13 years ago
parent
commit
b29aa68a3d
3 changed files with 35 additions and 28 deletions
  1. 1 0
      rtl/objpas/classes/classesh.inc
  2. 11 5
      rtl/objpas/classes/persist.inc
  3. 23 23
      rtl/objpas/classes/stringl.inc

+ 1 - 0
rtl/objpas/classes/classesh.inc

@@ -680,6 +680,7 @@ type
     FOwnsObjects : Boolean;
     FOwnsObjects : Boolean;
     procedure ExchangeItems(Index1, Index2: Integer);
     procedure ExchangeItems(Index1, Index2: Integer);
     procedure Grow;
     procedure Grow;
+    procedure InternalClear;
     procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
     procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
     procedure SetSorted(Value: Boolean);
     procedure SetSorted(Value: Boolean);
     procedure SetCaseSensitive(b : boolean);
     procedure SetCaseSensitive(b : boolean);

+ 11 - 5
rtl/objpas/classes/persist.inc

@@ -68,12 +68,14 @@ end;
 function  TPersistent.GetNamePath: string;
 function  TPersistent.GetNamePath: string;
 
 
 Var OwnerName :String;
 Var OwnerName :String;
+    TheOwner: TPersistent;
 
 
 begin
 begin
- Result:=ClassNAme;
- If GetOwner<>Nil then
+ Result:=ClassName;
+ TheOwner:=GetOwner;
+ If TheOwner<>Nil then
    begin
    begin
-   OwnerName:=GetOwner.GetNamePath;
+   OwnerName:=TheOwner.GetNamePath;
    If OwnerName<>'' then Result:=OwnerName+'.'+Result;
    If OwnerName<>'' then Result:=OwnerName+'.'+Result;
    end;
    end;
 end;
 end;
@@ -84,10 +86,14 @@ end;
 {****************************************************************************}
 {****************************************************************************}
 
 
 procedure TInterfacedPersistent.AfterConstruction;
 procedure TInterfacedPersistent.AfterConstruction;
+
+Var TheOwner: TPersistent;
+
 begin
 begin
   inherited;
   inherited;
-  if assigned(GetOwner) then
-    GetOwner.GetInterface(IUnknown,FOwnerInterface);
+  TheOwner:=GetOwner;
+  if assigned(TheOwner) then
+    TheOwner.GetInterface(IUnknown,FOwnerInterface);
 end;
 end;
 
 
 
 

+ 23 - 23
rtl/objpas/classes/stringl.inc

@@ -908,7 +908,28 @@ begin
   SetCapacity(NC);
   SetCapacity(NC);
 end;
 end;
 
 
+Procedure TStringList.InternalClear;
 
 
+Var
+  I: Integer;
+
+begin
+  if FOwnsObjects then
+    begin
+      For I:=0 to FCount-1 do
+        begin
+          Flist^[I].FString:='';
+          freeandnil(Flist^[i].FObject);
+        end;
+    end
+  else
+    begin
+      For I:=0 to FCount-1 do
+        Flist^[I].FString:='';
+    end;
+  FCount:=0;
+  SetCapacity(0);
+end;
 
 
 Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
 Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
 var
 var
@@ -1128,13 +1149,8 @@ end;
 
 
 destructor TStringList.Destroy;
 destructor TStringList.Destroy;
 
 
-Var I : Longint;
-
 begin
 begin
-  FOnChange:=Nil;
-  FOnChanging:=Nil;
-  Clear;
-  SetCapacity(0);
+  InternalClear;
   Inherited destroy;
   Inherited destroy;
 end;
 end;
 
 
@@ -1156,26 +1172,10 @@ end;
 
 
 Procedure TStringList.Clear;
 Procedure TStringList.Clear;
 
 
-Var I : longint;
-
 begin
 begin
   if FCount = 0 then Exit;
   if FCount = 0 then Exit;
   Changing;
   Changing;
-  if FOwnsObjects then
-    begin
-      For I:=0 to FCount-1 do
-        begin
-          Flist^[I].FString:='';
-          freeandnil(Flist^[i].FObject);
-        end;
-    end
-  else
-    begin
-      For I:=0 to FCount-1 do
-        Flist^[I].FString:='';
-    end;
-  FCount:=0;
-  SetCapacity(0);
+  InternalClear;
   Changed;
   Changed;
 end;
 end;