Test programs and Examples

test_wf.wft

This chapter presents the listing of the file test_wft.wft which is here to test some definitions.
 

Last update:

3-January-1999

State (estimation)

100%


/* ===========================================================================
  
   test_wf.wft                      Oliver Singla
 
   Description:  This file defines words to test wfroth.
 
   =========================================================================== */
 
forget <test_wf>
: <test_wf> ;
 
// *********************
// *** DEFERed words ***
// *********************
 
: test_defer1 1 . ;
: test_defer2 2 . ;
 
defer test_deferred
: test_defer
  ' test_defer1 is test_deferred
  test_deferred
  ' test_defer2 is test_deferred
  test_deferred ;
 
 
// ***************************
// *** IF...[ELSE]...ENDIF ***
// ***************************
 
: test_if1
  cr " Press a key " type
  key dup emit '0 '9 [within]
  IF space " is a digit" type ENDIF ;
 
: test_if2
  cr " Press a key " type
  key dup emit '0 '9 [within] space
  IF " is a digit" ELSE " is not a digit" ENDIF type ;
 
: test_if3
  cr " Press a key " type
  key dup emit dup '0 '9 [within] space
  IF 
      drop " is a digit" 
  ELSE 
      dup 'a 'z [within] swap 'A 'Z [within] or
      IF " is a letter" ELSE " neither a digit or a letter" ENDIF
  ENDIF type ;
 
 
// *****************************
// *** BEGIN..[BREAK]..AGAIN ***
// *****************************
 
: test_again1
  cr " Press keys. Never stop" type cr
  BEGIN
      key emit
  AGAIN ;
 
: test_again2
  cr " Press keys. Stop on X" type cr
  BEGIN
      key dup emit
    'X == ?break
  AGAIN ;
 
 
// *****************************
// *** BEGIN..WHILE..REPEAT  ***
// *****************************
 
: test_while1
  cr " Press keys. Stop on either X or x" type cr
  BEGIN
      key
    dup 'x == over 'X == or not
  WHILE
      emit
  REPEAT drop ;
 
: test_while2
  cr " Press keys. Stop on either X or x or a digit [0..9]" type cr
  BEGIN
      key
    dup '0 '9 [within] ?break
    dup 'x == over 'X == or not
  WHILE
      emit
  REPEAT drop ;
 
 
// *****************************
// *** CASE..ENDCASE         ***
// *****************************
 
: x10 10 ;
: x20 20 ;
: x30 30 ;
 
: test
//  cr " Press keys. Stop on either X or x" type cr
  key CASE
     '0 OF " zero" type ENDOF
   '1 OF " one" type ENDOF
   '2 OF " two" type TIPOF
   '3 OF " thr" type ENDOF
   " neither 0 or 1" type
  ENDCASE drop
  x10 x20 x30 ;
 
 
// *****************************
// *** TIMES..ENDTIMES       ***
// *****************************
 
: test_times1
  cr 10 TIMES
      '* emit
  ENDTIMES cr ;
 
/*
: test_times2
  5 TIMES
     cr I . " ?  " type
   key dup 'X ?break
   11 TIMES dup emit ENDTIMES
   drop
  ENDTIMES drop ;
*/
 
: wait_key
  BEGIN ?key ( WindowsPeekMsg ) UNTIL key ;
 
: test
  3 TIMES wait_key ENDTIMES
  emit emit emit ;