File: pointers.lisp

package info (click to toggle)
cl-uffi 1.4.37-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 708 kB
  • ctags: 378
  • sloc: lisp: 3,408; xml: 2,889; makefile: 229; ansic: 169; sh: 74
file content (69 lines) | stat: -rw-r--r-- 2,067 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          pointers.lisp
;;;; Purpose:       Test file for UFFI pointers
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  Aug 2003
;;;;
;;;; $Id: pointers.lisp 9839 2004-08-03 14:45:58Z kevin $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2003 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************

(in-package #:uffi-tests)

(deftest chptr.1
    (let ((native-string "test string"))
      (uffi:with-foreign-string (fs native-string)
	(ensure-char-character
	 (deref-pointer fs :char))))
  #\t)

(deftest chptr.2
    (let ((native-string "test string"))
      (uffi:with-foreign-string (fs native-string)
	(ensure-char-character
	 (deref-pointer fs :unsigned-char))))
  #\t)

(deftest chptr.3
    (let ((native-string "test string"))
      (uffi:with-foreign-string (fs native-string)
	(ensure-char-integer
	 (deref-pointer fs :unsigned-char))))
  116)

(deftest chptr.4
    (let ((native-string "test string"))
      (uffi:with-foreign-string (fs native-string)
	(numberp
	 (deref-pointer fs :byte))))
  t)
	
(deftest chptr.5
    (let ((fs (uffi:allocate-foreign-object :unsigned-char 128)))
      (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
	    (uffi:ensure-char-storable #\a))
      (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
	    (uffi:ensure-char-storable (code-char 0)))
      (uffi:convert-from-foreign-string fs))
  "a")

;; This produces an array which needs fli:foreign-aref to access
;; rather than fli:dereference

#-lispworks
(deftest chptr.6
    (uffi:with-foreign-object (fs '(:array :unsigned-char 128))
      (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
	    (uffi:ensure-char-storable #\a))
      (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
	    (uffi:ensure-char-storable (code-char 0)))
      (uffi:convert-from-foreign-string fs))
  "a")