X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftime.lisp;fp=tests%2Ftime.lisp;h=0dd1816d22aa6881c6acfacaacec8b190ba20eab;hb=33b8a5afb55eb161ef04a1be94e6d2dca85c748c;hp=0000000000000000000000000000000000000000;hpb=32a1ec81381452961a16a0dea1aff5711d4a3ed0;p=uffi.git diff --git a/tests/time.lisp b/tests/time.lisp new file mode 100644 index 0000000..0dd1816 --- /dev/null +++ b/tests/time.lisp @@ -0,0 +1,68 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: time.lisp +;;;; Purpose: UFFI test file, time, use C structures +;;;; Author: Kevin M. Rosenberg +;;;; Date Started: Feb 2002 +;;;; +;;;; $Id: time.lisp,v 1.1 2003/04/30 14:06:14 kevin Exp $ +;;;; +;;;; This file, part of UFFI, is Copyright (c) 2002 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 :uffi-tests) + +(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 ("gmtime" c-gmtime) + ((time (* time-t))) + :returning (* tm)) + +(uffi:def-type time-t :unsigned-long) +(uffi:def-type tm-pointer (* tm)) + +(deftest time.1 + (uffi:with-foreign-object (time 'time-t) + (setf (uffi:deref-pointer time :unsigned-long) 7381) + (uffi:deref-pointer time :unsigned-long)) + 7381) + +(deftest time.2 + (uffi:with-foreign-object (time 'time-t) + (setf (uffi:deref-pointer time :unsigned-long) 7381) + (let ((tm-ptr (the tm-pointer (c-gmtime time)))) + (values (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) + ))) + 1 1 1970 2 3 1) + + + + + +