X-Git-Url: http://git.kpe.io/?p=uffi.git;a=blobdiff_plain;f=tests%2Fgethostname.lisp;h=d581ccc52d45ea69f2e53de8352f51ccece3a92c;hp=a6e1b0e1afe7c33686d9de534c52f5d85fdabaa5;hb=b86fdf882156aa45dc6e8e93a158dedf506f4233;hpb=77378d36f07fe1f11893444217716b01628a329f diff --git a/tests/gethostname.lisp b/tests/gethostname.lisp index a6e1b0e..d581ccc 100644 --- a/tests/gethostname.lisp +++ b/tests/gethostname.lisp @@ -2,65 +2,49 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: gethostname.cl +;;;; Name: gethostname.lisp ;;;; Purpose: UFFI Example file to get hostname of system ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: gethostname.lisp,v 1.3 2002/12/02 13:21:43 kevin Exp $ +;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg ;;;; -;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; UFFI users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package :cl-user) +(in-package #:uffi-tests) ;;; This example is inspired by the example on the CL-Cookbook web site -(uffi:def-function ("gethostname" c-gethostname) - ((name (* :unsigned-char)) - (len :int)) - :returning :int) - -(defun gethostname () - "Returns the hostname" - (let* ((name (uffi:allocate-foreign-string 256)) - (result-code (c-gethostname name 256)) - (hostname (when (zerop result-code) - (uffi:convert-from-foreign-string name)))) - (uffi:free-foreign-object name) - (unless (zerop result-code) - (error "gethostname() failed.")) - hostname)) - -(defun gethostname2 () - "Returns the hostname" - (uffi:with-foreign-object (name '(:array :unsigned-char 256)) - (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256)) - (uffi:convert-from-foreign-string name) - (error "gethostname() failed.")))) - -#+examples-uffi -(progn - (format t "~&Hostname (technique 1): ~A" (gethostname)) - (format t "~&Hostname (technique 2): ~A" (gethostname2))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (uffi:def-function ("gethostname" c-gethostname) + ((name (* :unsigned-char)) + (len :int)) + :returning :int) + + (defun gethostname () + "Returns the hostname" + (let* ((name (uffi:allocate-foreign-string 256)) + (result-code (c-gethostname name 256)) + (hostname (when (zerop result-code) + (uffi:convert-from-foreign-string name)))) + (uffi:free-foreign-object name) + (unless (zerop result-code) + (error "gethostname() failed.")) + hostname)) + + (defun gethostname2 () + "Returns the hostname" + (uffi:with-foreign-object (name '(:array :unsigned-char 256)) + (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256)) + (uffi:convert-from-foreign-string name) + (error "gethostname() failed."))))) + +(deftest :gethostname.1 (stringp (gethostname)) t) +(deftest :gethostname.2 (stringp (gethostname2)) t) +(deftest :gethostname.3 (plusp (length (gethostname))) t) +(deftest :gethostname.4 (plusp (length (gethostname2))) t) +(deftest :gethostname.5 (string= (gethostname) (gethostname2)) t) -#+test-uffi -(progn - (let ((hostname1 (gethostname)) - (hostname2 (gethostname2))) - - (util.test:test (and (stringp hostname1) (stringp hostname2)) t - :fail-info "gethostname not string") - (util.test:test (and (not (zerop (length hostname1))) - (not (zerop (length hostname2)))) t - :fail-info "gethostname length 0") - (util.test:test (string= hostname1 hostname1) t - :fail-info "gethostname techniques don't match")) - )