tests/gethostname.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          gethostname.lisp
   6 ;;;; Purpose:       UFFI Example file to get hostname of system
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; *************************************************************************
  15
  16 (in-package #:uffi-tests)
  17
  18
  19 ;;; This example is inspired by the example on the CL-Cookbook web site
  20
  21 (eval-when (:compile-toplevel :load-toplevel :execute)
  22   (uffi:def-function ("gethostname" c-gethostname)
  23       ((name (* :unsigned-char))
  24        (len :int))
  25     :returning :int)
  26
  27   (defun gethostname ()
  28     "Returns the hostname"
  29     (let* ((name (uffi:allocate-foreign-string 256))
  30            (result-code (c-gethostname name 256))
  31            (hostname (when (zerop result-code)
  32                        (uffi:convert-from-foreign-string name))))
  33       (uffi:free-foreign-object name)
  34       (unless (zerop result-code)
  35         (error "gethostname() failed."))
  36       hostname))
  37
  38   (defun gethostname2 ()
  39     "Returns the hostname"
  40     (uffi:with-foreign-object (name '(:array :unsigned-char 256))
  41       (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256))
  42           (uffi:convert-from-foreign-string name)
  43           (error "gethostname() failed.")))))
  44
  45 (deftest gethostname.1 (stringp (gethostname)) t)
  46 (deftest gethostname.2 (stringp (gethostname2)) t)
  47 (deftest gethostname.3 (plusp (length (gethostname))) t)
  48 (deftest gethostname.4 (plusp (length (gethostname2))) t)
  49 (deftest gethostname.5 (string= (gethostname) (gethostname2)) t)
  50
  51
  52