tests/gethostname.lisp

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