ToDo. Interfaces with partial implementation in the model

Original in Russian: http://programmingmindstream.blogspot.ru/2015/07/todo_36.html

Interfaces are usually small, self-sufficient and self-consistent.

A “good”, well-developed interface has 3 to 5 methods that are not derived from each other .

However, there are “monsters” like IStream, IStorage and IDataObject in which interface methods are EXPLICITELY derived from the others by default.

IDataObject is a perfect example since it has GetData and GetDataHere as well as EnumFormatEtc and GetCanonicalFormatEtc .

There are also small interfaces with methods derived from the other methods by default in it.

For example:

type
 ICString = interaface
  function S: PChar;
  function Len: Integer;
  function EQ(const anOther: ICString): Boolean;
 end;//ICString

It is obvious that EQ can be derived from S and Len methods.

But, “as usual”, the “poor fellows” are forced to implement such “default methods”.

Again and again, one by one, they make systematic errors.

What can be done to it?

Naturally, we can develop a “bundle” of default implementations as global methods and pin the developers down to call these methods.

We can simplly remove the EQ methods from the interface and replace them with a “bundle” of default methods.

But!

Sometimes even OUTSIDE interfaces can be implemented in the code.

Sometimes it is also CONVENIENT to have default redefinable implementation.

So what is to do?

Well, we may add a tick to the model at the interface method “default implementation”.

Next, we add a mixin to code-generation process to the interface with such ticks, for example, a tick at ICString.EQ.

In this case, we get a mixin in code-generation:

type
 _CString_ = class(_CString_Parent_)
  protected
   function EQ(const anOther: ICString): Boolean; virtual;
 end;//_CString_
 
...
 
function _CString_.EQ(const anOther: ICString): Boolean;
begin
 // - default implementation here
end;

Let our TCString class implement (in the model) the ICString interface.

As a result, we have the code:

type
 _CString_Parent_ = TInterfacedObject;
 {$Include CString.imp.pas}
 TCString = class(_CString_, ICString)
 protected
  function S: PChar;
  function Len: Integer;
  //function EQ(const anOther: ICString): Boolean;
  // - implemented before, in _CString_
 end;//TCString

We may also get the TCString1:

type
 _CString_Parent_ = TInterfacedObject;
 {$Include CString.imp.pas}
 TCString1 = class(_CString_, ICString)
 protected
  function S: PChar;
  function Len: Integer;
  function EQ(const anOther: ICString): Boolean; override;
  // - default implementation overriden here
 end;//TCString1

As for me, this idea is interesting, I’ve been looking for it for a long time.

We may move on and add a tree-option “tick” - abstract/virtual/final.

The options:
abstract - we do default implementation.
virtual - we do virtual default implementation.
final - we do final (static) implementation.

+Victor Morozov
+Mikhail Kostitsyn
+Nikolay Zverev

References:

About patterns and mixins
My own implementation of IUnknown and reference counting. And mixins
Briefly. Much about “mixins and patterns” (in Russian)
Once again about “mixins”, now seriously (in Russian)
Languages with mixins possible one way or another (in Russian)
Why UML (in Russian)

I guess it’ll be ready by tomorrow.

Though it is not simple. There are some pitfalls.

If we copy interface methods to te mixin, these methods are implemented in descendants.

As parasites.

If we do not copy them, it is not clear how to show them.

As an option, we can add an “extra cycle” like %o or %O.

Still, how can we find out if “the method has been implemented”?

Should we move it to the PureMixIn?

Actually, it is SIMPLE - we should not implement methods with a tick AT ALL.

Some more about scripts

https://bitbucket.org/lulinalex/mindstream/commits/3933ac39a7427aa045ac168eded8f492c83043c1

FormsProcessingPack.rc.script:

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine$RTLandVCL"
// Модуль: "FormsProcessingPack.rc.script"
// Скрипты в ресурсах (.rc.script)
// Generated from UML model, root element: ScriptKeywordsPack::Class Shared Delphi Low Level::ScriptEngine$RTLandVCL::FormsProcessing::FormsProcessingPack
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

//#UC START# *50741A1F028Cimpl*

USES
 axiom:Component
 axiom:Form
 axiom:ActionList
 axiom:ContainedAction
;

//REDEFINITION
 PROCEDURE pop:form:ExecuteAction
    STRING IN anActionName
    STRING IN aListName
    TForm IN aForm
    
   TActionList VAR l_ActList
   
   aListName aForm pop:form:FindActionList >>> l_ActList
   l_ActList pop:object:IsNil ! ?ASSURE [ 'Не найден компонент ' aListName ' на форме ' aForm pop:Component:Name ]
   
   TContainedAction VAR l_Action
   
   anActionName l_ActList pop:ActionList:FindAction >>> l_Action
   l_Action pop:object:IsNil ! ?ASSURE [ 'Не найден Action ' anActionName ' в списке' aListName ]
   
   l_Action pop:ContainedAction:Execute
   //anActionName aListName aForm inherited
 ; // pop:form:ExecuteAction
 
//#UC END# *50741A1F028Cimpl*


EXPORTS
//#UC START# *50741A1F028Cexports*
 *
//#UC END# *50741A1F028Cexports*

FormsProcessingPack.pas:

unit FormsProcessingPack;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine$RTLandVCL"
// Модуль: "FormsProcessingPack.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: ScriptKeywordsPack::Class Shared Delphi Low Level::ScriptEngine$RTLandVCL::FormsProcessing::FormsProcessingPack
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Include ..\ScriptEngine\seDefine.inc}

interface

{$If not defined(NoScripts)}
uses
  Forms,
  ActnList,
  Menus,
  tfwScriptingInterfaces,
  tfwRegisterableWord,
  tfwAxiomaticsResNameGetter
  ;

{$IfEnd} //not NoScripts

implementation

{$If not defined(NoScripts)}
uses
  l3ObjectList,
  Classes,
  CustomFormProcessingPack,
  Controls,
  ActionListWordsPack,
  tfwScriptingTypes,
  TypInfo,
  SysUtils,
  tfwTypeRegistrator
  ;

type
//#UC START# *38481B365F20ci*
//#UC END# *38481B365F20ci*
 TFormsProcessingPackResNameGetter = {final} class(TtfwAxiomaticsResNameGetter)
  {* Регистрация скриптованой аксиоматики }
 public
 // realized methods
   class function ResName: AnsiString; override;
//#UC START# *38481B365F20publ*
//#UC END# *38481B365F20publ*
 end;//TFormsProcessingPackResNameGetter

// start class TFormsProcessingPackResNameGetter

class function TFormsProcessingPackResNameGetter.ResName: AnsiString;
 {-}
begin
 Result := 'FormsProcessingPack';
end;//TFormsProcessingPackResNameGetter.ResName

 {$R FormsProcessingPack.res FormsProcessingPack.rc}

type
 TkwPopFormActiveMDIChild = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:ActiveMDIChild
*Тип результата:* TForm
*Пример:*
[code]
OBJECT VAR l_TForm
 aForm pop:form:ActiveMDIChild >>> l_TForm
[code]  }
 private
 // private methods
   function PopFormActiveMDIChild(const aCtx: TtfwContext;
    aForm: TForm): TForm;
     {* Реализация слова скрипта pop:form:ActiveMDIChild }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormActiveMDIChild

// start class TkwPopFormActiveMDIChild

function TkwPopFormActiveMDIChild.PopFormActiveMDIChild(const aCtx: TtfwContext;
  aForm: TForm): TForm;
//#UC START# *8AB0508CEF4C_90DD5B736D00_var*
//#UC END# *8AB0508CEF4C_90DD5B736D00_var*
begin
//#UC START# *8AB0508CEF4C_90DD5B736D00_impl*
 Result := aForm.ActiveMDIChild;
//#UC END# *8AB0508CEF4C_90DD5B736D00_impl*
end;//TkwPopFormActiveMDIChild.PopFormActiveMDIChild

procedure TkwPopFormActiveMDIChild.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushObj((PopFormActiveMDIChild(aCtx, l_aForm)));
end;//TkwPopFormActiveMDIChild.DoDoIt

class function TkwPopFormActiveMDIChild.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:ActiveMDIChild';
end;//TkwPopFormActiveMDIChild.GetWordNameForRegister

function TkwPopFormActiveMDIChild.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(TForm);
end;//TkwPopFormActiveMDIChild.GetResultTypeInfo

type
 TkwPopFormClose = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:Close
*Пример:*
[code]
 aForm pop:form:Close
[code]  }
 private
 // private methods
   procedure PopFormClose(const aCtx: TtfwContext;
    aForm: TForm);
     {* Реализация слова скрипта pop:form:Close }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormClose

// start class TkwPopFormClose

procedure TkwPopFormClose.PopFormClose(const aCtx: TtfwContext;
  aForm: TForm);
//#UC START# *2435574FF0DB_EF68563BBDE0_var*
//#UC END# *2435574FF0DB_EF68563BBDE0_var*
begin
//#UC START# *2435574FF0DB_EF68563BBDE0_impl*
 aForm.Close;
//#UC END# *2435574FF0DB_EF68563BBDE0_impl*
end;//TkwPopFormClose.PopFormClose

procedure TkwPopFormClose.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 PopFormClose(aCtx, l_aForm);
end;//TkwPopFormClose.DoDoIt

class function TkwPopFormClose.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:Close';
end;//TkwPopFormClose.GetWordNameForRegister

function TkwPopFormClose.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := @tfw_tiVoid;
end;//TkwPopFormClose.GetResultTypeInfo

type
 TkwPopFormFindMenuItem = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:FindMenuItem
*Тип результата:* TMenuItem
*Пример:*
[code]
OBJECT VAR l_TMenuItem
 aName aForm pop:form:FindMenuItem >>> l_TMenuItem
[code]  }
 private
 // private methods
   function PopFormFindMenuItem(const aCtx: TtfwContext;
    aForm: TForm;
    const aName: AnsiString): TMenuItem;
     {* Реализация слова скрипта pop:form:FindMenuItem }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormFindMenuItem

// start class TkwPopFormFindMenuItem

function TkwPopFormFindMenuItem.PopFormFindMenuItem(const aCtx: TtfwContext;
  aForm: TForm;
  const aName: AnsiString): TMenuItem;
//#UC START# *91740A9F6F65_CCC0609B3BF5_var*
const
 cDelimiter = '/';

 function FindMainMenu(aComponent: TComponent): TMainMenu;
 var
  I: Integer;
 begin
  Result := nil;
  for I := 0 to aComponent.ComponentCount - 1 do
   if aComponent.Components[I] is TMainMenu then
   begin
    Result := aComponent.Components[I] as TMainMenu;
    Exit;
   end;    
  for I := 0 to aComponent.ComponentCount - 1 do
  begin
   Result := FindMainMenu(aComponent.Components[I]);
   if Assigned(Result) then
    Exit;
  end;
 end;

 function GetNextItem(var anItem: TMenuItem; var aPath: AnsiString): Boolean;
 var
  I: Integer;
  l_DelimiterIndex: Integer;
  l_Name: AnsiString;
  l_FindItem: TMenuItem;
 begin
  l_DelimiterIndex := Pos(cDelimiter, aPath);
  if l_DelimiterIndex = 0 then
   l_Name := aPath
  else
  begin
   l_Name := Copy(aPath, 1, l_DelimiterIndex - 1);
   aPath := Copy(aPath, l_DelimiterIndex + 1, MaxInt);
  end;
  l_FindItem := anItem.Find(l_Name);
  Result := Assigned(l_FindItem);
  if Result then
   anItem := l_FindItem;
 end;
               
var
 l_Path: AnsiString;
 l_Menu: TMainMenu;
 l_Item: TMenuItem;
//#UC END# *91740A9F6F65_CCC0609B3BF5_var*
begin
//#UC START# *91740A9F6F65_CCC0609B3BF5_impl*
 l_Menu := FindMainMenu(aForm);
 RunnerAssert(Assigned(l_Menu), 'На форме нет меню', aCtx);
 {$IfDef l3HackedVCL}
 l_Menu.Items.CallInitiateActions;
 {$EndIf l3HackedVCL}
 l_Menu.Items.RethinkHotkeys;
 l_Menu.Items.RethinkLines;
 l_Path := aName;
 l_Item := l_Menu.Items;
 {$IfDef l3HackedVCL}
 while GetNextItem(l_Item, l_Path) do
  l_Item.CallInitiateActions;
 {$EndIf l3HackedVCL}
 l_Item.RethinkHotkeys;
 l_Item.RethinkLines;
 Result := l_Item;
//#UC END# *91740A9F6F65_CCC0609B3BF5_impl*
end;//TkwPopFormFindMenuItem.PopFormFindMenuItem

procedure TkwPopFormFindMenuItem.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
 l_aName : AnsiString;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 try
  l_aName := (aCtx.rEngine.PopDelphiString);
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aName: AnsiString : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushObj((PopFormFindMenuItem(aCtx, l_aForm, l_aName)));
end;//TkwPopFormFindMenuItem.DoDoIt

class function TkwPopFormFindMenuItem.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:FindMenuItem';
end;//TkwPopFormFindMenuItem.GetWordNameForRegister

function TkwPopFormFindMenuItem.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(TMenuItem);
end;//TkwPopFormFindMenuItem.GetResultTypeInfo

type
 TkwPopFormGetWindowState = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:GetWindowState
*Тип результата:* TWindowState
*Пример:*
[code]
INTEGER VAR l_TWindowState
 aForm pop:form:GetWindowState >>> l_TWindowState
[code]  }
 private
 // private methods
   function PopFormGetWindowState(const aCtx: TtfwContext;
    aForm: TForm): TWindowState;
     {* Реализация слова скрипта pop:form:GetWindowState }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormGetWindowState

// start class TkwPopFormGetWindowState

function TkwPopFormGetWindowState.PopFormGetWindowState(const aCtx: TtfwContext;
  aForm: TForm): TWindowState;
//#UC START# *1AF6E71E5FCF_DA5ACD40FDF6_var*
//#UC END# *1AF6E71E5FCF_DA5ACD40FDF6_var*
begin
//#UC START# *1AF6E71E5FCF_DA5ACD40FDF6_impl*
 Result := aForm.WindowState;
//#UC END# *1AF6E71E5FCF_DA5ACD40FDF6_impl*
end;//TkwPopFormGetWindowState.PopFormGetWindowState

procedure TkwPopFormGetWindowState.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushInt(Ord(PopFormGetWindowState(aCtx, l_aForm)));
end;//TkwPopFormGetWindowState.DoDoIt

class function TkwPopFormGetWindowState.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:GetWindowState';
end;//TkwPopFormGetWindowState.GetWordNameForRegister

function TkwPopFormGetWindowState.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(TWindowState);
end;//TkwPopFormGetWindowState.GetResultTypeInfo

type
 TkwPopFormHasControl = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:HasControl
*Тип результата:* Boolean
*Пример:*
[code]
BOOLEAN VAR l_Boolean
 aName aForm pop:form:HasControl >>> l_Boolean
[code]  }
 private
 // private methods
   function PopFormHasControl(const aCtx: TtfwContext;
    aForm: TForm;
    const aName: AnsiString): Boolean;
     {* Реализация слова скрипта pop:form:HasControl }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormHasControl

// start class TkwPopFormHasControl

function TkwPopFormHasControl.PopFormHasControl(const aCtx: TtfwContext;
  aForm: TForm;
  const aName: AnsiString): Boolean;
//#UC START# *1040311EDE6F_AF277B657685_var*
//#UC END# *1040311EDE6F_AF277B657685_var*
begin
//#UC START# *1040311EDE6F_AF277B657685_impl*
 Result := (aForm.FindChildControl(aName) <> nil);
//#UC END# *1040311EDE6F_AF277B657685_impl*
end;//TkwPopFormHasControl.PopFormHasControl

procedure TkwPopFormHasControl.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
 l_aName : AnsiString;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 try
  l_aName := (aCtx.rEngine.PopDelphiString);
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aName: AnsiString : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushBool((PopFormHasControl(aCtx, l_aForm, l_aName)));
end;//TkwPopFormHasControl.DoDoIt

class function TkwPopFormHasControl.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:HasControl';
end;//TkwPopFormHasControl.GetWordNameForRegister

function TkwPopFormHasControl.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(Boolean);
end;//TkwPopFormHasControl.GetResultTypeInfo

type
 TkwPopFormMDIChildCount = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:MDIChildCount
*Тип результата:* Integer
*Пример:*
[code]
INTEGER VAR l_Integer
 aForm pop:form:MDIChildCount >>> l_Integer
[code]  }
 private
 // private methods
   function PopFormMDIChildCount(const aCtx: TtfwContext;
    aForm: TForm): Integer;
     {* Реализация слова скрипта pop:form:MDIChildCount }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormMDIChildCount

// start class TkwPopFormMDIChildCount

function TkwPopFormMDIChildCount.PopFormMDIChildCount(const aCtx: TtfwContext;
  aForm: TForm): Integer;
//#UC START# *12B749ECF277_2C52284D1B9B_var*
//#UC END# *12B749ECF277_2C52284D1B9B_var*
begin
//#UC START# *12B749ECF277_2C52284D1B9B_impl*
 Result := aForm.MDIChildCount;
//#UC END# *12B749ECF277_2C52284D1B9B_impl*
end;//TkwPopFormMDIChildCount.PopFormMDIChildCount

procedure TkwPopFormMDIChildCount.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushInt((PopFormMDIChildCount(aCtx, l_aForm)));
end;//TkwPopFormMDIChildCount.DoDoIt

class function TkwPopFormMDIChildCount.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:MDIChildCount';
end;//TkwPopFormMDIChildCount.GetWordNameForRegister

function TkwPopFormMDIChildCount.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(Integer);
end;//TkwPopFormMDIChildCount.GetResultTypeInfo

type
 TkwPopFormMDIChildren = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:MDIChildren
*Тип результата:* TForm
*Пример:*
[code]
OBJECT VAR l_TForm
 anIndex aForm pop:form:MDIChildren >>> l_TForm
[code]  }
 private
 // private methods
   function PopFormMDIChildren(const aCtx: TtfwContext;
    aForm: TForm;
    anIndex: Integer): TForm;
     {* Реализация слова скрипта pop:form:MDIChildren }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormMDIChildren

// start class TkwPopFormMDIChildren

function TkwPopFormMDIChildren.PopFormMDIChildren(const aCtx: TtfwContext;
  aForm: TForm;
  anIndex: Integer): TForm;
//#UC START# *3639BFFF59A0_8D30B82D3D31_var*
//#UC END# *3639BFFF59A0_8D30B82D3D31_var*
begin
//#UC START# *3639BFFF59A0_8D30B82D3D31_impl*
 Result := aForm.MDIChildren[anIndex];
//#UC END# *3639BFFF59A0_8D30B82D3D31_impl*
end;//TkwPopFormMDIChildren.PopFormMDIChildren

procedure TkwPopFormMDIChildren.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
 l_anIndex : Integer;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 try
  l_anIndex := (aCtx.rEngine.PopInt);
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра anIndex: Integer : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushObj((PopFormMDIChildren(aCtx, l_aForm, l_anIndex)));
end;//TkwPopFormMDIChildren.DoDoIt

class function TkwPopFormMDIChildren.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:MDIChildren';
end;//TkwPopFormMDIChildren.GetWordNameForRegister

function TkwPopFormMDIChildren.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(TForm);
end;//TkwPopFormMDIChildren.GetResultTypeInfo

type
 TkwPopFormModalResult = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:ModalResult
*Тип результата:* Integer
*Пример:*
[code]
INTEGER VAR l_Integer
 aForm pop:form:ModalResult >>> l_Integer
[code]  }
 private
 // private methods
   function PopFormModalResult(const aCtx: TtfwContext;
    aForm: TForm): Integer;
     {* Реализация слова скрипта pop:form:ModalResult }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormModalResult

// start class TkwPopFormModalResult

function TkwPopFormModalResult.PopFormModalResult(const aCtx: TtfwContext;
  aForm: TForm): Integer;
//#UC START# *258A2F5BBDB1_320C0D058217_var*
//#UC END# *258A2F5BBDB1_320C0D058217_var*
begin
//#UC START# *258A2F5BBDB1_320C0D058217_impl*
 RunnerAssert(fsModal in aForm.FormState, 'Это не модальная форма!', aCtx);
 Result := aForm.ModalResult;
//#UC END# *258A2F5BBDB1_320C0D058217_impl*
end;//TkwPopFormModalResult.PopFormModalResult

procedure TkwPopFormModalResult.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushInt((PopFormModalResult(aCtx, l_aForm)));
end;//TkwPopFormModalResult.DoDoIt

class function TkwPopFormModalResult.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:ModalResult';
end;//TkwPopFormModalResult.GetWordNameForRegister

function TkwPopFormModalResult.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(Integer);
end;//TkwPopFormModalResult.GetResultTypeInfo

type
 TkwPopFormNext = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:Next
*Пример:*
[code]
 aForm pop:form:Next
[code]  }
 private
 // private methods
   procedure PopFormNext(const aCtx: TtfwContext;
    aForm: TForm);
     {* Реализация слова скрипта pop:form:Next }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormNext

// start class TkwPopFormNext

procedure TkwPopFormNext.PopFormNext(const aCtx: TtfwContext;
  aForm: TForm);
//#UC START# *BE561C1EA571_12E2A5A1963A_var*
//#UC END# *BE561C1EA571_12E2A5A1963A_var*
begin
//#UC START# *BE561C1EA571_12E2A5A1963A_impl*
 aForm.Next;
//#UC END# *BE561C1EA571_12E2A5A1963A_impl*
end;//TkwPopFormNext.PopFormNext

procedure TkwPopFormNext.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 PopFormNext(aCtx, l_aForm);
end;//TkwPopFormNext.DoDoIt

class function TkwPopFormNext.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:Next';
end;//TkwPopFormNext.GetWordNameForRegister

function TkwPopFormNext.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := @tfw_tiVoid;
end;//TkwPopFormNext.GetResultTypeInfo

type
 TkwPopFormSetWindowState = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:SetWindowState
*Пример:*
[code]
 aValue aForm pop:form:SetWindowState
[code]  }
 private
 // private methods
   procedure PopFormSetWindowState(const aCtx: TtfwContext;
    aForm: TForm;
    aValue: TWindowState);
     {* Реализация слова скрипта pop:form:SetWindowState }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormSetWindowState

// start class TkwPopFormSetWindowState

procedure TkwPopFormSetWindowState.PopFormSetWindowState(const aCtx: TtfwContext;
  aForm: TForm;
  aValue: TWindowState);
//#UC START# *84606C12BBFD_062C119864B2_var*
//#UC END# *84606C12BBFD_062C119864B2_var*
begin
//#UC START# *84606C12BBFD_062C119864B2_impl*
 aForm.WindowState := aValue;
//#UC END# *84606C12BBFD_062C119864B2_impl*
end;//TkwPopFormSetWindowState.PopFormSetWindowState

procedure TkwPopFormSetWindowState.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
 l_aValue : TWindowState;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 try
  l_aValue := TWindowState(aCtx.rEngine.PopInt);
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aValue: TWindowState : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 PopFormSetWindowState(aCtx, l_aForm, l_aValue);
end;//TkwPopFormSetWindowState.DoDoIt

class function TkwPopFormSetWindowState.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:SetWindowState';
end;//TkwPopFormSetWindowState.GetWordNameForRegister

function TkwPopFormSetWindowState.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := @tfw_tiVoid;
end;//TkwPopFormSetWindowState.GetResultTypeInfo

type
 TkwPopFormFindActionList = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:form:FindActionList
*Тип результата:* TActionList
*Пример:*
[code]
OBJECT VAR l_TActionList
 aListName aForm pop:form:FindActionList >>> l_TActionList
[code]  }
 private
 // private methods
   function PopFormFindActionList(const aCtx: TtfwContext;
    aForm: TForm;
    const aListName: AnsiString): TActionList;
     {* Реализация слова скрипта pop:form:FindActionList }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopFormFindActionList

// start class TkwPopFormFindActionList

function TkwPopFormFindActionList.PopFormFindActionList(const aCtx: TtfwContext;
  aForm: TForm;
  const aListName: AnsiString): TActionList;
//#UC START# *2D6AE1A8E910_76B7945239DF_var*
var
 l_Component : TComponent;
 i : Integer;
 l_Control : TControl;
//#UC END# *2D6AE1A8E910_76B7945239DF_var*
begin
//#UC START# *2D6AE1A8E910_76B7945239DF_impl*
 Result := nil;
 l_Component := aForm.FindComponent(aListName);
 if (l_Component = nil) then
 // Попробуем спросить у дочерних фреймов...
 begin
  for i := 0 to aForm.ControlCount - 1 do
  begin
   l_Control := aForm.Controls[i];
   if (l_Control is TFrame) then
   begin
    l_Component := l_Control.FindComponent(aListName);
    if (l_Component <> nil) then
     Break;
   end // if l_Control is TFrame then
  end; // for i := 0 to aForm.ControlCount - 1 do
 end; // if l_Component = nil then
 Result := l_Component As TActionList;
//#UC END# *2D6AE1A8E910_76B7945239DF_impl*
end;//TkwPopFormFindActionList.PopFormFindActionList

procedure TkwPopFormFindActionList.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aForm : TForm;
 l_aListName : AnsiString;
begin
 try
  l_aForm := TForm(aCtx.rEngine.PopObjAs(TForm));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aForm: TForm : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 try
  l_aListName := (aCtx.rEngine.PopDelphiString);
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aListName: AnsiString : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushObj((PopFormFindActionList(aCtx, l_aForm, l_aListName)));
end;//TkwPopFormFindActionList.DoDoIt

class function TkwPopFormFindActionList.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:form:FindActionList';
end;//TkwPopFormFindActionList.GetWordNameForRegister

function TkwPopFormFindActionList.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(TActionList);
end;//TkwPopFormFindActionList.GetResultTypeInfo

type
 TkwIterateForms = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта IterateForms
*Пример:*
[code]
 aLambda IterateForms
[code]  }
 private
 // private methods
   procedure IterateForms(const aCtx: TtfwContext;
    aLambda: TtfwWord);
     {* Реализация слова скрипта IterateForms }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwIterateForms

// start class TkwIterateForms

procedure TkwIterateForms.IterateForms(const aCtx: TtfwContext;
  aLambda: TtfwWord);
//#UC START# *B1D8BF8B68F8_DBFEA799BB20_var*
var
 l_Obj: TObject;
 I: Integer;
 l_FormsList: Tl3ObjectList;
//#UC END# *B1D8BF8B68F8_DBFEA799BB20_var*
begin
//#UC START# *B1D8BF8B68F8_DBFEA799BB20_impl*
 l_FormsList := Tl3ObjectList.Create;
 try
  for I := 0 to Screen.CustomFormCount - 1 do
   l_FormsList.Add(Screen.CustomForms[I]);

  for I := 0 to l_FormsList.Count - 1 do
  try
   aCtx.rEngine.PushObj(l_FormsList[I]);
   aLambda.DoIt(aCtx);
  except
   on EtfwBreakIterator do
    Exit;
  end;//try..except
 finally
  l_FormsList.Free;
 end;
//#UC END# *B1D8BF8B68F8_DBFEA799BB20_impl*
end;//TkwIterateForms.IterateForms

procedure TkwIterateForms.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aLambda : TtfwWord;
begin
 try
  l_aLambda := TtfwWord(aCtx.rEngine.PopObjAs(TtfwWord));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aLambda: TtfwWord : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 IterateForms(aCtx, l_aLambda);
end;//TkwIterateForms.DoDoIt

class function TkwIterateForms.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'IterateForms';
end;//TkwIterateForms.GetWordNameForRegister

function TkwIterateForms.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := @tfw_tiVoid;
end;//TkwIterateForms.GetResultTypeInfo
{$IfEnd} //not NoScripts

initialization
{$If not defined(NoScripts)}
// Регистрация скриптованой аксиоматики
 TFormsProcessingPackResNameGetter.Register;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_ActiveMDIChild
 TkwPopFormActiveMDIChild.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_Close
 TkwPopFormClose.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_FindMenuItem
 TkwPopFormFindMenuItem.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_GetWindowState
 TkwPopFormGetWindowState.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_HasControl
 TkwPopFormHasControl.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_MDIChildCount
 TkwPopFormMDIChildCount.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_MDIChildren
 TkwPopFormMDIChildren.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_ModalResult
 TkwPopFormModalResult.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_Next
 TkwPopFormNext.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_SetWindowState
 TkwPopFormSetWindowState.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация pop_form_FindActionList
 TkwPopFormFindActionList.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация IterateForms
 TkwIterateForms.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TtfwContext
 TtfwTypeRegistrator.RegisterType(@tfw_tiStruct);
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TForm
 TtfwTypeRegistrator.RegisterType(TypeInfo(TForm));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа String
 TtfwTypeRegistrator.RegisterType(TypeInfo(AnsiString));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TMenuItem
 TtfwTypeRegistrator.RegisterType(TypeInfo(TMenuItem));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TWindowState
 TtfwTypeRegistrator.RegisterType(TypeInfo(TWindowState));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа Boolean
 TtfwTypeRegistrator.RegisterType(TypeInfo(Boolean));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа Integer
 TtfwTypeRegistrator.RegisterType(TypeInfo(Integer));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TActionList
 TtfwTypeRegistrator.RegisterType(TypeInfo(TActionList));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TtfwWord
 TtfwTypeRegistrator.RegisterType(TypeInfo(TtfwWord));
{$IfEnd} //not NoScripts

end.

ActionListWordsPack.pas:

unit ActionListWordsPack;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine$RTLandVCL"
// Модуль: "ActionListWordsPack.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: ScriptKeywordsPack::Class Shared Delphi Low Level::ScriptEngine$RTLandVCL::FormsProcessing::ActionListWordsPack
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Include ..\ScriptEngine\seDefine.inc}

interface

{$If not defined(NoScripts)}
uses
  ActnList,
  tfwScriptingInterfaces,
  tfwRegisterableWord
  ;

{$IfEnd} //not NoScripts

implementation

{$If not defined(NoScripts)}
uses
  ContainedActionsWordspack,
  tfwScriptingTypes,
  TypInfo,
  SysUtils,
  tfwTypeRegistrator
  ;

type
 TkwPopActionListFindAction = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:ActionList:FindAction
*Тип результата:* TContainedAction
*Пример:*
[code]
OBJECT VAR l_TContainedAction
 anActionName aActionList pop:ActionList:FindAction >>> l_TContainedAction
[code]  }
 private
 // private methods
   function FindAction(const aCtx: TtfwContext;
    aActionList: TActionList;
    const anActionName: AnsiString): TContainedAction;
     {* Реализация слова скрипта pop:ActionList:FindAction }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopActionListFindAction

// start class TkwPopActionListFindAction

function TkwPopActionListFindAction.FindAction(const aCtx: TtfwContext;
  aActionList: TActionList;
  const anActionName: AnsiString): TContainedAction;
//#UC START# *1F5508BF0CF4_E7F049DA4A74_var*
var
 l_Index : Integer;
//#UC END# *1F5508BF0CF4_E7F049DA4A74_var*
begin
//#UC START# *1F5508BF0CF4_E7F049DA4A74_impl*
 Result := nil;
 for l_Index := 0 to aActionList.ActionCount - 1 do
 begin
  Result := aActionList.Actions[l_Index];
  if (Result.Name = anActionName) then
   Break
  else
   Result := nil;
 end; // for i := 0 to l_ActList.ActionCount - 1 do
//#UC END# *1F5508BF0CF4_E7F049DA4A74_impl*
end;//TkwPopActionListFindAction.FindAction

procedure TkwPopActionListFindAction.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aActionList : TActionList;
 l_anActionName : AnsiString;
begin
 try
  l_aActionList := TActionList(aCtx.rEngine.PopObjAs(TActionList));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aActionList: TActionList : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 try
  l_anActionName := (aCtx.rEngine.PopDelphiString);
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра anActionName: AnsiString : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 aCtx.rEngine.PushObj((FindAction(aCtx, l_aActionList, l_anActionName)));
end;//TkwPopActionListFindAction.DoDoIt

class function TkwPopActionListFindAction.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:ActionList:FindAction';
end;//TkwPopActionListFindAction.GetWordNameForRegister

function TkwPopActionListFindAction.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := TypeInfo(TContainedAction);
end;//TkwPopActionListFindAction.GetResultTypeInfo
{$IfEnd} //not NoScripts

initialization
{$If not defined(NoScripts)}
// Регистрация pop_ActionList_FindAction
 TkwPopActionListFindAction.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TtfwContext
 TtfwTypeRegistrator.RegisterType(@tfw_tiStruct);
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TActionList
 TtfwTypeRegistrator.RegisterType(TypeInfo(TActionList));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа String
 TtfwTypeRegistrator.RegisterType(TypeInfo(AnsiString));
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TContainedAction
 TtfwTypeRegistrator.RegisterType(TypeInfo(TContainedAction));
{$IfEnd} //not NoScripts

end.

ContainedActionsWordspack.pas:

unit ContainedActionsWordspack;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine$RTLandVCL"
// Модуль: "ContainedActionsWordspack.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: ScriptKeywordsPack::Class Shared Delphi Low Level::ScriptEngine$RTLandVCL::FormsProcessing::ContainedActionsWordspack
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Include ..\ScriptEngine\seDefine.inc}

interface

{$If not defined(NoScripts)}
uses
  ActnList,
  tfwScriptingInterfaces,
  tfwRegisterableWord
  ;

{$IfEnd} //not NoScripts

implementation

{$If not defined(NoScripts)}
uses
  tfwScriptingTypes,
  TypInfo,
  SysUtils,
  tfwTypeRegistrator
  ;

type
 TkwPopContainedActionExecute = {final scriptword} class(TtfwRegisterableWord)
  {* Слово скрипта pop:ContainedAction:Execute
*Пример:*
[code]
 aContainedAction pop:ContainedAction:Execute
[code]  }
 private
 // private methods
   procedure Execute(const aCtx: TtfwContext;
    aContainedAction: TContainedAction);
     {* Реализация слова скрипта pop:ContainedAction:Execute }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 public
 // overridden public methods
   function GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo; override;
 end;//TkwPopContainedActionExecute

// start class TkwPopContainedActionExecute

procedure TkwPopContainedActionExecute.Execute(const aCtx: TtfwContext;
  aContainedAction: TContainedAction);
//#UC START# *AFC4E3ACD81B_87D5D18D9F8E_var*
//#UC END# *AFC4E3ACD81B_87D5D18D9F8E_var*
begin
//#UC START# *AFC4E3ACD81B_87D5D18D9F8E_impl*
 aContainedAction.Execute;
//#UC END# *AFC4E3ACD81B_87D5D18D9F8E_impl*
end;//TkwPopContainedActionExecute.Execute

procedure TkwPopContainedActionExecute.DoDoIt(const aCtx: TtfwContext);
 {-}
var
 l_aContainedAction : TContainedAction;
begin
 try
  l_aContainedAction := TContainedAction(aCtx.rEngine.PopObjAs(TContainedAction));
 except
  on E: Exception do
  begin
   RunnerError('Ошибка при получении параметра aContainedAction: TContainedAction : ' + E.Message, aCtx);
   Exit;
  end;//on E: Exception
 end;//try..except
 Execute(aCtx, l_aContainedAction);
end;//TkwPopContainedActionExecute.DoDoIt

class function TkwPopContainedActionExecute.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'pop:ContainedAction:Execute';
end;//TkwPopContainedActionExecute.GetWordNameForRegister

function TkwPopContainedActionExecute.GetResultTypeInfo(const aCtx: TtfwContext): PTypeInfo;
 {-}
begin
 Result := @tfw_tiVoid;
end;//TkwPopContainedActionExecute.GetResultTypeInfo
{$IfEnd} //not NoScripts

initialization
{$If not defined(NoScripts)}
// Регистрация pop_ContainedAction_Execute
 TkwPopContainedActionExecute.RegisterInEngine;
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TtfwContext
 TtfwTypeRegistrator.RegisterType(@tfw_tiStruct);
{$IfEnd} //not NoScripts
{$If not defined(NoScripts)}
// Регистрация типа TContainedAction
 TtfwTypeRegistrator.RegisterType(TypeInfo(TContainedAction));
{$IfEnd} //not NoScripts

end.

Ссылка. Использование статического анализа FixInsight для повышения качества кода в Delphi

https://www.youtube.com/watch?v=A2R34URarpA

Достойно.

Но есть "пять копеек" - Типа "венгерская нотация". Ещё немножко банальщины.

Про интерфейсы и GUID Роман кстати ошибается.

Если у интерфейса нет GUID, то Supports не скомпилируется.

Скажут:

"Interface has no GUID".

Там проблемы с Supports есть сложнее:

Ещё раз про Supports
Массовое использование интерфейсов "вообще" и InterlockedIncrement/InterlockedDecrement в частности...
Продолжаем про "особенности Supports"
Коротко. Об особенностях Supports

Про IfDef _FIXINSIGHT_ тоже - не очень понятно. Кто определяет этот символ? Можно ли забыть определить этот символ и разломать проект?

Ну и 50-60 "форм" либо "юнитов" - это звучит смешно.

Несколько (десятков, сотен) тысяч не хотите?

Можно взять утилиту командной строки и прогнать "мега-проект" под Delphi7?

Похоже - можно.

Где взять? :-)

"Она не исключает из компиляции" - ХОРОШИЙ ВОПРОС. Таки ДА - ИСКЛЮЧАЕТ.

Похоже IfDef и IfNDef - перепутаны.

Таки - ДА. Перепутаны. Там дальше есть разъяснение.

Ну и удручает тот факт, что анализируются только файлы НЕПОСРЕДСТВЕННО подключённые в проект.

ToDo. Сделать Redefinition для операторов ToPrintable и . (Print)

ToDo. Сделать Redefinition для операторов ToPrintable и . (Print).

Чтобы обрабатывали массивы (рекурсивно) и выводили их в "человекочитабельном" виде.

А может не только массивы. Но и например файлы (имя файла) и интерфейсы (guid).

ToDo. сделать проверку на то, что словари res:XXX уже компилировались

ToDo. сделать проверку на то, что словари res:XXX уже компилировались.

Проверять это дело в CompileAxiomaticsFromRes.

А потом сделать поддержку UP "need scripts" на SimpleClass.

В частности на TkwMain.

А после этого сделать нормальную обработку конструкции USES res:XXX.

Реентерабельную.

ToDo. Сделать проверку на равенство ClassType при регистрации дубликатов слов

ToDo. Сделать проверку на равенство ClassType при регистрации дубликатов слов.

И для начала - ругаться - когда такие дубликаты найдены.

Ну а потом - разобраться откуда берутся такие дубликаты и зачем.

Это всё в методе Add.

Коротко. Сделал описание части аксиоматики на Dephi, а части - на скриптах

По мотивам - Коротко. Сделал чудную штуку - переопределение слов

Коротко. Сделал описание части аксиоматики на Dephi, а части - на скриптах.

И сделал для этого обвязку генерируемую с модели.

Выглядит примерно так:

https://bitbucket.org/lulinalex/mindstream/commits/58dc1f79b8592717091c559c7cf0f8d509dbe97d

vtComboBoxWordsPack.pas:

Briefly. Wonder of words redefining

Original in Russian: http://programmingmindstream.blogspot.ru/2015/07/blog-post_28.html 

Briefly. I’ve made a wonderful thing – words redefining.

It allows Duck-Typing of a kind, though based on static type-checking, if possible.

Let us have:

UNIT TObjectA // - defines a unit for TObjectA
 
USES
 axiom:TObjectA // - uses TObjectA axiomatics
;
 
EXPORTS
 axiom:TObjectA // - exports axiomatics of TObjectA to units that use it
 
INTEGER FUNCTION A
 TObjectA IN anObj // - object of TObjectA type
 ...
 Result := anObj SomeCodeA // - calls SomeCodeA method on anObj instance
; // A
 
...
 
UNIT TObjectB // - defines a unit for TObjectB
 
USES
 axiom:TObjectB // - uses of TObjectB axiomatics
;
 
EXPORTS
 axiom:TObjectB // - exports axiomatics of TObjectB to units that use it
 
INTEGER FUNCTION B
 TObjectA IN anObj // - object of TObjectB type
 ...
 Result := anObj SomeCodeB // - calls SomeCodeB на экземпляре anObj
; // A

Function A works with object of TObjectA type.
Function B works with object of TObjectB type.

Therefore, we can write as follows:

USES
 TObjectA // - uses axiomatic of TObjectA and axiom:TObjectA
 TObjectB // - uses axiomatic of TObjectB and axiom:TObjectB
;
 
REDEFINE
 : A
   OBJECT IN anObj // - abstract object
   if ( anObj Is TObjectB ) then
   // - object of TObjectB type
    ( anObj B ) // - calls method B
   else
    ( anObj inherited ) // - calls the "MAIN" method of TObjectA::A
 ; // A

Thus, we can call in this way:

TObjectA VAR x1
TObjectB VAR x2
...
x1 A // - calling of TObjectA::A method
x2 A // - calling of TObjectB::B method

We can also write symmetrically:

USES
 TObjectA // - uses axiomatic of TObjectA and axiom:TObjectA
 TObjectB // - uses axiomatic of TObjectB and axiom:TObjectB
;
 
REDEFINE
 : B
   OBJECT IN anObj // - abstract object
   if ( anObj Is TObjectA ) then
   // - object of TObjectA type
    ( anObj A ) // - calls method B
   else
    ( anObj inherited ) // - calls the "MAIN" method of TObjectB::B
 ; // B

In this case, we can write:

TObjectA VAR x1
TObjectB VAR x2
TObjectA VAR x3
TObjectB VAR x4
...
x1 B // - calling of TObjectA::A method
x2 B // - calling of TObjectB::B method
x3 B // - calling of TObjectA::A method
x4 B // - calling of TObjectB::B method

The examples given are in Run-Time.

However, setting the IMMEDIATE attribute to the words redefined and CompileValue instead of direct calls results in statistic overriding which depends on the parameters types and it is compilable.

Why do we need it?

We need it in order to adapt the object model for those people who are not eager to know details about specific object model.

For example, it can be used by testers.

For them TEdit, TvgEdit and TsomeOtherEdit look as like as peas in a pod.

There are also other people who understand the system in terms of GUI and there are other “generic objects” that are not classified similarly to the project classification.

The issue relates to the primitive types like INTEGER and STRING or interfaces as well.

Quite understandable is the fact that this “mapping” can be done in different ways in various “specific axiomatics”. It is not viewed by the testers similarly to the way other people see it.

It depends on the set of used dictionaries.

Moreover, mapping differs for various system layers.

Even more so since the layers of the system are separated on the principle: “we can only see our neighbours at a lower or a peer layer”.

It is obvious that REDEFINE controls “generic signatures” for covariation.

Notice that REDEFINE is not OVERRIDE.

REDEFINE is not integrated inside the classes but keeps “on the side” for “outside users”.

It is like a helper or categories in Objective-C.

Let me remind you that each abstraction layer can have different REDEFINE.

These people aim to develop a pre-processing program - Link. Why can't an interface have class methods? (most of the links are in Russian)

I quote:

"Yes, I get that, I guess I was stuck in the mindset of the Java default method and the static method. This is sort of a mix between the two.
The default methods are way cool.
Interface helpers and interface operator overloading would go a long way towards achieving these goals.
(Then there's virtual methods for records, method inheritance for records, allowing multiple class helpers in scope, allowing
inheritance for record helpers).

I'm temped to write a pre-processor to add these things myself (borrow some syntax from oxygene or SMS and transparantly alter the sourcecode before compilation)."

Too bad, I am not able to get my opinion out to these guys which is they should work with models and “script extensions” instead of dealing with “pre-processors”. They are compilable at least into a “threaded code”.

I would also advise to integrate “diferent axiomatics transformations” at a higher level compared to the “target language code”.

P.S. It is clear that using these “tricks” can result in an “extraordinary messed” code, but i do not focus on people who love to “shoot off their own legs”.

You can shoot off your legs using Delphi or C++ or Haskel as well.

Not to mention Python and the slots...

It is important to understand what you do and be reluctant to “shoot”.

It is also obvious that all REDEFINES are found considering all USES and EXPORTS - Briefly. I exported the dictionaries.

If it is not possible to define the word PRECISELY (you can not choose one), the error message is popped up.

In this case we classify it as UNIT :: WORD.

It is totally equal to namespace in C++.

Oops..

Real life example:

Briefly. I made axiomatic description partly on Delphi, partly on scripts

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Library "ScriptEngine$VT"
// Unit: "vtComboBoxWordsPack.rc.script"
// Resource scripts (.rc.script)
// Generated from UML model, root element: ScriptKeywordsPack::Class Shared Delphi::ScriptEngine$VT::vtComboBoxWords::vtComboBoxWordsPack
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 
//#UC START# *54EC8C7C011Eimpl*
 
// Decorators of words that work with combo
 
USES
 axiom:ComboBox
 axiom:ComboTree
;
 
REDEFINITION
 : pop:ComboBox:DropDown
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:DropDown )
  else
   ( aCombo inherited )
 ; // pop:ComboBox:DropDown
  
REDEFINITION
 : pop:ComboBox:GetItemIndex
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:GetItemIndex )
  else
   ( aCombo inherited )
 ; // pop:ComboBox:DropDown
  
REDEFINITION
 : pop:ComboBox:IndexOf
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:IndexOf )
  else
   ( aCombo inherited )
 ; // pop:ComboBox:DropDown
  
REDEFINITION
 : pop:ComboBox:SaveItems
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:SaveItems )
  else
   ( aCombo inherited )
 ; // pop:ComboBox:SelectItem
  
REDEFINITION
 : pop:ComboBox:SelectItem
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:SelectItem )
  else
   ( aCombo inherited )
 ; // pop:ComboBox:SelectItem
  
REDEFINITION
 : pop:ComboBox:SetItemIndex
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:SetItemIndex )
  else
   ( aCombo inherited )
 ; // pop:ComboBox:SetItemIndex
  
//#UC END# *54EC8C7C011Eimpl*

And some other example:

// Decorators

USES
 axiom:DocEditorWindow
;

 : IsNeedSaveDocument
  OBJECT IN aWnd
  if ( aWnd Is class::TDocEditorWindow ) then
   ( aWnd DocEditorWindow:IsNeedSaveDocument )
  else 
   ( false )
 ; // pop:ComboBox:DropDown

Offtopic. Про историю...

"Владимир Святославич
Стал новгородским князем в 970 году, захватил киевский престол в 978 году.
В 981 году Владимир воевал с польским князем Мешко I за приграничную Червенскую Русь.
В 983 году Владимир покорил балто-литовское племя ятвягов и установил контроль над Судовией, что открывало путь к Балтике.
В 988 году Владимир осадил Корсунь в Крыму.
В 991 году был проведён поход в прикарпатские земли против белых хорватов.
Европа! Берегись!"

vs

"обороняемся от орды с востока"...

Кстати когда был Владимир - орды ещё не было....

https://ru.wikipedia.org/…/%D0%A7%D0%B8%D0%BD%D0%B3%D0%B8%D…

Чингисхан - парой веков позже родился:

"Чингисха́н (монг. Чингис хаан [tʃiŋɡɪs χaːŋ]), собственное имя — Тэмуджин[1][2], Темучин[3], Темучжин[4](монг. Тэмүжин) (ок. 1155 или 1162 — 25 августа 1227) — основатель и первый великий хан Монгольской империи, объединивший разрозненные монгольские племена; полководец, организовавший завоевательные походы монголов в Китай, Среднюю Азию, на Кавказ и Восточную Европу. Основатель самой крупной в истории человечества континентальной империи[5].

После смерти в 1227 году наследниками империи стали его прямые потомки от первой жены Бортэ по мужской линии, так называемые чингизиды."

http://telegraf.com.ua/ukraina/politika/1996700-poroshenko-myi-kak-i-knyaz-vladimir-oboronyaemsya-ot-ordyi-s-vostoka.html

Да уж... как-то надо взять и посмотреть "синхро-хронологические таблицы"... Этим людям... Но им скорее всего незачем...

 Может имелся в виду ИУДЕО-Хазарский каганат?

https://ru.wikipedia.org/wiki/%D0%A5%D0%B0%D0%B7%D0%B0%D1%80%D1%81%D0%BA%D0%B8%D0%B9_%D0%BA%D0%B0%D0%B3%D0%B0%D0%BD%D0%B0%D1%82

"Хаза́рский кагана́т, Хаза́рия (650—969)[1] — средневековое государство, созданное кочевым народом (хазарами). Выделился из Западно-Тюркского каганата. Контролировал территорию Предкавказья, Нижнего и Среднего Поволжья, современного Северо-Западного Казахстана, Приазовье, восточную часть Крыма, а также степи и лесостепи Восточной Европы вплоть до Днепра. Центр государства первоначально находился в приморской части современного Дагестана, позже переместился в низовья Волги. Часть правящей элиты приняла иудаизм. В политической зависимости от хазар находился ряд восточнославянских племенных союзов."

Так он вроде раньше был...

Коротко. Сделал экспорт словарей

Коротко. Сделал экспорт словарей.

Вдогонку к - Коротко. Сделал чудную штуку - переопределение слов.

Пример:

Вот есть код:

UNIT uA

PROCEDURE A
...
; // A

...

UNIT uB

USES
 uA
;

PROCEDURE B
...
 A // - компилируется, потому, что есть USES uA
; // B

UNIT uC

USES
 uB
;

PROCEDURE C
...
 B // - компилируется, потому, что есть USES uB
 A // - НЕ компилируется, потому, что нет USES uA
; // C

Как исправить ситуацию?

Можно так:

UNIT uA

PROCEDURE A
...
; // A

...

UNIT uB

USES
 uA
;

PROCEDURE B
...
 A // - компилируется, потому, что есть USES uA
; // B

UNIT uC

USES
 uA
 uB
;

PROCEDURE C
...
 B // - компилируется, потому, что есть USES uB
 A // - компилируется, потому, что есть USES uA
; // C

А можно так:

UNIT uA

PROCEDURE A
...
; // A

...

UNIT uB

USES
 uA
;

EXPORTS uA // - экспортируем модуль uA, он будет виден ТЕМ, кто включает в себя НАШ модуль uB

PROCEDURE B
...
 A // - компилируется, потому, что есть USES uA
; // B

UNIT uC

USES
 uB
;

PROCEDURE C
...
 B // - компилируется, потому, что есть USES uB
 A // - компилируется, потому, что в модуле B есть EXPORTS uA
; // C

Зачем это нужно?

А это очень полезно для написания "фасадных слоёв".

Когда слои вроде бы надо и изолировать с одной стороны, а с другой стороны надо давать им "прыгать через голову".

Очень удобно.

Особенно учитывая наличие слова FORGET. Которое позволяет выкинуть слово из области видимости.

Ну и ещё есть конструкция:

EXPORTS *

Это означает - "экспортировать из нашего словаря все словари, которые включены в нас через USES".

А также есть конструкция:

EXPORTS A :: X

Это означает "экспортировать из нашего словаря слово X из словаря A".

А также есть конструкция:

EXPORTS A :: X AS Y

Это означает "экспортировать из нашего словаря слово X из словаря A. Под именем Y".

А вот ещё есть проблема.

Есть Enum = (one, two, three).

В модуле A.

И есть модуль B, который определяет функцию X, которая работает с этим Enum.

Понятное дело, что B делает USES A и видит члены Enum.

А вот есть модуль C, который делает USES B и использует функцию X.

Так вот для того, чтобы ему использовать элементы Enum, то ему надо сделать USES A.

Чтобы "увидеть" one, two, three.

Ну или можно в модуле B сделать EXPORTS A, ну или EXPORTS A :: Enum.

И тогда модулю C не надо будет делать USES A.

Он будет видеть то что ему нужно, через USES B и EXPORTS A :: Enum.

Когда руками все эти USES пишешь - оно ещё ничего... Но когда расставляешь все эти стрелочки на модели, то тут и понимаешь весь "ужас"...

И тут на помощь приходят EXPORTS.

Понимаю, что есть C++ где сквозные include, но там есть другие проблемы. С изоляцией архитектурных слоёв

Да и понятно, что всё это с Python перекликается.

Коротко. Сделал чудную штуку - переопределение слов

Коротко. Сделал чудную штуку - переопределение слов.

Позволяет делать нечто вроде Duck-Typing, только со статическим контролем типов, где это возможно.

Пусть есть:

UNIT TObjectA // - определяем модуль для работы с TObjectA

USES
 axiom:TObjectA // - используем аксиоматику TObjectA
;

EXPORTS
 axiom:TObjectA // - экспортируем аксиоматику TObjectA наружу в использующие модули

INTEGER FUNCTION A
 TObjectA IN anObj // - объект типа TObjectA
 ...
 Result := anObj SomeCodeA // - вызываем метод SomeCodeA на экземпляре anObj
; // A

...

UNIT TObjectB // - определяем модуль для работы с TObjectB

USES
 axiom:TObjectB // - используем аксиоматику TObjectB
;

EXPORTS
 axiom:TObjectB // - экспортируем аксиоматику TObjectB наружу в использующие модули

INTEGER FUNCTION B
 TObjectB IN anObj // - объект типа TObjectB
 ...
 Result := anObj SomeCodeB // - вызываем метод SomeCodeB на экземпляре anObj
; // A

Функция A работает с объектом типа TObjectA.
Функция B работает с объектом типа TObjectB.

Тогда можно написать:

USES
 TObjectA // - используем аксиоматику TObjectA и axiom:TObjectA
 TObjectB // - используем аксиоматику TObjectB и axiom:TObjectB
;

REDEFINE
 : A
   OBJECT IN anObj // - абстрактный объект
   if ( anObj Is TObjectB ) then
   // - объект типа TObjectB
    ( anObj B ) // - вызываем метод B
   else
    ( anObj inherited ) // - вызываем "ОСНОВНОЙ" метод TObjectA::A
 ; // A

Теперь можно звать так:

TObjectA VAR x1
TObjectB VAR x2
...
x1 A // - тут вызовется метод TObjectA::A
x2 A // - тут вызовется метод TObjectB::B

Можно написать и симметрично:

USES
 TObjectA // - используем аксиоматику TObjectA и axiom:TObjectA
 TObjectB // - используем аксиоматику TObjectB и axiom:TObjectB
;

REDEFINE
 : B
   OBJECT IN anObj // - абстрактный объект
   if ( anObj Is TObjectA ) then
   // - объект типа TObjectA
    ( anObj A ) // - вызываем метод B
   else
    ( anObj inherited ) // - вызываем "ОСНОВНОЙ" метод TObjectB::B
 ; // B

И тогда можно будет написать:

TObjectA VAR x1
TObjectB VAR x2
TObjectA VAR x3
TObjectB VAR x4
...
x1 B // - тут вызовется метод TObjectA::A
x2 B // - тут вызовется метод TObjectB::B
x3 B // - тут вызовется метод TObjectA::A
x4 B // - тут вызовется метод TObjectB::B

Приведённые примеры это всё в Run-Time.

Но если переопределяемым словам поставить атрибут IMMEDIATE и сделать CompileValue вместо прямых вызовов, то получаем статическое переопределение.

Зависимое от типов параметров и компилируемое.

Зачем это всё нужно?

Для адаптации объектной модели для тех людей, которым не особенно важно знать о "тонкостях конкретной объектной модели".

Например для тестировщиков.

Для них, что TEdit, что TvgEdit, что TsomeOtherEdit - ЕДИНЫ, если они "крякают как утка и машут крыльями как утка".

А также для других людей, которые видят систему, через "призму GUI", ну или другие "обобщённые объекты", классификация которых не совпадает с проектной классификацией.

Ну и всё это дело распространяется не только на объекты, но и на "примитивные" типы, такие как INTEGER и STRING.

А также на интерфейсы.

Ну и понятное дело, что подобный "мапинг" может осуществляться по-разному в разных "специфичных аксиоматиках". Для тестировщиков - один, для других людей - другой.

Всё зависит от набора включаемых словарей.

Более того - в разных слоях системы можно иметь разные мапинги.

Тем более, что слои системы изолируются по принципу "видим только соседей из нижнего или равного нам уровня".

Ну и понятно, что REDEFINE - проверяет "обобщённые сигнатуры". На их ковариантность.

И REDEFINE это не OVERRIDE.

REDEFINE не "встраивается" внутрь классов. Он - "сбоку". Для "внешних пользователей".

Он что-то типа helper'а или категории в Objective-C.

При этом - повторю - для каждого конкретного уровня абстракции могут быть СВОИ REDEFINE.

Вот люди там пытаются "писать препроцессоры" - Ссылка. Why can't an interface have class methods?

Цитата:

"Yes, I get that, I guess I was stuck in the mindset of the Java default method and the static method. This is sort of a mix between the two.
The default methods are way cool.
Interface helpers and interface operator overloading would go a long way towards achieving these goals.
(Then there's virtual methods for records, method inheritance for records, allowing multiple class helpers in scope, allowing
inheritance for record helpers).

I'm temped to write a pre-processor to add these things myself (borrow some syntax from oxygene or SMS and transparantly alter the sourcecode before compilation)."

Жаль, что я не могу донести до них свою позицию, что надо писать не "препроцессоры", а работать с моделями и "скриптовыми расширениями".

Которые ещё и компилируются. Хотя бы в "шитый-код".

И встраивать "различные трансформации аксиоматики" выше, чем код на "целевом языке".

+Виктор Морозов
+Михаил Костицын
+Дмитрий Инишев
+Михаил Морозов
+Андрей Трофимов

P.S. Понятное дело, что с помощью подобных "штучек" можно учинить "чудный бардак" в коде, но на любителей "стрелять себе в ногу" - я всё же как-то не ориентируюсь.

Выстрелить себе в ногу можно и в Delphi и в C++ и в Haskel.

А уж в Python... С его слотами.

Тут главное понимать что делаешь и наличие желания "не стрелять".

Ну и понятное дело, что все REDEFINES вычисляются с учётом всех USES и EXPORTS - Коротко. Сделал экспорт словарей.

Ну и если слово не может быть ТОЧНО определено (т.е. существуют два и более кандидатов), то на этапе компиляции выводится сообщение об ошибке.

Тогда слово надо квалифицировать как - UNIT :: WORD.

Ну в полной аналогии с namespace из C++.

Ну и есть ещё один "побочный профит" от всей этой истории - у нас в мета-модели бывают переопределения стереотипов - один уровень мета-модели может переопределять стереотипы другого (более низкого) уровня.

Да.

Вот кстати "пример из жизни":
Коротко. Сделал описание части аксиоматики на Dephi, а части - на скриптах

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine$VT"
// Модуль: "vtComboBoxWordsPack.rc.script"
// Скрипты в ресурсах (.rc.script)
// Generated from UML model, root element: ScriptKeywordsPack::Class Shared Delphi::ScriptEngine$VT::vtComboBoxWords::vtComboBoxWordsPack
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

//#UC START# *54EC8C7C011Eimpl*

// Декораторы для слов работающих с комбо

USES
 axiom:ComboBox
 axiom:ComboTree
;

REDEFINITION
 : pop:ComboBox:DropDown
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:DropDown )
  else 
   ( aCombo inherited )
 ; // pop:ComboBox:DropDown
 
REDEFINITION
 : pop:ComboBox:GetItemIndex
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:GetItemIndex )
  else 
   ( aCombo inherited )
 ; // pop:ComboBox:DropDown
 
REDEFINITION
 : pop:ComboBox:IndexOf
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:IndexOf )
  else 
   ( aCombo inherited )
 ; // pop:ComboBox:DropDown
 
REDEFINITION
 : pop:ComboBox:SaveItems
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:SaveItems )
  else 
   ( aCombo inherited )
 ; // pop:ComboBox:SelectItem
 
REDEFINITION
 : pop:ComboBox:SelectItem
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:SelectItem )
  else 
   ( aCombo inherited )
 ; // pop:ComboBox:SelectItem
 
REDEFINITION
 : pop:ComboBox:SetItemIndex
  OBJECT IN aCombo
  if ( aCombo Is class::TvtComboTree ) then
   ( aCombo pop:ComboTree:SetItemIndex )
  else 
   ( aCombo inherited )
 ; // pop:ComboBox:SetItemIndex
 
//#UC END# *54EC8C7C011Eimpl*

ToDo. Компилировать GetRef при передаче правых и левых ссылочных параметров

ToDo. Компилировать GetRef при передаче правых и левых ссылочных параметров.

ToDo. Упростить CodeIterator

ToDo. Упростить CodeIterator.

Убрать все Is XXX из аксиоматики в скрипты.

Вот тут:

unit kwCodeIterator;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine"
// Модуль: "kwCodeIterator.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: ScriptKeyword::Class Shared Delphi Low Level::ScriptEngine::MembersWorking::MembersWorkingPack::CodeIterator
//
// Перебирает слова компилированного кода слова
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Include ..\ScriptEngine\seDefine.inc}

interface

{$If not defined(NoScripts)}
uses
  tfwRegisterableWord,
  tfwScriptingInterfaces
  ;
{$IfEnd} //not NoScripts

{$If not defined(NoScripts)}
type
 TkwCodeIterator = {final scriptword} class(TtfwRegisterableWord)
  {* Перебирает слова компилированного кода слова }
 protected
 // realized methods
   procedure DoDoIt(const aCtx: TtfwContext); override;
 protected
 // overridden protected methods
   class function GetWordNameForRegister: AnsiString; override;
 end;//TkwCodeIterator
{$IfEnd} //not NoScripts

implementation

{$If not defined(NoScripts)}
uses
  tfwCodeIterator,
  kwCompiledWordPrim,
  kwCompiledWordContainer,
  kwDualCompiledWordContainer,
  kwRuntimeWordWithCode,
  tfwWordRefList,
  SysUtils,
  kwForwardDeclarationHolder,
  kwCompiledWordWorkerWord,
  kwCompiledWordWorkerWordRunner,
  kwCompiledWordWorker,
  kwCompiledIfElse
  ;
{$IfEnd} //not NoScripts

{$If not defined(NoScripts)}

// start class TkwCodeIterator

procedure TkwCodeIterator.DoDoIt(const aCtx: TtfwContext);
//#UC START# *4DAEEDE10285_4F47932C001F_var*

 procedure DoWord(aWord: TtfwWord);
 var
  l_List : TtfwWordRefList;
  l_RightParamsCount : Integer;
  l_Index : Integer;
 begin
  if (aWord Is TkwForwardDeclaration) then
   DoWord(TkwForwardDeclaration(aWord).RealWord)
  else
  if (aWord is TkwCompiledWordWorkerWord) then
   DoWord(TkwCompiledWordWorkerWord(aWord).Compiled)
  else
  if (aWord is TkwForwardDeclarationHolder) then
  begin
   l_List := TtfwWordRefList.Create;
   try
    l_List.Add(TkwForwardDeclarationHolder(aWord).Holded);
    aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(l_List)));
   finally
    FreeAndNil(l_List);
   end;//try..finally
  end//aWord is TkwForwardDeclarationHolder
  else
  if (aWord is TkwCompiledIfElse) then
  begin
   l_List := TtfwWordRefList.Create;
   try
    l_List.Add(TkwCompiledIfElse(aWord).Condition);
    l_List.Add(TkwCompiledIfElse(aWord).Compiled);
    if (TkwCompiledIfElse(aWord).ElseBranch <> nil) then
     l_List.Add(TkwCompiledIfElse(aWord).ElseBranch);
    aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(l_List)));
   finally
    FreeAndNil(l_List);
   end;//try..finally
  end//aWord is TkwCompiledIfElse
  else
  if (aWord is TkwDualCompiledWordContainer) then
  begin
   l_List := TtfwWordRefList.Create;
   try
    l_List.Add(TkwDualCompiledWordContainer(aWord).Compiled);
    if (TkwDualCompiledWordContainer(aWord).ElseBranch <> nil) then
     l_List.Add(TkwDualCompiledWordContainer(aWord).ElseBranch);
    aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(l_List)));
   finally
    FreeAndNil(l_List);
   end;//try..finally
  end//aWord is TkwDualCompiledWordContainer
  else
  if (aWord is TkwCompiledWordContainer) then
  begin
   l_List := TtfwWordRefList.Create;
   try
    l_List.Add(TkwCompiledWordContainer(aWord).Compiled);
    aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(l_List)));
   finally
    FreeAndNil(l_List);
   end;//try..finally
  end//aWord is TkwCompiledWordContainer
  else
  if (aWord is TkwCompiledWordWorkerWordRunner) then
  begin
   l_List := TtfwWordRefList.Create;
   try
    l_RightParamsCount := TkwCompiledWordWorkerWordRunner(aWord).Compiled.RightParamsCount(aCtx);
    if (l_RightParamsCount = 1) then
     l_List.Add(TkwCompiledWordWorkerWordRunner(aWord).WordToWork)
    else
    begin
     for l_Index := 0 to Pred(l_RightParamsCount) do
      l_List.Add((TkwCompiledWordWorkerWordRunner(aWord).WordToWork As TkwRuntimeWordWithCode).Code[l_Index]);
    end;//l_RightParamsCount = 1
    aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(l_List)));
   finally
    FreeAndNil(l_List);
   end;//try..finally
  end//aWord is TkwCompiledWordWorkerWordRunner
  else
  if (aWord is TkwCompiledWordWorker) then
  begin
   l_List := TtfwWordRefList.Create;
   try
    l_List.Add(TkwCompiledWordWorker(aWord).WordToWork);
    aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(l_List)));
   finally
    FreeAndNil(l_List);
   end;//try..finally
  end//aWord is TkwCompiledWordWorker
  else
  if (aWord = nil) OR not (aWord Is TkwRuntimeWordWithCode) then
   aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(nil)))
  else
   aCtx.rEngine.Push(TtfwStackValue_C(TtfwCodeIterator.Make(TkwCompiledWordPrim(aWord).GetCode(aCtx))));
 end;//DoWord

var
 l_W : TtfwWord;
//#UC END# *4DAEEDE10285_4F47932C001F_var*
begin
//#UC START# *4DAEEDE10285_4F47932C001F_impl*
 l_W := (aCtx.rEngine.PopObj As TtfwWord);
 DoWord(l_W);
//#UC END# *4DAEEDE10285_4F47932C001F_impl*
end;//TkwCodeIterator.DoDoIt

class function TkwCodeIterator.GetWordNameForRegister: AnsiString;
 {-}
begin
 Result := 'CodeIterator';
end;//TkwCodeIterator.GetWordNameForRegister

{$IfEnd} //not NoScripts

initialization
{$If not defined(NoScripts)}
// Регистрация CodeIterator
 TkwCodeIterator.RegisterInEngine;
{$IfEnd} //not NoScripts

end.

И тут:

ARRAY FUNCTION ELEMLIST STRING IN aListName IN %S
 if ( %S NotValid ) then
  ( Result := [ ] )
 else
  (
   VAR l_List
   l_List := ( %S %% aListName )
   
   if ( l_List NotValid ) then
    ( Result := [ ] )
   else 
//    ( Result := ( [ l_List DO ] ) )
    ( Result := ( @ FilterMember ( @ DoMember ( l_List CodeIterator ) MAP ) FILTER ) ) 
  )
; // ELEMLIST

Offtopic. Высоцкий умер.. Сегодня... 35 лет назад...

http://www.kulichki.com/vv/pesni/ya-pri-zhizni-byl.html

Я при жизни был рослым и стройным,
Не боялся ни слова, ни пули
И в привычные рамки не лез,-
Но с тех пор, как считаюсь покойным,
Охромили меня и согнули,
К пьедесталу прибив "Ахиллес".

Не стряхнуть мне гранитного мяса
И не вытащить из постамента
Ахиллесову эту пяту,
И железные ребра каркаса
Мертво схвачены слоем цемента,-
Только судороги по хребту.

 Я хвалился косою саженью -
  Нате смерьте! -
 Я не знал, что подвергнусь суженью
  После смерти,-
 Но в обычные рамки я всажен -
  На спор вбили,
 А косую неровную сажень -
  Распрямили.

И с меня, когда взял я да умер,
Живо маску посмертную сняли
Расторопные члены семьи,-
И не знаю, кто их надоумил,-
Только с гипса вчистую стесали
Азиатские скулы мои.

Мне такое не мнилось, не снилось,
И считал я, что мне не грозило
Оказаться всех мертвых мертвей,-
Но поверхность на слепке лоснилась,
И могильною скукой сквозило
Из беззубой улыбки моей.

 Я при жизни не клал тем, кто хищный,
  В пасти палец,
 Подходившие с меркой обычной -
  Опасались,-
 Но по снятии маски посмертной -
  Тут же в ванной -
 Гробовщик подошел ко мне с меркой
  Деревянной...

А потом, по прошествии года,-
Как венец моего исправленья -
Крепко сбитый литой монумент
При огромном скопленье народа
Открывали под бодрое пенье,-
Под мое - с намагниченных лент.

Тишина надо мной раскололась -
Из динамиков хлынули звуки,
С крыш ударил направленный свет,-
Мой отчаяньем сорванный голос
Современные средства науки
Превратили в приятный фальцет.

 Я немел, в покрывало упрятан,-
  Все там будем! -
 Я орал в то же время кастратом
  В уши людям.
 Саван сдернули - как я обужен,-
  Нате смерьте! -
 Неужели такой я вам нужен
  После смерти?!

Командора шаги злы и гулки.
Я решил: как во времени оном -
Не пройтись ли, по плитам звеня?-
И шарахнулись толпы в проулки,
Когда вырвал я ногу со стоном
И осыпались камни с меня.

Накренился я - гол, безобразен,-
Но и падая - вылез из кожи,
Дотянулся железной клюкой,-
И, когда уже грохнулся наземь,
Из разодранных рупоров все же
Прохрипел я похоже: "Живой!"

 И паденье меня и согнуло,
  И сломало,
 Но торчат мои острые скулы
  Из металла!
 Не сумел я, как было угодно -
  Шито-крыто.
 Я, напротив,- ушел всенародно
  Из гранита.

1973

ToDo. Выводить в help словари из StandardDictionaries, но которые не попали в InitedDictionaries

ToDo. Выводить в help словари из StandardDictionaries, но которые не попали в InitedDictionaries.

Ссылка. Why can't an interface have class methods?

https://plus.google.com/u/0/104356847714991124070/posts/ZRdPwwzXbhw?cfem=1

Ну не дебилы ли?

"The whole point of an interface is that it doesn't come with an implementation."

Вот!

Читаем:
 Назад, к основам
 Back to Basics
 Object Factories
 FACTORIES AND FACTORY FINDERS
 Factory Example
 corba factory

И "эти люди" (типа Штефана Глинке) пытались мне рассказывать про SRP.

На тему - Weak reference to interface.

Ну и - http://delphisorcery.blogspot.ru/2012/06/weak-interface-references.html

ToDo. Сделать ITERATE2

ToDo. Сделать ITERATE2.

Чтобы итерировал пары из "массива".

Ссылки:

GUI-тестирование "по-русски". Массивы и итераторы. Ссылка на "черновик"
ToDo. Написать про массивы, списки и итераторы
Решил РАЗДЕЛИТЬ понятия ARRAY и ITERATABLE

А в "пределе" - ITERATE_N.

Ссылка. FALSE

https://ru.wikipedia.org/wiki/FALSE

Знаете... Начинаю понимать "логику авторов" подобных извращений.

ToDo. Сделать "устойчивые словосочетания"

ToDo. Сделать "устойчивые словосочетания".

Пример:

USES IN USED

значит не то что:

USES XXX

и не то что:

OBJECT IN A

Т.е. расширяем концепцию "DoubleQuotedString".

Только как-то так:

VOID operator "USES IN USED" TreatAsSentence
 ...
;

-- эта конструкция определяет не слово "USES IN USED", а словосочетание USES IN USED.

На основе Parser:NextToken и Parser:PushXXX. И Word:AddEnding.

Т.е. к слову добавляем "завершающие слова" и на этом строим разбор входного потока. И если разбор удался, то возвращаем "устойчивое словосочетание", а если не удался, то откатываемся к первому подходящему месту.

Таким образом конструкции:

Убедиться, что XXX
Убедиться, что объект XXX
Убедиться, что объект является XXX
Убедиться, что объект равен XXX

-- будут трактоваться, как РАЗНЫЕ слова.

Таким образом "перебором фраз" мы можем построить "человекочитабельную грамматику".

Которую ещё и компилятор скриптов понимает.

Конкатенативность языка (Конкатенативный язык программирования) - позволяет. Вроде.

С вменяемой диагностикой об ошибке.

Хм...

Не много ли я на себя беру...

Но это всё размышления не имеющие ничего общего с "основной веткой разработки".

Можно и без таких изысков обойтись.

Можно кстати и другим путём пойти.

Слово "Убедиться," смотрит что за ни слово "что", а слово "что" - смотрит, что за ним слово "объект", а слово "объект" смотрит, что за ним слово "является" или "равен". Ну  понятно, что есть "ветка успеха разбора" и "ветка неуспеха".

В итоге словосочетание даёт валидный список параметров.

Как-то так...

Варианты разные бывают.

В общем надо это дело обмозговать. Может быть выкинуть в корзину.

ToDo. Сделать USES in USED

ToDo. Сделать USES in USED.

И убрать %DISABLE_CASCADE_DICT.

ToDo. Сделать словам атрибут %NOHELP

ToDo. Сделать словам атрибут %NOHELP.

Таким как UIDS_LIST.

Чтобы не выводились в эталон.

ToDo. Заменить $IfDef CascadeDict на If Engine.CascadeDict

ToDo. Заменить $IfDef CascadeDict на If Engine.CascadeDict.

И сделать Engine.DisableCascadeDict.

ToDo. Changing text EVD parsing to parsing of special axiomatic scripts

Original in Russian: http://programmingmindstream.blogspot.ru/2015/07/todo-evd.html


This is a follow-up to - ToDo. Parsing the “old patterns” using parse tree forming (in Russian).

Actually, everything fits within the common scheme there.

Since, historically, scripts are rooted in EVD, at the moment, “circle has been closed”.

I promise to update you on the results.

The whole axiomatic fits within the current EVD-scheme AND processing of reserved characters like = { } and %XXX.

We would define them as IMMEDIATE-characters that use the stack and call the interface of the EVD generator.

Moreover (+) we would have to “lay a trap” in the form of UnknownWordHook and trap “unknown” tokens with it.

This “trap” would determine which token is passed (basing on the existing EVD-scheme I have already published) and what are the stack contents and call appropriate methods of generator interface.

We should keep in mind CheckBrackets in parser.

May be, we’d get to HTML and RTF afterwards.

However, most likely, we’d have to do non-greedy quantification or, possibly, recursive parsing in the active token.

Perhaps we can simply set the lists WordChars, DelimChars and SpaceChars correctly.

Perhaps these lists can change depending on the stack machine contents.

We have to do something with it.

On the contrary, XML freely fits within the existing scheme by means of formal grammar. But we do not really need it now.

Afterwards, it would be possible to make over the parsing of binary EVD by adding a special parser to pick out the “tokens” with fixed structure.

Then, we can think about another binary formats like DOC, etc.

Actually, quite the same stack structures are used all over the place there or processing the token with mandatory parameters on the right.

In other words, there are not many binary formats namely of the following kinds:

1. Either XML:

<a>
 <b>
 ...
 </b>
</a>

2. Or asm:

[prefix1 .. prefixK] instruction I1 [param1 .. paramM]
...
[prefix1 .. prefixK] instruction IN [param1 .. paramM]

3. Or the combination.

In this context, the less preferable format is HTML.

Moreover, usually, we DO NOT NEED to do “backtracking” (Backtracking) of the data we’ve already parsed.

Generally, people don’t bother themselves with data formats and prefer not to deal with backtracking.

If, however, backtracking is possible, then we have a point of stack fixation and a point of “returning back to the fixed value” or “value resetting”.

In other words, we merely need the “second stack” or “stack of stacks”.

It does not seem to be possible.

Namely:

Input flow parser for tokens -> Stack machine (+) Axiomatics -> Filter1 .. FilterN -> Generator

We also extend the scheme – Text processing. Generators, filters, transformers and "SAX developed on its own" (in Russian).

1. Parser splits the input stream for minimal tokens.
2. Stack machine converts the set of tokens into the parse tree.
3. Filters transform the parse tree.
4. Generator converts the parse tree to target language.

It corresponds much with (in Russian):

"Болье Л. Методы построения компиляторов. В кн.: Языки программирования /Под ред.Ф.Женюи, м., Мир, 1972, с.87-276.Научная библиотека диссертаций и авторефератов disserCat http://www.dissercat.com/content/razrabotka-adaptivnogo-metoda-postroeniya-i-organizatsii-kross-kompilyatorov-protsedurno-ori#ixzz3g5rXwthj"

In two or so years I’d have a “universal parsing”. If anyone would need it by that time.

Actually, the time has come for me to translate implementation of “my scripts” to some “sane” and “immortal” language like C++.

Again, do not forget about stl and boost as well as cross-platforms.

If anybody is interested in this project – come join me.

ToDo. Сделать << вместо file:write и >> вместо file:read

ToDo. Сделать << вместо file:write и >> вместо file:read.

ToDo. Сделать "консольную" запускалку "моих скриптов"

ToDo. Сделать "консольную" запускалку "моих скриптов"

ToDo. Сделать "консольную" запускалку "моих скриптов".

Побрюзжу... Про github, sourceforge и bitbucket

Типа:

msscript filename.script [param1 .. paramN]

filename.scrpt:

for ( FoldersByMask ParamStr 1 )
 ( 
  STRING IN aFolderName
  FILE aFile
  aFolderName ExtractFilePath (+) '.gitignore' file:openRead >>> aFile
  '/CVS/' aFile write
  nil >>> aFile
 )

Вот и "неожиданное" применение скриптов наклёвывается.

По аналогии с:

search.script

CONST gPath 'W:\common\components\SearchTest\TestSet' // путь к директории TestSet, где лежит SearchProfiler.cmd
CONST cTimeLimit 0 //5000 // пороговое значение в милисекундах, для которого графики не строятся, чем больше значение, тем меньше графиков
CONST cEtalonLimit 20

STRING VAR l_MarkFile

gPath '\doneMark.tmp' Cat =: l_MarkFile
l_MarkFile DeleteFile DROP

[ gPath '\SearchProfiler.cmd ' gPath ] strings:Cat WinExec

WHILE ( l_MarkFile sysutils:FileExists ! ) 
 ( 100 SLEEP )

l_MarkFile DeleteFile DROP

CONST "Пустая строка" ''

BOOLEAN VAR l_WasException
false =: l_WasException

ARRAY VAR l_Files

: "Сравнить с эталонами" STRING IN aMask

 VAR l_EtalonCount
 l_EtalonCount := 0

 : "Сравнить с эталонами 1" STRING IN aPath
  @ (
   STRING IN aFile
   
   if ( l_EtalonCount МЕНЬШЕ cEtalonLimit ) then
    TRY 
     aFile '.etalon' Cat aFile "Пустая строка" tests:CheckOutputWithInput 
    EXCEPT
     true =: l_WasException
     ++! l_EtalonCount
     STRING VAR l_File
     aFile sysutils:ExtractFileName =: l_File
     [ #13#10 '# ' '[[^' l_File '.diff.log.uni' ']]' ' / ' '[[^' l_File '.sdiff.log.uni' ']]' ] strings:Cat >>>[] l_Files
     ' ' >>>[] l_Files
    END 
  ) aMask aPath ProcessFilesWithMask
 ;
 
 gPath '\Result\Contexts\' Cat "Сравнить с эталонами 1"
 gPath '\Result\Other\' Cat "Сравнить с эталонами 1"
;

: "Записать время" STRING IN aMask

 : "Записать время 1" STRING IN aPath
  @ (
   STRING IN aFile

   FILE VAR l_In
   aFile file:OpenRead =: l_In
   TRY
   
    : DoLine W-STRING IN aStr
     STRING VAR l_Str
     STRING VAR l_Str1
     aStr WString:ToString =: l_Str
     ';' string:RSplitTo! l_Str
     l_Str =: l_Str1 
     =: l_Str
     //[ l_Str1 ' ' l_Str ] strings:Cat .
     
     INTEGER VAR vTime
     l_Str StrToInt =: vTime
     ( vTime cTimeLimit > ) ?
      ( l_Str1 '' vTime TimeToLog )
    ;
    
    l_In file:ReadLines DoLine
    
   FINALLY 
    nil =: l_In
   END 
   
  ) aMask aPath ProcessFilesWithMask
 ;
 
 gPath '\Result\Contexts\' Cat "Записать время 1"
 gPath '\Result\Other\' Cat "Записать время 1"
;

'*.ctx' "Сравнить с эталонами"
'*.oth' "Сравнить с эталонами"
'*.rt' "Записать время"

l_WasException ! [ 'Были несовпадения с эталонами: ' l_Files strings:Cat ] strings:Cat ASSERTS