"Поток сознания" о тестировании и программировании: Ни о чём. Обновление аксиоматики

Коммит:
https://bitbucket.org/lulinalex/mindstream/commits/7182b640d68cdf088d7c62573ce1b9e0cda6c309
// Аксиоматика

IMMEDIATE OPERATOR VOID
 TtfwWordModifier::tfw_wmVoid Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR ^@
 TtfwWordModifier::tfw_wmLeftWordRef Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR ^
 TtfwWordModifier::tfw_wmRightWordRef Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR AGGREGATION
 TtfwWordModifier::tfw_wmAggregation Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR LINK
 TtfwWordModifier::tfw_wmLink Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR REFERENCE
 TtfwWordModifier::tfw_wmReference Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR INLINE
 TtfwWordModifier::tfw_wmInline Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR SUMMONED
 TtfwWordModifier::tfw_wmSummoned Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR ABSTRACT
 TtfwWordModifier::tfw_wmAbstract Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR VIRTUAL
 TtfwWordModifier::tfw_wmAbstract Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR FINAL
 TtfwWordModifier::tfw_wmFinal Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR SEALED
 TtfwWordModifier::tfw_wmSealed Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR OVERRIDE
 TtfwWordModifier::tfw_wmOverride Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR REDEFINITION
 TtfwWordModifier::tfw_wmRedefinition Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR REDEFINEABLE
 TtfwWordModifier::tfw_wmRedefineable Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR REALIZE
 TtfwWordModifier::tfw_wmRealize Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR PRIVATE
 TtfwWordModifier::tfw_wmPrivate Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR PROTECTED
 TtfwWordModifier::tfw_wmProtected Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR PUBLIC
 TtfwWordModifier::tfw_wmPublic Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR W-STRING
 TtfwWordModifier::tfw_wmWStr Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR FILE
 TtfwWordModifier::tfw_wmFile Ctx:IncludeModifier
; 

VOID IMMEDIATE OPERATOR OBJECT
 TtfwWordModifier::tfw_wmObj Ctx:IncludeModifier
; // OBJECT

VOID IMMEDIATE OPERATOR ^L
 // - определяет ПРАВЫЙ параметр, который может быть как словом, так и неизвестным идентификатором
 //   L - сокращение типа от слова Literal
 //   При этом передаётся ссылка на ИСХОДНОЕ слово, а не на КОМПИЛИРОВАННУЮ последовательность.
 //   Это важно для ОПЕРАТОРОВ и WordWorker'ов.
 TtfwWordModifier::tfw_wmRightWordRef Ctx:IncludeModifier
 TtfwWordModifier::tfw_wmTreatUnknownAsString Ctx:IncludeModifier
; // ^L

OPERATOR __DefineParam
 // - тут стереотип на стеке
 // - тут имя на стеке
 Ctx:NewWordDefinitor pop:NewWordDefinitor:DefineInParameter
 // - тут параметр на стеке
 Ctx:PushCompiler pop:Compiler:CompileInParameterPopCode
 Ctx:ClearTypeInfo
; // __DefineParam

IMMEDIATE VOID OPERATOR __DefineNameParam
 @SELF 'aName' __DefineParam
; // __DefineNameParam
 
IMMEDIATE VOID OPERATOR IN
 ^L __DefineNameParam
 @SELF aName DO __DefineParam
; // IN
 
FUNCTION ->0 
 // - возвращает первый параметр указанного слова
  OBJECT IN %S
 0 %S pop:Word:GetParam DO >>> Result
; // ->0

VOID IMMEDIATE OPERATOR BOOLEAN
 TtfwWordModifier::tfw_wmBool Ctx:IncludeModifier
; // BOOLEAN

VOID IMMEDIATE OPERATOR CALLER
 TtfwWordModifier::tfw_wmCaller Ctx:IncludeModifier
; // BOOLEAN

VOID IMMEDIATE OPERATOR CARDINAL
 TtfwWordModifier::tfw_wmInt Ctx:IncludeModifier
; // CARDINAL

VOID IMMEDIATE OPERATOR INTEGER
 TtfwWordModifier::tfw_wmInt Ctx:IncludeModifier
; // INTEGER

VOID IMMEDIATE OPERATOR STRING
 TtfwWordModifier::tfw_wmStr Ctx:IncludeModifier
; // STRING

VOID IMMEDIATE OPERATOR ARRAY
 TtfwWordModifier::tfw_wmList Ctx:IncludeModifier
; // ARRAY

VOID IMMEDIATE OPERATOR INTERFACE
 TtfwWordModifier::tfw_wmIntf Ctx:IncludeModifier
; // INTERFACE

VOID IMMEDIATE OPERATOR CHAR
 TtfwWordModifier::tfw_wmChar Ctx:IncludeModifier
; // CHAR

VOID IMMEDIATE OPERATOR CLASS
 TtfwWordModifier::tfw_wmClass Ctx:IncludeModifier
; // CLASS

INLINE OPERATOR then
  ^ IN aWhatToThen
 aWhatToThen DO
; // then

BOOLEAN FUNCTION NotValid IN %S
 if ( %S IsVoid ) then
  ( true >>> Result )
 else
 if ( %S pop:object:IsNil ) then
  ( true >>> Result )
 else 
  ( false >>> Result )
; // NotValid

BOOLEAN OPERATOR IS
  CLASS OBJECT IN anObj
  ^ IN aClass
 if ( anObj IsClass ) then
  ( ( aClass DO anObj pop:class:Inherits ) >>> Result )
 else
  ( ( aClass DO anObj pop:object:Inherits ) >>> Result )
; // IS

STRING FUNCTION |N

  /*OBJECT*/ IN %S

 if ( %S IsVoid ) then
  ( '' >>> Result )
 else
 if ( %S pop:object:IsNil ) then
  ( '' >>> Result )
 else
 if ( class::TkwString %S pop:object:Inherits ) then
  ( %S DO >>> Result )
 else
 if ( class::TkwInteger %S pop:object:Inherits ) then
  ( %S DO IntToStr >>> Result )
 else
 if ( class::TkwMain %S pop:object:Inherits ) then
  ( %S pop:object:ClassName >>> Result )
 else
 if ( class::TkwCompiledMain %S pop:object:Inherits ) then
  ( %S pop:object:ClassName >>> Result )
 else
  ( %S pop:Word:Name >>> Result )
; // |N

STRING OPERATOR (+)
 STRING IN aLeft
 ^ IN aRight
 aLeft aRight DO Cat >>> Result
; // (+)

IMMEDIATE OPERATOR WordAlias
 ^L IN aName
 ^ LINK IN aCode
 aCode aName |N Define
; // WordAlias

WordAlias begin BEGIN
WordAlias end END

WordAlias operator OPERATOR
WordAlias __operator OPERATOR

WordAlias ITERATE Iterate
WordAlias WordWorker WORDWORKER

STRING FUNCTION strings:Cat ARRAY IN anArray
 // - складывает строки массива на стеке
 '' >>> Result
 @ ( Result SWAP Cat >>> Result ) anArray Iterate
; // strings:Cat

STRING OPERATOR __SourceInfo
 OBJECT IN aCaller
 if ( Ctx:Parser IsNil ) then
 begin
  aCaller pop:Word:SourcePointString >>> Result
 end
 else
 begin
  [ Ctx:Parser pop:Parser:FileName ' line: ' Ctx:Parser pop:Parser:SourceLine IntToStr ] strings:Cat >>> Result
 end
; // __SourceInfo

FORWARD VarMsgToStr

VOID OPERATOR __ERROR
 IN aMsg
 OBJECT IN aCaller
 if ( Ctx:Parser IsNil ) then
 begin
  [ aCaller __SourceInfo ' |=> ' aMsg VarMsgToStr ] strings:Cat class::EtfwRunner CreateAndRaise
 end
 else
 begin
  [ aCaller __SourceInfo ' |=> ' aMsg VarMsgToStr ] strings:Cat class::EtfwCompiler CreateAndRaise
 end
; // __ERROR

OBJECT OPERATOR |^@
 ^@ IN aSelf
 aSelf pop:Word:GetRef >>> Result
; // |^@

OPERATOR EVAL
 ^ IN aWhat
 aWhat |^@ DO
; // EVAL

VOID CALLER OPERATOR ASSURE
 ^ IN aCondition
 ^ IN aMessage
 EVAL aCondition ! ?
 begin
  aMessage Caller __ERROR
 end
; // ASSURE

VOID CALLER OPERATOR ?ASSURE
 BOOLEAN IN aCondition
 ^ IN aMessage
 aCondition ! ?
 begin
  aMessage Caller __ERROR
 end
; // ?ASSURE

VOID CALLER OPERATOR ?FAIL
 BOOLEAN IN aCondition
 ^ IN aMessage
 aCondition ?
 begin
  aMessage Caller __ERROR
 end
; // ?FAIL

VOID CALLER OPERATOR ERROR
 ^ IN aMsg
 aMsg Caller __ERROR
; // ERROR

: __DefineVarEx
  STRING IN aName
  OBJECT IN aStereo
 
 aName Ctx:NewWordDefinitor pop:NewWordDefinitor:CheckWord pop:KeyWord:Word pop:object:IsNil
  ?ASSURE [ 'Слово ' aName ' уже существует. Нельзя определить переменную с таким же именем' ]

 aName true Ctx:NewWordDefinitor pop:NewWordDefinitor:CheckVar
 DUP aStereo SWAP pop:Word:SetProducer
 Ctx:ClearTypeInfo
; // __DefineVarEx

: __DefineVar
 __DefineVarEx DROP
; // __DefineVar

IMMEDIATE VOID OPERATOR VAR
 ^L IN aName
 aName |N @SELF __DefineVar
; // VAR

STRING FUNCTION VarMsgToStr
 OBJECT IN aMessage
  VAR l_Msg
  aMessage DO >>> l_Msg
  if ( l_Msg IsArray ) then
   ( l_Msg strings:Cat >>> Result )
  else
   ( l_Msg >>> Result )
; // VarMsgToStr

WordAlias var VAR

IMMEDIATE VOID operator PROCEDURE
 @SELF Ctx:SetWordProducerForCompiledClass
 'VOID' Ctx:Parser:PushSymbol
 '__operator' Ctx:Parser:PushSymbol
; // PROCEDURE

WordAlias procedure PROCEDURE
WordAlias function FUNCTION

^@ OPERATOR @^
 // - возвращает ссылку на слово, любое, даже непосредственного исполнения
 //   Не адрес, а именно ССЫЛКУ.
 // Разница в примере:
/*
 @ A DO
 @^ A
 
 @ A ^:= 1
 @^ A := 1
 // - записи делают одно и то же
*/ 
 ^ LINK IN aSelf
 aSelf >>> Result
; // @^

VOID operator :=
//operator :=
// - пока так, иначе конструкция @ XXX -> A := 1024 - не работает, т.к. XXX снимается со стека уже в контексте := И срабатывает КОНТРОЛЬ СТЕКА   
  ^@ IN aLeft
  ^ IN aRight
 aRight DO >>>^ aLeft
;

VOID operator ^:=
  IN aLeft
  ^ IN aRight
 aRight DO >>>^ aLeft
;

VOID operator >>>[]
  IN aLeft
  ^ IN aRight
 aLeft aRight DO Array:Add
;

operator IT 
  ARRAY IN A
  ^ IN aWhatToDo
 aWhatToDo A ITERATE
; // IT

WordAlias ==> IT

operator for
  ^ IN aList
  ^ IN aWhatToDo
 aList DO ==> ( aWhatToDo DO )
; // for

WordAlias CONSTANT CONST

IMMEDIATE VOID operator Test
 @SELF Ctx:SetWordProducerForCompiledClass
 'VOID' Ctx:Parser:PushSymbol
 '__operator' Ctx:Parser:PushSymbol
; // Test

WordAlias Тест Test

WordAlias Если if
WordAlias если if
WordAlias то then
WordAlias иначе else

WordAlias выходим EXIT
WordAlias Выходим EXIT

WordAlias =:^ >>>^
WordAlias =: >>>

VOID operator +!
  INTEGER IN anIncrement
  ^ IN aWhatToIncrement
// Пример:
// {code}
// VAR l_WinID
// 5 >>> l_WinID
// 1 +! l_WinID
// l_WinID .
// {code}

 aWhatToIncrement DO anIncrement + =:^ aWhatToIncrement
; // +!

WordAlias =+ +!

VOID operator =- 
  INTEGER IN anInc
  ^ IN aWhatToDecrement
 aWhatToDecrement DO anInc - =:^ aWhatToDecrement
; // =-

VOID operator +=
  ^@ IN aLeft
  ^ IN aRight
 aLeft DO
 aRight DO
 +
 >>>^ aLeft
;

VOID operator -=
  ^@ IN aLeft
  ^ IN aRight
 aLeft DO
 aRight DO
 -
 >>>^ aLeft
;

VOID operator INC
  ^ IN aWhatToIncrement
 aWhatToIncrement DO 1 + =:^ aWhatToIncrement
; // INC

WordAlias ++! INC
WordAlias Inc INC

VOID operator DEC
  ^ IN aWhatToDecrement
 aWhatToDecrement DO 1 - =:^ aWhatToDecrement
; // DEC

WordAlias --! DEC
WordAlias Dec DEC

BOOLEAN FUNCTION array:HasString ARRAY IN anArray STRING IN aString
 Result := false

  PROCEDURE Поиск STRING IN anItem
   if ( anItem aString SameStr )
    ( Result := true )
  ; // Поиск

  @ Поиск anArray ITERATE
; // array:HasString

BOOLEAN FUNCTION array:HasText ARRAY IN anArray STRING IN aString
 Result := false

  PROCEDURE Поиск STRING IN anItem
   if ( anItem aString SameText )
    ( Result := true )
  ; // Поиск

  @ Поиск anArray ITERATE
; // array:HasText

INTEGER FUNCTION array:StringCount ARRAY IN anArray STRING IN aString
 Result := 0

  PROCEDURE Поиск STRING IN anItem
   if ( anItem aString SameStr )
    ( ++! Result )
  ; // Поиск

  @ Поиск anArray ITERATE
; // array:StringCount

PROCEDURE "Сравнить текущее исключение с эталоном"
 STRING VAR l_ClassName
 current:exception:ClassName >>> l_ClassName
 l_ClassName .
 STRING VAR l_Message
 STRING VAR l_Message_out
 current:exception:Message >>> l_Message

 if ( l_ClassName 'EAssertionFailed' SameText )
  ( l_Message '(' string:Split DROP >>> l_Message )
 else
  ( l_ClassName 'EAccessViolation' SameText ? (
     l_Message ' at ' string:Split DROP >>> l_Message
    )
  )
 l_Message 'Главный файл:' string:Split =: l_Message_out =: l_Message
 l_Message_out '. ' string:Split =: l_Message_out DROP
 l_Message l_Message_out Cat .
; // "Сравнить текущее исключение с эталоном"

PROCEDURE "Выполнить и если было исключение, то выполнить" IN aProc1 IN aProc2
 INTEGER VAR l_StackLevel
 l_StackLevel := StackLevel
 TRY
  TRY
   aProc1 DO
  EXCEPT
   "Сравнить текущее исключение с эталоном"
   aProc2 DO
  END
 FINALLY
  l_StackLevel ReduceStackLevel
 END
; // "Выполнить и если было исключение, то выполнить"

VOID operator анти-тест
  ^ IN aWhatToDo
 VAR l_WasException
 false =: l_WasException
 "Выполнить {(@ ( aWhatToDo DO ) )} и если было исключение, то выполнить {(@ ( true =: l_WasException ) )}"
 l_WasException
  [ 'Тест ' script:FileName ' почему-то стал проходить' ] strings:Cat
   ASSERTS
; // анти-тест

WordAlias "тест с падением" анти-тест

VOID operator "Выполнить подавив исключение"
  ^ IN aWhatToDo
 VAR l_WasException
 false =: l_WasException
 "Выполнить {(@ ( aWhatToDo DO ) )} и если было исключение, то выполнить {(@ ( true =: l_WasException ) )}"
 l_WasException
  [ 'Запланированного исключения в тесте: ' script:FileName ' почему-то не случилось' ] strings:Cat
   ASSERTS
; // "Выполнить подавив исключение"

PROCEDURE "Выполнить обработав исключение" OBJECT IN aProc STRING IN anException
 TRY
  aProc DO
 EXCEPT
  current:exception:Message anException ?!= ? RAISE
 END
; // "Выполнить обработав исключение"

PROCEDURE ToDo STRING IN aString
 'To Do: ' aString Cat .
; // ToDo

PROCEDURE "! Тест в разработке"
 script:FileName sysutils:ExtractFileName ' в состоянии разработки' Cat ToDo
; // "! Тест в разработке"

PROCEDURE OnTest
// - ждёт обновления контролов по OnTest
  3 LOOP (
   ProcessMessages
   application:ActionIdle
  )
  // - позволяем пройти всем OnTest
; // OnTest

WordAlias "Дать системе перерисоваться" OnTest

PROCEDURE "Нажать" STRING IN aString
 aString key
 OnTest
; // "Нажать"

VOID operator "Обработать Enter модально"
  ^ IN aWhatToDo
 @ ( "Нажать {('Enter')}" ) MODAL ( aWhatToDo DO )
; // "Обработать Enter модально"

PROCEDURE ASSUME STRING IN aStr
 // Включает "условную директиву" aStr в тестируемом приложении
 // http://mdp.garant.ru/pages/viewpage.action?pageId=236719181 №44
; // ASSUME

PROCEDURE UNASSUME STRING IN aStr
 // Выключает "условную директиву" aStr в тестируемом приложении
 // http://mdp.garant.ru/pages/viewpage.action?pageId=236719181 №44
; // UNASSUME

BOOLEAN FUNCTION ArraysAreEqual ARRAY IN A ARRAY IN B
 A IsArray 'Где массив?' ASSERTS
 B IsArray 'Где массив?' ASSERTS
 CONST l_Exception 'Выходим из итератора'
 INTEGER VAR l_Index
 l_Index := 0
 INTEGER VAR l_Count
 l_Count := ( A Array:Count )

   PROCEDURE DoWithItem IN B[i]
    if ( l_Index A [i] B[i] ?== ) then
     ++! l_Index
    else
    (
     Result := false
     l_Exception RAISE
    )
   ;

 if ( l_Count B Array:Count ?!= ) then
 (
  Result := false
  EXIT
 )
 TRY
  @ DoWithItem B ITERATE
  Result := true
 EXCEPT
  if ( current:exception:Message l_Exception ?!= ) then
   RAISE
 END
; // ArraysAreEqual

BOOLEAN operator AND BOOLEAN
  IN aFirst
  ^ IN aSecond
 // Двусторонний, а не обратный польский &&
 if aFirst then
  (
   if ( aSecond DO ) then
    ( Result := true )
   else
    ( Result := false )
   )
 else
  ( Result := false )
; // AND

WordAlias И AND

BOOLEAN operator OR BOOLEAN
  IN aFirst
  ^ IN aSecond
 // Двусторонний, а не обратный польский ||
 if aFirst then
  ( Result := true )
 else
  if ( aSecond DO ) then
   ( Result := true )
  else
   ( Result := false )
; // OR

WordAlias ИЛИ OR

BOOLEAN operator NOT
  ^ IN aWhatToNot
 // Правосторонний, а не обратный польский !
 Result := ( aWhatToNot DO ! )
; // NOT

WordAlias НЕ NOT

BOOLEAN operator =
  IN aLeft
  ^ IN aRight
 // Правосторонний, а не обратный польский ==
 // ТЕПЕРЬ С БЛЭКДЖЕКОМ И МАССИВАМИ!

//1 РАВНО 1  . - True
//[ 10 20 ] РАВНО ( 10 20 ) . - True
//[ 10 20 ] РАВНО ( [ 10 20 ] ) . - True
//[ 10 ] РАВНО ( [ 10 ] ) . - True
//[ 10 ] РАВНО ( 10 ) . - True
//[ 10 ] РАВНО ( 20 ) . - False

 ARRAY VAR l_Right
 l_Right := [ aRight DO ]
 TRY
  if ( aLeft IsArray ) then
  (
   if
    (
     ( l_Right IsArray ) И
     ( l_Right Array:Count 1 == ) И
     ( 0 l_Right [i] IsArray )
    )
   then
   (
    Result := ( aLeft 0 l_Right [i] ArraysAreEqual )
   )
   else
   (
    Result := ( aLeft l_Right ArraysAreEqual )
   )
  )
  else
  (
   if ( l_Right Array:Count 1 == ) then
   (
    Result := ( aLeft 0 l_Right [i] ?== )
   )
   else
   (
    Result := false
   )
  )
 FINALLY
  l_Right := [ ]
  aLeft := nil
 END
; // =

WordAlias РАВНО =

BOOLEAN operator <>
  IN aLeft
  ^ IN aRight
 // Правосторонний, а не обратный польский !=
 Result := ( aLeft = ( aRight DO ) ! )
; //<>

WordAlias НЕРАВНО <>
WordAlias "НЕ РАВНО" НЕРАВНО

BOOLEAN operator >
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
 Result := ( aLeft aRight DO GREATER )
;

WordAlias БОЛЬШЕ >

BOOLEAN operator <
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
  Result := ( aLeft aRight DO LESS )
;

WordAlias МЕНЬШЕ <

BOOLEAN operator >=
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
 Result := ( aLeft < ( aRight DO ) ! )
;

WordAlias "БОЛЬШЕ ИЛИ РАВНО" >=

BOOLEAN operator <=
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
 Result := ( aLeft > ( aRight DO ) ! )
;

WordAlias "МЕНЬШЕ ИЛИ РАВНО" <=

WordAlias ЯВЛЯЕТСЯ IS
WordAlias Is IS

BOOLEAN operator NOTIS
  CLASS OBJECT IN anObj
  ^ IN aClass
 Result := NOT ( anObj Is ( aClass DO ) )
; // NOTIS

WordAlias NotIs NOTIS
WordAlias НЕЯВЛЯЕТСЯ NOTIS
WordAlias "НЕ ЯВЛЯЕТСЯ" НЕЯВЛЯЕТСЯ

IMMEDIATE operator WordAliasByRef
 ^L IN aName
 ^ IN aCode
 aCode DO aName |N Define
; // WordAliasByRef

IMMEDIATE operator [EXECUTE]
 ^ IN aCode
 aCode DO
; // [EXECUTE] 
 
STRING operator |NS
 IN aName
 Result := ( [ '`' aName |N '`' ] strings:Cat )
; // |NS

OBJECT FUNCTION %ST IN %S
 if ( %S NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  Result := ( %S pop:Word:Producer )
 ) 
; // %ST

STRING FUNCTION |S IN %S
 %S %ST |N =: Result
; // |S

operator WHILE
  ^ IN aCondition
  ^ IN aWhatToDo
 @ ( aCondition DO ) WHILEDO ( aWhatToDo DO )
; // WHILE

WordAlias ПОКА WHILE
WordAlias while WHILE

OBJECT operator %%
 OBJECT IN aWord
 ^ IN aName
 
 OBJECT VAR l_Member
 aName DO aWord pop:Word:FindMember >>> l_Member
 
 if ( l_Member pop:object:IsNil ) then
  ( Result := nil )
 else
  ( Result := ( l_Member pop:KeyWord:Word ) ) 
; // %%
 
OBJECT FUNCTION %P IN %S
 VAR l_P
 l_P := ( %S pop:Word:Parent )
 if ( l_P pop:Word:Name '%C' SameText ) then
 ( 
  l_P := ( l_P pop:Word:Parent )
 ) 
 if ( l_P NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  Result := l_P
 ) 
; // %P

ARRAY FUNCTION LIST
 OBJECT IN anObject
 ^ IN aFunctor
 
 OBJECT VAR l_Element
 l_Element := anObject
 Result := [
  while true
  begin
   l_Element := ( l_Element aFunctor DO )
   if ( l_Element pop:object:IsNil ) then
    BREAK
   l_Element 
  end
 ]
; // LIST
 
^@ operator ::
 ^@ IN aSelf
 ^L IN aName

 OBJECT VAR l_Self
 aSelf |^@ >>> l_Self
 
 STRING VAR l_Name
 aName |N >>> l_Name
 
 OBJECT VAR l_Res
 l_Self %% l_Name >>> l_Res
 
 ASSURE 
  NOT ( l_Res pop:object:IsNil ) 
  [ 'Не найдено поле: ' l_Self LIST %P Reverted ==> ( |N '::' ) l_Self |N '::' l_Name ]
 l_Res >>> Result
; // ::
 
OBJECT operator ->^
 ^@ IN aSelf
 ^ IN aName
 
 STRING VAR l_Name
 aName DO >>> l_Name
 
 OBJECT VAR l_Self
 aSelf |^@ >>> l_Self
 
 if ( l_Self pop:object:IsNil ) then
 begin
  nil >>> Result
 end 
 else 
 begin
  VAR l_NewVar
  
  l_Name l_Self pop:NewWordDefinitor:CheckWord pop:KeyWord:Word >>> l_NewVar
  
  if ( l_NewVar pop:object:IsNil ) then
   (
    l_Name false l_Self pop:NewWordDefinitor:CheckVar
    
     >>> l_NewVar
    Ctx:ClearTypeInfo
    
    @ VAR l_NewVar pop:Word:SetProducer
   )
  
  l_NewVar >>> Result
 end // l_Self pop:object:IsNil
; // ->^

^@ operator ->
 ^@ IN aSelf
 ^L IN aName

 aSelf ->^ ( aName |N ) >>> Result
; // ->

OBJECT FUNCTION %T IN %S
 VAR l_T
 l_T := ( %S ->^ '%T' )
 if ( l_T NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  l_T := ( l_T DO )
  if ( l_T NotValid ) then
  (
   Result := nil
  ) 
  else
  (
   Result := l_T
  )
 )
; // %T

STRING FUNCTION %TN IN %S
 Result := ( %S %T |N )
; // %TN

STRING FUNCTION %TS IN %S
 Result := ( %S %T |S )
; // %TS

STRING FUNCTION |U IN %S
 VAR l_U
 l_U := ( %S ->^ '%U' )
 if ( l_U NotValid ) then
 (
  Result := ''
 ) 
 else
 (
  Result := ( l_U DO |N )
 )
; // |U

WordAlias ДА true

WordAlias НЕТ false

BOOLEAN operator "в интервале"
  INTEGER IN aValue
  ^ IN anInterval
 INTEGER VAR "нижнее значение"
 INTEGER VAR "верхнее значение"
 ( anInterval DO )
 >>> "верхнее значение"
 >>> "нижнее значение"
 Result := ( ( aValue "БОЛЬШЕ ИЛИ РАВНО" "нижнее значение" )
 И ( aValue "МЕНЬШЕ ИЛИ РАВНО" "верхнее значение" ) )
; // "в интервале"
   
ARRAY FUNCTION SplitToArray
 STRING IN aValue
 STRING IN aDelim
 STRING VAR l_Tail
 aValue >>> l_Tail
 if ( l_Tail = '' ) then
 begin
  Result := [ '' ]
 end 
 else
 begin 
  Result := [ 
   while ( l_Tail <> '' )
   begin
    l_Tail aDelim string:Split >>> l_Tail
   end
  ]
 end
; // SplitToArray

IMMEDIATE operator __INIT_VAR
 IN aValue
 ^ IN aVar
 aValue >>>^ aVar
; // __INIT_VAR

PROCEDURE Ctx:Parser:PushSymbols
 STRING IN aString
 aString ' ' SplitToArray ==> ( 
  STRING IN aStr
  aStr '%#32' ' ' string:Replace >>> aStr
  if ( '`' aStr StartsStr ) then
  begin
   aStr '`' '' string:Replace Ctx:Parser:PushString
  end
  else
  begin
   aStr Ctx:Parser:PushSymbol 
  end
 )
; // Ctx:ParserPushSymbols

PROCEDURE Ctx:Parser:PushArray
 ARRAY IN anArray
 anArray ==> Ctx:Parser:PushSymbols
; // Ctx:Parser:PushArray

IMMEDIATE VOID operator WordProducer
  ^L IN aName
 
 @SELF Ctx:SetWordProducerForCompiledClass
 [
  'IMMEDIATE __operator'
  aName |N
  '@SELF Ctx:SetWordProducerForCompiledClass'
  '@ operator DO'
  ';'
 ] Ctx:Parser:PushArray
; // WordProducer
 
IMMEDIATE VOID operator NamedWordProducer
  ^L IN aName
  ^L IN aNewName
 
 @SELF Ctx:SetWordProducerForCompiledClass
 [
  'IMMEDIATE __operator'
  aName |N
  '@SELF Ctx:SetWordProducerForCompiledClass'
  aNewName |NS
  'Ctx:SetNewWordName'
  '@ operator DO'
  ';'
 ] Ctx:Parser:PushArray
; // NamedWordProducer

WordAlias ClassProducer WordProducer

NamedWordProducer %INHERITS %G
 // - список унаследованных элементов

NamedWordProducer %CHILDREN %C
// - список дочерних элементов элемента

IMMEDIATE VOID operator VarProducer
  ^L IN aName
 STRING VAR l_Name
 aName |N >>> l_Name

 [
  'IMMEDIATE __operator'
  l_Name
  '^L IN aName'
  'aName |N @SELF __DefineVar'
  ';'
 ] Ctx:Parser:PushArray
; // VarProducer

IMMEDIATE VOID operator InitedVarProducer
  ^L IN aName
 
 [
  'IMMEDIATE __operator'
  aName |N
  '^L IN aName'
  '^ IN aValue'
  'VAR l_NewVar'
  'aName |N @SELF __DefineVarEx >>> l_NewVar'
  'aValue DO >>>^ l_NewVar'
  ';'
 ] Ctx:Parser:PushArray
; // InitedVarProducer

operator AllMembers==>
// Итерирует все вложенные элементы рекурсивно
 OBJECT IN anObject
 ^ IN aLambda
 
 FORWARD DoMembers
 
 PROCEDURE DoMembers
  OBJECT IN anObject
  anObject MembersIterator ==> (
   IN aWord 
   aWord aLambda DO
   aWord DoMembers
  )
 ; // DoMembers
 
 anObject DoMembers
; // AllMembers==>

STRING FUNCTION strings:CatSep 
 // - складывает строки массива
  ARRAY IN anArray
  STRING IN aSep

 PROCEDURE DoCat 
  STRING IN aStr
  
  if ( aStr <> '' ) then
  begin
   if ( Result = '') then
    ( Result := aStr )
   else
    (
     if ( aSep Result EndsStr ) then
      (
       Result := ( Result aStr Cat )
      )
     else
      (
       Result := ( Result aSep Cat aStr Cat )
      ) 
    )
  end // aStr <> ''
 ; // DoCat

 Result := ''
 @ DoCat anArray ITERATE
; // strings:Cat

PROCEDURE __DumpMembers
 OBJECT IN anObject
 
 PROCEDURE Dump
  OBJECT IN anObject
   [
    anObject pop:Word:Directives
    anObject LIST %ST Reverted ==> |N
    anObject |N
   ] ' ' strings:CatSep .
 ; // Dump
 
 anObject Dump
 anObject AllMembers==> Dump
 anObject %P Dump
; // __DumpMembers

operator Ctx:Parser:PushSymbolAtRight
 ^L IN aName 
 aName |N Ctx:Parser:PushSymbol
; // Ctx:Parser:PushSymbolAtRight

IMMEDIATE VOID operator NamedInitedVarProducer
  ^L IN aName
  ^L IN aNewName
 
 @SELF Ctx:SetWordProducerForCompiledClass 
 [
  'IMMEDIATE __operator'
  aName |N
  '^ IN aValue'
  
  'VAR l_NewVar'
  
  aNewName |NS
  
  '@SELF __DefineVarEx >>> l_NewVar'
  'aValue DO >>>^ l_NewVar'
  ';'
 ] Ctx:Parser:PushArray
; // NamedInitedVarProducer

NamedInitedVarProducer %DOCUMENTATION %Doc
// - документация к элементу

IMMEDIATE VOID operator NamedAutolinkProducer
 ^L IN aOpName
 ^L IN aName
 
 @SELF Ctx:SetWordProducerForCompiledClass
 [
  'IMMEDIATE __operator'
  aOpName |N
  '^ IN aCode'
  'aCode '
  aName |NS
  'Define'
  ';' 
 ] Ctx:Parser:PushArray
; // NamedAutolinkProducer

STRING FUNCTION __CheckSpaces
 STRING IN aName
 aName ' ' '%#32' string:Replace >>> Result
; // __CheckSpaces

STRING FUNCTION Add<<>>
 STRING IN aName
 [ '<<' aName '>>' ] strings:Cat >>> Result
 Result __CheckSpaces >>> Result
; // Add<<>>

STRING FUNCTION Add<<@>>
 STRING IN aName
 [ '@' aName ] strings:Cat Add<<>> >>> Result
; // Add<<>>

VOID operator DefineStereo
 IN aName
 IN aSelf
 
 aSelf
 Ctx:SetWordProducerForCompiledClass
 
 [
  'IMMEDIATE __operator' aName Add<<>>
  '^L IN aName'
 
  'aName |N @SELF DefineStereoInstance'
 
  'EXIT'
 ] Ctx:Parser:PushArray
; // DefineStereo
 
VOID operator DefineStereoInstance
 IN aName
 IN aSelf
 
 aSelf
 Ctx:SetWordProducerForCompiledClass
 
 [
  '__operator' aName __CheckSpaces
 ] Ctx:Parser:PushArray
; // DefineStereoInstance

/*{IMMEDIATE operator StereotypeProducer
  ^L IN aName
  
 @SELF Ctx:SetWordProducerForCompiledClass
 [
  'IMMEDIATE __operator' aName |N Add<<>>
  '^L IN aName'
  'aName |N @SELF DefineStereo'
  
  'EXIT'
 ] Ctx:Parser:PushArray
; // StereotypeProducer}*/

VOID operator DefineStereotypeProducer
 IN aName
 IN aSelf
 
 aSelf
 Ctx:SetWordProducerForCompiledClass
 [
  'IMMEDIATE __operator' aName Add<<>>
  '^L IN aName'
  'aName |N @SELF DefineStereo'
  
  'EXIT'
 ] Ctx:Parser:PushArray
; // DefineStereotypeProducer

IMMEDIATE VOID operator StereotypeStereotypeProducer
  ^L IN aName
 @SELF Ctx:SetWordProducerForCompiledClass 
 [
  'IMMEDIATE __operator' aName |N Add<<@>>
  '^L IN aName'
  
  'aName |N @SELF DefineStereotypeProducer'
  
  'EXIT'
 ] Ctx:Parser:PushArray
; // StereotypeStereotypeProducer

StereotypeStereotypeProducer StereotypeProducer ;
WordAlias StereotypeProducer <<@StereotypeProducer>>
"Поток сознания" о тестировании и программировании

среда, 8 июля 2015 г.

Ни о чём. Обновление аксиоматики

Комментариев нет:

Отправить комментарий

среда, 8 июля 2015 г.

Ни о чём. Обновление аксиоматики

Комментариев нет:

Отправить комментарий

среда, 8 июля 2015 г.
