things/fs-at-test.scm

;;;;    Copyright (C) 2021 Maxime Devos <maximedevos at telenet dot be>
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 U>
(use-modules (srfi srfi-64)
	     (fs-at))

;; XXX use call-with-temporary-directory or something
;; like that.
;; XXX don't rely on GC for closing ports
(define *testdir* (make-parameter "/tmp/fs-at-test"))
(define (file-in-testdir name)
  (string-append (*testdir*) name))

(define (t:mkdir)
  (let* ((test (open (*testdir*) O_RDONLY))
	 (new  (make-path-at test "mkdir0")))
    (mkdir new)
    (test-eq "type of diretory made with mkdirat"
      'directory
      (stat:type (stat new)))))

(define (touch where)
  (open where O_CREAT))

(define (stat:repro f)
  (let ((s (stat f)))
    ;; XXX investigate
    (vector-set! s 17 'dont-look-at-ctimensec)
    ;; XXX I presume these are affected as well
    (vector-set! s 10 'dont-look-at-ctime)
    (vector-set! s 8 'dont-look-at-atime)
    (vector-set! s 6 'dont-look-at-atimensec)
    s))

(define (t:stat)
  (let* ((test (open (*testdir*) O_RDONLY))
	 (new  (make-path-at test "stat0"))
	 (new-port (touch new)))
    (let ((guile-stat (stat:repro (string-append (*testdir*) "/stat0")))
	  (port-stat  (stat:repro new-port))
	  (stat-at    (stat:repro new)))
      (test-equal "stat filename/port" guile-stat port-stat)
      (test-equal "stat filename/at"   guile-stat stat-at))))

(define (test)
  (if (file-exists? (*testdir*))
      (system* "rm" "-r" (*testdir*)))
  (mkdir (*testdir*))
  (test-begin "fs-at")
  (t:mkdir)
  (t:stat)
  (test-end "fs-at"))

(test)