From d62866b0f6bbd6be51647f1b91aeee51eb3d57d3 Mon Sep 17 00:00:00 2001
From: "Robert P. Goldman" <rpgoldman@gmail.com>
Date: Mon, 24 Mar 2014 19:02:39 -0500
Subject: [PATCH] Handle Allegro lisp program specified as absolute pathname.

Previously only accepted relative pathnames, and would generate spurious
test failure when given an absolute one.
---
 test/test-program.script | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/test/test-program.script b/test/test-program.script
index 994ca947..d8465e80 100644
--- a/test/test-program.script
+++ b/test/test-program.script
@@ -9,7 +9,9 @@
 
 #+allegro
 (defparameter *lisp*
-  (truename (subpathname #p"sys:" (first (raw-command-line-arguments)))))
+  (if (absolute-pathname-p (first (raw-command-line-arguments)))
+      (first (raw-command-line-arguments))
+    (truename (subpathname #p"sys:" (first (raw-command-line-arguments))))))
 
 ;; Try to load lisp-invocation from xcvb
 (setf *central-registry*
@@ -49,8 +51,8 @@
   (run-program
    (symbol-call :lisp-invocation :lisp-invocation-arglist
                 #+allegro :lisp-path #+allegro *lisp*
-		:image-path (native-namestring img)
-		:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)")
+                :image-path (native-namestring img)
+                :eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)")
    :output :lines :error-output t))
  '("hello, world"))
 
@@ -60,9 +62,9 @@
  (run-program
   (symbol-call :lisp-invocation :lisp-invocation-arglist
                #+allegro :lisp-path #+allegro *lisp*
-	       :image-path (native-namestring img)
-	       :eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)"
-	       :arguments '("a" "b c" "d"))
+               :image-path (native-namestring img)
+               :eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)"
+               :arguments '("a" "b c" "d"))
   :output :lines :error-output t)
  '("hello, world"
    "You passed 3 arguments:"
-- 
GitLab