| 1 | ;-*- Mode: Lisp -*- |
|---|
| 2 | ;;;; Author: Paul Dietz |
|---|
| 3 | ;;;; Created: Sat Dec 6 14:23:54 2003 |
|---|
| 4 | ;;;; Contains: Tests for PATHNAME-DEVICE |
|---|
| 5 | |
|---|
| 6 | (in-package :cl-test) |
|---|
| 7 | |
|---|
| 8 | (compile-and-load "pathnames-aux.lsp") |
|---|
| 9 | |
|---|
| 10 | (deftest pathname-device.1 |
|---|
| 11 | (loop for p in *pathnames* |
|---|
| 12 | for device = (pathname-device p) |
|---|
| 13 | unless (or (stringp device) |
|---|
| 14 | (member device '(nil :wild :unspecific))) |
|---|
| 15 | collect (list p device)) |
|---|
| 16 | nil) |
|---|
| 17 | |
|---|
| 18 | (deftest pathname-device.2 |
|---|
| 19 | (loop for p in *pathnames* |
|---|
| 20 | for device = (pathname-device p :case :local) |
|---|
| 21 | unless (or (stringp device) |
|---|
| 22 | (member device '(nil :wild :unspecific))) |
|---|
| 23 | collect (list p device)) |
|---|
| 24 | nil) |
|---|
| 25 | |
|---|
| 26 | (deftest pathname-device.3 |
|---|
| 27 | (loop for p in *pathnames* |
|---|
| 28 | for device = (pathname-device p :case :common) |
|---|
| 29 | unless (or (stringp device) |
|---|
| 30 | (member device '(nil :wild :unspecific))) |
|---|
| 31 | collect (list p device)) |
|---|
| 32 | nil) |
|---|
| 33 | |
|---|
| 34 | (deftest pathname-device.4 |
|---|
| 35 | (loop for p in *pathnames* |
|---|
| 36 | for device = (pathname-device p :allow-other-keys nil) |
|---|
| 37 | unless (or (stringp device) |
|---|
| 38 | (member device '(nil :wild :unspecific))) |
|---|
| 39 | collect (list p device)) |
|---|
| 40 | nil) |
|---|
| 41 | |
|---|
| 42 | (deftest pathname-device.5 |
|---|
| 43 | (loop for p in *pathnames* |
|---|
| 44 | for device = (pathname-device p :foo 'bar :allow-other-keys t) |
|---|
| 45 | unless (or (stringp device) |
|---|
| 46 | (member device '(nil :wild :unspecific))) |
|---|
| 47 | collect (list p device)) |
|---|
| 48 | nil) |
|---|
| 49 | |
|---|
| 50 | (deftest pathname-device.6 |
|---|
| 51 | (loop for p in *pathnames* |
|---|
| 52 | for device = (pathname-device p :allow-other-keys t :allow-other-keys nil :foo 'bar) |
|---|
| 53 | unless (or (stringp device) |
|---|
| 54 | (member device '(nil :wild :unspecific))) |
|---|
| 55 | collect (list p device)) |
|---|
| 56 | nil) |
|---|
| 57 | |
|---|
| 58 | ;;; section 19.3.2.1 |
|---|
| 59 | (deftest pathname-device.7 |
|---|
| 60 | (loop for p in *logical-pathnames* |
|---|
| 61 | always (eq (pathname-device p) :unspecific)) |
|---|
| 62 | t) |
|---|
| 63 | |
|---|
| 64 | (deftest pathname-device.8 |
|---|
| 65 | (do-special-strings (s "" nil) (pathname-device s)) |
|---|
| 66 | nil) |
|---|
| 67 | |
|---|
| 68 | (deftest pathname-device.error.1 |
|---|
| 69 | (signals-error (pathname-device) program-error) |
|---|
| 70 | t) |
|---|
| 71 | |
|---|
| 72 | (deftest pathname-device.error.2 |
|---|
| 73 | (check-type-error #'pathname-device #'could-be-pathname-designator) |
|---|
| 74 | nil) |
|---|
