--- Merging r23341 into '.':

U    packages/fcl-stl/src/gvector.pp
--- Merging r23411 into '.':
C    packages/fcl-image/src/fpcanvas.pp  (resolved, no netto change)
--- Merging r24163 into '.':
U    packages/fcl-fpcunit/src/plaintestreport.pp
U    packages/fcl-fpcunit/src/consoletestrunner.pas
U    packages/fcl-fpcunit/src/fpcunitreport.pp
U    packages/fcl-fpcunit/src/latextestreport.pp
--- Merging r24170 into '.':
U    packages/fcl-fpcunit/src/xmlreporter.pas
U    packages/fcl-fpcunit/src/xmltestreport.pp
--- Merging r24172 into '.':
G    packages/fcl-fpcunit/src/xmlreporter.pas
Summary of conflicts:
  Text conflicts: 1

# revisions: 23341,23411,24163,24170,24172,
r23341 | michael | 2013-01-07 16:55:48 +0100 (Mon, 07 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-stl/src/gvector.pp

* Patch from Denis Volodarsky to add enumerator to vector (bug ID #22689)
r23411 | sekelsenmat | 2013-01-16 16:10:42 +0100 (Wed, 16 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/fpcanvas.pp

Fixes a spelling mistake in TFPCustomFont
r24163 | michael | 2013-04-06 14:35:34 +0200 (Sat, 06 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-fpcunit/src/consoletestrunner.pas
   M /trunk/packages/fcl-fpcunit/src/fpcunitreport.pp
   M /trunk/packages/fcl-fpcunit/src/latextestreport.pp
   M /trunk/packages/fcl-fpcunit/src/plaintestreport.pp

* Added SkipTimings option
r24170 | michael | 2013-04-07 10:24:22 +0200 (Sun, 07 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-fpcunit/src/xmlreporter.pas
   M /trunk/packages/fcl-fpcunit/src/xmltestreport.pp

* SkipTiming by Reinier
r24172 | michael | 2013-04-07 12:10:16 +0200 (Sun, 07 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-fpcunit/src/xmlreporter.pas

* Fix compilation

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

packages/fcl-fpcunit/src/consoletestrunner.pas

@@ -29,10 +29,10 @@ uses
   dom;
 
 const
-  Version = '0.2';
+  Version = '0.3';
 
 type
-  TFormat = (fPlain, fLatex, fXML);
+  TFormat = (fPlain, fLatex, fXML, fPlainNoTiming);
 
 var
   DefaultFormat : TFormat = fXML;
@@ -73,8 +73,8 @@ uses testdecorator;
 
 const
   ShortOpts = 'alhp';
-  DefaultLongOpts: array[1..8] of string =
-     ('all', 'list', 'progress', 'help',
+  DefaultLongOpts: array[1..9] of string =
+     ('all', 'list', 'progress', 'help', 'skiptiming',
       'suite:', 'format:', 'file:', 'stylesheet:');
 
   { TProgressWriter }
@@ -145,14 +145,15 @@ end;
 function TTestRunner.GetResultsWriter: TCustomResultsWriter;
 begin
   case FormatParam of
-    fLatex: Result := TLatexResultsWriter.Create(nil);
-    fPlain: Result := TPlainResultsWriter.Create(nil);
+    fLatex:         Result := TLatexResultsWriter.Create(nil);
+    fPlain:         Result := TPlainResultsWriter.Create(nil);
   else
     begin
       Result := TXmlResultsWriter.Create(nil);
       ExtendXmlDocument(TXMLResultsWriter(Result).Document);
     end;
   end;
+  Result.SkipTiming:=HasOption('skiptiming');
 end;
 
 procedure TTestRunner.DoTestRun(ATest: TTest);
@@ -211,6 +212,7 @@ begin
     writeln('  --format=latex            output as latex source (only list implemented)');
     writeln('  --format=plain            output as plain ASCII source');
     writeln('  --format=xml              output as XML source (default)');
+    writeln('  --skiptiming              Do not output timings (useful for diffs of testruns)');
     writeln('  --stylesheet=<reference>   add stylesheet reference');
     writeln('  --file=<filename>         output results to file');
     writeln;
@@ -232,6 +234,8 @@ begin
       FormatParam := fLatex
     else if CompareText(GetOptionValue('format'),'plain')=0 then
       FormatParam := fPlain
+    else if CompareText(GetOptionValue('format'),'plainnotiming')=0 then
+      FormatParam := fPlainNoTiming
     else if CompareText(GetOptionValue('format'),'xml')=0 then
       FormatParam := fXML;
   end;
@@ -369,8 +373,9 @@ begin
   //get a list of all registed tests
   if HasOption('l', 'list') then
     case FormatParam of
-      fLatex: Write(GetSuiteAsLatex(GetTestRegistry));
-      fPlain: Write(GetSuiteAsPlain(GetTestRegistry));
+      fLatex:         Write(GetSuiteAsLatex(GetTestRegistry));
+      fPlain:         Write(GetSuiteAsPlain(GetTestRegistry));
+      fPlainNoTiming: Write(GetSuiteAsPlain(GetTestRegistry));
     else
       Write(GetSuiteAsLatex(GetTestRegistry));;
     end;

packages/fcl-fpcunit/src/fpcunitreport.pp

@@ -62,6 +62,8 @@ type
     procedure IncrementIgnores;
   end;
 
+  { TCustomResultsWriter }
+
   TCustomResultsWriter = class(TComponent, ITestListener)
   private
     FLevel: integer;
@@ -79,6 +81,7 @@ type
     FOnEndTest: TTestEvent;
     FOnStartTestSuite: TTestEvent;
     FOnEndTestSuite: TTestEvent;
+    FSkipTiming: Boolean;
   protected
     procedure WriteTestHeader(ATest: TTest; ALevel: integer; ACount: integer); virtual;
     procedure WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime); virtual;
@@ -118,6 +121,7 @@ type
     property OnEndTest: TTestEvent read FOnEndTest write FOnEndTest;
     property OnStartTestSuite: TTestEvent read FOnStartTestSuite write FOnStartTestSuite;
     property OnEndTestSuite: TTestEvent read FOnEndTestSuite write FOnEndTestSuite;
+    Property SkipTiming : Boolean Read FSkipTiming Write FSkipTiming;
   end; 
 
 implementation

packages/fcl-fpcunit/src/latextestreport.pp

@@ -154,10 +154,16 @@ begin
 end;
 
 procedure TLatexResultsWriter.WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime);
+
+Var
+  S : String;
 begin
   inherited;
-  FDoc.Add(StringOfChar(' ',ALevel*2)+ '  '+ '\item[-] ' + FormatDateTime('ss.zzz', ATiming)  
-    + '  ' + EscapeText(ATest.TestName));
+  S:=StringOfChar(' ',ALevel*2)+ '  '+ '\item[-] ';
+  if Not SkipTiming then
+    S:=S+FormatDateTime('ss.zzz', ATiming);
+  S:=S+ '  ' + EscapeText(ATest.TestName);
+  FDoc.Add(S);
   if Assigned(FTempFailure) then
   begin
     //check if it's an error 
@@ -200,13 +206,18 @@ procedure TLatexResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: i
   ANumIgnores: integer);
 var
   idx: integer;
+  S : String;
+
 begin
   inherited;
   FDoc.Add(StringOfChar(' ',ALevel*2)+ ' \end{itemize}');
   idx := Integer(FSuiteHeaderIdx[FSuiteHeaderIdx.Count -1]);
-  FDoc[idx] := FDoc[idx] + ' {\color{Blue}'+ '  Time:'+ FormatDateTime('ss.zzz', ATiming)+
-    ' N:'+ IntToStr(ANumRuns)+ ' E:'+ IntToStr(ANumErrors)+ ' F:'+ IntToStr(ANumFailures)+ 
-    ' I:'+ IntToStr(ANumIgnores)+'}';
+  S:= ' {\color{Blue}';
+  if Not SkipTiming then
+    S:=S+ ' Time: '+FormatDateTime('ss.zzz', ATiming);
+  S:=S+' N:'+ IntToStr(ANumRuns)+ ' E:'+ IntToStr(ANumErrors)+ ' F:'+ IntToStr(ANumFailures)+
+  ' I:'+ IntToStr(ANumIgnores)+'}';
+  FDoc[idx] := FDoc[idx] +S;
   FSuiteHeaderIdx.Delete(FSuiteHeaderIdx.Count -1);
 end;
 

packages/fcl-fpcunit/src/plaintestreport.pp

@@ -102,10 +102,17 @@ begin
 end;
 
 procedure TPlainResultsWriter.WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime);
+
+Var
+  S : String;
+
 begin
   inherited;
-  FDoc.Add('  ' + StringOfChar(' ',ALevel*2) +  FormatDateTime('ss.zzz', ATiming) + '  ' 
-    + ATest.TestName);
+  S:='  ' + StringOfChar(' ',ALevel*2);
+  if Not SkipTiming then
+    S:=S + FormatDateTime('ss.zzz', ATiming) + '  ';
+  S:=S + ATest.TestName;
+  FDoc.Add(S);
   if Assigned(FTempFailure) then
   begin
     //check if it's an error 
@@ -137,12 +144,15 @@ procedure TPlainResultsWriter.WriteSuiteFooter(ATestSuite: TTestSuite; ALevel: i
   ANumIgnores: integer);
 var
   idx: integer;
+  S: String;
 begin
   inherited;
   idx := Integer(FSuiteHeaderIdx[FSuiteHeaderIdx.Count -1]);
-  FDoc[idx] := FDoc[idx] + ' Time:'+ FormatDateTime('ss.zzz', ATiming)+
-    ' N:'+ IntToStr(ANumRuns)+ ' E:'+ IntToStr(ANumErrors)+ ' F:'+ IntToStr(ANumFailures)+ 
-    ' I:'+ IntToStr(ANumIgnores);
+  if Not SkipTiming then
+    S:= ' Time:'+ FormatDateTime('ss.zzz', ATiming);
+  S:=S+ ' N:'+ IntToStr(ANumRuns)+ ' E:'+ IntToStr(ANumErrors)+ ' F:'+ IntToStr(ANumFailures)+
+    ' I:'+ IntToStr(ANumIgnores) ;
+  FDoc[idx] := FDoc[idx]+S;
   FSuiteHeaderIdx.Delete(FSuiteHeaderIdx.Count -1);
 end;
 

packages/fcl-fpcunit/src/xmlreporter.pas

@@ -18,10 +18,10 @@
   
 
   Purpose:
-    This unit contains a XML TestListener for use with the fpcUnit testing
-    framework.  It uses the XMLWrite unit, which is part of FPC, to generate
-    the XML document. The benefit of using the XMLWrite unit, is that the
-    data generated is valid XML, with resevered characters correctly escaped.
+    This unit contains an XML TestListener for use with the fpcUnit testing
+    framework. It uses the XMLWrite unit, which is part of FPC, to generate
+    the XML document. The benefit of using the XMLWrite unit is that the
+    data generated is valid XML, with reserved characters correctly escaped.
     This allows the XML document to be further processed with XSLT etc without
     any issues.
 
@@ -43,7 +43,7 @@ uses
   
 
 type
-  { XML Test Listner }
+  { XML Test Listener }
 
   { TXMLResultsWriter }
 
@@ -58,6 +58,7 @@ type
     FErrors: TDOMNode;
     FLastTestSuite: TDOMNode;
     FStartCrono: TDateTime;
+    FskipTiming : Boolean;
     { Converts the actual test results into XML nodes. This gets called
       by the public method WriteResult. }
     procedure   TestResultAsXML(pTestResult: TTestResult);
@@ -78,6 +79,7 @@ type
 
     { A public property to the internal XML document }
     property    Document: TXMLDocument read FDoc;
+    Property    SkipTiming : Boolean Read FSkipTiming Write FSkipTiming;
   end;
 
 
@@ -107,9 +109,13 @@ begin
   n.AppendChild(FDoc.CreateTextNode(IntToStr(pTestResult.NumberOfIgnoredTests)));
   lResults.AppendChild(n);
 
-  n := FDoc.CreateElement('TotalElapsedTime');
-  n.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz', Now - pTestResult.StartingTime)));
-  lResults.AppendChild(n);
+  { We don't have access to TCustomResultsWriter so we cannot honour SkipTiming}
+  if not(SkipTiming) then
+  begin
+    n := FDoc.CreateElement('TotalElapsedTime');
+    n.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz', Now - pTestResult.StartingTime)));
+    lResults.AppendChild(n);
+  end;
 
   { Summary of ISO 8601  http://www.cl.cam.ac.uk/~mgk25/iso-time.html }
   n := FDoc.CreateElement('DateTimeRan');
@@ -244,9 +250,12 @@ var
   lNew: TDOMElement;
 begin
   n := FLastTestSuite.LastChild;
-  lNew := FDoc.CreateElement('ElapsedTime');
-  lNew.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz', Now - FStartCrono)));
-  n.AppendChild(lNew);
+  if not(SkipTiming) then
+  begin
+    lNew := FDoc.CreateElement('ElapsedTime');
+    lNew.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz', Now - FStartCrono)));
+    n.AppendChild(lNew);
+  end;
 end;
 
 procedure TXMLResultsWriter.StartTestSuite(ATestSuite: TTestSuite);

packages/fcl-fpcunit/src/xmltestreport.pp

@@ -129,7 +129,8 @@ end;
 procedure TXMLResultsWriter.WriteTestFooter(ATest: TTest; ALevel: integer; ATiming: TDateTime);
 begin
   inherited;
-  FCurrentTest['ElapsedTime'] := FormatDateTime('hh:nn:ss.zzz', ATiming);
+  if not SkipTiming then
+    FCurrentTest['ElapsedTime'] := FormatDateTime('hh:nn:ss.zzz', ATiming);
 end;
 
 
@@ -156,7 +157,8 @@ var
 begin
   inherited;
   n := TDomElement(FSuitePath[FSuitePath.Count -1]);
-  n['ElapsedTime'] := FormatDateTime('hh:nn:ss.zzz', ATiming);
+  if not SkipTiming then
+    n['ElapsedTime'] := FormatDateTime('hh:nn:ss.zzz', ATiming);
   n['NumberOfRunTests'] := IntToStr(ANumRuns);
   n['NumberOfErrors'] := IntToStr(ANumErrors);
   n['NumberOfFailures'] := IntToStr(ANumFailures);
@@ -267,10 +269,13 @@ begin
   n.AppendChild(FDoc.CreateTextNode(IntToStr(aResult.NumberOfIgnoredTests)));
   lResults.AppendChild(n);
 
-  n := FDoc.CreateElement('TotalElapsedTime');
-  n.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz', 
-    Now - aResult.StartingTime)));
-  lResults.AppendChild(n);     
+  if not SkipTiming then
+  begin
+    n := FDoc.CreateElement('TotalElapsedTime');
+    n.AppendChild(FDoc.CreateTextNode(FormatDateTime('hh:nn:ss.zzz',
+      Now - aResult.StartingTime)));
+    lResults.AppendChild(n);
+  end;
 
   { Summary of ISO 8601  http://www.cl.cam.ac.uk/~mgk25/iso-time.html }
   n := FDoc.CreateElement('DateTimeRan');

packages/fcl-stl/src/gvector.pp

@@ -17,33 +17,57 @@ unit gvector;
 interface
 
 type
-  generic TVector<T>=class
+
+  { TVector }
+
+  generic TVector<T> = class
   private
   type
-    PT=^ T;
-    TArr=array of T;
+    PT = ^ T;
+    TArr = array of T;
   var
     FCapacity:SizeUInt;
     FDataSize:SizeUInt;
     FData:TArr;
 
-    procedure SetValue(Position:SizeUInt; Value:T);inline;
-    function GetValue(Position:SizeUInt):T;inline;
-    function GetMutable(Position:SizeUInt):PT;inline;
-    procedure IncreaseCapacity;inline;
+    procedure SetValue(Position: SizeUInt; const Value: T); inline;
+    function GetValue(Position: SizeUInt):T; inline;
+    function GetMutable(Position: SizeUInt):PT; inline;
+    procedure IncreaseCapacity; inline;
+
+  const
+    // todo: move these constants to implementation when
+    // mantis #0021310 will be fixed.
+    SVectorPositionOutOfRange      = 'Vector position out of range';
+    SAccessingElementOfEmptyVector = 'Accessing element of empty vector';
+
+  type
+    TVectorEnumerator = class
+    private
+      FVector: TVector;
+      FPosition: Integer;
+    public
+      constructor Create(AVector: TVector);
+      function GetCurrent: T; inline;
+      function MoveNext: Boolean; inline;
+      property Current: T read GetCurrent;
+    end;
+
   public
     constructor Create;
-    function Size:SizeUInt;inline;
-    procedure PushBack(Value:T);inline;
-    procedure PopBack;inline;
-    function IsEmpty:boolean;inline;
-    procedure Insert(Position:SizeUInt; Value:T);inline;
-    procedure Erase(Position:SizeUInt);inline;
-    procedure Clear;inline;
-    function Front:T;inline;
-    function Back:T;inline;
-    procedure Reserve(Num:SizeUInt);inline;
-    procedure Resize(Num:SizeUInt);inline;
+    function Size: SizeUInt; inline;
+    procedure PushBack(const Value: T); inline;
+    procedure PopBack; inline;
+    function IsEmpty: boolean; inline;
+    procedure Insert(Position: SizeUInt; const Value: T); inline;
+    procedure Erase(Position: SizeUInt); inline;
+    procedure Clear; inline;
+    function Front: T; inline;
+    function Back: T; inline;
+    procedure Reserve(Num: SizeUInt); inline;
+    procedure Resize(Num: SizeUInt); inline;
+
+    function GetEnumerator: TVectorEnumerator;
 
     property Items[i : SizeUInt]: T read getValue write setValue; default;
     property Mutable[i : SizeUInt]: PT read getMutable;
@@ -51,39 +75,61 @@ end;
 
 implementation
 
+{ TVector.TVectorEnumerator }
+
+constructor TVector.TVectorEnumerator.Create(AVector: TVector);
+begin
+  FVector := AVector;
+  FPosition := -1;
+end;
+
+function TVector.TVectorEnumerator.GetCurrent: T;
+begin
+  Result := FVector[FPosition];
+end;
+
+function TVector.TVectorEnumerator.MoveNext: Boolean;
+begin
+  Result := FPosition < FVector.Size - 1;
+  if Result then
+    inc(FPosition);
+end;
+
+{ TVector }
+
 constructor TVector.Create();
 begin
   FCapacity:=0;
   FDataSize:=0;
 end;
 
-procedure TVector.SetValue(Position:SizeUInt; Value:T);inline;
+procedure TVector.SetValue(Position: SizeUInt; const Value: T);
 begin
-  Assert(position < size, 'Vector position out of range');
+  Assert(position < size, SVectorPositionOutOfRange);
   FData[Position]:=Value;
 end;
 
 function TVector.GetValue(Position:SizeUInt):T;inline;
 begin
-  Assert(position < size, 'Vector position out of range');
+  Assert(position < size, SVectorPositionOutOfRange);
   GetValue:=FData[Position];
 end;
 
 function TVector.GetMutable(Position:SizeUInt):PT;inline;
 begin
-  Assert(position < size, 'Vector position out of range');
+  Assert(position < size, SVectorPositionOutOfRange);
   GetMutable:=@FData[Position];
 end;
 
 function TVector.Front():T;inline;
 begin
-  Assert(size > 0, 'Accessing element of empty vector');
+  Assert(size > 0, SAccessingElementOfEmptyVector);
   Front:=FData[0];
 end;
 
 function TVector.Back():T;inline;
 begin
-  Assert(size > 0, 'Accessing element of empty vector');
+  Assert(size > 0, SAccessingElementOfEmptyVector);
   Back:=FData[FDataSize-1];
 end;
 
@@ -100,7 +146,7 @@ begin
     IsEmpty:=false;
 end;
 
-procedure TVector.PushBack(Value:T);inline;
+procedure TVector.PushBack(const Value: T);
 begin
   if FDataSize=FCapacity then
     IncreaseCapacity;
@@ -117,13 +163,18 @@ begin
   SetLength(FData, FCapacity);
 end;
 
+function TVector.GetEnumerator: TVectorEnumerator;
+begin
+  Result := TVectorEnumerator.Create(self);
+end;
+
 procedure TVector.PopBack();inline;
 begin
   if FDataSize>0 then
     FDataSize:=FDataSize-1;
 end;
 
-procedure TVector.Insert(Position:SizeUInt; Value: T);inline;
+procedure TVector.Insert(Position: SizeUInt; const Value: T);
 var i:SizeUInt;
 begin
   pushBack(Value);