Loop does not terminate if O2, O3 ( REGVAR) used (Conditions: Function return value not used, variable reused, afterward exception is coded)

Summary

If a rare combination of repeat...until, combined with an function call and reusing the loop control variable later and an later exception is combined, the loop does not terminate, because the return value of the function call in the loop is not copied into the rax register.

System Information

  • Operating system: Windows
  • Processor architecture: x86-64
  • Compiler version: 3.2.2
  • Device: Computer

Steps to reproduce

For Details see the short most example program! You need

  • an empty project
  • a new class, containing an pointer to the same class named "NextObj", to build an chained object list
  • a Root instance of the new class
  • a FormCreate-Event where the forms Root-Field is instatiated and some elements are created and attached to the chained list
  • a FormDestroy-Event where all the Objects are freed (optional, not relevant regarding the error)
  • a private function where the passed Object's NextObj-field is returned
  • a Button
  • a Button-OnClick event, where the list, beginning with Root is iterated, using a repeat...until loop, the loops are counted, and the loop variable of the Object is set Nil after the end of the loop, plus an exception is generated if count of the loops is zero.
  • the compiler must be set to "release" modes using optimization O2 or O3 (this includes the REGVAR option)
  • debugging must be enabled
  • Set a breakpoint to " until not Assigned(lTest);"
  • start the program
  • "enjoy" that the loop will never terminate, since the return value from the "NextObj"-function is not used.

000000010002E63A E8F1000000 call +$000000F1 # $000000010002E730 NextObj unit1.pas:99 (...)\LinkedListTest\unit1.pas:64 until not Assigned(lTest); 000000010002E63F 4885C0 test rax,rax 000000010002E642 75EC jnz -$14 # $000000010002E630 Button1Click+48 unit1.pas:62

The bug only arise if the following conditions are met: The REGVAR optimization, the loop entered with a preset loop variable, the reuse of the local loop variable after the end of the loop (e.g. setting to Nil), plus the exception at the end of the method. If one thing is missed the compiler does not create the problem.

Example Project

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  TTestObj = class(TObject)
  private
    FNext : TTestObj;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FRoot : TTestObj;
    function NextObj(const ATestObj : TTestObj) : TTestObj;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

{
  In the release-mode, using Optimization O2 or O3 (including the REGVAR-Option),
  the following method will have an infinite loop.
  The compiler misses to move the return-code from the NextObj-function into
  the rax register. This keeps the default value and subsequently the
  loop is never terminated.

  There are three possibilites to "repair":
  1.) not using the REGVAR optimization (by using the "$optimization noREGVAR" command).
  2.) removing the "lTest := Nil;" command after the loop.
  3.) removing the raise of the Exception.
}
procedure TForm1.Button1Click(Sender: TObject);
var
  lTest : TTestObj;
  cnt : Integer;
begin
  {.$optimization noREGVAR}

  cnt := 0;
  lTest := FRoot;
  repeat
    Inc(cnt);
    lTest := NextObj(lTest);
  until not Assigned(lTest);

  lTest := Nil;
  if cnt = 0 then
    raise Exception.Create('Including this exception causes the compiler fault!');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
  lTest : TTestObj;
begin
  FRoot := TTestObj.Create;
  lTest := FRoot;
  for i := 0 to 9 do
  begin
    lTest.FNext := TTestObj.Create;
    lTest := lTest.FNext;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  lTest, lNext : TTestObj;
begin
  lTest := FRoot;
  repeat
    lNext := lTest.FNext;
    lTest.Free;
    lTest := lNext;
  until not Assigned(lTest);
end;

function TForm1.NextObj(const ATestObj: TTestObj): TTestObj;
begin
  Result := ATestObj.FNext;
end;

end.

What is the current bug behavior?

The repeat...until-loop never terminates. The program ist blocking.

What is the expected (correct) behavior?

The repeat...until-loop should terminate after the last Object is processed and the return value is Nil.

Relevant logs and/or screenshots

None.

Possible fixes

To bypass the behavior three methods exists: 1.) not using the REGVAR optimization (by using the "$optimization noREGVAR" command). 2.) removing the "lTest := Nil;" command after the loop. 3.) removing the raise of the Exception. Also the loop could be slightly different constructed, removing the termination and using a break inside.

Edited by Ekkehard Domning