Blog

6 Oct 2015

FixInsight 2015.10 release
by Roman Yankovsky Leave a comment

I’m happy to introduce the FixInsight 2015.10 release.

What’s New

  • Introduced rule W527 (“Property is referenced directly in its getter or setter”)
  • Introduced rule W528 (“Loop variable is not used in FOR-loop”)
  • Support for suppressing a warning message on a particular line using a comment
  • A number of false positives fixed
  • Better multi-monitor support
  • Improved parser
  • Minor fixes

http://sourceoddity.com/fixinsight/download.html

The very first version of FixInsight has been released to public a year ago — October 6, 2014. During last 12 months it has been improved significantly. It would not be happened without all the support I got from Delphi community. Thank you :)

11 Apr 2015

FixInsight vs FMX
by Roman Yankovsky 6 Comments

In this post I will continue to analyze Delphi source code. Previous episodes was about Delphi VCL and RTL. As usual I will ignore minor issues and will try to find out the most interesting pieces of code. All code examples in this post are related to Delphi XE8 (version 22.0.19027.8951).

W517 Variable hides a class field, method or property

procedure TLight.ReadDiffuse(Reader: TReader);
var
  Color: Integer;
begin
  IdentToAlphaColor(Reader.ReadIdent, Color);
  {$R-}
  Color := TAlphaColor(Color);
  {$R+}
end;

The same issue in other unit.

procedure TStrokeCube.ReadDiffuse(Reader: TReader);
var
  Color: Integer;
begin
  IdentToAlphaColor(Reader.ReadIdent, Color);
  {$R-}
  Color := TAlphaColor(Color);
  {$R+}
end;

That’s one of those “variable hides a class field” warnings I mentioned in previous post. This case is definetely a bug. TLight class, as well as TStrokeCube class, has Color property (it’s TAlphaColor, of course). So I guess it should be “Self.Color := TAlphaColor(Color)”, but better rename the variable. It’s a very bad style to use the same names for properties and variables. Usually it doesn’t harm, but sometimes leads to hard to find bugs. Just look at this code and don’t do that, ever.

W511 Object created in TRY block

begin
  if ([csDesigning, csDestroying, csLoading, csUpdating] * ComponentState <> []) or
     (FUpdating > 0) then Exit;
  { Update objects in form }
  try
    Comparer := TComparerTFmxObject.Create;
    ClientList := TTObjInfoList.Create(Comparer);
    Bucket := TDictionary<TObject, TObject>.Create;
    for InitiatedCount := 0 to 7 do
    begin
      if CollectActionClients(ClientList) = 0 then
        Break;
      ClientList.Sort;
      for I := 0 to ClientList.Count - 1 do
        ClientList[I].ActionClient.InitiateAction;
      ClientList.Clear;
    end;
  finally
    FreeAndNil(ClientList);
    FreeAndNil(Bucket);
  end;
end;

Application may raise an exception before an object instance is actually assigned to ClientList and/or Bucket variables. That means the finally block below will try to free the memory which is unassigned.

W523 Interface declared without a GUID

  IModelImporter = interface
    function GetDescription: string;
    function GetExt: string;

    function LoadFromFile(const AFileName: string; out AMesh: TMeshDynArray;
      const AOwner: TComponent): Boolean;
  end;

  IFMXUISwitch = interface(UISwitch)
    { Touches }
    procedure touchesBegan(touches: NSSet; withEvent: UIEvent); cdecl;
    procedure touchesCancelled(touches: NSSet; withEvent: UIEvent); cdecl;
    procedure touchesEnded(touches: NSSet; withEvent: UIEvent); cdecl;
    procedure touchesMoved(touches: NSSet; withEvent: UIEvent); cdecl;
    procedure ValueChanged; cdecl;
  end;

Not a bug, actually. But since the interface does not have a GUID, it cannot be used with Supports function or with As operator. Maybe it worth adding a GUID, why not?

W510 Values on both sides of the operator are equal

function SamePosition(const APosition1, APosition2: TPosition): Boolean; overload;
begin
  Result := (APosition1.X = APosition2.X) and (APosition1.Y = APosition1.Y);
end;

I guess, it should be “APosition1.Y = APosition2.Y”.

W508 Variable is assigned twice successively

  FPixelShader := TShaderManager.RegisterShaderFromData('gouraud.fps', TContextShaderKind.PixelShader, '', [
    TContextShaderSource.Create(TContextShaderArch.DX9, [
      $00, $02, $FF, $FF, $FE, $FF, $32, $00, $43, $54, $41, $42, $1C, $00, $00, $00, $9F, $00, $00, $00, $00, $02, $FF, $FF, $03, $00, $00, $00, $1C, $00, $00, $00, $00, $01, $00, $20, $98, $00, $00, $00,
// skipped

  FPixelShader := TShaderManager.RegisterShaderFromData('gouraud.fps', TContextShaderKind.PixelShader, '', [
    TContextShaderSource.Create(TContextShaderArch.DX9, [
      $00, $02, $FF, $FF, $FE, $FF, $32, $00, $43, $54, $41, $42, $1C, $00, $00, $00, $9F, $00, $00, $00, $00, $02, $FF, $FF, $03, $00, $00, $00, $1C, $00, $00, $00, $00, $01, $00, $20, $98, $00, $00, $00,
// skipped

Two assignments in a row, probably not an issue, just a sloppy copy-paste.

W503 Assignment right hand side is equal to its left hand side

  if X1 > X2 then
    X1 := X1;
  if Y1 > Y2 then
    Y1 := Y2;

I guess, it should be “X1 := X2”.

      if (Self.Form <> nil) and (Self.Form.Handle <> nil) then
        Self.Form := Self.Form;

Not sure what was meant to be there (Self.Form is a record field).

And one more.

      if FNew.FFrequency <> 0 then
        FNew.FValue := Round(FNew.FValue / FNew.FFrequency) * FNew.FFrequency
      else
        FNew.FValue := FNew.FValue;

W510 Values on both sides of the operator are equal

            if RegionSize = RegionSize then
            begin
              SetLength(UpdateRects, RegionData.rdh.nCount);
              for i := 0 to RegionData.rdh.nCount - 1 do
              begin
                R := PRgnRects(@RegionData.buffer[0])[i];
                UpdateRects[i] := RectF(R.Left, R.Top, R.Right, R.Bottom);
              end;
            end;

Not sure what was meant to be there.

W513 Format parameter count mismatch

function TCustomValueRange.GetNamePath: string;
begin
  Result := Format( 'Value: %0:*.*f (%1:*.*f..%2:*.*f)', [Value, Min, Max]);
end;

The format string is incorrect. This code will raise an exception.

W505 Empty THEN block

      if FoundValue.Count > 1 then
      else if FoundValue.Count > 0 then
        PropValues[Name] := FoundValue[0];

This looks strange, perhaps it could be replaces with a simple “If FoundValue.Count = 1 then PropValues[Name] := FoundValue[0]”.

Well, that’s all I have to bring today. Use FixInsight to find bugs in your code before your customers do :)

9 Apr 2015

Implementing LISP-like language in Delphi
by Roman Yankovsky 1 Comment

This is a translation of the post I wrote a couple of years ago in Russian.

I was working on my homework for Programming Languages course at Coursera (absolutely fantastic course, by the way, I even managed to get a statement of accomplishment) and decided to try to build an interpreter of a simple programming language in Delphi. This language has a LISP-like semantics.

Each language element is an expression, that can be evaluated. It other words, this language doesn’t have procedures or statements, functions only.

The most primitive expression is a number. It evaluates to itself.

(Number 5) -> (Number 5)

Other expresions are more useful. For instance, Add function works this way:

(Add (Number 2) (Number 3)) -> (Number 5)

or

(Add (Number 2) (Add (Number 1) (Number 3))) -> (Number 6)

Obviously, there can be any degree of function nesting and before a function is evaluated its parameters values have to be evaluated first. We are dealing with a tree and its evaluation has to be recursive.

In Delphi this expression tree can be represented as a tree of objects that implement the following interface.

IExpression = interface
  function Evaluate: IExpression;
end;

So let’s implement classes for expressions above (I will not dig deeper in the details, you can download the full source code).

constructor TNumber.Create(AValue: Integer);
begin
  inherited Create;
  FValue := AValue;
end;
 
function TNumber.Evaluate: IExpression;
begin
  Result := Self;
end;

Number expression stores its value and evaluates to itself.

Add expression is a bit more complicated. This class takes two expressions, evaluates them and then calculates the sum.

constructor TAdd.Create(AValue1, AValue2: IExpression);
begin
  inherited Create;
  FExprs.Add(AValue1);
  FExprs.Add(AValue2);
end;
 
function TAdd.Evaluate: IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate;
  Expr2 := FExprs[1].Evaluate;
 
  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
    Result := TNumber.Create(Val1.Value + Val2.Value)
  else
    raise EExprException.Create('Invalid expression applied to TAdd');
end;

IHasValue interface is used to check if an expression has a value and to get the value.

IHasValue = interface
  ['{567A6313-3ABE-4620-9560-64F93BC4979A}']
  function GetValue: Variant;
  property Value: Variant read GetValue;
end;

I use Variant because I may decide to support other types (other than numbers) in the future.

Also I have implemented factory-functions. They do nothing special, just make my life a bit more convenient :)

function Number(AValue: Integer): IExpression;
begin
  Result := TNumber.Create(AValue);
end;
 
function Add(Expr1, Expr2: IExpression): IExpression;
begin
  Result := TAdd.Create(Expr1, Expr2);
end;

And for debugging purposes I added AsString property to IExpression interface. It returns object’s representation as a string.

For instance,

function TNumber.GetAsString: string;
begin
  Result := Format('(%s %d)', [Self.ClassName, FValue]);
end;

TNumber, TAdd and other classes in this post have this method.

OK, finally that should be enough to evaluate one of the examples above.

var
  Test: IExpression;
begin
  Test := Add(Number(2), Add(Number(1), Number(3)));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

After executing this code Edit1.Text value is

(TAdd (TNumber 2) (TAdd (TNumber 1) (TNumber 3)))

and Edit2.Text value is

(TNumber 6)

Bingo! :)

This is cool, but absolutely useless.

What’s the difference between a real programming language and this little demo? Real programming languages support variables and scopes. Abstract syntax tree is not enough. Syntax tree has to be executed in some environment.

Let’s think about variables and scopes. What is a variable? It has a name and a value. In other words, it is a name and some associated expression (in this language everything is expression).

That’s why I need IEnvironment interface.

IEnvironment = interface
  function GetValue(const AName: string): IExpression;
  function SetValue(const AName: string; AExpr: IExpression): IEnvironment;
end;

Everything is clear with GetValue method, but I will pay a little bit more attention to SetValue. When we declare a variable, it has to be visible to the current tree node and to its childs, but not for parent node or above. Therefore, in order not to spoil the environment of caller, when declare a variable we essentially create a new copy of the environment and put it into its own independent life within the current scope.

function TEnvironment.SetValue(const AName: string; AExpr: IExpression): IEnvironment;
var
  EnvPair: TPair<string, IExpression>;
  NewEnv: TEnvironment;
begin
  NewEnv := TEnvironment.Create;
  for EnvPair in FEnv do
    NewEnv.FEnv.Add(EnvPair.Key, EnvPair.Value);
  NewEnv.FEnv.AddOrSetValue(AName, AExpr);
 
  Result := NewEnv;
end;

It would be better to not make a full copy of environment, but I want to make it as simple as possible.

Because now an environment must be taken into account when an expression is evaluated, IExpression interface has to slightly change.

IExpression = interface
  function GetAsString: string;
 
  function Evaluate: IExpression; overload;
  function Evaluate(Env: IEnvironment): IExpression; overload;
 
  property AsString: string read GetAsString;
end;

Evaluate without a parameter just runs the evaluation within the empty environment.

function TExpression.Evaluate: IExpression;
begin
  Result := Evaluate(TEnvironment.Create);
end;

Now we are ready to implement variables.

constructor TVariable.Create(AName: string);
begin
  inherited Create;
  FName := AName;
end;
 
function TVariable.Evaluate(Env: IEnvironment): IExpression;
begin
  Result := Env.GetValue(FName);
end;

This class stores variable name and return an associated expression from the current environment.

Well, you may notice that now this language has variables, but doesn’t have a syntax to declare them. Let’s implement LISP-like function let.

(let 
  [varname varvalue]
body)

This function binds a name (varname) and expression (varvalue) and then evaluates the body in a just created new environment. If it’s not clear, just take a look at code below.

constructor TLet.Create(const AVarName: string; AVarValue, ABody: IExpression);
begin
  inherited Create;
  FVarName := AVarName;
  FExprs.Add(AVarValue);
  FExprs.Add(ABody);
end;
 
function TLet.Evaluate(Env: IEnvironment): IExpression;
var
  VarValue: IExpression;
begin
  VarValue := FExprs[0].Evaluate(Env);
  Result := FExprs[1].Evaluate(Env.SetValue(FVarName, VarValue));
end;

Here the value of a variable is calculated within an external environment and the body expression is calculated within a just created new environment.

It is a good time for a small test.

var
  Test: IExpression;
begin
  Test := Let('N', Number(5),
              Add(Variable('N'), Add(Number(1), Number(3))));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

Edit1.Text value is 

(TLet [N (TNumber 5)] (TAdd (TVariable N) (TAdd (TNumber 1) (TNumber 3))))

Edit2.Text value is

(TNumber 9)

Nice :)

But that’s not all. Useful language must support functions. Let’s think about them. For simplicity, suppose that the function will have only one parameter. Actually, it does not impose any restrictions on the language, but that’s not important right now.

First, the functions need to be declared and, secondly, to be called. These are two different actions. Let it be TDefineFunc and TCallFunc.

Obviously, the function is an expression. That is, those variables that we have – it is a function without parameters. The difference is in the fact that the value of the variable is evaluated immediately, but the evaluation of the function at the moment of its declaration makes little sense. Another important caveat is that the function must be evaluated in the environment in which it is declared (plus the parameter value, of course), but not within the environment in which it is called. This is so-called lexical scope – the approach adopted in most programming languages.

This leads us to a simple thought. The result of TDefineFunc evaluation should be an object that contains a function’s expression body, its environment and, of course, the name of the parameter. And then evaluating TCallFunc we assign the parameter value and evaluate the body. Let’s call the object returned by TDefineFunc – TClosure.

constructor TClosure.Create(AFunc: IExpression; AEnv: IEnvironment; const AParamName: string);
begin
  inherited Create;
  FEnv := AEnv;
  FParamName := AParamName;
  FExprs.Add(AFunc);
end;
 
function TClosure.EvaluateClosure(AParamValue: IExpression): IExpression;
begin
  Result := FExprs[0].Evaluate(FEnv.SetValue(FParamName, AParamValue));
end;

As I said above, it is aware about the environment, the parameter name, and also has a link to the body of the function. The Evaluate method in this case is different from other classes because it uses the previously saved environment with an addition of a parameter value.

Thus, TDefineFunc looks simple enough.

constructor TDefineFunc.Create(const AParamName: string; ABody: IExpression);
begin
  inherited Create;
  FParamName := AParamName;
  FExprs.Add(ABody);
end;
 
function TDefineFunc.Evaluate(Env: IEnvironment): IExpression;
begin
  Result := TClosure.Create(FExprs[0], Env, FParamName);
end;

And TCallFunc is a bit more complicated.

constructor TCallFunc.Create(const AFuncName: string; AParamValue: IExpression);
begin
  inherited Create;
  FFuncName := AFuncName;
  FExprs.Add(AParamValue);
end;
 
function TCallFunc.Evaluate(Env: IEnvironment): IExpression;
var
  FuncExpr, ParamVal: IExpression;
  Closure: IClosure;
begin
  ParamVal := FExprs[0].Evaluate(Env);
  FuncExpr := Env.GetValue(FFuncName);
 
  if Supports(FuncExpr, IClosure, Closure) then
    Result := Closure.EvaluateClosure(ParamVal)
  else
    raise EExprException.Create('Invalid expression applied to TCallFunc');
end;

TCallFunc takes a function name and a parameter, looks for an appropriate TClosure bound to a name in the environment, and then evaluates the value, passing the argument.

One more test.

var
  Test: IExpression;
begin
  Test := Let('Add2', DefineFunc('N', Add(Variable('N'), Number(2))),
              CallFunc('Add2', Number(3)));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

Here we declare a function with parameter N that returns N+2, bind it to Add2 name, and then call it with parameter equal 3. The result should be equal 5, I guess.

Edit1:

(TLet 
  [Add2 (TDefineFunc N (TAdd (TVariable N) (TNumber 2)))]
  (Add2 (TNumber 3)))

Edit2:

(TNumber 5)

Very nice :)

This language can do a lot :) But I must confess that my initial goal was to write at least a calculation of factorial. In current language implementation it’s not possible. Why? Because it does not support recursion. At the time the function is declared there is no information about itself in the current environment, it appears in the environment only after that. That is, having only a copy of the environment before the function is declared, the function cannot call itself.

That’s why I slightly changed the evaluation of Let. Looks like a hack, you can do better.

function TLet.Evaluate(Env: IEnvironment): IExpression;
var
  VarValue: IExpression;
  Closure: IClosure;
begin
  VarValue := FExprs[0].Evaluate(Env);
  if Supports(VarValue, IClosure, Closure) then
    Closure.Env := Closure.Env.SetValue(FVarName, VarValue);
 
  Result := FExprs[1].Evaluate(Env.SetValue(FVarName, VarValue));
end;

We add a link to its name and its body to TClosure’s saved environment.

We are ready for the final test. I’ve added a few more functions (TSub, TMul, TEquals and TIfThenElse). They are pretty straightforward.

function TSub.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);
  Expr2 := FExprs[1].Evaluate(Env);
 
  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
    Result := TNumber.Create(Val1.Value - Val2.Value)
  else
    raise EExprException.Create('Invalid expression applied to TSub');
end;
 
function TMul.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);
  Expr2 := FExprs[1].Evaluate(Env);
 
  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
    Result := TNumber.Create(Val1.Value * Val2.Value)
  else
    raise EExprException.Create('Invalid expression applied to TMul');
end;
 
// Returns 1, if expressions are equal or 0 otherwise
function TEquals.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);
  Expr2 := FExprs[1].Evaluate(Env);
 
  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
  begin
    if Val1.Value = Val2.Value then
      Result := TNumber.Create(1)
    else
      Result := TNumber.Create(0);
  end
  else
    raise EExprException.Create('Invalid expression applied to TEquals');
end;
 
// IfThenElse e1 e2 e3
// Returns e2, if e1 > 0, or e3 otherwise
function TIfThenElse.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1: IExpression;
  Val1: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);
 
  if Supports(Expr1, IHasValue, Val1) then
  begin
    if Val1.Value > 0 then
      Result := FExprs[1].Evaluate(Env)
    else
      Result := FExprs[2].Evaluate(Env);
  end
  else
    raise EExprException.Create('Invalid expression applied to TIfThenElse');
end;

And the test itself. Let’s calculate factorial of 10.

var
  Test: IExpression;
begin
  Test := Let('Factorial',
    DefineFunc('N', IfThenElse(Eq(Variable('N'), Number(0)),
                       Number(1),
                       Mul(Variable('N'), 
                           CallFunc('Factorial', Sub(Variable('N'), Number(1)))))),
    CallFunc('Factorial', Number(10)));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

The Edit2.Text value is “(TNumber 3628800)”. Very very nice :)

The next step is to allow the user to write something like:

Let(Factorial,
    DefineFunc(N, IfThenElse(Eq(N, 0),
                    1,
                    Mul(N, Factorial(Sub(N, 1))))),
    Factorial(10))

to parse the text automatically, build a syntax tree and evaluate. Parsing of this sort of syntax is quite simple. You can go ahead and make the syntax more friendly. Personally, I would prefer to read a function like so:

let
  fun Factorial N =
    if Eq(N, 0) then 1 else Mul(N, Factorial(Sub(N, 1))
do
    Factorial(10)
end

It looks different, but semantically it’s still the same. Anyways this is a topic for another post.

And finally you can download the full source code.

30 Mar 2015

FixInsight vs RTL
by Roman Yankovsky 5 Comments

In this post I will continue to analyze Delphi source code. Last episode was about Delphi VCL, in this post we will look into Delphi RTL. I will ignore minor issues and will try to find out the most interesting pieces of code. All code examples in this post are related to Delphi XE7 (version 21.0.17017.3725).

W503 Assignment right hand side is equal to its left hand side

  constructor TNativeDownloader.Create(PublicKey: string; Salt: array of Byte; MainFile, PatchFile: TApkFileInfo);
  begin
    FMainFile := MainFile;
    FPatchFile := FPatchFile;
    FDownloader := TJNativeDownloaderLauncher.JavaClass.init(StringToJString(PublicKey), ByteArrayToJArray(Salt),
      CreateApkList(MainFile, PatchFile));
    Create;
  end;

I think, it should be “FPatchFile := PatchFile”.

W501 Empty EXCEPT block

  try
    Assert(FConnections.Count = 0); // All connections should have been removed
  except
  end;

That’s not an issue, just a WTF moment :)

W517 Variable hides a class field, method or property

procedure TTask.ExecuteReplicates(Root: TTask);
var
                                     
//  ReplicasQuitting: Boolean;
  ReplicaProc: TProc;
begin
//  ReplicasQuitting := False;
  ReplicaProc := procedure
    var
      CurrentTask, ChildTask: ITask;
    begin
      CurrentTask := CurrentTask;
      if not Root.ShouldCreateReplica {or ReplicasQuitting} then
        Exit;
      ChildTask := Root.CreateReplicaTask(ReplicaProc, Self, [TCreateFlag.Replicating, TCreateFlag.Replica]);
      ChildTask.Start;
      try
        Root.CallUserCode;
      except
        Root.HandleException(TTask(ChildTask), TObject(AcquireExceptionObject));
      end;
    end;
  ReplicaProc;
end;

W517 is a very popular warning for Delphi VCL and RTL. But I find this one to be the most interesting. TTask class has a class method called CurrentTask and CurrentTask variable hides that method. By the way there is one more warning (line 1865): “W503 Assignment right hand side is equal to its left hand side”.

So should that assignment look like “CurrentTask := Self.CurrentTask” or is it just a useless variable? In any case that code looks weird.

I cannot quote all W517 warnings, there are too many of them. But let me quote one more example from VCL.

procedure TCustomTaskDialog.ShowHelpException(E: Exception);
var
  Msg: string;
  Flags: Integer;
  SubE: Exception;
begin
  Flags := MB_OK or MB_ICONSTOP;
  if Application.UseRightToLeftReading then
    Flags := Flags or MB_RTLREADING;
  // ... [skipped]

That’s not a bug. But it could cause bugs in the future if you change this code. For instance, this code will compile even if you remove Flags variable, because TCustomTaskDialog has a property with the same name – Flags. Also it’s too easy to mistype and use the variable in this method instead of the propety and vice versa.

W504 Missing INHERITED call in destructor

destructor TJavaImport.Destroy;
begin
  TJNIResolver.DeleteGlobalRef(GetObjectID);
end;

There are a number of missed “inherited” calls again, I quote only one though.

W508 Variable is assigned twice successively

      // Another thread could start traversing the list between when we set the
      // head to P and when we assign to P.Next.  Initializing P.Next to point
      // to itself will make others spin until we assign the tail to P.Next.
      P.Next := P;
      P.Next := PThreadInfo(AtomicExchange(Pointer(FHashTable[H]), Pointer(P)));

Not an issue, as far as I understood. But I think it worth quoting. I never thought that it is possible to do multithreading like this.

That’s all I have to bring today. If you like this post, please let me know what library or framework you wish to run FixInsight against at the next time. FMX? JEDI? Anything else?

27 Mar 2015

FixInsight vs VCL
by Roman Yankovsky 1 Comment

Of course I couldn’t resist analyzing Delphi VCL with FixInsight. All examples in this post are related to Delphi XE7 (version 21.0.17017.3725). I will try to choose the most interesting places and ignore minor issues like methods that are too long or nested “with” statements (have you ever thought how many nested “with” statement in VCL?).

W512 Odd ELSE-IF condition

    if Element = sbGroupStartInactive then
      LSrcRect := System.Types.Rect(0, 110, 22 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(22, 110, 46 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(47, 110, 70 - 2, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95 - 2, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);

Pay attention to lines 809 and 811. These conditions are equal. There is obviously something wrong. How could we fix this?

Let’s look around:

  else if Element in [sbGroupStartInactive, sbGroupMiddleInactive,
    sbGroupEndInactive, sbGroupSingleInactive] then
  begin
    if Element = sbGroupStartInactive then
      LSrcRect := System.Types.Rect(0, 110, 22, 132)
    else if Element = sbGroupMiddleInactive then
      LSrcRect := System.Types.Rect(22, 110, 46, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(47, 110, 70, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);
  end
  else if Element in [sbGroupStartSplitInactive, sbGroupMiddleSplitInactive,
    sbGroupEndSplitInactive, sbGroupSingleSplitInactive] then
  begin
    if Element = sbGroupStartInactive then
      LSrcRect := System.Types.Rect(0, 110, 22 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(22, 110, 46 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(47, 110, 70 - 2, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95 - 2, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);
  end
  else if Element in [sbSmallSplitHoverSplit, sbSmallSplitPressedSplit,
    sbSmallSplitInactiveSplit] then

That’s even more interesting. Along with “Element in [sbGroupStartSplitInactive, sbGroupMiddleSplitInactive, sbGroupEndSplitInactive, sbGroupSingleSplitInactive]” condition (see line 804), that code looks even more strange. I guess it is a rought copy-paste of the code above (lines 794 – 802) and actually it is intended to look like this:

  else if Element in [sbGroupStartSplitInactive, sbGroupMiddleSplitInactive,
    sbGroupEndSplitInactive, sbGroupSingleSplitInactive] then
  begin
    if Element = sbGroupStartSplitInactive then
      LSrcRect := System.Types.Rect(0, 110, 22 - 2, 132)
    else if Element = sbGroupMiddleSplitInactive then
      LSrcRect := System.Types.Rect(22, 110, 46 - 2, 132)
    else if Element = sbGroupEndSplitInactive then
      LSrcRect := System.Types.Rect(47, 110, 70 - 2, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95 - 2, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);
  end

I don’t have much experience with Ribbon controls, so the fix offered solely on the basis of common sense. Maybe someone can do it better.

OK, go ahead.

W507 THEN statement is equal to ELSE statement

It’s Ribbon again :)

procedure TRibbonDropDownButton.DrawBackground(var PaintRect: TRect);
var
  LPt: TPoint;
begin
  inherited;
  LPt := GetArrowPosition(PaintRect);
  if not Enabled then
    DrawArrow(LPt, clNone, clNone, -1)
  else
    DrawArrow(LPt, clNone, clNone, -1);
end;

No comments. Obviously, the code in “then” and “else” are the same. It’s not clear what was meant to be there.

A similar issue in another file:

      if Assigned(Clients[I].ActionBar) then
      begin
        if Assigned(ActionProc) then
          ActionProc(Clients[I])
        else
          Clients[I].Refresh;
        UpdateActionBar(Clients[I]);
      end
      else
      begin
        if Assigned(ActionProc) then
          ActionProc(Clients[I])
        else
          Clients[I].Refresh;
        UpdateActionBar(Clients[I]);
      end;

And one more:

        if Style <> csSimple then
          if DroppedDown then
            DrawFrameControl(C.Handle, R, DFC_SCROLL, DFCS_FLAT or DFCS_SCROLLCOMBOBOX)
          else
            DrawFrameControl(C.Handle, R, DFC_SCROLL, DFCS_FLAT or DFCS_SCROLLCOMBOBOX);

OK, next.

W503 Assignment right hand side is equal to its left hand side

function CheckPoint(const Point, Source: TPoint; Deviation,
  ErrorMargin: Integer): Double;
var
  Distance: Double;
  ErrorMarginDistance: Double;
  M, B: Double;
begin
  Deviation := Deviation;
  Distance := Sqrt(Sqr(Point.X - Source.X) + Sqr(Point.Y - Source.Y));
  ErrorMarginDistance := MulDiv(Deviation, ErrorMargin, 100);

This assignment either should be different or it is completely useless.

And one more:

procedure TScreenTipsWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := WS_POPUP;
    WindowClass.Style := WindowClass.Style;
    if NewStyleControls then
      ExStyle := WS_EX_TOOLWINDOW;
    if CheckWin32Version(5, 1) then
      WindowClass.Style := WindowClass.Style or CS_DROPSHADOW;
    if NewStyleControls then
      ExStyle := WS_EX_TOOLWINDOW;
    AddBiDiModeExStyle(ExStyle);
  end;
end;

And last, but not least…

W504 Missing INHERITED call in destructor

There are too many messages of this type, so I’m not going to quote everything.

destructor TActiveXPropertyPage.Destroy;
begin
  FPropertyPageImpl.FPropertyPage.Free;
  FPropertyPageImpl.Free;
end;

There is no “inherited” call, ancestor’s destructor is never called.

Well, let’s finish. As I said at the beginning, I don’t want to nitpick, so I ignored minor issues. In the next episode, we may talk about FMX or RTL :)

Static analysis is cool, isn’t it?

27 Feb 2015

How to get a list of used units with DelphiAST
by Roman Yankovsky 4 Comments

Getting a list of used units from the source code can be useful in many code automation tasks. There are a number of tools that can help you to investigate what dependencies you have in your project. In this post I will show how you can write your own simple dependency analysis tool using DelphiAST library.

This demo program will count how many times each unit is used by other units and will consist of two steps:

  1. Get a list of units from a DPR file.
  2. Go through this list, analyze uses statements and count used units.

To keep demo as simple as possible, it will ignore a unit if its path was not mentioned in a DPR.

As Delphi strings and chars are Unicode, before starting to parse any file we have to convert it to Unicode. This function reads a file to a string, converting it to Unicode if needed.

function TForm1.ReadFileToString(const FileName: string): string;
var
  Buffer: TBytes;
  Content: TMemoryStream;
  Encoding: TEncoding;
  PreambleSize: Integer;
begin
  Encoding := nil;

  Content := TMemoryStream.Create;
  try
    Content.LoadFromFile(FileName);

    SetLength(Buffer, Content.Size);
    Content.Read(Buffer, 0, Content.Size);

    PreambleSize := TEncoding.GetBufferEncoding(Buffer, Encoding, TEncoding.Default);

    Result := Encoding.GetString(Buffer, PreambleSize, Content.Size - PreambleSize);
  finally
    Content.Free;
  end;
end;

And now we’re getting to the fun part, to parsing.

function TForm1.Parse(const Content: string): string;
var
  ASTBuilder: TPasSyntaxTreeBuilder;
  StringStream: TStringStream;
  SyntaxTree: TSyntaxNode;
begin
  Result := '';

  StringStream := TStringStream.Create(Content, TEncoding.Unicode);
  try
    StringStream.Position := 0;

    ASTBuilder := TPasSyntaxTreeBuilder.Create;
    try
      ASTBuilder.InitDefinesDefinedByCompiler;

      SyntaxTree := ASTBuilder.Run(StringStream);
      try
        Result := TSyntaxTreeWriter.ToXML(SyntaxTree);
      finally
        SyntaxTree.Free;
      end;
    finally
      ASTBuilder.Free;
    end;
  finally
    StringStream.Free;
  end;
end;

This function returns parser’s output as an XML in a string. The coolest fact about XML is that it makes possible to query the syntax tree using XPath. You will see some examples below.

Let’s see how a DPR syntax tree looks like.

<UNIT line="1" col="1" name="UnitCounter">
  <USES line="3" col="1">
    <UNIT line="4" col="3" name="Vcl.Forms"/>
    <UNIT line="5" col="3" name="frmMain" path="frmMain.pas">
      <EXPRESSION line="5" col="14">
        <LITERAL line="5" col="35" type="string" value="frmMain.pas"/>
      </EXPRESSION>
    </UNIT>
  </USES>
  <STATEMENTS end_line="14" begin_line="10" end_col="1" begin_col="3">
    <CALL line="10" col="3">
      <DOT>
        <IDENTIFIER line="10" col="3" name="Application"/>
        <IDENTIFIER line="10" col="15" name="Initialize"/>
      </DOT>
    </CALL>
    <ASSIGN line="11" col="3">
      <LHS>
        <DOT>
          <IDENTIFIER line="11" col="3" name="Application"/>
          <IDENTIFIER line="11" col="15" name="MainFormOnTaskbar"/>
        </DOT>
      </LHS>
      <RHS>
        <EXPRESSION line="11" col="36">
          <IDENTIFIER line="11" col="36" name="True"/>
        </EXPRESSION>
      </RHS>
    </ASSIGN>
    <CALL line="12" col="3">
      <CALL>
        <DOT>
          <IDENTIFIER line="12" col="3" name="Application"/>
          <IDENTIFIER line="12" col="15" name="CreateForm"/>
        </DOT>
        <EXPRESSIONS>
          <EXPRESSION line="12" col="26">
            <IDENTIFIER line="12" col="26" name="TForm1"/>
          </EXPRESSION>
          <EXPRESSION line="12" col="34">
            <IDENTIFIER line="12" col="34" name="Form1"/>
          </EXPRESSION>
        </EXPRESSIONS>
      </CALL>
    </CALL>
    <CALL line="13" col="3">
      <DOT>
        <IDENTIFIER line="13" col="3" name="Application"/>
        <IDENTIFIER line="13" col="15" name="Run"/>
      </DOT>
    </CALL>
  </STATEMENTS>
</UNIT>

Definetely, we are interested in UNIT/USES subtree.

Thats how it looks like in Delphi, it couldn’t be easier.

procedure TForm1.GetFileList(const RootFolder, ParsedDpr: string;
  const Files: TStringList);
var
  XmlDoc: IXMLDOMDocument2;
  UnitNodes: IXMLDOMNodeList;
  PathAttrNode: IXMLDOMNode;
  I: Integer;
  FileName: string;
begin
  Files.Clear;

  XmlDoc := CoDOMDocument60.Create;
  XmlDoc.SetProperty('SelectionLanguage', 'XPath');
  XmlDoc.validateOnParse := False;
  XmlDoc.preserveWhiteSpace := False;
  XmlDoc.resolveExternals := False;
  XmlDoc.loadXML(ParsedDpr);

  // select all units nodes
  UnitNodes := XmlDoc.documentElement.selectNodes('/UNIT/USES/UNIT');
  for I := 0 to UnitNodes.length - 1 do
  begin
    // if 'path' attribute exists, then use it
    PathAttrNode := UnitNodes.item[I].attributes.getNamedItem('path');
    if Assigned(PathAttrNode) then
      FileName := PathAttrNode.nodeValue
    else
      FileName := UnitNodes.item[I].attributes.getNamedItem('name').nodeValue + '.pas';

    FileName := ExpandFileName(TPath.Combine(RootFolder, FileName));

    // ignore units that placed somewhere on the search path
    if FileExists(FileName) then
      Files.Add(FileName);
  end;
end;

Now, when we have a list of units file names we can start to calculate.

That’s how a unit syntax tree looks like. I have skipped not interesting but too long parts. You can use DelphiAST demo application to see a full syntax tree for any unit.

<UNIT line="1" col="1" name="frmMain">
  <INTERFACE line="3" col="1">
    <USES line="5" col="1">
      <UNIT line="6" col="3" name="Winapi.Windows"/>
      <UNIT line="6" col="19" name="Winapi.Messages"/>
      <UNIT line="6" col="36" name="System.SysUtils"/>
      <UNIT line="6" col="53" name="System.Variants"/>
      <UNIT line="6" col="70" name="System.Classes"/>
      <UNIT line="6" col="86" name="Vcl.Graphics"/>
      <UNIT line="7" col="3" name="Vcl.Controls"/>
      <UNIT line="7" col="17" name="Vcl.Forms"/>
      <UNIT line="7" col="28" name="Vcl.Dialogs"/>
      <UNIT line="7" col="41" name="Vcl.StdCtrls"/>
      <UNIT line="7" col="55" name="Generics.Collections"/>
    </USES>
    <SKIPPED>..</SKIPPED>
  </INTERFACE>
  <IMPLEMENTATION line="27" col="1">
    <USES line="29" col="1">
      <UNIT line="30" col="3" name="DelphiAST"/>
      <UNIT line="30" col="14" name="DelphiAST.Classes"/>
      <UNIT line="30" col="33" name="DelphiAST.Writer"/>
      <UNIT line="30" col="51" name="MSXML2_TLB"/>
      <UNIT line="30" col="63" name="IOUtils"/>
    </USES>
    <SKIPPED>..</SKIPPED>
  </IMPLEMENTATION>
</UNIT>

We are interested in particular name attribute of /UNIT/INTERFACE/USES/UNIT and /UNIT/IMPLEMENTATION/USES/UNIT nodes.

procedure TForm1.CalculateUnits(const ParsedUnit: string;
  const Stats: TDictionary<string, Integer>);
var
  XmlDoc: IXMLDOMDocument2;
  UnitNodes: IXMLDOMNodeList;
  I: Integer;
  UnitName: string;
begin
  XmlDoc := CoDOMDocument60.Create;
  XmlDoc.SetProperty('SelectionLanguage', 'XPath');
  XmlDoc.validateOnParse := False;
  XmlDoc.preserveWhiteSpace := False;
  XmlDoc.resolveExternals := False;
  XmlDoc.loadXML(ParsedUnit);

  UnitNodes := XmlDoc.documentElement.selectNodes('/UNIT/INTERFACE/USES/UNIT/@name|/UNIT/IMPLEMENTATION/USES/UNIT/@name');

  for I := 0 to UnitNodes.length - 1 do
  begin
    UnitName := UnitNodes.item[I].nodeValue;

    if not Stats.ContainsKey(UnitName) then
      Stats.Add(UnitName, 0);

    Stats[UnitName] := Stats[UnitName] + 1;
  end;
end;

And last, but not least, let’s put all parts together.

var
  Units: TStringList;
  FileName: string;
  Stats: TDictionary<string, Integer>;
  UnitCounter: TPair<string, Integer>;
begin
  if OpenDialog.Execute then
  begin
    Units := TStringList.Create;
    try
      GetFileList(ExtractFilePath(OpenDialog.FileName),
        Parse(ReadFileToString(OpenDialog.FileName)), Units);

      Stats := TDictionary<string, Integer>.Create;
      try
        for FileName in Units do
          CalculateUnits(Parse(ReadFileToString(FileName)), Stats);

        memUnits.Clear;
        for UnitCounter in Stats do
          memUnits.Lines.Add(UnitCounter.Key + ' : ' + IntToStr(UnitCounter.Value));
      finally
        Stats.Free;
      end;
    finally
      Units.Free;
    end;
  end;

That’s it. You can see an example of its output on the screenshot in the beginning of this post.

You can download the full source code here, DelphiAST is available on GitHub. This application is much less complicated than this kind of application is usually expected to be. DelphiAST is a powerful tool and it is a must have if you are going to automatically process your Delphi source code.

14 Sep 2014

DelphiAST Announce
by Roman Yankovsky Leave a comment

In this post I would like to announce DelphiAST project.

DelphiAST is built on the top of publically available version of CastaliaDelphiParser which was much improved (see SimpleParser directory). I fixed a number of issues, added new syntax support and so forth.

With DelphiAST you can take real Delphi code and get an abstract syntax tree. One unit at time and without a symbol table though. Take a look at the sample code to see how it works.

This is a part of my effort to build a static analysis tool for Delphi. I decided to publish this under MPL 2.0 licence as my contribution to the community. I hope the community will contribute to this project too :)