tests/objects.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          pointers.lisp
   6 ;;;; Purpose:       Test file for UFFI pointers
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Aug 2003
   9 ;;;;
  10 ;;;; This file, part of UFFI, is Copyright (c) 2003-2010 by Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (in-package #:uffi-tests)
  15
  16 (deftest :chptr.1
  17     (let ((native-string "test string"))
  18       (uffi:with-foreign-string (fs native-string)
  19         (ensure-char-character
  20          (deref-pointer fs :char))))
  21   #\t)
  22
  23 (deftest :chptr.2
  24     (let ((native-string "test string"))
  25       (uffi:with-foreign-string (fs native-string)
  26         (ensure-char-character
  27          (deref-pointer fs :unsigned-char))))
  28   #\t)
  29
  30 (deftest :chptr.3
  31     (let ((native-string "test string"))
  32       (uffi:with-foreign-string (fs native-string)
  33         (ensure-char-integer
  34          (deref-pointer fs :unsigned-char))))
  35   116)
  36
  37 (deftest :chptr.4
  38     (let ((native-string "test string"))
  39       (uffi:with-foreign-string (fs native-string)
  40         (integerp
  41          (ensure-char-integer
  42           (deref-pointer fs :unsigned-char)))))
  43   t)
  44
  45 (deftest :chptr.5
  46     (let ((fs (uffi:allocate-foreign-object :unsigned-char 128)))
  47       (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
  48             (uffi:ensure-char-storable #\a))
  49       (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
  50             (uffi:ensure-char-storable (code-char 0)))
  51       (uffi:convert-from-foreign-string fs))
  52   "a")
  53
  54 ;; This produces an array which needs fli:foreign-aref to access
  55 ;; rather than fli:dereference
  56
  57 #-lispworks
  58 (deftest :chptr.6
  59     (uffi:with-foreign-object (fs '(:array :unsigned-char 128))
  60       (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
  61             (uffi:ensure-char-storable #\a))
  62       (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
  63             (uffi:ensure-char-storable (code-char 0)))
  64       (uffi:convert-from-foreign-string fs))
  65   "a")
  66
  67
  68