diff --git a/packages/fcl-fpcunit/src/consoletestrunner.pas b/packages/fcl-fpcunit/src/consoletestrunner.pas index 3510c20f55..d84a7dee00 100644 --- a/packages/fcl-fpcunit/src/consoletestrunner.pas +++ b/packages/fcl-fpcunit/src/consoletestrunner.pas @@ -295,8 +295,8 @@ Var I : Integer; begin If (T is TTestSuite) then - for I:=0 to TTestSuite(t).Tests.Count-1 do - FreeDecorators(TTest(TTestSuite(t).Tests[i])); + for I:=0 to TTestSuite(t).ChildTestCount-1 do + FreeDecorators(TTest(TTestSuite(t).Test[i])); if (T is TTestDecorator) and (TTestDecorator(T).Test is TDecoratorTestSuite) then T.free; end; @@ -339,7 +339,7 @@ procedure TTestRunner.DoRun; begin if (test is ttestsuite) then begin - for I := 0 to TTestSuite(test).Tests.Count - 1 do + for I := 0 to TTestSuite(test).ChildTestCount - 1 do CheckTestRegistry ((test as TTestSuite).Test[I], c, res) end else if (test is TTestDecorator) then @@ -391,7 +391,7 @@ begin S := ''; S := GetOptionValue('suite'); if S = '' then - for I := 0 to GetTestRegistry.Tests.Count - 1 do + for I := 0 to GetTestRegistry.ChildTestCount - 1 do writeln(GetTestRegistry[i].TestName) else begin @@ -402,13 +402,13 @@ begin P:=Pos(',',S); if P = 0 Then begin - for I := 0 to GetTestRegistry.Tests.count-1 do + for I := 0 to GetTestRegistry.ChildTestCount-1 do CheckTestRegistry (GetTestregistry[I], S, TS); S := ''; end else begin - for I := 0 to GetTestRegistry.Tests.count-1 do + for I := 0 to GetTestRegistry.ChildTestCount-1 do CheckTestRegistry (GetTestregistry[I],Copy(S, 1,P - 1), TS); Delete(S, 1, P); end; diff --git a/packages/fcl-fpcunit/src/fpcunit.pp b/packages/fcl-fpcunit/src/fpcunit.pp index d9b6b08abb..a390711df8 100644 --- a/packages/fcl-fpcunit/src/fpcunit.pp +++ b/packages/fcl-fpcunit/src/fpcunit.pp @@ -241,6 +241,7 @@ type FTestSuiteName: string; FEnableIgnores: boolean; function GetTest(Index: integer): TTest; + function GetTestCount: Integer; protected Function DoAddTest(ATest : TTest) : Integer; function GetTestName: string; override; @@ -263,9 +264,11 @@ type procedure AddTestSuiteFromClass(ATestClass: TClass); virtual; class function Warning(const aMessage: string): TTestCase; property Test[Index: integer]: TTest read GetTest; default; + Property ChildTestCount : Integer Read GetTestCount; property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName; property TestName: string read GetTestName write SetTestName; - property Tests: TFPList read FTests; + // Only for backwards compatibility. Use Test and ChildTestCount. + property Tests: TFPList read FTests; deprecated; end; TProtect = procedure(aTest: TTest; aResult: TTestResult); @@ -1199,6 +1202,11 @@ begin Result := TTestItem(FTests[Index]).Test; end; +function TTestSuite.GetTestCount: Integer; +begin + Result:=FTests.Count; +end; + function TTestSuite.DoAddTest(ATest: TTest): Integer; begin Result:=FTests.Add(TTestItem.Create(ATest)); diff --git a/packages/fcl-fpcunit/src/latextestreport.pp b/packages/fcl-fpcunit/src/latextestreport.pp index 19ca4032bb..66bdf9bdd8 100644 --- a/packages/fcl-fpcunit/src/latextestreport.pp +++ b/packages/fcl-fpcunit/src/latextestreport.pp @@ -257,7 +257,7 @@ var begin Result := TLatexResultsWriter.EscapeText(aSuite.TestSuiteName) + System.sLineBreak; Result := Result + '\begin{itemize}'+ System.sLineBreak; - for i := 0 to aSuite.CountTestCases - 1 do + for i := 0 to aSuite.ChildTestCount - 1 do if ASuite.Test[i] is TTestSuite then begin Result:=Result + '\item[-] '; diff --git a/packages/fcl-fpcunit/src/plaintestreport.pp b/packages/fcl-fpcunit/src/plaintestreport.pp index 058f8c6b03..5a84449353 100644 --- a/packages/fcl-fpcunit/src/plaintestreport.pp +++ b/packages/fcl-fpcunit/src/plaintestreport.pp @@ -214,7 +214,7 @@ var p : string; begin Result := Prefix+ASuite.TestName+System.sLineBreak; - for i := 0 to aSuite.CountTestCases - 1 do + for i := 0 to aSuite.ChildTestCount - 1 do if aSuite.Test[i] is TTestSuite then begin P:=Prefix; diff --git a/packages/fcl-fpcunit/src/testregistry.pp b/packages/fcl-fpcunit/src/testregistry.pp index 976a7a0e7e..002d7665a7 100644 --- a/packages/fcl-fpcunit/src/testregistry.pp +++ b/packages/fcl-fpcunit/src/testregistry.pp @@ -63,7 +63,7 @@ var lSuiteName: String; lPathRemainder: String; lDotPos: Integer; - lTests: TFPList; + begin if APath = '' then begin @@ -89,19 +89,15 @@ begin // Check to see if the path already exists lTargetSuite := nil; - lTests := ARootSuite.Tests; - for i := 0 to lTests.Count -1 do - begin - lCurrentTest := TTest(lTests[i]); - if lCurrentTest is TTestSuite then + I:=0; + While (lTargetSuite=Nil) and (I' + System.sLineBreak; Inc(Indent, 2); - for i := 0 to aSuite.Tests.Count - 1 do - if TTest(aSuite.Tests.Items[i]) is TTestSuite then - Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Tests.Items[i]),Indent) + for i := 0 to aSuite.ChildTestCount - 1 do + if TTest(aSuite.Test[i]) is TTestSuite then + Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Test[i]),Indent) else - if TTest(aSuite.Tests.Items[i]) is TTestCase then - Result := Result + StringOfChar(' ',Indent) + '' + TTestcase(aSuite.Tests.Items[i]).TestName + '' + System.sLineBreak; + if TTest(aSuite.Test[i]) is TTestCase then + Result := Result + StringOfChar(' ',Indent) + '' + TTestcase(aSuite.Test[i]).TestName + '' + System.sLineBreak; Dec(Indent, 2); Result := Result + StringOfChar(' ',Indent) + '' + System.sLineBreak; end; +function EscapeText(const S: string): String; +var + i: integer; +begin + SetLength(Result, 0); + for i := 1 to Length(S) do + case S[i] of + '&','{','}','#','_','$','%': // Escape these characters + Result := Result + '\' + S[i]; + '~','^': + Result := Result + '\'+S[i]+' '; + '\': + Result := Result + '$\backslash$'; + '<': + Result := Result + '$<$'; + '>': + Result := Result + '$>$' + else + Result := Result + S[i]; + end; +end; function TestSuiteAsLatex(aSuite:TTestSuite): string; var i,j: integer; s: TTestSuite; begin - Result := '\flushleft' + System.sLineBreak; - for i := 0 to aSuite.Tests.Count - 1 do - begin - s := TTestSuite(ASuite.Tests.Items[i]); - Result := Result + s.TestSuiteName + System.sLineBreak; - Result := Result + '\begin{itemize}'+ System.sLineBreak; - for j := 0 to s.Tests.Count - 1 do - if TTest(s.Tests.Items[j]) is TTestCase then - Result := Result + '\item[-] ' + TTestcase(s.Tests.Items[j]).TestName + System.sLineBreak; - Result := Result +'\end{itemize}' + System.sLineBreak; - end; + Result := EscapeText(aSuite.TestSuiteName) + System.sLineBreak; + Result := Result + '\begin{itemize}'+ System.sLineBreak; + for i := 0 to aSuite.ChildTestCount - 1 do + if ASuite.Test[i] is TTestSuite then + begin + Result:=Result + '\item[-] '; + Result := Result + '\flushleft' + System.sLineBreak; + Result:=Result+TestSuiteAsLatex(TTestSuite(ASuite.Test[i]))+System.sLineBreak; + end + else + begin + Result := Result + '\item[-] ' + + EscapeText(TTestcase(aSuite.Test[i]).TestName) + + System.sLineBreak; + end; + Result := Result +'\end{itemize}' + System.sLineBreak; end; function TestSuiteAsPlain(aSuite:TTestSuite): string; @@ -220,12 +246,12 @@ var i,j: integer; s: TTestSuite; begin - for i := 0 to aSuite.Tests.Count - 1 do - if TTest(aSuite.Tests.Items[i]) is TTestSuite then - Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Tests.Items[i])) + for i := 0 to aSuite.ChildTestCount - 1 do + if TTest(aSuite.Test[i]) is TTestSuite then + Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Test[i])) else - if TTest(aSuite.Tests.Items[i]) is TTestCase then - Result := Result + ' ' + ASuite.TestName+'.' + TTestcase(aSuite.Tests.Items[i]).TestName + System.sLineBreak; + if TTest(aSuite.Test[i]) is TTestCase then + Result := Result + ' ' + ASuite.TestName+'.' + TTestcase(aSuite.Test[i]).TestName + System.sLineBreak; end; function GetSuiteAsXML(aSuite: TTestSuite): string; diff --git a/packages/fcl-fpcunit/src/xmltestreport.pp b/packages/fcl-fpcunit/src/xmltestreport.pp index 46fb060db5..6bda9c6e9d 100644 --- a/packages/fcl-fpcunit/src/xmltestreport.pp +++ b/packages/fcl-fpcunit/src/xmltestreport.pp @@ -112,7 +112,7 @@ begin end else E:=N; - for i:=0 to Pred(aSuite.CountTestCases) do + for i:=0 to Pred(aSuite.ChildTestCount) do if TTest(aSuite.Test[i]) is TTestSuite then TestSuiteAsXML(E, FDoc, TTestSuite(aSuite.Test[i])) else