Explorar el Código

* Fix memory leaks in tests

git-svn-id: trunk@24770 -
michael hace 12 años
padre
commit
98c9425c8b

+ 2 - 1
packages/fcl-db/tests/dbtestframework_gui.lpi

@@ -59,6 +59,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="4">
@@ -87,7 +88,7 @@
     <Version Value="11"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src/base;../src/sqldb/odbc;../src/sqldb/mssql;../src/sqldb/sqlite;../src/sqldb/postgres;../src/sqldb/oracle;../src/memds;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mysql;../src/dbase;../src/sdf"/>
+      <OtherUnitFiles Value="../src/base;../src/sqldb/odbc;../src/sqldb/mssql;../src/sqldb/sqlite;../src/sqldb/postgres;../src/sqldb/oracle;../src/memds;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mysql;../src/dbase;../src/sdf;../src/export"/>
     </SearchPaths>
     <Linking>
       <Debugging>

+ 0 - 1
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -534,7 +534,6 @@ begin
     end; // try
     end;
   inherited Destroy;
-
   FreeAndNil(FQuery);
   FreeAndNil(FTransaction);
   FreeAndNil(FConnection);

+ 20 - 8
packages/fcl-db/tests/testbasics.pas

@@ -136,6 +136,7 @@ var ds       : TDataset;
     
 begin
   ds := TDataset.Create(nil);
+  try
 
   F1:=TStringField.Create(ds);
   F1.Size := 10;
@@ -164,6 +165,10 @@ begin
   CompareFieldAndFieldDef(F1,ds.FieldDefs[0]);
   CompareFieldAndFieldDef(F2,ds.FieldDefs[1]);
   CompareFieldAndFieldDef(F3,ds.FieldDefs[2]);
+  finally
+    ds.Free;
+  end;
+
 end;
 
 procedure TTestBasics.TestDoubleFieldDef;
@@ -173,22 +178,29 @@ begin
   // If a second field with the same name is added to a TFieldDefs, an exception
   // should occur
   ds := TDataset.create(nil);
-  ds.FieldDefs.Add('Field1',ftInteger);
-  PassException:=False;
   try
-    ds.FieldDefs.Add('Field1',ftString,10,false)
-  except
-    on E: EDatabaseError do PassException := True;
+    ds.FieldDefs.Add('Field1',ftInteger);
+    PassException:=False;
+    try
+      ds.FieldDefs.Add('Field1',ftString,10,false)
+    except
+      on E: EDatabaseError do PassException := True;
+    end;
+    AssertTrue(PassException);
+  finally
+    ds.Free;
   end;
-  AssertTrue(PassException);
 end;
 
 procedure TTestBasics.TestFieldDefWithoutDS;
 var FieldDefs : TFieldDefs;
 begin
   FieldDefs := TFieldDefs.Create(nil);
-  FieldDefs.Add('test',ftString);
-  FieldDefs.Free;
+  try
+    FieldDefs.Add('test',ftString);
+  finally
+    FieldDefs.Free;
+  end;
 end;
 
 procedure TTestBasics.TestGetFieldList;

+ 106 - 71
packages/fcl-db/tests/testdbbasics.pas

@@ -1383,8 +1383,12 @@ begin
   ds.close;
 
   LoadDs := TCustomBufDataset.Create(nil);
-  LoadDs.LoadFromFile('test.xml');
-  FTestXMLDatasetDefinition(LoadDS);
+  try
+    LoadDs.LoadFromFile('test.xml');
+    FTestXMLDatasetDefinition(LoadDS);
+  finally
+    LoadDS.free;
+  end;
 end;
 
 procedure TTestBufDatasetDBBasics.TestFileNameProperty;
@@ -1414,26 +1418,31 @@ var ds : TCustomBufDataset;
     i  : integer;
 begin
   ds := TCustomBufDataset.Create(nil);
-  DS.FieldDefs.Add('ID',ftInteger);
-  DS.FieldDefs.Add('NAME',ftString,50);
-  DS.CreateDataset;
-  DS.Open;
-  for i := 1 to 10 do
-    begin
-    ds.Append;
-    ds.FieldByName('ID').AsInteger := i;
-    ds.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
-    DS.Post;
-    end;
-  ds.first;
-  for i := 1 to 10 do
-    begin
-    CheckEquals(i,ds.fieldbyname('ID').asinteger);
-    CheckEquals('TestName' + inttostr(i),ds.fieldbyname('NAME').AsString);
-    ds.next;
-    end;
-  CheckTrue(ds.EOF);
-  DS.Close;
+    try
+    DS.FieldDefs.Add('ID',ftInteger);
+    DS.FieldDefs.Add('NAME',ftString,50);
+    DS.CreateDataset;
+    DS.Open;
+    for i := 1 to 10 do
+      begin
+      ds.Append;
+      ds.FieldByName('ID').AsInteger := i;
+      ds.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+      DS.Post;
+      end;
+    ds.first;
+    for i := 1 to 10 do
+      begin
+      CheckEquals(i,ds.fieldbyname('ID').asinteger);
+      CheckEquals('TestName' + inttostr(i),ds.fieldbyname('NAME').AsString);
+      ds.next;
+      end;
+    CheckTrue(ds.EOF);
+    DS.Close;
+
+  finally
+    ds.Free;
+  end;
 end;
 
 procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd;
@@ -1580,10 +1589,20 @@ begin
     checkequals(fields[0].OldValue,i);
     checkequals(fields[1].OldValue,s);
     CheckEquals(ChangeCount,1);
+    Next;
+    Edit;
+    i := fields[0].AsInteger;
+    s := fields[1].AsString;
+    fields[0].AsInteger:=23;
+    fields[1].AsString:='hanged';
+    Post;
+    checkequals(fields[0].OldValue,i);
+    checkequals(fields[1].OldValue,s);
+    CheckEquals(ChangeCount,2);
     MergeChangeLog;
     CheckEquals(ChangeCount,0);
-    checkequals(fields[0].OldValue,64);
-    checkequals(fields[1].OldValue,'Changed');
+    checkequals(fields[0].OldValue,23);
+    checkequals(fields[1].OldValue,'hanged');
     end;
 end;
 
@@ -1716,6 +1735,7 @@ begin
     AFieldType:=ftString;
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
     FList := TStringList.Create;
+    try
     FList.Sorted:=true;
     FList.CaseSensitive:=True;
     FList.Duplicates:=dupAccept;
@@ -1744,6 +1764,9 @@ begin
       CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
       Prior;
       end;
+    finally
+      flist.free;
+    end;  
     end;
 end;
 
@@ -1760,34 +1783,38 @@ begin
     AFieldType:=ftString;
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'F'+FieldTypeNames[AfieldType]);
     FList := TStringList.Create;
-    FList.Sorted:=true;
-    FList.CaseSensitive:=True;
-    FList.Duplicates:=dupAccept;
-    open;
+    try
+      FList.Sorted:=true;
+      FList.CaseSensitive:=True;
+      FList.Duplicates:=dupAccept;
+      open;
 
-    while not eof do
-      begin
-      flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Next;
-      end;
+      while not eof do
+        begin
+        flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Next;
+        end;
 
-    IndexName:='testindex';
-    first;
-    i:=FList.Count-1;
+      IndexName:='testindex';
+      first;
+      i:=FList.Count-1;
 
-    while not eof do
-      begin
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      dec(i);
-      Next;
-      end;
+      while not eof do
+        begin
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        dec(i);
+        Next;
+        end;
 
-    while not bof do
-      begin
-      inc(i);
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Prior;
-      end;
+      while not bof do
+        begin
+        inc(i);
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Prior;
+        end;
+    finally
+      flist.free;
+    end;  
     end;
 end;
 
@@ -1804,33 +1831,37 @@ begin
     AFieldType:=ftString;
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]);
     FList := TStringList.Create;
-    FList.Sorted:=true;
-    FList.Duplicates:=dupAccept;
-    open;
+    try
+      FList.Sorted:=true;
+      FList.Duplicates:=dupAccept;
+      open;
 
-    while not eof do
-      begin
-      flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Next;
-      end;
+      while not eof do
+        begin
+        flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Next;
+        end;
 
-    IndexName:='testindex';
-    first;
-    i:=0;
+      IndexName:='testindex';
+      first;
+      i:=0;
 
-    while not eof do
-      begin
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      inc(i);
-      Next;
-      end;
+      while not eof do
+        begin
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        inc(i);
+        Next;
+        end;
 
-    while not bof do
-      begin
-      dec(i);
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Prior;
-      end;
+      while not bof do
+        begin
+        dec(i);
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Prior;
+        end;
+    finally
+      FList.Free;
+    end;  
     end;
 end;
 
@@ -1915,6 +1946,7 @@ begin
     begin
     AFieldType:=ftString;
     FList := TStringList.Create;
+    try
     FList.Sorted:=true;
     FList.CaseSensitive:=True;
     FList.Duplicates:=dupAccept;
@@ -1971,6 +2003,9 @@ begin
       end;
 
     CheckEquals('',IndexFieldNames);
+    finally
+      flist.free;
+    end;  
 
     end;
 end;

+ 12 - 5
packages/fcl-db/tests/testdbexport.pas

@@ -13,9 +13,16 @@ interface
 uses
   fpcunit, testregistry,
   Classes, SysUtils, db, ToolsUnit, bufdataset,
-  fpDBExport, fpXMLXSDExport, fpdbfexport, fpcsvexport, fpfixedexport,
-  fpSimpleXMLExport, fpsimplejsonexport, fpSQLExport,
-  fptexexport, fprtfexport;
+  fpDBExport,
+  fpXMLXSDExport,
+  fpdbfexport,
+  fpcsvexport,
+  fpfixedexport,
+  fpSimpleXMLExport,
+  fpsimplejsonexport,
+  fpSQLExport,
+  fptexexport,
+  fprtfexport;
 
 
 type
@@ -146,7 +153,7 @@ procedure TTestDBExport.SetUp;
 begin
   inherited SetUp;
   InitialiseDBConnector;
-  //DBConnector.StartTest; //is this needed?
+  DBConnector.StartTest; //is this needed?
   FExportTempDir:=IncludeTrailingPathDelimiter(ExpandFileName(''))+'exporttests'+PathDelim; //Store output in subdirectory
   ForceDirectories(FExportTempDir);
   FKeepFilesAfterTest:=true; //keep test files; consistent with other units right now
@@ -155,7 +162,7 @@ end;
 procedure TTestDBExport.TearDown;
 begin
   inherited TearDown;
-  //DBConnector.StopTest; //is this needed?
+  DBConnector.StopTest; //is this needed?
   FreeDBConnector;
 end;
 

+ 5 - 0
packages/fcl-db/tests/testfieldtypes.pas

@@ -224,6 +224,7 @@ begin
       TSQLDBConnector(DBConnector).CommitDDL;
       end;
   finally
+    AScript.Free;
     TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
     TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
     // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
@@ -2242,8 +2243,10 @@ begin
       open;
     except
       on E: Exception do
+      begin
         passed := (E.ClassType.InheritsFrom(EDatabaseError))
       end;
+      end;
     AssertTrue(passed);
 
     Close;
@@ -2272,10 +2275,12 @@ end;
 procedure TTestFieldTypes.SetUp;
 begin
   InitialiseDBConnector;
+  DBConnector.StartTest;
 end;
 
 procedure TTestFieldTypes.TearDown;
 begin
+  DBConnector.StopTest;
   if assigned(DBConnector) then
     TSQLDBConnector(DBConnector).Transaction.Rollback;
   FreeDBConnector;

+ 1 - 0
packages/fcl-db/tests/toolsunit.pas

@@ -242,6 +242,7 @@ begin
   if assigned(FUsedDatasets) then FUsedDatasets.Destroy;
   DropNDatasets;
   DropFieldDataset;
+  Inherited;
 end;
 
 function TDBConnector.GetTestUniDirectional: boolean;