/usr/share/doc/cl-uffi/examples/gettime.lisp is in cl-uffi 2.1.2-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: gettime
;;;; Purpose: UFFI Example file to get time, use C structures
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************
(in-package :cl-user)
(uffi:def-foreign-type time-t :unsigned-long)
(uffi:def-struct tm
(sec :int)
(min :int)
(hour :int)
(mday :int)
(mon :int)
(year :int)
(wday :int)
(yday :int)
(isdst :int))
(uffi:def-function ("time" c-time)
((time (* time-t)))
:returning time-t)
(uffi:def-function ("localtime" c-localtime)
((time (* time-t)))
:returning (* tm))
(uffi:def-type time-t :unsigned-long)
(uffi:def-type tm-pointer (* tm))
(defun gettime ()
"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))))
#+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")))
|