From 92dc2fec520cfbd023afee26bd4ad578745ee0f5 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@gmail.com> Date: Sun, 30 Nov 2014 12:17:22 -0600 Subject: [PATCH] Added TEST-PATHNAME-PARSING for launchpad bug 1396847. --- test/asdf-pathname-test.script | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script index aa52de4e..ba6d4014 100644 --- a/test/asdf-pathname-test.script +++ b/test/asdf-pathname-test.script @@ -418,6 +418,34 @@ (setf (logical-pathname-translations "ASDFTEST") nil)) (clear-system "test-system"))) +(defun test-pathname-parsing () + #-(or allegro clisp clozure ecl lispworks mkcl sbcl cmu) + (progn + ;; FIXME: unable to get DBG to load in this file. [2014/11/30:rpg] + (format t "Can't test pathname parsing: this lisp lacks SETENV support.") + t) + #+(or allegro clisp clozure ecl lispworks mkcl sbcl cmu) + (let ((old-config (uiop:getenvp "XDG_CONFIG_DIRS")) + (old-home-config (uiop:getenvp "XDG_CONFIG_HOME"))) + (unwind-protect + (progn + (setf (uiop:getenv "XDG_CONFIG_DIRS") "/foo:prismatic") + (multiple-value-bind (ret err) + (ignore-errors + (uiop:user-configuration-directories)) + (assert (and (not ret) err))) + (setf (uiop:getenv "XDG_CONFIG_DIRS") "/foo:") + (setf (uiop:getenv "XDG_CONFIG_HOME") "") + (multiple-value-bind (ret err) + (ignore-errors + (uiop:user-configuration-directories)) + (assert (not err)) + (assert (= (length ret) 2)))) + (when old-config + (setf (uiop:getenv "XDG_CONFIG_DIRS") old-config)) + (when old-home-config + (setf (uiop:getenv "XDG_CONFIG_HOME") old-home-config))))) + (asdf:initialize-source-registry) (format t "source registry: ~S~%" (hash-table->alist asdf::*source-registry*)) (asdf:initialize-output-translations) @@ -439,3 +467,5 @@ #-gcl (assert (test-component-pathnames :delete-host t :support-string-pathnames nil)) + +(test-pathname-parsing) -- GitLab