GUI-Тестирование "по-русски". Как всё устроено №2.5. Про TscriptContext

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

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

В целом это конечно - "стек значений".

Но не только... Но об этом - позже.

Пока - про стек..

Стек значений - это ОДИН из краеугольных камней устройства нашей тестовой машины.

Теорию можно почитать тут - http://ru.wikipedia.org/wiki/Forth

И кстати ещё одна забавная ссылка - http://ru.wikipedia.org/wiki/%D0%9A%D0%BE%D0%BD%D0%BA%D0%B0%D1%82%D0%B5%D0%BD%D0%B0%D1%82%D0%B8%D0%B2%D0%BD%D1%8B%D0%B9_%D1%8F%D0%B7%D1%8B%D0%BA_%D0%BF%D1%80%D0%BE%D0%B3%D1%80%D0%B0%D0%BC%D0%BC%D0%B8%D1%80%D0%BE%D0%B2%D0%B0%D0%BD%D0%B8%D1%8F

А пока - займёмся практикой.

Как выглядит стек значений внутри.
Примерно вот так:

interface

type
  TscriptValueType = (script_vtVoid, script_vtInteger, script_vtBoolean, script_vtString, script_vtObject);

  TscriptValue = {$IfDef XE}record{$Else}object{$EndIf}
   private
    rType : TscriptValueType;
    rInteger : Integer;
    rBoolean : Boolean;
    rString : String;
    rObject : TObject;
   public
    function AsInteger: Integer;
    function AsBoolean: Boolean;
    function AsString: String;
    function AsObject: TObject;

    function EQ(anOther: TscriptValue): Boolean;
  end;//TscriptValue
 
  function TscriptValue_C(aValue: Integer): TscriptValue; overload;
  function TscriptValue_C(aValue: Boolean): TscriptValue; overload;
  function TscriptValue_C(aValue: String): TscriptValue; overload;
  function TscriptValue_C(aValue: TObject): TscriptValue; overload;

  // - преобразовать это в "вариантную запись" - оставляю самым пытливым читателям

  _ItemType_ = TscriptValue;
  _List_Parent_ = TRefcounted;

  {$Include _List_.imp.pas}
 
  TscriptContext = class(_List_)
   public
    function PopInteger: Integer;
    function PopBoolean: Boolean;
    function PopString: String;
    function PopObject: TObject;

    procedure PushInteger(aValue: Integer);
    procedure PushBoolean(aValue: Boolean);
    procedure PushString(aValue: String);
    procedure PushObject(aValue: TObject);
  end;//TscriptContext

implementation

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

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

{$Include _List_.imp.pas}

function TscriptValue.AsInteger: Integer;
begin
 Assert(rType = script_vtInteger);
 Result := rInteger;
end;

function TscriptValue.AsBoolean: Boolean;
begin
 Assert(rType = script_vtBoolean);
 Result := rBoolean;
end;

function TscriptValue.AsString: String;
begin
 Assert(rType = script_vtString);
 Result := rInteger;
end;

function TscriptValue.AsObject: TObject;
begin
 Assert(rType = script_vtObject);
 Result := rObject;
end;

function TscriptValue.EQ(anOther: TscriptValue): Boolean;
begin
 Result := (rType = anOther.rType);
 if Result then
 begin
  Case rType of
   script_vtInteger:
    Result := Self.AsInteger = anOther.AsInteger;
   script_vtBoolean:
    Result := Self.AsBoolean = anOther.AsBoolean;
   script_vtString:
    Result := Self.AsString = anOther.AsString;
   script_vtObject:
    Result := Self.AsObject = anOther.AsObject;
   else
   begin
    Assert(false);
    Result := false;
   end;//else
  end;//Case rType
 end;//Result
end;

function TscriptValue_C(aValue: Integer): TscriptValue; 
begin
 Result.rType := script_vtInteger;
 Result.rInteger := aValue;
end;

function TscriptValue_C(aValue: Boolean): TscriptValue;
begin
 Result.rType := script_vtBoolean;
 Result.rBoolean := aValue;
end;

function TscriptValue_C(aValue: String): TscriptValue;
begin
 Result.rType := script_vtString;
 Result.rString := aValue;
end;
 
function TscriptValue_C(aValue: TObject): TscriptValue;
begin
 Result.rType := script_vtObject;
 Result.rObject := aValue;
end;

function TscriptContext.PopInteger: Integer;
begin
 Result := Self.Last.AsInteger;
 Delete(Pred(Count));
end;

function TscriptContext.PopBoolean: Boolean;
begin
 Result := Self.Last.AsBoolean;
 Delete(Pred(Count));
end;

function TscriptContext.PopString: String;
begin
 Result := Self.Last.AsInteger;
 Delete(Pred(Count));
end;

function TscriptContext.PopObject: TObject;
begin
 Result := Self.Last.AsObject;
 Delete(Pred(Count));
end;

procedure TscriptContext.PushInteger(aValue: Integer);
begin
 Self.Add(TscriptValue_C(aValue));
end;

procedure TscriptContext.PushBoolean(aValue: Boolean);
begin
 Self.Add(TscriptValue_C(aValue));
end;

procedure TscriptContext.PushString(aValue: String);
begin
 Self.Add(TscriptValue_C(aValue));
end;

procedure TscriptContext.PushObject(aValue: TObject);
begin
 Self.Add(TscriptValue_C(aValue));
end;

Вот как-то так пока...

Замечу лишь, что ещё есть наследник от TscriptContext - TscriptCompileContext:

  TscriptCompileContext = class(TscriptContext)
   property Parser: IscriptParser;
    {* - Текущий парсер. }
   property Code: TscriptCode;
    {* - Текущий компилируемый код. }
  end;//TscriptCompileContext

Он используется в процессе компиляции кода и служит для обеспечения возможности управления процессом разбора кода (парсинга) и собственно построения компилируемого кода.

О нём подробнее я напишу в следующих сериях.