From ff7f64d95ca92b644e0d66e2195a69344895b2ce Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 14 Oct 2010 12:29:19 +0200 Subject: Moved tiOPF related units into the tiOPF repository. It makes more sense to have the tiOPF related units with the rest of the tiOPF. It's easier to keep changes in sync, and have atomic commits across the various GUI toolkits supported by tiOPF. --- .../Demo_TtiBaseObject/PerformanceTesting.lpi | 59 ----- .../Demo_TtiBaseObject/PerformanceTesting.lpr | 31 --- extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas | 218 ------------------ .../demos/Demo_TtiBaseObject/performancetest.lpi | 117 ---------- .../demos/Demo_TtiBaseObject/performancetest.lpr | 248 --------------------- 5 files changed, 673 deletions(-) delete mode 100644 extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpi delete mode 100644 extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpr delete mode 100644 extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas delete mode 100644 extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpi delete mode 100644 extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpr (limited to 'extras/tiopf/demos/Demo_TtiBaseObject') diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpi b/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpi deleted file mode 100644 index 047ccf7a..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpi +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpr b/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpr deleted file mode 100644 index e43592fd..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpr +++ /dev/null @@ -1,31 +0,0 @@ -{ - This demo does performance testing of the TtiBaseObject to see the difference - when Reference Counting is enabled, linked in or not. -} -program PerformanceTesting; - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, frm_main; - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - try - frm.Show; - fpgApplication.Run; - finally - frm.Free; - end; -end; - -begin - MainProc; -end. - diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas b/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas deleted file mode 100644 index 6b39cf0d..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas +++ /dev/null @@ -1,218 +0,0 @@ -unit frm_main; - -{$mode objfpc}{$H+} - -// You need to enable these in tiOPF's tiDefines.inc as well. -{.$Define object_tracking} -{$Define reference_counting} - - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listbox, fpg_memo, fpg_combobox, fpg_grid, - fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, - fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu, - fpg_panel, fpg_popupcalendar, fpg_gauge; - -type - - TMainForm = class(TfpgForm) - private - procedure PerformanceTestNoReferenceCounting(Sender: TObject); - procedure PerformanceTestReferenceCounting(Sender: TObject); - procedure btnTestValidClick(Sender: TObject); - procedure Log(const AMessage: string); - public - {@VFD_HEAD_BEGIN: MainForm} - btnNoRefCount: TfpgButton; - btnRefCount: TfpgButton; - btnTestValid: TfpgButton; - memName1: TfpgMemo; - lblName1: TfpgLabel; - lblName2: TfpgLabel; - memLog: TfpgMemo; - {@VFD_HEAD_END: MainForm} - constructor Create(AOwner: TComponent); override; - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - tiUtils, - tiBaseObject; - -const - CTestRunTime = 5; // Seconds - CTestCount = 1000000; // 1 million - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.PerformanceTestNoReferenceCounting(Sender: TObject); -var - LO: TtiBaseObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TtiBaseObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (no reference counting)', - [tiIntToCommaStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMainForm.PerformanceTestReferenceCounting(Sender: TObject); -{$ifdef reference_counting} -var -// LO: IInterface; - LO: TtiBaseObject; // We are testing object creation only. Hence a class and not interface reference. - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TtiBaseObject.CreateWithRefCounting; - LO.Free; // we are testing object creation. This remove the garbage collector. - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (reference counting)', - [tiIntToCommaStr(LCount), tiGetTickCount - LStart])); -{$else} -begin - Assert(False, 'reference_counting not enabled'); -{$endif} -end; - -procedure TMainForm.btnTestValidClick(Sender: TObject); -var - LO: TtiBaseObject; -begin - LO := TtiBaseObject.Create; - Assert(LO.TestValid); - LO.Free; - Assert(not LO.TestValid); -end; - -procedure TMainForm.Log(const AMessage: string); -begin - memLog.Lines.Add(AMessage); - memLog.Invalidate; -end; - -constructor TMainForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - memLog.Lines.Clear; - {$ifdef object_tracking} - Log('object_tracking is ON'); - {$else} - btnTestValid.Enabled := False; - Log('object_tracking is OFF'); - {$endif} - {$ifdef reference_counting} - Log('reference_counting is ON'); - {$else} - Log('reference_counting is OFF'); - btnRefCount.Enabled := False; - {$endif} - Log('---'); -end; - -procedure TMainForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(307, 319, 357, 290); - WindowTitle := 'TtiBaseObject Performance Demo'; - WindowPosition := wpScreenCenter; - - btnNoRefCount := TfpgButton.Create(self); - with btnNoRefCount do - begin - Name := 'btnNoRefCount'; - SetPosition(16, 28, 155, 23); - Text := 'No reference counting'; - FontDesc := '#Label1'; - ImageName := ''; - OnClick := @PerformanceTestNoReferenceCounting; - end; - - btnRefCount := TfpgButton.Create(self); - with btnRefCount do - begin - Name := 'btnRefCount'; - SetPosition(16, 56, 155, 23); - Text := 'Reference counting'; - FontDesc := '#Label1'; - ImageName := ''; - OnClick := @PerformanceTestReferenceCounting; - end; - - btnTestValid := TfpgButton.Create(self); - with btnTestValid do - begin - Name := 'btnTestValid'; - SetPosition(16, 112, 155, 23); - Text := 'TtiBaseObject.TestValid'; - FontDesc := '#Label1'; - ImageName := ''; - OnClick := @btnTestValidClick; - end; - - memName1 := TfpgMemo.Create(self); - with memName1 do - begin - Name := 'memName1'; - SetPosition(176, 28, 176, 125); - Lines.Add('Toggle the conditional defines'); - Lines.Add('REFERENCE_COUNTING '); - Lines.Add('and OBJECT_TRACKING on '); - Lines.Add('and off to examine behaviour.'); - FontDesc := '#Edit1'; - Enabled := False; - end; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(8, 8, 160, 15); - Text := 'Performance'; - FontDesc := '#Label2'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(8, 92, 160, 15); - Text := 'TtiBaseObject.TestValid'; - FontDesc := '#Label2'; - end; - - memLog := TfpgMemo.Create(self); - with memLog do - begin - Name := 'memLog'; - SetPosition(8, 164, 344, 121); - Lines.Add(''); - FontDesc := '#Edit1'; - end; - - {@VFD_BODY_END: MainForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpi b/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpi deleted file mode 100644 index cf7d5e86..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpi +++ /dev/null @@ -1,117 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpr b/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpr deleted file mode 100644 index d42615cc..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpr +++ /dev/null @@ -1,248 +0,0 @@ -{ - This program tests the speed of Reference Counted and non-Reference Counted - objects over a set time period. Default of 5 seconds. -} -program performancetest; - -{$mode objfpc}{$H+} - -uses - Classes, SysUtils, CustApp; - -const - CTestCount = 1000000; // 1 million - -type - TMyApplication = class(TCustomApplication) - protected - procedure DoRun; override; - procedure TestRefCountedObjects; - procedure TestNonRefCountedObjects; - procedure TestRefCountedMyObjects; - procedure TestNonRefCountedMyObjects; - procedure Log(const AMessage: string); - public - constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; - procedure WriteHelp; virtual; - end; - - - TMyBaseObject = class(TObject, IUnknown) - private - FRefCounting: Boolean; - FRefCount: Integer; - protected - function QueryInterface(const IID: TGUID; out Obj): longint; stdcall; - function _AddRef: longint; stdcall; - function _Release: longint; stdcall; - public - constructor Create; - destructor Destroy; override; - constructor CreateWithRefCounting; - procedure AfterConstruction; override; - procedure BeforeDestruction; override; - class function NewInstance: TObject; override; - end; - -{ TMyBaseObject } - -function TMyBaseObject.QueryInterface(const IID: TGUID; out Obj): longint; stdcall; -begin - if GetInterface(IID, Obj) then - Result := 0 - else - Result := E_NOINTERFACE; -end; - -function TMyBaseObject._AddRef: longint; stdcall; -begin - Result := InterlockedIncrement(FRefCount); -end; - -function TMyBaseObject._Release: longint; stdcall; -begin - Result := InterlockedDecrement(FRefCount); - if FRefCounting then - if Result = 0 then - Destroy; -end; - -constructor TMyBaseObject.Create; -begin - FRefCounting := False; -end; - -destructor TMyBaseObject.Destroy; -begin - inherited Destroy; -end; - -constructor TMyBaseObject.CreateWithRefCounting; -begin - Create; - FRefCounting := True; -end; - -procedure TMyBaseObject.AfterConstruction; -begin - inherited AfterConstruction; - // Release the constructor's implicit refcount - if FRefCounting then - InterlockedDecrement(FRefCount); -end; - -procedure TMyBaseObject.BeforeDestruction; -begin - if FRefCounting then - if FRefCount <> 0 then - System.Error(reInvalidPtr); - inherited BeforeDestruction; -end; - -class function TMyBaseObject.NewInstance: TObject; -begin - Result := inherited NewInstance; - TMyBaseObject(Result).FRefCount := 1; -end; - -function tiGetTickCount: Cardinal; -begin - Result := Cardinal(Trunc(Now * 24 * 60 * 60 * 1000)); -end; - - -{ TMyApplication } - -procedure TMyApplication.DoRun; -var - ErrorMsg: String; -begin - // quick check parameters - ErrorMsg := CheckOptions('h','help'); - if ErrorMsg <> '' then - begin - ShowException(Exception.Create(ErrorMsg)); - Halt; - end; - - // parse parameters - if HasOption('h','help') then - begin - WriteHelp; - Halt; - end; - -// TestNonRefCountedMyObjects; - TestNonRefCountedObjects; - TestRefCountedObjects; - TestNonRefCountedMyObjects; - TestRefCountedMyObjects; - - // stop program loop - Terminate; -end; - -procedure TMyApplication.TestRefCountedObjects; -var - LO: TInterfacedObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TInterfacedObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (reference counting with TInterfacedObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.TestNonRefCountedObjects; -var - LO: TObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (no reference counting with TObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.TestRefCountedMyObjects; -var - LO: TMyBaseObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TMyBaseObject.CreateWithRefCounting; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (reference counting with MyBaseObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.TestNonRefCountedMyObjects; -var - LO: TMyBaseObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TMyBaseObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (no reference counting with MyBaseObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.Log(const AMessage: string); -begin - writeln(AMessage); -end; - -constructor TMyApplication.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - StopOnException := True; -end; - -destructor TMyApplication.Destroy; -begin - inherited Destroy; -end; - -procedure TMyApplication.WriteHelp; -begin - { add your help code here } - writeln('Usage: ',ExeName,' -h'); -end; - -var - Application: TMyApplication; -begin - Application := TMyApplication.Create(nil); - Application.Title := 'My Application'; - Application.Run; - Application.Free; -end. - -- cgit v1.2.3-70-g09d2