tests.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/ (DIR) Log (DIR) Files (DIR) Refs (DIR) Tags (DIR) README (DIR) LICENSE --- tests.lisp (4001B) --- 1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 ;;; 3 ;;; tests.lisp --- trivial-features tests. 4 ;;; 5 ;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net> 6 ;;; 7 ;;; Permission is hereby granted, free of charge, to any person 8 ;;; obtaining a copy of this software and associated documentation 9 ;;; files (the "Software"), to deal in the Software without 10 ;;; restriction, including without limitation the rights to use, copy, 11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 12 ;;; of the Software, and to permit persons to whom the Software is 13 ;;; furnished to do so, subject to the following conditions: 14 ;;; 15 ;;; The above copyright notice and this permission notice shall be 16 ;;; included in all copies or substantial portions of the Software. 17 ;;; 18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 21 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 25 ;;; DEALINGS IN THE SOFTWARE. 26 27 (in-package :trivial-features-tests) 28 29 (defun run () 30 (let ((*package* (find-package :trivial-features-tests))) 31 (do-tests) 32 (null (regression-test:pending-tests)))) 33 34 ;;;; Support Code 35 36 #-windows 37 (progn 38 ;; Hmm, why not just use OSICAT-POSIX:UNAME? 39 (defcfun ("uname" %uname) :int 40 (buf :pointer)) 41 42 ;; Get system identification. 43 (defun uname () 44 (with-foreign-object (buf '(:struct utsname)) 45 (when (= (%uname buf) -1) 46 (error "uname() returned -1")) 47 (macrolet ((utsname-slot (name) 48 `(foreign-string-to-lisp 49 (foreign-slot-pointer buf 'utsname ',name)))) 50 (values (utsname-slot sysname) 51 ;; (utsname-slot nodename) 52 ;; (utsname-slot release) 53 ;; (utsname-slot version) 54 (utsname-slot machine)))))) 55 56 (defun mutually-exclusive-p (features) 57 (= 1 (loop for feature in features when (featurep feature) count 1))) 58 59 ;;;; Tests 60 61 (deftest endianness.1 62 (with-foreign-object (p :uint16) 63 (setf (mem-ref p :uint16) #xfeff) 64 (ecase (mem-ref p :uint8) 65 (#xfe (featurep :big-endian)) 66 (#xff (featurep :little-endian)))) 67 t) 68 69 (defparameter *bsds* '(:darwin :netbsd :openbsd :freebsd)) 70 (defparameter *unices* (list* :linux *bsds*)) 71 72 #+windows 73 (deftest os.1 74 (featurep (list* :or :unix *unices*)) 75 nil) 76 77 #-windows 78 (deftest os.1 79 (featurep (make-keyword (string-upcase (uname)))) 80 t) 81 82 (deftest os.2 83 (if (featurep :bsd) 84 (mutually-exclusive-p *bsds*) 85 (featurep `(:not (:or ,@*bsds*)))) 86 t) 87 88 (deftest os.3 89 (if (featurep `(:or ,@*unices*)) 90 (featurep :unix) 91 t) 92 t) 93 94 (deftest os.4 95 (if (featurep :windows) 96 (not (featurep :unix)) 97 t) 98 t) 99 100 (deftest cpu.1 101 (mutually-exclusive-p '(:ppc :ppc64 :x86 :x86-64 :alpha :mips)) 102 t) 103 104 #+windows 105 (deftest cpu.2 106 (case (get-system-info) 107 (:intel (featurep :x86)) 108 (:amd64 (featurep :x86-64)) 109 (:ia64 nil) ; add this feature later! 110 (t t)) 111 t) 112 113 #-windows 114 (deftest cpu.2 115 (let ((machine (nth-value 1 (uname)))) 116 (cond ((member machine '("x86" "x86_64") :test #'string=) 117 (ecase (foreign-type-size :pointer) 118 (4 (featurep :x86)) 119 (8 (featurep :x86-64)))) 120 (t 121 (format *debug-io* 122 "~&; NOTE: unhandled machine type, ~a, in CPU.2 test.~%" 123 machine) 124 t))) 125 t) 126 127 (deftest cpu.3 128 (ecase (foreign-type-size :pointer) 129 (4 (featurep :32-bit)) 130 (8 (featurep :64-bit))) 131 t) 132 133 ;; regression test: sometimes, silly logic leads to pushing nil to 134 ;; *features*. 135 (deftest nil.1 (featurep nil) nil) 136 (deftest nil.2 (featurep :nil) nil)