Assertion

Copyright [c] 2011, Marc Simpson Updated for RETRO 12 by Charles Childers, 2018

Description

This vocabulary provides support for testing code in a clean, predicatable manner.

Assertion predicates first check the stack for underflow; if the stack is deep enough, their embedded predicates are applied; if not, the assertion fails.

The result of each assertion - including the underflow check - is ANDed with the assertionFlag which can then be tested after the containing thread has finished executing; this is handled by the .assertion word class.

For custom behaviour, revector preCond and/or postCond; by default the pre-condition is an effective nop while the post-condition simply prints 'Success' or 'Failure'.

Given that each assertion predicate mutates assertionFlag, use of the word class class:assertion is encouraged; this resets the assertionFlag before execution and push its final value to the stack before calling postCond when the thread exits.

NOTE: For simplicity of implementation, failure within a word of class class:assertion will not result in immediate termination; instead, the false value of assertionFlag is left to propagate.

~~~'assertionFlag var   :assert  (f-)   &assertionFlag [ and ] v:update ;   :deep?   (n-f)   n:inc depth lteq? dup assert ;   :assert:eq    #2 deep? [ eq?      assert ] if ; :assert:false #1 deep? [ n:zero?  assert ] if ; :assert:true  #1 deep? [ n:-zero? assert ] if ; :assert:gt    #2 deep? [ gt?      assert ] if ; :assert:gteq  #2 deep? [ gteq?    assert ] if ; :assert:lt    #2 deep? [ lt?      assert ] if ; :assert:lteq  #2 deep? [ lteq?    assert ] if ;   :putAssertion (f-)   nl [ 'Success ] [ reset 'Failure ] choose s:put ; ~~~

These are from Hooks.forth:

~~~:hook (-)  #1793 , here n:inc , ; immediate :set-hook (aa-) n:inc store ; :unhook (a-) n:inc dup n:inc swap store ; ~~~

~~~:preCond  (-)  hook ; :postCond (f-) hook putAssertion ;   {{   :buildUp preCond  &assertionFlag v:on ;   :tearDown @assertionFlag  &assertionFlag v:on  postCond ; ---reveal---   :class:assertion (a-)     &buildUp class:word class:word &tearDown class:word ; }}   :assertion (-) &class:assertion reclass ; ~~~

~~~  :a1 (xyz-) #30 assert:eq #20 assert:eq #10 assert:eq ; assertion   :a2 (xy-) assert:true assert:false ; assertion   :a3 (x-) #5 assert:gt ; assertion     :go     nl '---------- s:put     #10 #20 #30 a1     #30 #20 #10 a1     nl '---------- s:put     #10 a1     nl '---------- s:put     a1     nl '---------- s:put     #-1 #0 a2     #0 #-1 a2     #-1 #-1 a2     #-1 a2     nl '---------- s:put     #3 a3     #4 a3     #5 a3     a3     nl '---------- s:put   ;     go ~~~

Functions

+-----------------+-----+-----------------------+ | Name |Stack| Usage | +=================+=====+=======================+ | assertionFlag | -a | Variable. This holds a| | | | true (-1) or false (0)| | | | value indicating | | | | whether the current | | | | set of assertions have| | | | passed or failed. The | | | | class:assertion | | | | class will set this to| | | | true automatically. | +-----------------+-----+-----------------------+ | assert | f- | Updates the | | | | assertionFlag | | | | using bitwise AND | +-----------------+-----+-----------------------+ | deep? | n-f | Checks to see if there| | | | are at least n items| | | | on the stack. | | | | Returns true if there | | | | are, false otherwise. | +-----------------+-----+-----------------------+ | assert:eq | nn- | Check to see if two | | | | values are equal | +-----------------+-----+-----------------------+ | assert:false | f- | Check to see if flag | | | | is false (0) | +-----------------+-----+-----------------------+ | assert:true | f- | Check to see if flag | | | | is true (non-zero) | +-----------------+-----+-----------------------+ | assert:gt | nn- | Check to see if n1 is | | | | greather than n2 | +-----------------+-----+-----------------------+ | assert:gteq | nn- | Check to see if n1 is | | | | greater than or equal | | | | to n2 | +-----------------+-----+-----------------------+ | assert:lt | nn- | Check to see if n1 is | | | | less than n2 | +-----------------+-----+-----------------------+ | assert:lteq | nn- | Check to see if n1 is | | | | less than or equal to | | | | n2 | +-----------------+-----+-----------------------+ | putAssertion | f- | Display 'Success' or | | | | 'Failure' based on | | | | flag | +-----------------+-----+-----------------------+ | preCond | - | Hook, does nothing by | | | | default | +-----------------+-----+-----------------------+ | postCond | f- | Hook, displays either | | | | 'Success' or 'Failure'| | | | by default | +-----------------+-----+-----------------------+ | class:assertion | a- | Class handler for | | | | assertions | +-----------------+-----+-----------------------+ | assertion | - | Change the class of a | | | | function to | | | | class:asssertion | +-----------------+-----+-----------------------+