GUI-тестирование "по-русски". Как всё это устроено №2

Предыдущая серия была тут - http://18delphi.blogspot.ru/2013/11/gui_5.html

Теперь хочется рассказать об устройстве TscriptCode и TscriptContext.

Для этого придётся вспомнить вот о чём:

Подсчёт ссылок и TRefcounted:

• http://18delphi.blogspot.ru/2013/03/blog-post_4606.html

Абстрактные контейнеры:

• http://18delphi.blogspot.ru/2013/07/blog-post_3683.html
• http://18delphi.blogspot.ru/2013/07/2.html

Счастливы - "счастливые обладатели" ARC и generic'ов. Они могут сделать это по-другому. Но это (как говорил Фейнман (http://ru.wikipedia.org/wiki/%D0%A4%D0%B5%D0%B9%D0%BD%D0%BC%D0%B0%D0%BD,_%D0%A0%D0%B8%D1%87%D0%B0%D1%80%D0%B4_%D0%A4%D0%B8%D0%BB%D0%BB%D0%B8%D0%BF%D1%81)) - "читатели могут сделать это самостоятельно".

TscriptCode с одной стороны является наследником от TRefcounted, а с другой стороны - подмешивает в себя список ссылок на TscriptKeyWord.

Итак:

interface

  TscriptKeyWord = class(TRefcounted)
   procedure DoIt(aContext: TscriptContext); virtual; abstract;
    {* - собственно код выполнения слова. }
  end;//TscriptKeyWord

  _ItemType_ = TscriptKeyWord;
  _List_Parent_ = TRefcounted;

  {$Include _List_.imp.pas}

  TscriptCode = class(_List_)
   procedure CompileInteger(aValue: Integer);
   procedure CompileString(const aValue: String);
   procedure CompileKeyWord(aValue: TscriptKeyWord);
   procedure Run; // - выполняет скомпилированный код
   procedure RunInContext(aContext: TscriptContext); // - выполняет скомпилированный код в указанном контексте
   ...
  end;//TscriptCode

implementation

function IsSame(const A: _ItemType_;
  const B: _ItemType_): Boolean;
begin
 Result := (A = B);
end;//IsSame

procedure FreeItem(var thePlace: _ItemType_);
begin
 FreeAndNil(thePlace);
end;//FreeItem
 
procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_);
begin
 thePlace := aFrom.Use;
end;//FillItem

{$Include List.imp.pas}

procedure TscriptCode.CompileKeyWord(aValue: TscriptKeyWord);
begin
 Self.Add(aValue);
end;

procedure TscriptCode.Run;
var
 l_Context: TscriptContext;
begin
 l_Context := TscriptContext.Create;
 try
  RunInContext(l_Context);
 finally
  FreeAndNil(l_Context);
 end;//try..finally
end;

procedure TscriptCode.RunInContext(aContext: TscriptContext);
var
 l_Index : Integer;
begin
 for l_Index := 0 to Pred(Self.Count) do
  Self.Items[l_Index].DoIt(aContext); // - выполняем каждое компилированное слово
end;

type
 TkwInteger = class(TscriptKeyWord)
  private
   f_Value : Integer;
  protected
   procedure DoIt(aContext: TscriptContext); override;
  public
   constructor Create(aValue : Integer);
 end;//TkwInteger

procedure TkwInteger.DoIt(aContext: TscriptContext);
begin
 aContext.PushInteger(f_Value);
end;

constructor TkwIntegerCreate(aValue : Integer);
begin
 inherited Create;
 f_Value := aValue;
end;

procedure TscriptCode.CompileInteger(aValue: Integer);
var
 l_Integer : TkwInteger;
begin
 l_Integer := TkwInteger.Create(aValue);
 try
  CompileKeyWord(l_Integer);
 finally
  FreeAndNil(l_Integer);
 end;//try..finally
end;

type
 TkwString = class(TscriptKeyWord)
  private
   f_Value : String;
  protected
   procedure DoIt(aContext: TscriptContext); override;
  public
   constructor Create(const aValue : String);
 end;//TkwString

procedure TkwString.DoIt(aContext: TscriptContext);
begin
 aContext.PushString(f_Value);
end;

constructor TkwString.Create(const aValue : String);
begin
 inherited Create;
 f_Value := aValue;
end;

procedure TscriptCode.CompileString(const aValue: String);
var
 l_String : TkwString;
begin
 l_String := TkwString.Create(aValue);
 try
  CompileKeyWord(l_String);
 finally
  FreeAndNil(l_String);
 end;//try..finally
end;

Про TscriptContext - нету уже сил писать. Отвлёкся я на RTTI. Время - позднее...

Продолжу про TscriptContext в следующей серии. В общем там банально всё конечно. "Стек значений". Но - не совсем...