unit uCOSBI_TTest;
{
  COSBI: Comprehensive Open Source Benchmarking Initiative
  Copyright (c) 2004 Van Smith

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  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.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

  The current web address of the GNU General Public License is:
  http://www.gnu.org/licenses/gpl.html

  You can contact the authors of this software at:
  cosbi@vanshardware.com
  See www.vanshardware.com or www.cosbi.org for more contact details.
}
//==============================================================================
// Unit name: uCOSBI_TTest
// Unit description: TTest is the base class for all COSBI tests.
// Author: Van Smith
// Date: March 24, 2003
// OS dependent: Yes: Windows
// Resolution dependent: No, but resolution and color depth may impact scores.
// External unit dependencies: COSBI_Common, COSBI_Status
//==============================================================================
// Modification History
// ------------ -------
// Ver  Date   Who    Description
// ==== ====== ====== ==========================================================
// 1.0 020503 Van     Created.
// 1.1 030324 Van     Created separate unit and updated to support Status
//                    window.
// 1.2 031017 Van     Added TQTests and fQTestType. Increased status display
//                    time. Added OutputForm.
// 1.3 040128 Van     Added a multitude of new tests.  Added raw score and
//                    units.
//==============================================================================

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, COSBI_Common, COSBI_Status, uOutput;

type

  TQTests = (
    qtFirstTest, // must always be first!
    // the order of these tests will be reflected in how the results are reported.
    qtGrid, qtGridFP, qtFibThreads, qtNBody, qtPiThreads, qtPlotTrig,
    qtPlotTrig2, qtPlotLines, qtRandomDots, qtMandelbrotThreads, qtCircles,
    qtMaze, qtFern, qtRichEd, qtDrawEllipses, qtPi, qtDhrystoneThreads,
    qtWhetstoneThreads, qtMazeThreads, qtDrawRectangles, qtBandwidthBP64old,
    qtMemLatencyOld, qtOrthogonalThreads, qtIdenticalThreads, qtDrawLines,
    qtJpgDecode, qtImageResize, qtImageRotate, qtMP3Encode, qtWebPageLoad,
    qtZipCompress, qtEncryptDecryptOld, qtFileCopy, qtFPMultiply, qtLorenz,
    qtNBodyOpenGL,
    qtLaunchProgramThreads,
    qtTCPlotLines, qtTCMaze,
    qtFib, qtDhrystone, qtWhetstone, qtFernThreads,
    qtEncryptDecrypt, qtBandwidthBP64, qtMemLatency, qtPngOut, qt7zip, qtUpx
    , qtLastTest // must always be last!
    );

  TTestType = (ttCPU, ttFPU, tt3dGraphics, tt2dGraphics, ttDisk,
               ttMemory, ttSystem, ttSSE, ttSSE2, tt3dNow, ttThreads,
               ttThinClient, ttCryptography);

  TTest = class( TObject )
  private
  protected
    fRunCount   : integer;
    fTotalTime  : double;
    fMaxTime    : double;
    fMinTime    : double;
    fLastTime   : double;
    fReferenceTime : double;
    fReferenceTime2 : double;
    fStopWatch  : TStopWatch;
    fTestName   : string;
    fTestDescription : string;
    fTestVersion: string;
    fTestType   : TTestType;
    fQTestType   : TQTests;
    fTestAuthor : string;
    ffrmStatus  : TfrmStatus;
    fShowStatus : Boolean;
    fShowStatusTime : integer;
    fOutputForm  : TfrmOutput;
    fRawScore : double;
    fRawUnits : string;
    fSpinUp : Boolean;
    function GetAverageTime : double;
    function GetTestName : string; Virtual;
    function GetTestDescription : string; Virtual;
    function GetRawScore : double; Virtual;
    function GetRawUnits : string;
    procedure IntializeFPU;
    procedure CreateStatusFull(ai_PauseMilliSec : integer);
    procedure SetRunCount( Value : integer );
  public
    constructor Create; Overload;
    function GetFormattedMinTime : string;
    function GetScore(ai_index : integer) : integer; Virtual;
    procedure Run; Virtual;
    procedure Clear; Virtual;
    procedure BeforeTest; Virtual;
    procedure RunTest; Virtual;
    procedure AfterTest; Virtual;
    property RunCount:   integer     read fRunCount write SetRunCount;
    property TotalTime:  double      read fTotalTime;
    property MaxTime:    double      read fMaxTime;
    property MinTime:    double      read fMinTime;
    property LastTime:   double      read fLastTime;
    property StopWatch:  TStopWatch  read fStopWatch write fStopWatch;
    property AverageTime  : double   read GetAverageTime;
    property TestName     : string  read GetTestName write fTestName;
    property TestDescription : string read GetTestDescription write fTestDescription;
    property TestVersion  : string read fTestVersion write fTestVersion;
    property TestType     : TTestType read fTestType write fTestType;
    property TestAuthor   : string read fTestAuthor write fTestAuthor;
    property ShowStatus : Boolean read fShowStatus write fShowStatus;
    property ShowStatusTime : integer read fShowStatusTime write fShowStatusTime;
    property QTestType   : TQTests read fQTestType write fQTestType;
    property OutputForm : TfrmOutput read fOutputForm write fOutputForm;
    property RawScore : double read GetRawScore;
    property RawUnits : string read GetRawUnits;
    property SpinUp : Boolean read fSpinUp write fSpinUp;
  end; // TTest ................................................

const
  PI = 3.141592653589793238462643383279502884197;
  ERR_NO_STOPWATCH = ': You need to give me a StopWatch before I can run!';

implementation

const
  DEFAULT_STATUS_TIME = 3000; // ms
  SPIN_UP_FIB_NUMBER = 39;

// TTest begins............................................................

  constructor TTest.Create;
  begin
    inherited;
    fSpinUp := FALSE;
    Clear;
    fShowStatus := TRUE;
    fShowStatusTime := DEFAULT_STATUS_TIME;
    // explcitly initializing the FPU causes performance on the VIA C3 to
    // improve by 150% or more
    IntializeFPU;
  end; // constructor TTest.Create;

  function TTest.GetFormattedMinTime : string;
  begin
    result := FloatToStrF(fMinTime,ffNumber,6, 3);
  end;

  function TTest.GetTestName : string;
  begin
    result := fTestName;
  end; // function TTest.GetTestName : string;

  function TTest.GetTestDescription : string;
  begin
    result := fTestDescription;
  end; // function TTest.GetTestName : string;

  procedure TTest.IntializeFPU;
  asm
    finit
    wait
  end;

  procedure TTest.Run;
  begin
    if fStopWatch = nil then begin
      raise Exception.Create( fTestName + ERR_NO_STOPWATCH );
    end;
    try
      BeforeTest;
      fStopWatch.StartTimer;
      RunTest;
      fStopWatch.StopTimer;
      fRunCount := fRunCount + 1;
      fLastTime := fStopWatch.ElapsedTime;
      fTotalTime := fTotalTime + fLastTime;
      if fLastTime > fMaxTime then fMaxTime := fLastTime;
      if fLastTime < fMinTime then fMinTime := fLastTime;
    finally
      AfterTest;
    end;
  end; // procedure TTest.Run;

  function TTest.GetScore( ai_index : integer) : integer;
  begin
    if ai_index = 0 then begin
      result := Round(1000 * ( fReferenceTime / fMinTime ));
    end else begin
      result := Round(1000 * ( fReferenceTime2 / fMinTime ));
    end;
  end;

  procedure TTest.SetRunCount( Value : integer );
  begin
    fRunCount := Value - 1;
  end; // procedure SetRunCount( Value : integer );

  procedure TTest.Clear;
  begin
    // initialize field variables:
    fTotalTime  := 0;
    fMaxTime    := 0;
    fMinTime    := 1e100;
    fLastTime   := 0;
    fRawScore   := 0;
  end; //procedure TTest.Clear;

  function TTest.GetAverageTime;
  begin
    if fRunCount = 0 then begin
      result := 0
    end else begin
      result := fTotalTime / fRunCount;
    end;
  end; //procedure TTest.AverageTime;

  procedure TTest.RunTest;
  begin
    // This is a placeholder for the actual test
  end; //procedure TTest.RunTest;

  procedure TTest.CreateStatusFull(ai_PauseMilliSec : integer);
  var
    ls_TestType : string;
  begin
    ffrmStatus := TfrmStatus.Create( nil );
    ffrmStatus.Show;
    ffrmStatus.Clear;
    ffrmStatus.AddLine('Test name: ' + fTestName);
    ffrmStatus.AddLine('Test description: ' + TestDescription);
    ffrmStatus.AddLine('Test version: ' + fTestVersion);
    ffrmStatus.AddLine('Test authors: ' + fTestAuthor);
    case fTestType of
    ttCPU: ls_TestType := 'CPU';
    ttFPU: ls_TestType := 'FPU';
    tt3dGraphics: ls_TestType := '3d-Graphics';
    tt2dGraphics: ls_TestType := '2d-Graphics';
    ttDisk: ls_TestType := 'Disk';
    ttMemory:  ls_TestType := 'Memory';
    ttSystem: ls_TestType := 'System';
    ttSSE: ls_TestType := 'SSE';
    ttSSE2: ls_TestType := 'SSE2';
    tt3dNow: ls_TestType := '3dNow!';
    ttThreads: ls_TestType := 'Threads';
    else
      ls_TestType := 'Unknown';
    end; // case
    ffrmStatus.AddLine('Test type: ' + ls_TestType);
    ffrmStatus.AddLine('Run #: ' + IntToStr( fRunCount + 1) );
    if not fSpinUp then sleep( ai_PauseMilliSec );
  end; // procedure CreateStatusFull

  procedure TTest.BeforeTest;
  begin
    if fShowStatus then begin
      CreateStatusFull( fShowStatusTime );
    end; // if
    if fSpinUp then Fibonacci(SPIN_UP_FIB_NUMBER);
  end; //procedure TTest.BeforeTest;

  procedure TTest.AfterTest;
  var
    ld_Score : double;
  begin
    // This is a placeholder
    if fShowStatus then begin
      ffrmStatus.AddLine('TEST COMPLETE');
      ld_Score := GetScore( 0 );
      ffrmStatus.AddLine(Format('Score: %6.0n', [ld_Score]));
      if not fSpinUp then sleep( fShowStatusTime ) else Fibonacci(SPIN_UP_FIB_NUMBER);
    end; // if
    freeAndNil( ffrmStatus );
  end; //procedure TTest.AfterTest;

  function TTest.GetRawScore : double;
  begin
    result := fRawScore;
  end; // function TTest.GetRawScore

  function TTest.GetRawUnits : string;
  begin
    result := fRawUnits;
  end; // function TTest.GetRawUnits

// TTest ends...................................................................

end.
