mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-12 23:00:22 +02:00
More of: New file.
This commit is contained in:
Kevin Ryde
parent
409eb4e54f
commit
c065f32614
1 changed files with 223 additions and 58 deletions
|
|
@ -26,60 +26,211 @@
|
||||||
(begin
|
(begin
|
||||||
|
|
||||||
(define-module (test-suite test-ice-9-slib)
|
(define-module (test-suite test-ice-9-slib)
|
||||||
#:duplicates (last) ;; avoid warnings about various replacements
|
|
||||||
#:use-module (test-suite lib)
|
#:use-module (test-suite lib)
|
||||||
#:use-module (ice-9 slib))
|
#:use-module (ice-9 slib))
|
||||||
|
|
||||||
;;
|
|
||||||
;; delete-file
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; in guile 1.6.4 and earlier delete-file didn't match the slib spec
|
(with-test-prefix "Configuration"
|
||||||
(with-test-prefix "delete-file"
|
|
||||||
(pass-if "non existant file"
|
|
||||||
(eq? #f (delete-file "nosuchfile")))
|
|
||||||
(pass-if "existing file"
|
|
||||||
(call-with-output-file "slibtest.tmp" noop)
|
|
||||||
(eq? #t (delete-file "slibtest.tmp"))))
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; browse-url
|
;; char-code-limit
|
||||||
;;
|
;;
|
||||||
|
|
||||||
(with-test-prefix "browse-url"
|
(with-test-prefix "char-code-limit"
|
||||||
(pass-if (procedure? browse-url)))
|
(pass-if "integer" (integer? char-code-limit)))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; call-with-open-ports
|
;; most-positive-fixnum
|
||||||
;;
|
;;
|
||||||
|
|
||||||
(with-test-prefix "call-with-open-ports"
|
(with-test-prefix "most-positive-fixnum"
|
||||||
(pass-if (procedure? call-with-open-ports))
|
(pass-if "integer" (integer? most-positive-fixnum)))
|
||||||
|
|
||||||
(pass-if "close on return"
|
|
||||||
(let ((port (open-input-file "/dev/null")))
|
|
||||||
(call-with-open-ports port (lambda (port) #f))
|
|
||||||
(port-closed? port))))
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; nil
|
;; slib:form-feed
|
||||||
;;
|
;;
|
||||||
|
|
||||||
;; in guile 1.6.4 and earlier this was missing
|
(with-test-prefix "slib:form-feed"
|
||||||
(with-test-prefix "nil"
|
;; in guile 1.6.4 this wasn't exported
|
||||||
(pass-if (eq? #f nil)))
|
(pass-if "char" (char? slib:form-feed)))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; open-file
|
;; slib:report
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:report"
|
||||||
|
(pass-if "exists" (procedure? slib:report)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:report-version
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:report-version"
|
||||||
|
(pass-if "exists" (procedure? slib:report-version)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:tab
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:tab"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "char" (char? slib:tab)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; software-type
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "software-type"
|
||||||
|
(pass-if "exists" (procedure? software-type))))
|
||||||
|
|
||||||
|
|
||||||
|
(with-test-prefix "Input/Output"
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; call-with-open-ports
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "call-with-open-ports"
|
||||||
|
(pass-if "exists" (procedure? call-with-open-ports))
|
||||||
|
|
||||||
|
(pass-if "close on return"
|
||||||
|
(let ((port (open-input-file "/dev/null")))
|
||||||
|
(call-with-open-ports port (lambda (port) #f))
|
||||||
|
(port-closed? port))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; delete-file
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; in guile 1.6.4 and earlier delete-file didn't match the slib spec
|
||||||
|
(with-test-prefix "delete-file"
|
||||||
|
(pass-if "non existant file"
|
||||||
|
(eq? #f (delete-file "nosuchfile")))
|
||||||
|
(pass-if "existing file"
|
||||||
|
(call-with-output-file "slibtest.tmp" noop)
|
||||||
|
(eq? #t (delete-file "slibtest.tmp"))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; output-port-height
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "output-port-height"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? output-port-height)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; output-port-width
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "output-port-width"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? output-port-width)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; open-file
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; this style open-file is only a requirement in slib 3a1 and up, but
|
||||||
|
;; we provide it always
|
||||||
|
(with-test-prefix "open-file"
|
||||||
|
(pass-if "r" (port? (open-file "/dev/null" 'r)))
|
||||||
|
(pass-if "rb" (port? (open-file "/dev/null" 'rb)))
|
||||||
|
(pass-if "w" (port? (open-file "/dev/null" 'w)))
|
||||||
|
(pass-if "wb" (port? (open-file "/dev/null" 'wb)))))
|
||||||
|
|
||||||
|
|
||||||
|
(with-test-prefix "System stuff"
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; browse-url
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "browse-url"
|
||||||
|
(pass-if "exists" (procedure? browse-url)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:error
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:error"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? slib:error)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:eval
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:eval"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? slib:eval)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:eval-load
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:eval-load"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? slib:eval-load)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:exit
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:exit"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? slib:exit)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:load
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:load"
|
||||||
|
(pass-if "exists" (procedure? slib:load)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:load-source
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:load-source"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? slib:load-source)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; slib:warn
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "slib:warn"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? slib:warn))))
|
||||||
|
|
||||||
|
|
||||||
|
(with-test-prefix "Miscellany"
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; identity
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "identity"
|
||||||
|
(pass-if "exists" (procedure? identity)))
|
||||||
|
|
||||||
|
(with-test-prefix "Legacy"
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; nil
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; in guile 1.6.4 and earlier this was missing
|
||||||
|
(with-test-prefix "nil"
|
||||||
|
(pass-if "value" (eq? #f nil)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; t
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; in guile 1.6.4 and earlier this was missing
|
||||||
|
(with-test-prefix "t"
|
||||||
|
(pass-if "value" (eq? #t t)))))
|
||||||
|
|
||||||
;; this style open-file is only a requirement in slib 3a1 and up, but
|
|
||||||
;; we provide it always
|
|
||||||
(with-test-prefix "open-file"
|
|
||||||
(pass-if (port? (open-file "/dev/null" 'r)))
|
|
||||||
(pass-if (port? (open-file "/dev/null" 'rb)))
|
|
||||||
(pass-if (port? (open-file "/dev/null" 'w)))
|
|
||||||
(pass-if (port? (open-file "/dev/null" 'wb))))
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; rev2-procedures
|
;; rev2-procedures
|
||||||
|
|
@ -89,12 +240,13 @@
|
||||||
;; these existed, but they didn't
|
;; these existed, but they didn't
|
||||||
(with-test-prefix "rev2-procedures"
|
(with-test-prefix "rev2-procedures"
|
||||||
(require 'rev2-procedures)
|
(require 'rev2-procedures)
|
||||||
(pass-if (procedure? -1+))
|
(pass-if "-1+" (procedure? -1+))
|
||||||
(pass-if (procedure? <?))
|
(pass-if "<?" (procedure? <?))
|
||||||
(pass-if (procedure? <=?))
|
(pass-if "<=?" (procedure? <=?))
|
||||||
(pass-if (procedure? =?))
|
(pass-if "=?" (procedure? =?))
|
||||||
(pass-if (procedure? >?))
|
(pass-if ">?" (procedure? >?))
|
||||||
(pass-if (procedure? >=?)))
|
(pass-if ">=?" (procedure? >=?)))
|
||||||
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; system
|
;; system
|
||||||
|
|
@ -102,17 +254,29 @@
|
||||||
|
|
||||||
;; in guile 1.6.4 and earlier system didn't match the slib spec
|
;; in guile 1.6.4 and earlier system didn't match the slib spec
|
||||||
(with-test-prefix "system"
|
(with-test-prefix "system"
|
||||||
(pass-if (= 0 (system "exit 0")))
|
(pass-if "exit 0" (= 0 (system "exit 0")))
|
||||||
(pass-if (= 1 (system "exit 1")))
|
(pass-if "exit 1" (= 1 (system "exit 1")))
|
||||||
(pass-if (= 99 (system "exit 99"))))
|
(pass-if "exit 99" (= 99 (system "exit 99"))))
|
||||||
|
|
||||||
;;
|
|
||||||
;; t
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; in guile 1.6.4 and earlier this was missing
|
(with-test-prefix "Time"
|
||||||
(with-test-prefix "t"
|
|
||||||
(pass-if (eq? #t t)))
|
;;
|
||||||
|
;; difftime
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "difftime"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? difftime)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; offset-time
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "offset-time"
|
||||||
|
;; in guile 1.6.4 this wasn't exported
|
||||||
|
(pass-if "exists" (procedure? offset-time))))
|
||||||
|
|
||||||
|
|
||||||
(require 'array)
|
(require 'array)
|
||||||
(with-test-prefix "array"
|
(with-test-prefix "array"
|
||||||
|
|
@ -124,4 +288,5 @@
|
||||||
;; create-array isn't in old slib, but when it exists it should work
|
;; create-array isn't in old slib, but when it exists it should work
|
||||||
(if (defined? 'create-array)
|
(if (defined? 'create-array)
|
||||||
(with-test-prefix "create-array"
|
(with-test-prefix "create-array"
|
||||||
(pass-if (array? (create-array (As32 0) '(0 1)))))))))
|
(pass-if "As32 create"
|
||||||
|
(array? (create-array (As32 0) '(0 1)))))))))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue