118 lines
3.9 KiB
Plaintext
Executable File
118 lines
3.9 KiB
Plaintext
Executable File
#!/usr/bin/newlisp
|
|
|
|
; Test libffi routines - all of the tests are performed using only the
|
|
; OS platforms libc system library. For tests compiling a C libray
|
|
; with source code in util/ffitest.c see qa-libffi
|
|
|
|
; some simple libc functions
|
|
|
|
; when doing "make testall" only text lines starting with ">>>" are printed
|
|
|
|
(set-locale "C")
|
|
|
|
(when (zero? (& 1024 (sys-info -1)))
|
|
(println ">>>>> qa-libc-libffi: tests only run on extended FFI enabled versions compiled with ffilib")
|
|
(exit))
|
|
|
|
(set 'is64bit (not (zero? (& 256 (sys-info -1))))) ; used later
|
|
|
|
(define (get-libc-name)
|
|
(letn (libc-name (first (exec "gcc -print-file-name=libc.so"))
|
|
libc-filetype (first (exec (string "file -b " libc-name))))
|
|
(if (find "ASCII" libc-filetype)
|
|
(first (regex "[^ \t]+/libc\\.so\\.*[0-9]*" (read-file libc-name)))
|
|
libc-name))
|
|
)
|
|
|
|
(define LIBC
|
|
(case ostype
|
|
("Windows" "msvcrt.dll")
|
|
("Cygwin" "msvcrt.dll")
|
|
("OSX" "libc.dylib")
|
|
("BSD" (get-libc-name) )
|
|
("Linux" (get-libc-name) )
|
|
))
|
|
|
|
(println "\nTesting imports from " LIBC "\n")
|
|
|
|
(unless (catch (import LIBC "sprintf" "int" "char*" "char*" "int" "double") 'result)
|
|
(println ">>>>> ERR cannot find library in qa-libc-libffi")
|
|
(exit))
|
|
|
|
(set 'buff (dup "\000" 64))
|
|
(sprintf buff "int 42 => %i, double Pi => %6.4f" 42 (mul 2 (acos 0)))
|
|
(set 'buff (get-string buff)) ;; trim buff of trailing zeroes
|
|
(println "->" buff "<-")
|
|
(unless (= buff "int 42 => 42, double Pi => 3.1416")
|
|
(println ">>>>> ERR problem importing sprinf() in qa-libc-libffi"))
|
|
|
|
(import LIBC "atof" "double" "char*")
|
|
(println {(atof "3.141") => } (atof "3.141"))
|
|
(unless (= (atof "3.141") 3.141)
|
|
(println ">>>>> ERR problem importing atof() in qa-libc-libffi"))
|
|
|
|
(import LIBC "atoi" "int" "char*")
|
|
(println {(atoi "3434") => } (atoi "3434"))
|
|
(unless (= (atoi "3434") 3434)
|
|
(println ">>>>> ERR problem importing atoi() in qa-libc-libffi"))
|
|
|
|
(import LIBC "strcpy" "char*" "char*" "char*")
|
|
(set 'from "Hello World")
|
|
(set 'to (dup "\000" (length from)))
|
|
(strcpy to from)
|
|
(println "(strcpy from to) => " to)
|
|
(unless (= to from)
|
|
(println ">>>>> ERR problem importing strcpy() in qa-libc-libffi"))
|
|
|
|
(when (!= ostype "Linux")
|
|
(import LIBC "fabs" "double" "double")
|
|
(println {(fabs -8.230) => } (fabs 8.230))
|
|
(println {(fabs 3.14159) => } (fabs 3.14159))
|
|
(unless (and (= (fabs -8.230) 8.230) (= (fabs 3.14159) 3.14159))
|
|
(println ">>>>> ERR problem importing fabs() in qa-libc-libffi"))
|
|
)
|
|
|
|
; test struct pack unpack
|
|
|
|
(import LIBC "asctime" "char*" "void*")
|
|
(import LIBC "localtime" "void*" "void*")
|
|
|
|
(if (find ostype '("Windows"))
|
|
(struct 'tm "int" "int" "int" "int" "int" "int" "int" "int" "int")
|
|
(struct 'tm "int" "int" "int" "int" "int" "int" "int" "int" "int" "long" "char*")
|
|
)
|
|
|
|
(if (find ostype '("Windows" "Cygwin"))
|
|
(set 'tmlist '(1 2 3 4 5 6 7 8 9))
|
|
(set 'tmlist '(1 2 3 4 5 6 7 8 9 10 "hello world")))
|
|
|
|
(if (= tmlist (unpack tm (pack tm tmlist)))
|
|
(println "unpack pack => true")
|
|
(println ">>>>> ERR problem in struct pack/unpack in qa-libc-libffi"))
|
|
|
|
(set 'ptr (localtime (address (date-value))))
|
|
(println "unpack localtime structure => " (unpack tm ptr))
|
|
(println "struct testing, today => " (asctime (localtime (address (date-value)))))
|
|
|
|
; test callback
|
|
|
|
(import LIBC "qsort" "void" "void*" "int" "int" "void*")
|
|
(set 'len 1000)
|
|
(set 'rlist (rand 10 len))
|
|
(set 'carray (pack (dup "ld " len) rlist))
|
|
(define (cmp a b) (- (get-int a) (get-int b)))
|
|
(qsort (address carray) len 4 (callback 'cmp "int" "void*" "void*"))
|
|
(println "qsort " len " elements => " (apply <= (unpack (dup "ld " len) carray)))
|
|
(unless (apply <= (unpack (dup "ld " len) carray))
|
|
(println ">>>>> ERR problem in import qsort() with callback in qa-libc-libffi"))
|
|
|
|
|
|
(unless (= ostype "Linux")
|
|
(import LIBC "atexit" "void" "void*")
|
|
(define (quit) (println "-> Quit ! => true"))
|
|
(print "atexit callback => ")
|
|
(atexit (callback 'quit "void" "void"))
|
|
)
|
|
|
|
(exit)
|