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 / test19.sc < prev    next >
Text File  |  1991-10-11  |  4KB  |  97 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 test19)
  47.  
  48. (define-external (chk test-number result expected) testchk)
  49.  
  50. (define (TEST19)
  51.     
  52.     ;;; 6.10  I/O tests.
  53.  
  54.     (let ((port (open-input-string "*")))
  55.      (chk 1 (peek-char port) #\*)
  56.      (chk 2 (peek-char port) #\*)
  57.      (chk 3 (read-char port) #\*)
  58.      (chk 4 (eof-object? (read-char port)) #t)
  59.      (chk 5 (eof-object? (peek-char port)) #t)
  60.      (chk 6 (char-ready? port) #t))
  61.  
  62.     (with-output-to-file "test19.tmp"
  63.     (lambda ()
  64.         (write-char #\*)
  65.         (chk 10 (write-count) 1)
  66.         (chk 11 (write-width) 80)
  67.         (set-write-width! 132)
  68.         (chk 12 (write-width) 132)))
  69.  
  70.     (with-input-from-file "test19.tmp"
  71.     (lambda ()
  72.         (chk 20 (char-ready?) #t)
  73.         (chk 21 (peek-char) #\*)
  74.         (chk 22 (peek-char) #\*)
  75.         (chk 23 (read-char) #\*)
  76.         (chk 24 (eof-object? (read-char)) #t)
  77.         (chk 25 (eof-object? (peek-char)) #t)
  78.         (chk 26 (char-ready?) #t)))
  79.  
  80.     (with-output-to-file "test19.tmp"
  81.     (lambda ()
  82.         (with-input-from-file "test19.tmp"
  83.             (lambda ()
  84.                 (display 'a)
  85.                 (chk 30 (eof-object? (read)) #t)
  86.                 (flush-buffer)
  87.                 (chk 31 (read) 'a)))))
  88.  
  89.     (chk 40 (number? (port->stdio-file stderr-port)) #t)
  90.  
  91.     (chk 50 (format "~%") (list->string '(#\newline)))
  92.     (chk 51 (format "~a~s" "a" "a") "a\"a\"")
  93.     (chk 52 (format "~A~S" "a" "a") "a\"a\"")
  94.     (chk 53 (format "~c~C" #\a #\a) "aa")
  95.     (chk 54 (format "~~") "~")
  96. )
  97.