Creating data driven tests dynamically with FPTest/DUnit

I've been trying, whenever possible, to write tests along side new code i write. In fact, in one recent mid sized project, i created the tests before writing the code and the experience was broadly positive.

Given the personal need of a JSON Schema validator implemented in pascal, i decided to write one and, naturally, with a test driven approach.

The JSON Schema organization maintains a language agnostic test suite.  It's comprised of JSON files describing the specifications for each rule a validator must check.

I could write a program to convert the JSON specification to pascal units with the tests cases like i've done with mustache spec, but is far from optimal approach, imposing the need to recreate the test application each time a change is done in the spec.

So, i looked a way to create the tests dynamically reading directly the JSON files. A quick search lead me to the solution of creating a custom TTestCase class with a published method (named generically as Run) that implements the test. An instance of this class is created for each test, passing the appropriate data.

While it works, this approach has the drawback of the generic method name that would clutter the test runner output with meaningless information. To overcome this issue is possible to aggregate tests in one big test case, e.g., a unique test case for JSON Schema type rule, instead of creating one test case for each test description.

With the confidence that should exist a better solution, i digged into FPTest source code (a freepascal port of DUnit2) looking how i could have the best of two worlds, data driven dynamic tests with the granularity of handcraft tests.

Fortunately, i've got a way. The key is to subclass TTestProc and properly instantiate it .

  TJSONSchemaTestProc = class(TTestProc)
  private
    FData: TJSONObject;
    procedure ExecuteTest(SchemaData, TestData: TJSONObject);
    procedure ExecuteTests;
  public
    constructor Create(Data: TJSONObject);
  end;

constructor TJSONSchemaTestProc.Create(Data: TJSONObject);
begin
  inherited Create(@ExecuteTests, '', @ExecuteTests, Data.Get('description', 'jsonschema-test'));
  FData := Data;
end;

A TJSONObject with the test specification is passed in constructor. A not published method (ExecuteTests) is registered with the description of the test as name.

procedure TJSONSchemaTestProc.ExecuteTest(SchemaData, TestData: TJSONObject);
var
  Description: String;
  ValidateResult: Boolean;
begin
  Description := TestData.Get('description', '');
  ValidateResult := ValidateJSON(TestData.Elements['data'], SchemaData);
  if TestData.Booleans['valid'] then
    CheckTrue(ValidateResult, Description)
  else
    CheckFalse(ValidateResult, Description);
end;

procedure TJSONSchemaTestProc.ExecuteTests;
var
  SchemaData: TJSONObject;
  TestsData: TJSONArray;
  i: Integer;
begin
  SchemaData := FData.Objects['schema'];
  TestsData := FData.Arrays['tests'];
  for i := 0 to TestsData.Count - 1 do
    ExecuteTest(SchemaData, TestsData.Objects[i]);
end;

In ExecuteTests, the assertions (called in the specification tests) are executed one by one.

With this i get a comprehensive test suite that allows to effectively drive the development.

 

While took me some time to understand the FPTest/DUnit2 source code, the solution ended simpler and clearer than i think earlier. In a way that i foresee using this technique for testing other projects, not only third party specifications.

BTW: the test runner source code can be found here

Effect of using a constant parameter for string types (revisited)

Long eight years ago i wrote an post about using const for string parameters and effects in generated code. It showed benefits in using const for string types but was far from difference showed with similar test done with Delphi. I never bothered to replicate in Freepascal, i took it as granted.

As the discussion arose in forum, i decided to do a test equals to Delphi one, basically just using the parameter without modifying it, by the way, the most common usage.

I compared

procedure ByValueReadOnly(V: String);
begin
  DoIt(V);
end;

with

procedure ByReferenceReadOnly(const V: String);
begin
  DoIt(V);
end;    

The result talks by itself

Also compared

procedure ByValue(V: String);
begin
  V := V + 'x';
  DoIt(V);
end;

with

procedure ByReference(const V: String);
var
  S: String;
begin
  S := V + 'x';
  DoIt(S);
end;

The generated code is similar, size and performance wise.

For those that underestimate the impact of such differences, read this.

For the curious (or the wary), i uploaded the code.

Resistance was futile: Git won

I consider myself a seasoned Subversion user.  Since at least 2005, when FreePascal migrated to SVN, i've been using it to manage my own projects or projects that i collaborate. It's not by chance that i bought not one, but two licenses from SmartSVN.

I'm also a adept of "If it ain't broke, don't fix it" philosophy so i did not bother to change the source code management software even with all the fuzz around Git. A system designed for distributed development would not improve over what Subversion offers for an "one man" work flow. Or so i thought.

With the time, i started to use Git to interact with a couple of GitHub hosted projects. Initially, just to fetch the code and, eventually, to send patches, or better, do pull requests. Following other teams work flows based in advanced branch management, i realized that Git could improve my software development efforts. So i bite the bullet, read a book and started to migrate my repositories.

And I do not regret, here are a few cases where Git made my life easier:

• Save and share local modifications. There was times when i needed to test local, work in progress modifications in other environments before commiting. To do so, i had to keep moving a patch file around. Now i just create a temporary branch and push it, later delete it. No need to worry with HD crashes or messing with the main development line.
• Sync a forked repository. In Subversion days, i had to manually sync the Lazarus VirtualTreeView fork. Only those that did a three way merge of 1MB of source code with heavy modifications knows how hard is. Now is a matter of doing a merge and resolving a few conflicts
• Test different Lazarus package versions. When maintaining Lazarus packages in different branches, to switch between versions is necessary to load the respective file. With git no need to load a different file, just checkout the branch and recompile.
• Develop alongside upstream projects. Some times there are changes that are not suitable to send upstream. Git makes easy to maintain personal changes at same time that tracks main development line. No need to bother upstream maintainers.

MV* with Lazarus: between Presenter and ViewModel

The MVC conundrum

Sooner or later a programmer will get in touch with the acronym MVC (Model-View-Controller). Despite its ubiquitous presence in discussions or articles about code design, there's few comprehensive examples of using this pattern with Delphi / Lazarus. Most of the examples are just "one form application" that does not show how to organize a large scale application. There's not even a common pattern between them, some have reference to the controller in the view while others do the opposite.

This is not an object pascal exclusive issue. Other languages have the same problem and the reason is simple: the MVC as was designed to Smalltalk decades ago does not fits naturally in the modern, event driven, GUI architecture. The MVP (Model-View-Presenter) and its variations Passive View and Supervising Controller updates the pattern to match the requirements of today user interfaces. There's also Presentation Model and its most famous deviation MVVM (Model-View-ViewModel).

Meeting the presentation layer

All in all, the objective of all these patterns are to separate the presentation from the business layer thus facilitating the code maintenance. The difference lies in the responsibility of each presentation layer component and how they interact with the model (business object). In order to improve the architecture of my Lazarus projects, i found that the MVP is the most doable to be used with object pascal. There are good examples of MVP/PassiveView with Delphi that could be easily adapted but, in my opinion, is overkill and counterproductive to define read and write properties for each GUI element.

I have forms as simple as seem below

procedure TAppConfigViewForm.FormShow(Sender: TObject);
begin
  BaseURLEdit.Text := Config.BaseURL;
end;

procedure TAppConfigViewForm.SaveButtonClick(Sender: TObject);
begin
  Config.BaseURL := BaseURLEdit.Text;
  Config.Save;
end;

Having to define a view and a presenter interfaces and implement a presenter to such a simple view is a no-no to me. On the other hand, in complexes views, handling the GUI logic in a separated component is worth the work.

With these in mind, i defined an interface (IPresentation) to abstract how a view (TForm) is configured and show. To use just reference one by a string id, call SetProperties to set published properties and ShowModal to show it.

  
var
  Presentation: IPresentation;

Presentation := PresentationManager['myview'];
Presentation.SetProperties(['ConfigProp', FConfig]).ShowModal;

The presentations are registered to a specialized IoC container through two overloaded methods:

  
IPresentationManager = interface
  procedure Register(const PresentationName: String; ViewClass: TFormClass);
  procedure Register(const PresentationName: String; PresenterClass: TPresenterClass);
end;

Both has a PresentationName argument that will identify the presentation. The first overload accepts a TFormClass, the view is instantiated directly and there's no presenter. The second, accepts a PresenterClass that will be responsible to show the view.

This is how the presenter and view classes looks:

//presenter 
interface

  TNutritionEvaluationPresenter = class(TBasePresenter)
  public
    function ShowModal: TModalResult; override;
    function CanImportPreviousEvaluation: Boolean;
    procedure ImportPreviousEvaluation;
    procedure SaveEvaluation;
    property EvaluationData: TJSONObject read GetEvaluationData;
  end;

implementation

uses
  NutritionEvaluationView;


function TNutritionEvaluationPresenter.ShowModal: TModalResult;
var
  View: TNutritionEvaluationViewForm;
begin
  View := TNutritionEvaluationViewForm.Create(nil);
  try
    View.Presenter := Self;
    Result := View.ShowModal;
  finally
    View.Destroy;
  end;
end;

//view
interface

uses
  NutritionEvaluationPresenter;


  TNutritionEvaluationViewForm = class(TForm)
  [..]
  published
    property Presenter: TNutritionEvaluationPresenter read FPresenter write SetPresenter;
  end;

procedure TNutritionEvaluationViewForm.ImportPreviousLabelClick(Sender: TObject);
begin
  FPresenter.ImportPreviousEvaluation;
end;

procedure TNutritionEvaluationViewForm.SaveButtonClick(Sender: TObject);
begin
  FPresenter.SaveEvaluation;
end;

procedure TNutritionEvaluationViewForm.FormShow(Sender: TObject);
begin
  ImportPreviousLabel.Visible := FPresenter.CanImportPreviousEvaluation;
  //update GUI with evaluation data
end;

The Presenter here is acting more like a ViewModel (expose data, state, operations to view) than a true presenter. It works fine but with serious caveats:

• The view and the presenter know each other which defeats the purpose of independent implementations. Also is not possible to hold a view reference in presenter interface (circular unit reference)
• The TForm presenter property must be set manually (subject to forget)
• Registering a TForm class that expects a presenter directly will crash since there'll be no presenter

Interfaces and conventions to the rescue

I was not not really satisfied with the above approach, so reworked the code and got the following design:

• The presentation register method now has three arguments: name, view class and presenter class (optional). When the presenter class is not defined, the view is instantiated directly
• The view (TForm) is show by the internal code. No need to the presenter do it.
• If a presenter class is specified, the view class must define a published property named Presenter. An error is throw if the property does not exists or if is of an incompatible type
• The presenter property can be declared as a interface also, allowing to completely decouple the presenter from the view implementations
• There's the possibility to bind a view instance to a presenter property. Not implemented since, until now I did not need.

So much talk. The current code can be found here  and a example how I use it here.

Thoughts about application architeture with Lazarus

The Delphi books of my days (or why i'm not guilt of my application's poor design)

As most of Lazarus developers, i started to code in Delphi (in fact i learned computer programming with turbo pascal) and to get most of the tool i read some books, i bought three or four and read part of others in bookstores. This is supposed to be a good practice when learning a new technology.

The problem, noticed by me only years later, is the lack of teaching of good application design like separation of concerns (view, business, persistence layers) and how to achieve them with Delphi. Most of the books focused in the visual aspect (how to create a good looking form, reports etc) and how to setup datasets and the db aware controls. The closer to a good practice advice was putting datasets and datasources in data modules instead of forms.

We can't even blame the book authors. The Delphi's greatest selling point was (is?) the Rapid Application Development (RAD) features.

Recipes for a bulky spaghetti

In early days, when developing my applications, i was a diligent student: i put database logic in data modules and designed the forms as specified in the books. But, as all developers that created applications with more than three forms knows, things started to get hard to evolve and maintain.

Keeping the database components in data modules did not help much. You end with shared dataset states, and all problems that comes with it, across different parts of applications.

Below is a data module's snapshot of my first big application (still in production, by the way).

It could be even worse if i had not started to use a TDataset factory in the middle of development 

In the end, the project has code like:

  // a form to select a profile
  DataCenter.PrescriptionProfilesDataset.Open;
  with TLoadPrescriptionProfileForm.Create(AOwner) do
  try
    Result := ShowModal;
    if Result = mrYes then
      DataCenter.LoadPrescriptionProfile;
  finally
    DataCenter.PrescriptionProfilesDataset.Close;
    Destroy;
  end;
  
  //snippet of DataCenter.LoadPrescriptionProfile (copy the selected profile to PrescriptionItemsDataset)
  with PrescriptionItemsDataset do
  begin
    DisableControls;
    try
      FilterPrescriptionProfileItems(PrescriptionProfilesDataset.FieldByName('Id').AsInteger);
      while not PrescriptionProfileItemsDataset.Eof do
      begin
        NewMedication := PrescriptionProfileItemsDataset.FieldByName('Medication').AsString;
        if Lookup('Medication', NewMedication, 'Id') = Null then
        begin
          Append;
          FieldByName('PatientId').AsInteger := PatientsDatasetId.AsInteger;
          FieldByName('Medication').AsString := NewMedication;
          FieldByName('Dosage').AsString := PrescriptionProfileItemsDataset.FieldByName('Dosage').AsString;
          [..]
          Post;
        end;
        PrescriptionProfileItemsDataset.Next;
      end;
      ApplyUpdates;
      PrescriptionProfileItemsDataset.Close;
    finally
      EnableControls;
    end;
  end;

Its not necessary to be a software architect guru to know that this is unmanageable

Eating the pasta with business objects and inversion of control

In the projects that succeeded the first one, most of the data related code is encapsulated in business objects. The data module does not contain TDataset instances anymore, it's responsible only to act as a TDataset factory and to implement some specific data action. To work with dataset it's necessary just reference one from a key which leads to code like the below:

  FWeightHistoryDataset := DataModule.GetQuery(Self, 'weighthistory');
  FWeightHistoryDataset.ParamByName('prontuaryid').AsInteger := FId;
  FWeightHistoryDataset.Open;

This fixes the shared state issue since each dataset has a clear, limited scope. But does not solve the  business objects dependency of a global instance (DataModule), which  makes testing harder.

In the project that i'm starting, i solved the dependency to the global instance by using the service locator pattern through the IoC Container i cited in a previous post. I defined a resource factory service that is resolved as soon as the business object is created, opening the doors to setup testing environments in a clear manner.

All done?

Not yet. The business logic is contained in specific classes, there's no shared state across application and no hardcoded global dependency but the view layer (forms) is still (dis)organized  in the classic way with each TForm calling and being called by other ones directly. This problem, and the solutions i'm working, will be the subject to a future post.

Number of units, optimization and executable size

I tend to split my code in small units instead of writing a big unit with lot of classes or functions. The drawback is the large number of files but, in my opinion, the benefits outweight it.


One thing that always bothered me was if this practice has any effect in file size.


Seems not. I wrote two versions of the same program. In the first, all classes (one descendant of another) are defined in the same unit while in the second each class lives in a separated unit. When compiled with the debugging info the separated program is a little bigger. This difference in size does not exist when compiled without debugging info.


As a side note, i noticed that compiling with -O2 flag leads to smaller executables compared with -O1, the Lazarus default. It's just a few kilobytes but worth the note.  

Using TComponent with automatic reference count

For some time, i know the concepts of Inversion of Control (IoC) and Dependency Injection (DI) as well the benefits they bring but never used them in my code.  Now that i'm a starting a new project from scratch, and the deadline is not so tight, i decided to raise the bar for my code design.

I'll implement an IoC container in the line of VSoft's one. While adding the possibility of doing DI through constructor injection would be great, i won't implement it. It's not a hard requirement of mine and fpc currently does not support the features (basically Delphi's new RTTI) needed to implement it without hacks.

Automatic reference counting

Most of Delphi IoC implementations use COM interfaces and rely on the automatic reference count to manage object instance life cycle. So do i. This approach's drawback is that the class to be instantiated must handle the reference count. When designing new classes or when class hierarchy can be modified, is sufficient to inherit from TInterfaced* classes. The problem rises when is necessary to use a class that has a defined hierarchy and does not handle reference counting, like LCL ones.

Since i plan to decouple TForm descendants, i need a way to use them with the IoC container. Below is the (rough) design, in pseudo code:

//Define interface
  IPersonView = interface
  ['{9B5BBA42-E82B-4CA0-A43D-66A22DCC10DE}']
    procedure DoIt;
  end;

  //Implement an IPersonView
  TPersonViewForm = class(TForm, IPersonView)   
    procedure DoIt;
  end;

  //Register implementation   
  Container.Register(IPersonView, TPersonViewForm); 

  //Instantiate the view
  Container.Resolve(IPersonView)

At first look, it should work seamlessly. And in fact does: a TPersonViewForm is instantiated and returned as IPersonView. The only issue is that the object instance will never be freed even when the interface reference goes out of scope. This occurs because _AddRef and _Release methods of TComponent does not handle reference count by default.

VCLComObject to the rescue

Examining the code, we observe that TComponent _AddRef and _Release forwards to VCLComObject property. There's not good documentation or examples of using this property. So i wrote an example to see if it would solve my problem.

Basically i wrote TComponentReference, a descendant of TInterfacedObject with a dummy implementation of IVCLComObject that gets a TComponent reference in the constructor and free it in BeforeDestruction.

constructor TComponentReference.Create(Component: TComponent);
begin
  FComponent := Component;
end;
procedure TComponentReference.BeforeDestruction;
begin
  inherited BeforeDestruction;
  FComponent.Free;
end;

And this is how i tested:

function GetMyIntf: IMyIntf;
var
  C: TMyComponent;
  R: IVCLComObject;
begin
  C := TMyComponent.Create(nil);
  R := TComponentReference.Create(C);
  C.VCLComObject := R;
  Result := C as IMyIntf;
end;
var
  MyIntf: IMyIntf;
begin
  MyIntf := GetMyIntf;
  MyIntf.DoIt;
end.   

It worked! I get a IMyIntf reference and no memory leaks. Easier than i initially think.

The code can be downloaded here.

The cost to supress a warning (and how not pay for it)

In the previous post, i pointed that passing a managed type (dynamic array) as a var parameter is more efficient than returning the value as a function result. However this technique have a known side effect: the compiler outputs a message  (Warning: Local variable "XXX" does not seem to be initialized) each time a call to the procedure is compiled.

The direct way to suppress the warning is change the parameter from var to out. Pretty simple but out does more than inhibit the compiler message. It implicitly initialize managed types parameters to nil or add a call FPC_INITIALIZE if the parameter is a record that has at least a field of a managed type. It does not add implicit code to simple types like Integer or class instances (TObject etc).

Although the performance impact is mostly negligible, is extra code anyway. In my case i initialize the parameter explicitly so out would add redundant code. There's an alternative to suppress the message: add the directive {%H-} in front of the variable that is being passed to the procedure. In the example of the previous post would be:

BuildRecArray({%H-}Result);

It can be annoying if the function is called often or the routine is part of a public API, otherwise is fine. At least for me.

Update: out does not generate initialization code for records that contains only fields which type is not automatically managed by the compiler, e.g., Integer.

Does it matter how dynamic arrays are passed/returned to/from a routine?

I was implementing a routine that should return a dynamic array and wondered if the produced code of a function and a procedure with a var parameter are different. So, i setup a simple test:

type
  TMyRec = record
    O: TObject;
    S: String;
  end;

  TMyRecArray = array of TMyRec;

function BuildRecArray: TMyRecArray;
begin
  SetLength(Result, 1);
  Result[0].O := nil;
  Result[0].S := 'x';
end;

procedure BuildRecArray(var Result: TMyRecArray);
begin
  SetLength(Result, 1);
  Result[0].O := nil;
  Result[0].S := 'x';
end;

var
  Result: TMyRecArray;

begin
  BuildRecArray(Result); //or Result := BuildRecArray
end.

Looking at the generated assembly revealed that the function version (returns the array in the result) leads to bigger code when compared with the procedure version (pass the array as a var parameter). More: the code difference is due to an implicit exception frame which is known to impact performance.

And what about the caller code? Again the function version generates more code (creates a temporary variable and calls FPC_DYNARRAY_DECR_REF).

In short: yes, it matters.

The cost of using generics

Since a few versions, fpc provides support for generics. It allows the developer to save some typing and also improves type safety at the time that prevents unsafe typecasts.

Unfortunately it's benefits is not for free.  Every time a generic is specialized, the whole implementation code is copied into the unit/program.

To be more clear, i created two examples that implements a list of a custom class (TMyObj): one uses a TFPList, the other specializes a TFPGList. The difference in usage is that the former needs a typecast.

I compiled both with fpc 2.6.0 under windows. The result is a difference in executable size of 2Kb, the generic version being bigger. Than i looked the generated asm: the code to use the list classes are the same, the difference comes from the copy of implementation of  TFPGList.

Many will say that code size is not a issue anymore given the availability of big hard drives, but i still think that is a good practice seeking smaller code. Regarding generics, it should be used, IMHO, when benefits are clear like classes that are instantiated many times in user (programmer) code and avoided in internal structures of e.g. RTL or third party libraries.

Generic cross data report with lazreport

In the lazreport repository there's a demo app showing how to create a cross data report. It uses two instances of TfrUserDataset: one for the master (row) data and one for the cross (column) data. At first glance the component does not provide another way to build such reports. A deeper look shows the contrary. Here are the steps to build a cross data report with arbitrary number of rows and columns.

WARNING: to follow this guide is necessary basic lazreport knowledge.

Prepare the report

Nothing special here

• Create an empty report


• Add a Master Data band


• Add a Cross Data band


• Add a Text Object inside the Cross Data


• In the Text Object put a variable named value: [value]

Add handler to retrieve the value

Those familiar with lazreport will have no problems:

procedure TForm1.frReport1GetValue(const ParName: String; var ParValue: Variant);
begin
  if ParName = 'value' then
    ParValue := IntToStr(FRow) + ' - ' + IntToStr(FCol);
end; 

Just the column and row indexes for demonstration purpose. Using together with matrix like data structures the retrieve of actual data is straightforward.

Set the number of rows and columns

The most attentive developers will notice that no dataset (even the virtual dataset) was linked to each band. In fact running the report at this stage will lead to a blank page.
If the number of columns and rows are previously know just set the Virtual Dataset option for each band. This is not an optimum solution since not always we have that info. Here's how to set the Virtual Dataset record count at runtime:

procedure TForm1.frReport1BeginDoc;
var
  BandView: TfrBandView;
begin
  BandView := frReport1.FindObject('MasterData1') as TfrBandView;
  BandView.DataSet := '9';
  BandView := frReport1.FindObject('CrossData1') as TfrBandView;
  BandView.DataSet := '2';
end;

This will create a report with nine rows and two columns. Yep, you read right: lazreport store the number of the records of band's Virtual Dataset in an string field, the same field that store the name of an associated TfrDataset.
WARNING: don't look at lazreport source. It may scare the faint hearted ;-)

Track the row and column positions

The tricky part. The first thing to do is add two integer fields (FRow and FCol) to the Form/Data Module containing the TfrReport instance.

To get the column add an event to OnPrintColumn, and store the ColNo parameter:

procedure TForm1.frReport1PrintColumn(ColNo: Integer; var ColWidth: Integer);
begin
  FCol := ColNo;
end;

Notice that the Lazarus IDE will create an event declaration with the second parameter named Width. This will not compile with {$mode ObjFpc}. Renaming it to ColWidth will make the compiler happy.

There's not an event that pass the current row position. The first try is to hook into the OnBeginBand

procedure TForm1.frReport1BeginBand(Band: TfrBand);
begin
  Inc(FRow);
end;

Running the report with this will show wrong row indexes because it will increment in all bands not only the Master/Row band. The fix is easy:

procedure TForm1.frReport1BeginBand(Band: TfrBand);
begin
  if Band.Typ = btMasterData then
    Inc(FRow);
end;

It's done, add Data Header and Cross Header bands, glue with actual data and the generic cross data report is done. The sample project.

Make a generic control behaves like a "DropDown window"

Some controls, like the dropdown list of a combo box, disappears as soon as focus is lost. In web applications / pages this concept is expanded further by allowing form controls inside the drop down window.

To make a generic LCL control works like those web widgets, basically is necessary to hide it when the focus is lost. If the drop down control is a form this can be accomplished as simple as setting the BorderStyle to bsNone and using the Deactivate handler to hide itself:

procedure TMyForm.FormDeactivate(Sender: TObject);
begin
 Hide;
end;

For TFrame is possible to put an instance of it in an temp TForm configured as above. For other control classes, created at design time and with a parent already assigned, this may work but is not desired.

The alternative is to detect when the focus has changed and then check if the focused control is outside the "drop down" control. Unfortunately, AFAIK, there's no way in VCL/LCL to detect globally when the focus changed. Well, in fact there's an event that just do that: Screen.OnActiveControlChange. The drawback of using this event each time a "drop down" control is used is that will override a previously set event handler. Fortunately, LCL provides an alternative to set multiple handlers through Screen.AddHandlerActiveControlChanged.

So, for a TPanel descendant we would use something like to add remove the handler when the visible state is changed:

procedure TMyPanel.VisibleChanged;
begin
 if Visible then
   Screen.AddHandlerActiveControlChanged(@FocusChangeHandler)
 else
   Screen.RemoveHandlerActiveControlChanged(@FocusChangeHandler);
end;

In the handler code check if the focused control is itself or a child. If not hide:

procedure TMyPanel.FocusChangeHandler(Sender: TObject; LastControl: TControl);
var
 AControl: TControl;
begin
 AControl := Screen.ActiveControl;
 if (AControl <> Self) and not IsParentOf(AControl) then
   Visible := False;
end;

Yep! When the focus goes to outside of the "drop down" control it will automatically hide itself.

But...

Sometimes clicking outside of the control will not change the focus so it will not hide like desired. The solution is to detect user inputs (mouse click) globally. Setting OnMouse* events for all form controls is a no-no for obvious reasons. Using Application.OnUserInput event is an idea but has the same drawback of Screen.OnActiveControlChange. Similar problem, similar solution: is possible to set multiple handlers through Application.AddOnUserInputHandler.

The updated VisibleChanged code:

procedure TMyPanel.VisibleChanged;
begin
 if Visible then
 begin
   Screen.AddHandlerActiveControlChanged(@FocusChangeHandler);
   Application.AddOnUserInputHandler(@UserInputHandler);
 end
 else
 begin
   Screen.RemoveHandlerActiveControlChanged(@FocusChangeHandler);
   Application.RemoveOnUserInputHandler(@UserInputHandler);
 end;
end;

And the input handler that checks if the control where mouse is over is outside or not:

procedure TMyPanel.UserInputHandler(Sender: TObject; Msg: Cardinal);
var
 AControl: TControl;
begin
 case Msg of
   LM_LBUTTONDOWN, LM_LBUTTONDBLCLK, LM_RBUTTONDOWN, LM_RBUTTONDBLCLK,
   LM_MBUTTONDOWN, LM_MBUTTONDBLCLK, LM_XBUTTONDOWN, LM_XBUTTONDBLCLK:
   begin
     AControl := Application.MouseControl;
     if (AControl <> Self) and not IsParentOf(AControl) then
       Visible := False;
   end;
 end;
end;

Relatively simple but doing that for each control would be annoying so i wrote a component that takes care of it (among other few details). Enjoy.

JSON to the rescue

Tired of creating boilerplate dialogs for every TDataSet i needed to edit, i developed a generic dialog with a data grid plus the basic edit buttons (add, delete). To edit a TDataset i just call a wrapper function that setup the grid with some configuration.

While most of the time i just needed to edit a single field, it was desirable to keep the ability to edit more than one field. Also it would be necessary also to set the column width for each field. So i was passing a record with the following structure to configure the dialog:

  TDataDialogInfo = record
    FieldNames: String;
    FieldWidths: array of Integer;
    Title: String;
  end;

Title stores the dialog title, FieldNames store the Field names in semicolon separated string and FieldWidths the width of corresponding field. Here is the first problem: without adding another record type with the field name and width there is noway to guarantee the correspondence between the values leading to error easily.

Another problem is that there's no way in fpc to create the record on the fly so i need to declare a constant somewhere. To use a dialog with Title "Edit Test Dataset" and editing field "Name" i need to do:

const
  Info: TDataDialogInfo = (
    FieldNames: 'Name';
    FieldWidths: nil;
    Title: 'Edit Test Dataset'
    );

Notice that even if i don't need/want to set the width i have to declare the record field Widths.

I used this way for some time, and is really a lot less work than creating a TForm and setting the components for each TDataset, until i needed to add an option to show more rows than the usual in the grid. How to add such option? Adding a field to the TDataDialogInfo record would make all previous defined constants unusable and i would need to fix than all. What if later i needed to add another option?

It was at this moment that i think: "How it would be good if pascal had the ability to define objects with arbitrary fields on the fly, like in JavaScript!". Well, in fact, although indirectly, is possible to do it in pascal thanks to the native fpc implementation of JSON.

So instead of using a record to pass the configuration now i use a string with a (valid) JSON definition. In the previous example (Title "Edit Test Dataset" and editing field "Name") now i do:

Info = '{"title": "Edit Test Dataset", "fields": {"name": "Name", "title": "Person"}}';

If i just need to define the field name:

Info = '"Name"';

If i want to edit two fields:

Info = '["Id", "Name"]';

And i can set different properties for each field

Info = '{"title": "Edit Test Dataset",'+
    '"fields": ["Id", {"name": "Name", "title": "Person"},' +
    ' { "name": "Phone", "width": 100}]}';

Notice that the format of the property (in this case "fields") vary from a single string to a JSON array or object. Better: you can mix in the same property different formats! Flexibility it's your name. All of this backward compatible: i can add another property and previous definitions will still work!

The cost of accessing object fields (part 2)

In the last post, we could see the benefits of using a temporary variable to access frequently used object fields. What if the object field is accessed only two times. The benefit would be maintained?
Let's see this example:
Before:

begin
  if FDataLink.Field <> nil then
    Caption := FDataLink.Field.DisplayText
  else
    Caption := '';
end; 

After:

var
  DataLinkField: TField;
begin
  DataLinkField := FDataLink.Field;
  if DataLinkField <> nil then
    Caption := DataLinkField.DisplayText
  else
    Caption := '';
end; 

It seems that yes, although very little (saves only two instructions). This is the kind of optimization to be done on only very sensitive areas.

Since the benefit was mainly due to the compiler saving the local variable in a register, a doubt that i had in mind was what would happen in a method with many parameters? The addition of the variable would still be beneficial?

So i tested the addition of a variable in a method with the following header

procedure DoIt(Sender, Sender2, Sender3: TObject);

As we can see, the version with the local variable is still smaller.

All in all, some like to say that less is more, but sometimes, as in this case, more is less!

The cost of accessing object fields (part 1)

The common sense make us believe that adding more code and/or more variables leads to bigger programs. Looking at the generated code of one example in the previous post, the addition of one variable made the executable smaller. This occurs because fpc is smart enough to reuse registers (in this case eax).

This week, while fixing one Lazarus bug i noticed the following pattern in the generated code of method TDBEdit.DataChange:

 movl 12(%ebx),%eax
 movl 24(%eax),%eax

Basically this is the code to access FDataLink.Field property (the first instruction get the FDataLink address and the second get the Field address). So what would happen if this field was "buffered" in a TField local variable?

Before:

procedure TDBEdit.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then begin
    Alignment := FDataLink.Field.Alignment; 
  [..]

After:

procedure TDBEdit.DataChange(Sender: TObject);
var
  DataLinkField: TField;
begin
  DataLinkField := FDataLink.Field;
  if DataLinkField <> nil then begin
    Alignment := DataLinkField.Alignment; 
  [..]

This simple change lead to these differences.

As expected the code became smaller but two things surprised me:

There's no increase in the temporary memory allocated

The variable assignment did cost nothing (not even one instruction)

The above test was done with a "clone" of TDBEdit.DataChange in a test project. To make sure there are no confounding factors i also tested with the original code to confirm the differences. Notice that in this case, although the code is also smaller, the addition of the variable increase the temporary memory allocated as well the variable assignment requires one extra instruction. Bad.

But there was one last hope: compile LCL with -O2 option (i assumed that LCL was already compiled with that optimization turned on). Seems that my assumption was wrong. The -O2 option did the trick: the same result as before.

In the next post i will play with a few more scenarios.

And remember: don't forget to put -O2 in LCL build options when doing a release, it makes difference.

Condition check versus a type map

Often, the programmer is faced with the need to translate from one type to another, e.g., given a boolean variable return a corresponding integer value. As a real world example see a piece of Lazarus code:

  if NewWordWrap then
    gtk_text_view_set_wrap_mode(AGtkTextView, GTK_WRAP_WORD)
  else
    gtk_text_view_set_wrap_mode(AGtkTextView, GTK_WRAP_NONE); 

NewWordWrap is a boolean variable, but the gtk function expects an integer. To translate from type to another a condition check is done.

Another way to handle this would be creating a map array with the type to be translated. Lazarus also has an example of this technique:

const
  WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL);
[..]
  gtk_widget_set_direction(AGtkWidget, WidgetDirection[UseRightToLeftAlign]);

Here is the same pattern: UseRightToLeftAlign is a boolean variable and the gtk function expects a integer, but instead of checking for the variable value a boolean to integer map (WidgetDirection) is used.

While the map approach seems faster because avoids a check, it adds an additional constant. I decided to look at the generated code to see the actual benefits.

Check the condition code:

  if B then
    DoIt(CONST_1)
  else
    DoIt(CONST_2);

Map code:

const
  BoolMap: array[Boolean] of Integer = (CONST_2, CONST_1);

  DoIt(BoolMap[B])

Here is the generated code. This shows a clear advantage to the map approach. Notice that in this small example the size of executables were the same.

I also tested a more complex type than boolean: an enumerated.

Check the condition code:

  case E of
    EnumA: DoIt(CONST_1);
    EnumB: DoIt(CONST_2);
    EnumC: DoIt(CONST_3);
  end;

Map code:

const
  EnumMap: array[TMyEnum] of Integer = (CONST_1, CONST_2, CONST_3);

  DoIt(EnumMap[E])

The result.

Now with a slight optimized code for the condition check...

var
  I: Integer;

  case E of
    EnumA: I := CONST_1;
    EnumB: I := CONST_2;
    EnumC: I := CONST_3;
  end;
  DoIt(I);

... i got this.

The discover of RTTI

I never got much interest, or knowledge, by Delphi/fpc RTTI. But the recent fuzz about the new RTTI features introduced in Delphi 2010 raised my curiosity even if the fpc provides only the old style RTTI. 

The opportunity to learn, and use, RTTI came when i figured the possibility to enhance/clear some of my code.

To show a generic TForm i created a very imaginative simple function:

function ShowForm(FormClass: TFormClass; Owner: TWinControl): TModalResult;
var
  Form: TForm;
begin
  Form := FormClass.Create(Owner);
  try
    Result := Form.ShowModal;
  finally
    Form.Destroy;
  end;
end;

This little function works nice and save some boilerplate code but it's limited to forms that don't need to initialize a property before is called since i don't know class type before hand.

As stated before, messages can be used to notify with arbitrary information any TControl, so i created a variant of the ShowForm that takes two ordinal (LPARAM and WPARAM) parameters and send a CM_INIT message to the created TForm instance. The TForm descendant would need to add a CM_INIT message handler and interpret the TLMessage parameter.

function ShowForm(FormClass: TFormClass; Owner: TWinControl; WData: WPARAM = 0; LData: LPARAM = 0): TModalResult;
var
  Form: TForm;
begin
  Form := FormClass.Create(Owner);
  try
    Form.Perform(CM_INIT, WData, LData);
    Result := Form.ShowModal;
  finally
    Form.Destroy;
  end;
end;

So to set to true the MyBool field of a TForm descendant i would call:

ShowForm(TMyForm, nil, 1);

And in the CM_INIT handler:

procedure TMyForm.CMInit(var Msg: TLMessage);
begin
  MyBool := (Msg.lParam = 1);
end;

It worked nice for simple variables like a integer or boolean, but things started to look clumsy when i needed to pass a variable of string or TObject type. Furthermore there's the limitation of restricted number of variables and the danger of the need to assume the meaning of the Msg(TLMessage) fields

There's where the RTTI ability to set arbitrary properties came in hand. All i needed to do is publish a property in the TForm descendant and set it through RTTI functions. This way i got type safety, unlimited number of parameters/variables and clearer code.

The new ShowForm interface:

function ShowForm(FormClass: TFormClass; Owner: TWinControl; FormProperties: array of const): TModalResult;

FormProperties is a array of const where the even items are the property names and the odd items, the property values.

What about RTTI? Pretty simple and direct:

//stripped code (no type check, no array of const parsing)
uses typinfo;
[..]
  ClassInfo := Form.ClassInfo;
  PropInfo := GetPropInfo(ClassInfo, PropertyName);
  case PropInfo^.PropType^.Kind of
    tkAString, tkSString:
      SetStrProp(Form, PropInfo, StrPropertyValue);
    tkInteger:
      SetOrdProp(Form, PropInfo, IntPropertyValue);
    tkBool:
      SetOrdProp(Form, PropInfo, Integer(BoolPropertyValue));
  end; 
[..]

Now to set MyBool property of TMyForm i do:

ShowForm(TMyForm, nil, ['MyBool', True]);

A lot clearer no? ;-)

Draw Rotated Text

Current version of Lazarus provides the ability to draws text in an arbitrary rotation angle. Although is needed just to set the TFont.Orientation property to configure the feature, the position of the draw text will change according to the angle. So, to make things easier, i wrote a routine that draws a rotated text centered in a given Rect.

If someone needs something similar:

type
  TRotateType = (rtNone, rtCounterClockWise, rtClockWise, rtFlip);

procedure DrawRotateText(Canvas: TCanvas; const R: TRect; 
  const Text: String; RotateType: TRotateType);
var
  TextExtent: TSize;
  SavedOrientation: Integer;
begin
  SavedOrientation := Canvas.Font.Orientation;
  TextExtent := Canvas.TextExtent(Text);
  case RotateType of
    rtNone:
    begin
      Canvas.Font.Orientation := 0;
      Canvas.TextOut((R.Right - R.Left - TextExtent.cx) div 2,
        (R.Bottom - R.Left - TextExtent.cy) div 2, Text);
    end;
    rtCounterClockWise:
    begin
      Canvas.Font.Orientation := 900;
      Canvas.TextOut((R.Right - R.Left - TextExtent.cy) div 2,
        (R.Bottom - R.Left + TextExtent.cx) div 2, Text);
    end;
    rtFlip:
    begin
      Canvas.Font.Orientation := 1800;
      Canvas.TextOut((R.Right - R.Left + TextExtent.cx) div 2,
        (R.Bottom - R.Left + TextExtent.cy) div 2, Text);
    end;
    rtClockWise:
    begin
      Canvas.Font.Orientation := -900;
      Canvas.TextOut((R.Right - R.Left + TextExtent.cy) div 2,
        (R.Bottom - R.Left - TextExtent.cx) div 2, Text);
    end;
  end;
  Canvas.Font.Orientation := SavedOrientation;
end;

Finally...

... the VirtualTreeView port is released.

The release notes.

Convert database files from Ansi to UTF-8

While porting old Delphi projects that uses paradox files i faced the problem that the data was stored in an ANSI code page (the current Lazarus version expects UTF-8 encoded strings).

So i wrote an simple application that can convert the encoding of database files (sqlite3, dbf, paradox).

That program can be useful for more than legacy code: after converting a spreadsheet data to a sqlite3 file using Sqlite Data Wizard. The resulted file was in ANSI and there was no option (AFAIK) to convert directly to UTF-8.

I put it here in hope that can be used by someone else.