home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d556 / scheme2c.lha / Scheme2C / Scheme-doc.lzh / test / test53.sc < prev    next >
Text File  |  1991-10-11  |  3KB  |  79 lines
  1. ;;;
  2. ;;; Scheme->C test program
  3. ;;;
  4. ;;;
  5. ;;; Test functions for basic Scheme functions.
  6. ;;;
  7.  
  8. ;*              Copyright 1989 Digital Equipment Corporation
  9. ;*                         All Rights Reserved
  10. ;*
  11. ;* Permission to use, copy, and modify this software and its documentation is
  12. ;* hereby granted only under the following terms and conditions.  Both the
  13. ;* above copyright notice and this permission notice must appear in all copies
  14. ;* of the software, derivative works or modified versions, and any portions
  15. ;* thereof, and both notices must appear in supporting documentation.
  16. ;*
  17. ;* Users of this software agree to the terms and conditions set forth herein,
  18. ;* and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free
  19. ;* right and license under any changes, enhancements or extensions made to the
  20. ;* core functions of the software, including but not limited to those affording
  21. ;* compatibility with other hardware or software environments, but excluding
  22. ;* applications which incorporate this software.  Users further agree to use
  23. ;* their best efforts to return to Digital any such changes, enhancements or
  24. ;* extensions that they make and inform Digital of noteworthy uses of this
  25. ;* software.  Correspondence should be provided to Digital at:
  26. ;* 
  27. ;*                       Director of Licensing
  28. ;*                       Western Research Laboratory
  29. ;*                       Digital Equipment Corporation
  30. ;*                       100 Hamilton Avenue
  31. ;*                       Palo Alto, California  94301  
  32. ;* 
  33. ;* This software may be distributed (but not offered for sale or transferred
  34. ;* for compensation) to third parties, provided such third parties agree to
  35. ;* abide by the terms and conditions of this notice.  
  36. ;* 
  37. ;* THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL
  38. ;* WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
  39. ;* MERCHANTABILITY AND FITNESS.   IN NO EVENT SHALL DIGITAL EQUIPMENT
  40. ;* CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
  41. ;* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
  42. ;* PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
  43. ;* ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
  44. ;* SOFTWARE.
  45.  
  46. (module test53)
  47.  
  48. ;;; Loops until a key is entered on the keyboard
  49.  
  50. (define (KEY-LOOP)
  51.     (let loop () (when (char-ready?) (read-char) (loop)))
  52.     (display "Waiting for char (and a return) ...")
  53.     (flush-buffer)
  54.     (let loop ((cnt 0))
  55.      (unless (char-ready?)
  56.          (if (zero? (modulo cnt 1000))
  57.              (begin (display ".")
  58.                 (loop 1)))
  59.          (loop (+ cnt 1))))
  60.     (write (read-char))
  61.     (display " entered")
  62.     (let loop () (when (char-ready?) (read-char) (loop)))
  63.     (newline))
  64.  
  65. (define (CONTROL-C)
  66.     (display "Hit control-c ...")
  67.     (flush-buffer)
  68.     (let loop ((cnt 1))
  69.      (if (zero? (modulo cnt 10000))
  70.          (begin (display ".")
  71.             (flush-buffer)
  72.             (loop 1))
  73.          (loop (+ cnt 1)))))
  74.  
  75. (define (TEST53)
  76.     (key-loop)
  77.     (control-c))
  78.  
  79.