#! /bin/sh
exec ../src/sizzle -qs $0 $*
!#
;; test/posix.scm -- tests for the Posix/Unix functions
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; This software 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 this package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

;; Load the test framework.

(load "test-suite.scm")

(use-modules (core posix))

(begin-section "environment")

(begin-sub-section "getenv")
(pass-if (string? (getenv "HOME")) #t eq?)

(begin-sub-section "putenv")
(catch 'not-available
       (lambda () (putenv "foobar=frob"))
       (lambda ignore #f))
(pass-if (getenv "foobar") "frob" equal?)
(catch 'not-available
       (lambda () (putenv "foobar"))
       (lambda ignore #f))
(pass-if (boolean? (getenv "foobar")) #t eq?)

(begin-section "file system")

(begin-sub-section "getcwd")
(pass-if (string? 
	  (catch 'not-available
		 (lambda () (getcwd))
		 (lambda ignore #f))) #t eq?)
(pass-if (substring 
	  (catch 'not-available
		 (lambda () (getcwd))
		 (lambda ignore "blablabla"))
	  (- (string-length 
	      (catch 'not-available
		     (lambda () (getcwd))
		     (lambda ignore "blablabla"))) 4)
	  (string-length (getcwd)))
	 "test" equal?)

(begin-sub-section "chdir")
(define old-dir (getcwd))
(chdir "/")
(pass-if (getcwd) "/" equal?)
(chdir (getenv "HOME"))
(pass-if (getcwd) (getenv "HOME") equal?)
(chdir old-dir)

(begin-sub-section "stat")
(define st (stat "posix.scm"))
(pass-if (vector-length st) 15 =)
(pass-if (> (vector-ref st 7) 0) #t eq?)

(begin-sub-section "access?")
(pass-if (access? "posix.scm" F_OK) #t eq?)
(pass-if (access? "posix.scm" R_OK) #t eq?)
(pass-if (access? "posix.scm" W_OK) #t eq?)
(pass-if (access? "posix.scm" X_OK) #t eq?)
(pass-if (access? "README" X_OK) #f eq?)

(begin-sub-section "sleep")
(pass-if (integer? (sleep 1)) #t eq?)

(begin-section "system information")

(begin-sub-section "uname")
(pass-if (vector? (uname)) #t eq?)

(begin-section "process control")

(begin-sub-section "system")
(pass-if (system "true") 0 =)
(pass-if (system "false") 256 =)

(begin-section "process information")

(begin-sub-section "getpid")
(pass-if (integer? (getpid)) #t eq?)

(begin-sub-section "getppid")
(pass-if (integer? 
	  (catch 'not-available
		 (lambda () (getppid))
		 (lambda ignore #f)))
	 #t eq?)

(begin-sub-section "getuid")
(pass-if (integer?  
	  (catch 'not-available
		 (lambda () (getuid))
		 (lambda ignore #f)))
	 #t eq?)

(begin-sub-section "geteuid")
(pass-if (integer?   
	  (catch 'not-available
		 (lambda () (geteuid))
		 (lambda ignore #f)))
	 #t eq?)

(begin-sub-section "getgid")
(pass-if (integer?    
	  (catch 'not-available
		 (lambda () (getgid))
		 (lambda ignore #f)))
	 #t eq?)

(begin-sub-section "getegid")
(pass-if (integer?     
	  (catch 'not-available
		 (lambda () (getegid)) 
		 (lambda ignore #f)))
	#t eq?)

(begin-sub-section "getpgid")
(pass-if (integer?      
	  (catch 'not-available
		 (lambda () (getpgid (getpid)))
		 (lambda ignore #f)))
	#t eq?)

(begin-sub-section "getpgrp")
(pass-if (integer? 
	  (catch 'not-available
		 (lambda () (getpgrp)) 
		 (lambda ignore #f)))
	#t eq?)

(begin-section "user database")

(begin-sub-section "getpwnam")
(define pwinfo  
  (catch 'not-available
	 (lambda () (getpwnam "root"))
	 (lambda ignore (vector "bla" #f 1 2))))
(pass-if (vector-length pwinfo) 7 =)
(pass-if (vector-ref pwinfo 0) "root" equal?)
(pass-if (vector-ref pwinfo 2) 0 =)
(pass-if (vector-ref pwinfo 3) 0 =)

(begin-sub-section "getpwuid")
(set! pwinfo
      (catch 'not-available
	     (lambda () (getpwuid (getuid)))
	     (lambda ignore (vector "bla" #f 0))))
(pass-if (vector-length pwinfo) 7 =)

(define uid
	(catch 'not-available
	     (lambda () (getuid))
		 (lambda ignore -1)))

(pass-if (vector-ref pwinfo 2) uid =)

(begin-sub-section "getpwent")
(set! pwinfo
      (catch 'not-available
	     (lambda () (getpwent))
	     (lambda ignore (vector "bla" #f 1 2))))
(pass-if (vector-length pwinfo) 7 =)
(pass-if (vector-ref pwinfo 0) "root" equal?)
(pass-if (vector-ref pwinfo 2) 0 =)
(pass-if (vector-ref pwinfo 3) 0 =)

(begin-sub-section "setpwent")
(catch 'not-available
	     (lambda () (setpwent))
	     (lambda ignore #f))
(set! pwinfo 
      (catch 'not-available
	     (lambda () (getpwent))
	     (lambda ignore (vector "bla" #f 1 2))))
(pass-if (vector-length pwinfo) 7 =)
(pass-if (vector-ref pwinfo 0) "root" equal?)
(pass-if (vector-ref pwinfo 2) 0 =)
(pass-if (vector-ref pwinfo 3) 0 =)

(begin-sub-section "endpwent")
;; Just check if the check throws an error or something.
(pass-if (catch 'not-available
       (lambda () (endpwent) #t)
       (lambda ignore #f)) #t eq?)

(begin-section "file system")

;; Here we test only if lstat somehow works by giving it a regular
;; file.  When I figure out how to get a proper symlink everywhere,
;; I'll put it in here.
(begin-sub-section "lstat")
(define st
  (catch 'not-available
	 (lambda () (lstat "posix.scm"))
	 (lambda ignore (vector 0 1 2 3 4 5 0 0))))
(pass-if (vector-length st) 15 =)
(pass-if (> (vector-ref st 7) 0) #t eq?)

(begin-section "process control")

(begin-sub-section "fork / wait")

(define (fork-func)
  (let ((pid (fork)))
    (if (zero? pid)
	(primitive-exit 1)
	pid)))

(define have-fork (false-if-exception (fork-func)))

(if have-fork
    (begin
      (define child0 (fork-func))
      (pass-if (positive? child0) #t eq?)
      (pass-if (let ((status (wait)))
		 (and (pair? status) (= child0 (car status))
		      (= 256 (cdr status))))
	       #t eq?)))

(begin-sub-section "fork / waitpid")

(if have-fork
    (begin
      (define child1 (fork-func))
      (pass-if (positive? child1) #t eq?)
      (pass-if (let ((status (waitpid child1)))
		 (and (pair? status) (= child1 (car status)) (= 256 (cdr status))))
	       #t eq?)))

(begin-sub-section "sync")
(pass-if (begin (false-if-exception (sync)) #t) #t eq?)

(begin-sub-section "nice")
(pass-if (begin (false-if-exception (nice 1)) #t) #t eq?)

(begin-section "directory streams")
(begin-sub-section "opendir")
(define dir (opendir "."))
(pass-if (not (null? dir)) #t eq?)
(pass-if (directory-stream? dir) #t eq?)

(begin-sub-section "directory-stream?")
(pass-if (directory-stream? #t) #f eq?)
(pass-if (directory-stream? dir) #t eq?)

(begin-sub-section "readdir")
(define de (readdir dir))
(pass-if (string? de) #t eq?)
(define de (readdir dir))
(define second-de de)
(pass-if (string? de) #t eq?)

(begin-sub-section "rewinddir")
(catch 'not-available
	(lambda () (rewinddir dir))
	(lambda ignore #f))
(define de (readdir dir))
(pass-if (string? de) #t eq?)
(define de (readdir dir))
(pass-if (string? de) #t eq?)
(pass-if (string=? second-de de) #t eq?)

(begin-sub-section "closedir")
(closedir dir)
(pass-if (catch 'wrong-type-argument
		(lambda () (readdir dir) #f)
		(lambda ignore #t))
	 #t eq?)

(begin-sub-section "directory-files")
(define d (directory-files "."))
(pass-if (list? d) #t eq?)
(pass-if (> (length d) 1) #t eq?)

(begin-section "time functions")

(begin-sub-section "strftime")
(define t (localtime (current-time)))
(pass-if (string? (strftime "%H:%M" t)) #t eq?)

(begin-sub-section "strptime")

(define s (catch 'not-available
	(lambda () (strptime "%H:%M" "12:21"))
	(lambda ignore '(#(0 0 0) . 0))))
(pass-if (pair? s) #t eq?)
(pass-if (vector? (car s)) #t eq?)
(pass-if (vector-ref (car s) 1) 21 =)
(pass-if (vector-ref (car s) 2) 12 =)

(test-summary)
