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