test-suite/tests/slib.test

   1 ;;;; slib.test --- Test suite for Guile's SLIB glue. -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright 2003, 2004 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This program is free software; you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation; either version 2, or (at your option)
   8 ;;;; any later version.
   9 ;;;;
  10 ;;;; This program is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with this software; see the file COPYING.  If not, write to
  17 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  18 ;;;; Boston, MA 02110-1301 USA
  19
  20 ;; These tests are run only if slib is available.  slib will need to be
  21 ;; installed (or linked) under the configured guile $prefix.
  22 ;;
  23 (if (catch #t
  24       (lambda () (resolve-module '(ice-9 slib)))
  25       (lambda args #f))
  26     (begin
  27
  28       (define-module (test-suite test-ice-9-slib)
  29         #:use-module (test-suite lib)
  30         #:use-module (ice-9 slib))
  31
  32
  33       (with-test-prefix "Configuration"
  34
  35         ;;
  36         ;; char-code-limit
  37         ;;
  38
  39         (with-test-prefix "char-code-limit"
  40           (pass-if "integer" (integer? char-code-limit)))
  41
  42         ;;
  43         ;; most-positive-fixnum
  44         ;;
  45
  46         (with-test-prefix "most-positive-fixnum"
  47           (pass-if "integer" (integer? most-positive-fixnum)))
  48
  49         ;;
  50         ;; slib:form-feed
  51         ;;
  52
  53         (with-test-prefix "slib:form-feed"
  54           ;; in guile 1.6.4 this wasn't exported
  55           (pass-if "char" (char? slib:form-feed)))
  56
  57         ;;
  58         ;; slib:report
  59         ;;
  60
  61         (with-test-prefix "slib:report"
  62           (pass-if "exists" (procedure? slib:report)))
  63
  64         ;;
  65         ;; slib:report-version
  66         ;;
  67
  68         (with-test-prefix "slib:report-version"
  69           (pass-if "exists" (procedure? slib:report-version)))
  70
  71         ;;
  72         ;; slib:tab
  73         ;;
  74
  75         (with-test-prefix "slib:tab"
  76           ;; in guile 1.6.4 this wasn't exported
  77           (pass-if "char" (char? slib:tab)))
  78
  79         ;;
  80         ;; software-type
  81         ;;
  82
  83         (with-test-prefix "software-type"
  84           (pass-if "exists" (procedure? software-type))))
  85
  86
  87       (with-test-prefix "Input/Output"
  88
  89         ;;
  90         ;; call-with-open-ports
  91         ;;
  92
  93         (with-test-prefix "call-with-open-ports"
  94           (pass-if "exists" (procedure? call-with-open-ports))
  95
  96           (pass-if "close on return"
  97             (let ((port (open-input-file "/dev/null")))
  98               (call-with-open-ports port (lambda (port) #f))
  99               (port-closed? port))))
 100
 101         ;;
 102         ;; delete-file
 103         ;;
 104
 105         ;; in guile 1.6.4 and earlier delete-file didn't match the slib spec
 106         (with-test-prefix "delete-file"
 107           (pass-if "non existant file"
 108             (eq? #f (delete-file "nosuchfile")))
 109           (pass-if "existing file"
 110             (call-with-output-file "slibtest.tmp" noop)
 111             (eq? #t (delete-file "slibtest.tmp"))))
 112
 113         ;;
 114         ;; output-port-height
 115         ;;
 116
 117         (with-test-prefix "output-port-height"
 118           ;; in guile 1.6.4 this wasn't exported
 119           (pass-if "exists" (procedure? output-port-height)))
 120
 121         ;;
 122         ;; output-port-width
 123         ;;
 124
 125         (with-test-prefix "output-port-width"
 126           ;; in guile 1.6.4 this wasn't exported
 127           (pass-if "exists" (procedure? output-port-width)))
 128
 129         ;;
 130         ;; open-file
 131         ;;
 132
 133         ;; this style open-file is only a requirement in slib 3a1 and up, but
 134         ;; we provide it always
 135         (with-test-prefix "open-file"
 136           (pass-if "r"  (port? (open-file "/dev/null" 'r)))
 137           (pass-if "rb" (port? (open-file "/dev/null" 'rb)))
 138           (pass-if "w"  (port? (open-file "/dev/null" 'w)))
 139           (pass-if "wb" (port? (open-file "/dev/null" 'wb)))))
 140
 141
 142       (with-test-prefix "System stuff"
 143
 144         ;;
 145         ;; browse-url
 146         ;;
 147
 148         (with-test-prefix "browse-url"
 149           (pass-if "exists" (procedure? browse-url)))
 150
 151         ;;
 152         ;; slib:error
 153         ;;
 154
 155         (with-test-prefix "slib:error"
 156           ;; in guile 1.6.4 this wasn't exported
 157           (pass-if "exists" (procedure? slib:error)))
 158
 159         ;;
 160         ;; slib:eval
 161         ;;
 162
 163         (with-test-prefix "slib:eval"
 164           ;; in guile 1.6.4 this wasn't exported
 165           (pass-if "exists" (procedure? slib:eval)))
 166
 167         ;;
 168         ;; slib:eval-load
 169         ;;
 170
 171         (with-test-prefix "slib:eval-load"
 172           ;; in guile 1.6.4 this wasn't exported
 173           (pass-if "exists" (procedure? slib:eval-load)))
 174
 175         ;;
 176         ;; slib:exit
 177         ;;
 178
 179         (with-test-prefix "slib:exit"
 180           ;; in guile 1.6.4 this wasn't exported
 181           (pass-if "exists" (procedure? slib:exit)))
 182
 183         ;;
 184         ;; slib:load
 185         ;;
 186
 187         (with-test-prefix "slib:load"
 188           (pass-if "exists" (procedure? slib:load)))
 189
 190         ;;
 191         ;; slib:load-source
 192         ;;
 193
 194         (with-test-prefix "slib:load-source"
 195           ;; in guile 1.6.4 this wasn't exported
 196           (pass-if "exists" (procedure? slib:load-source)))
 197
 198         ;;
 199         ;; slib:warn
 200         ;;
 201
 202         (with-test-prefix "slib:warn"
 203           ;; in guile 1.6.4 this wasn't exported
 204           (pass-if "exists" (procedure? slib:warn))))
 205
 206
 207       (with-test-prefix "Miscellany"
 208
 209         ;;
 210         ;; identity
 211         ;;
 212
 213         (with-test-prefix "identity"
 214           (pass-if "exists" (procedure? identity)))
 215
 216         (with-test-prefix "Legacy"
 217
 218           ;;
 219           ;; nil
 220           ;;
 221
 222           ;; in guile 1.6.4 and earlier this was missing
 223           (with-test-prefix "nil"
 224             (pass-if "value" (eq? #f nil)))
 225
 226           ;;
 227           ;; t
 228           ;;
 229
 230           ;; in guile 1.6.4 and earlier this was missing
 231           (with-test-prefix "t"
 232             (pass-if "value" (eq? #t t)))))
 233
 234
 235       ;;
 236       ;; rev2-procedures
 237       ;;
 238
 239       ;; in guile 1.6.4 the 'rev2-procedures feature we defined claimed
 240       ;; these existed, but they didn't
 241       (with-test-prefix "rev2-procedures"
 242         (require 'rev2-procedures)
 243         (pass-if "-1+" (procedure? -1+))
 244         (pass-if "<?"  (procedure? <?))
 245         (pass-if "<=?" (procedure? <=?))
 246         (pass-if "=?"  (procedure? =?))
 247         (pass-if ">?"  (procedure? >?))
 248         (pass-if ">=?" (procedure? >=?)))
 249
 250
 251       ;;
 252       ;; system
 253       ;;
 254
 255       ;; in guile 1.6.4 and earlier system didn't match the slib spec
 256       (with-test-prefix "system"
 257         (pass-if "exit 0"  (= 0  (system "exit 0")))
 258         (pass-if "exit 1"  (= 1  (system "exit 1")))
 259         (pass-if "exit 99" (= 99 (system "exit 99"))))
 260
 261
 262       (with-test-prefix "Time"
 263
 264         ;;
 265         ;; difftime
 266         ;;
 267
 268         (with-test-prefix "difftime"
 269           ;; in guile 1.6.4 this wasn't exported
 270           (pass-if "exists" (procedure? difftime)))
 271
 272         ;;
 273         ;; offset-time
 274         ;;
 275
 276         (with-test-prefix "offset-time"
 277           ;; in guile 1.6.4 this wasn't exported
 278           (pass-if "exists" (procedure? offset-time))))
 279
 280
 281       (require 'array)
 282       (with-test-prefix "array"
 283
 284         ;;
 285         ;; create-array
 286         ;;
 287
 288         ;; create-array isn't in old slib, but when it exists it should work
 289         (if (defined? 'create-array)
 290             (with-test-prefix "create-array"
 291               (pass-if "As32 create"
 292                 (array? (create-array (As32 0) '(0 1)))))))))