X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=examples%2Fgettime.cl;h=c562fade74e514648dace5c253ed1d531a32c08c;hb=4464cb9bed614c141d39ffaf72328cfc4d5a1452;hp=be0bdee36ddf6be971ae2ca89f4d25574c31b9cd;hpb=baabff1a8dbf4813072d87f6977cd488c376fe56;p=uffi.git diff --git a/examples/gettime.cl b/examples/gettime.cl index be0bdee..c562fad 100644 --- a/examples/gettime.cl +++ b/examples/gettime.cl @@ -2,34 +2,23 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: getenv.cl -;;;; Purpose: UFFI Example file to get time +;;;; Name: gettime +;;;; Purpose: UFFI Example file to get time, use C structures ;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Mar 2002 +;;;; Date Started: Feb 2002 ;;;; -;;;; Copyright (c) 2002 Kevin M. Rosenberg +;;;; $Id: gettime.cl,v 1.9 2002/04/02 23:27:05 kevin Exp $ ;;;; -;;;; $Id: gettime.cl,v 1.3 2002/03/10 04:15:33 kevin Exp $ +;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; -;;;; This file is part of UFFI. -;;;; -;;;; UFFI is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License (version 2) as -;;;; published by the Free Software Foundation. -;;;; -;;;; UFFI is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with UFFI; if not, write to the Free Software Foundation, Inc., -;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +;;;; 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) -(uffi:def-type time-t :unsigned-long) +(uffi:def-foreign-type time-t :unsigned-long) (uffi:def-struct tm (sec :int) @@ -50,24 +39,38 @@ ((time (* time-t))) :returning (* tm)) +(uffi:def-type time-t :unsigned-long) +(uffi:def-type tm-pointer (* tm)) + (defun gettime () - "Returns the local time" - (let* ((time (uffi:allocate-foreign-object time-t))) - (c-time time) - (let* ((tm-ptr (c-localtime time)) - (time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d" - (1+ (uffi:get-slot-value tm-ptr 'mon 'tm)) - (uffi:get-slot-value tm-ptr 'mday 'tm) - (+ 1900 (uffi:get-slot-value tm-ptr 'year 'tm)) - (uffi:get-slot-value tm-ptr 'hour 'tm) - (uffi:get-slot-value tm-ptr 'min 'tm) - (uffi:get-slot-value tm-ptr 'sec 'tm) - ))) - (uffi:free-foreign-object time) - time-string) - )) + "Returns the local time" + (uffi:with-foreign-object (time 'time-t) +;; (declare (type time-t time)) + (c-time time) + (let ((tm-ptr (the tm-pointer (c-localtime time)))) + (declare (type tm-pointer tm-ptr)) + (let ((time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d" + (1+ (uffi:get-slot-value tm-ptr 'tm 'mon)) + (uffi:get-slot-value tm-ptr 'tm 'mday) + (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year)) + (uffi:get-slot-value tm-ptr 'tm 'hour) + (uffi:get-slot-value tm-ptr 'tm 'min) + (uffi:get-slot-value tm-ptr 'tm 'sec) + ))) + time-string)))) -#+test-uffi + + + +#+examples-uffi (format t "~&~A" (gettime)) +#+test-uffi +(progn + (let ((time (gettime))) + (util.test:test (stringp time) t :fail-info "Time is not a string") + (util.test:test (plusp (parse-integer time :junk-allowed t)) + t + :fail-info "time string does not start with a number"))) +