X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Fgethostname.lisp;h=c5ef751776b3784460046679b185b15e010db9e7;hb=0824453227a26da41a3929c9117b66714980414b;hp=909811487b39e8ad6b1421a24c71e820c0a52fb6;hpb=a95b9a217335917d96b8c0cced4f49c3e4846115;p=uffi.git diff --git a/tests/gethostname.lisp b/tests/gethostname.lisp index 9098114..c5ef751 100644 --- a/tests/gethostname.lisp +++ b/tests/gethostname.lisp @@ -2,64 +2,51 @@ ;;;; ************************************************************************* ;;;; 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.1 2002/09/30 10:02:36 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; This file, part of UFFI, is Copyright (c) 2002-2003 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) +(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) -(defun gethostname () - "Returns the hostname" - (let* ((name (uffi:allocate-foreign-string 256)) - (result (c-gethostname name 256))) - (unwind-protect - (if (zerop result) - (uffi:convert-from-foreign-string name) - (error "gethostname() failed.")) - (uffi:free-foreign-object name)))) - -(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))) - -#+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")) - )