home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / forth / pfe-0.000 / pfe-0 / pfe-0.9.13 / test / exceptn.4th < prev    next >
Encoding:
Text File  |  1995-07-13  |  776 b   |  33 lines
  1. \
  2. \ test/exception.4th --- tests the exception word set
  3. \ (duz 10Aug93)
  4. \
  5.  
  6. CR .( exception words) CR .(    )
  7.  
  8. : FCL        FDEPTH 0 > IF  FDEPTH 0 DO  FDROP  LOOP  THEN ;
  9. D SPACE                    \ stack must be empty on entry!
  10.  
  11. : STK        DROP ?STACK ;        \ a stack underflow exception
  12. : FPE        1E0 0E0 F/ ;        \ a floating point exception
  13.  
  14. : EX1        ['] STK CATCH ;        EX1  -4 = Y  D SPACE
  15. : EX2        ['] FPE CATCH ;        EX2 -55 = Y  D SPACE
  16.  
  17. : FPEE        S" FPE" EVALUATE ;    ' FPEE CATCH -55 = Y  D FCL SPACE
  18.  
  19. : FPEEE        S" ' FPEE CATCH" ;    FPEEE EVALUATE -55 = Y  D FCL SPACE
  20.  
  21. : UNDEF        S" :-) 0 Y " ;        UNDEF ' EVALUATE CATCH -13 = Y
  22.                     2DROP  D
  23.  
  24. \
  25. \ Test handling signals with Forth words.
  26. \
  27.  
  28. CR
  29. : SIG-TERM-HDL    ." SIGTERM handled ok. " ;
  30. ' SIG-TERM-HDL SIGTERM SIGNAL .
  31. SIGTERM RAISE
  32. 0 SIGTERM SIGNAL ' SIG-TERM-HDL = Y
  33.