external/cffi.darcs/_darcs/pristine/tests/misc.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; misc.lisp --- Miscellaneous tests.
   4 ;;;
   5 ;;; Copyright (C) 2006, 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
  28 (in-package #:cffi-tests)
  29
  30 ;;; From CLRFI-1
  31 (defun featurep (feature-expression)
  32   (etypecase feature-expression
  33     (symbol (not (null (member feature-expression *features*))))
  34     (cons                ; Not LIST, as we've already eliminated NIL.
  35      (ecase (first feature-expression)
  36        (:and (every #'featurep (rest feature-expression)))
  37        (:or  (some #'featurep (rest feature-expression)))
  38        (:not (not (featurep (cadr feature-expression))))))))
  39
  40 ;;;# Test relations between OS features.
  41
  42 (deftest features.os.1
  43     (if (featurep 'cffi-features:windows)
  44         (not (or (featurep 'cffi-features:unix)
  45                  (featurep 'cffi-features:darwin)))
  46         t)
  47   t)
  48
  49 (deftest features.os.2
  50     (if (featurep 'cffi-features:darwin)
  51         (and (not (featurep 'cffi-features:windows))
  52              (featurep 'cffi-features:unix))
  53         t)
  54   t)
  55
  56 (deftest features.os.3
  57     (if (featurep 'cffi-features:unix)
  58         (not (featurep 'cffi-features:windows))
  59         t)
  60   t)
  61
  62 ;;;# Test mutual exclusiveness of CPU features.
  63
  64 (defparameter *cpu-features*
  65   '(cffi-features:x86
  66     cffi-features:x86-64
  67     cffi-features:ppc32
  68     cffi-features:sparc
  69     cffi-features:sparc64
  70     cffi-features:hppa
  71     cffi-features:hppa64
  72     ))
  73
  74 (deftest features.cpu.1
  75     (loop for feature in *cpu-features*
  76           when (featurep feature)
  77           sum 1)
  78   1)
  79
  80 ;;;# foreign-symbol-pointer tests
  81
  82 ;;; This might be useful for some libraries that compare function
  83 ;;; pointers. http://thread.gmane.org/gmane.lisp.cffi.devel/694
  84 (defcfun "compare_against_abs" :boolean (p :pointer))
  85
  86 (deftest foreign-symbol-pointer.1
  87     (compare-against-abs (foreign-symbol-pointer "abs"))
  88   t)
  89
  90 (defcfun "compare_against_xpto_fun" :boolean (p :pointer))
  91
  92 (deftest foreign-symbol-pointer.2
  93     (compare-against-xpto-fun (foreign-symbol-pointer "xpto_fun"))
  94   t)
  95
  96 ;;;# Library tests
  97 ;;;
  98 ;;; Need to figure out a way to test this.  CLISP, for instance, will
  99 ;;; automatically reopen the foreign-library when we call a foreign
 100 ;;; function so we can't test CLOSE-FOREIGN-LIBRARY this way.
 101 ;;;
 102 ;;; IIRC, GCC has some extensions to have code run when a library is
 103 ;;; loaded and stuff like that.  That could work.
 104
 105 #||
 106 #-(and :ecl (not :dffi))
 107 (deftest library.close.2
 108     (unwind-protect
 109          (progn
 110            (close-foreign-library 'libtest)
 111            (ignore-errors (my-sqrtf 16.0)))
 112       (load-test-libraries))
 113   nil)
 114
 115 #-(or (and :ecl (not :dffi))
 116       cffi-features:flat-namespace
 117       cffi-features:no-foreign-funcall)
 118 (deftest library.close.2
 119     (unwind-protect
 120          (values
 121           (foreign-funcall ("ns_function" :library libtest) :boolean)
 122           (close-foreign-library 'libtest)
 123           (foreign-funcall "ns_function" :boolean)
 124           (close-foreign-library 'libtest2)
 125           (close-foreign-library 'libtest2)
 126           (ignore-errors (foreign-funcall "ns_function" :boolean)))
 127       (load-test-libraries))
 128   t t nil t nil nil)
 129 ||#
 130
 131 (deftest library.error.1
 132     (handler-case (load-foreign-library "libdoesnotexistimsure")
 133       (load-foreign-library-error () 'error))
 134   error)
 135
 136 ;;;# Shareable Byte Vector Tests
 137
 138 (deftest shareable-vector.1
 139     (let ((vector (cffi-sys::make-shareable-byte-vector 5)))
 140       (cffi::with-pointer-to-vector-data (pointer vector)
 141         (strcpy pointer "xpto"))
 142       vector)
 143   #(120 112 116 111 0))
 144
 145 (deftest shareable-vector.2
 146     (block nil
 147       (let ((vector (cffi-sys::make-shareable-byte-vector 5)))
 148         (cffi::with-pointer-to-vector-data (pointer vector)
 149           (strcpy pointer "xpto")
 150           (return vector))))
 151   #(120 112 116 111 0))