From 7ba708cb0f5667dd12b1dc979750fc98ba13a31c Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Wed, 16 Jan 2013 19:33:38 -0500
Subject: [PATCH] 2.26.104: get program-op to work alright on ECL.

Some attempts at making things work for ABCL and CLISP.
---
 asdf.asd                   |  2 +-
 bundle.lisp                | 11 ++++++-----
 compatibility.lisp         |  1 +
 header.lisp                |  2 +-
 image.lisp                 |  2 +-
 lisp-build.lisp            |  4 ++--
 package.lisp               | 24 +++++++++++++-----------
 pathname.lisp              |  2 +-
 test/make-hello-world.lisp |  1 +
 test/run-tests.sh          | 13 ++++++++-----
 test/script-support.lisp   |  4 ++--
 test/test-encodings.script |  3 +++
 upgrade.lisp               |  2 +-
 version.lisp-expr          |  2 +-
 14 files changed, 42 insertions(+), 31 deletions(-)

diff --git a/asdf.asd b/asdf.asd
index 8072fcfd..214fa899 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -15,7 +15,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.103" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.104" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components ((:module "build" :components ((:file "asdf"))))
   :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf))))
diff --git a/bundle.lisp b/bundle.lisp
index 6ca94024..a9c5e1db 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -7,7 +7,7 @@
    :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation
    :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate)
   (:export
-   #:bundle-op #:bundle-op-build-args #:bundle-type #:bundle-system
+   #:bundle-op #:bundle-op-build-args #:bundle-type #:bundle-system #:bundle-pathname-type
    #:fasl-op #:load-fasl-op #:lib-op #:dll-op #:binary-op
    #:monolithic-op #:monolithic-bundle-op #:dependency-files
    #:monolithic-binary-op #:monolithic-fasl-op #:monolithic-lib-op #:monolithic-dll-op
@@ -266,7 +266,8 @@
 
 (defmethod component-depends-on ((o program-op) (c system))
   (declare (ignorable o))
-  `((#+(or ecl mkcl) monolithic-lib-op #-(or ecl mkcl) load-op ,c)))
+  #+(or ecl mkcl) (component-depends-on (make-operation 'monolithic-lib-op) c)
+  #-(or ecl mkcl) `((load-op ,c)))
 
 (defmethod component-depends-on ((o binary-op) (c system))
   (declare (ignorable o))
@@ -491,12 +492,12 @@
            :init-name init-name
            :lisp-files (append object-files (bundle-op-lisp-files o))
            (append (bundle-op-build-args o)
-                   (when (typep o 'program-op)
-                     `(:prologue-code
-                       (restore-image :entry-point ,(component-entry-point c))))
                    (when (and (typep o 'monolithic-bundle-op)
                               (monolithic-op-prologue-code o))
                      `(:prologue-code ,(monolithic-op-prologue-code o)))
+                   (when (typep o 'program-op)
+                     `(:epilogue-code
+                       (restore-image :entry-point ,(component-entry-point c))))
                    (when (and (typep o 'monolithic-bundle-op)
                               (monolithic-op-epilogue-code o))
                      `(:epilogue-code ,(monolithic-op-epilogue-code o)))))))
diff --git a/compatibility.lisp b/compatibility.lisp
index 56a8cfc3..3b713982 100644
--- a/compatibility.lisp
+++ b/compatibility.lisp
@@ -45,6 +45,7 @@
 
 #+ecl
 (eval-when (:load-toplevel :compile-toplevel :execute)
+  (setf *load-verbose* nil)
   (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t))
   (unless (use-ecl-byte-compiler-p) (require :cmp)))
 
diff --git a/header.lisp b/header.lisp
index 3d835343..8c3d680b 100644
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.103: Another System Definition Facility.
+;;; This is ASDF 2.26.104: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/image.lisp b/image.lisp
index 8be82203..a6b8bccf 100644
--- a/image.lisp
+++ b/image.lisp
@@ -226,7 +226,7 @@ if we are not called from a directly executable image dumped by XCVB."
     (standard-eval-thunk *image-prelude*)
     (let ((results (multiple-value-list
                     (if *image-entry-point*
-                        (apply *image-entry-point* *command-line-arguments*)
+                        (apply (ensure-function *image-entry-point*) *command-line-arguments*)
                         t))))
       (if *lisp-interaction*
           (apply 'values results)
diff --git a/lisp-build.lisp b/lisp-build.lisp
index f8454b82..7d4501ba 100644
--- a/lisp-build.lisp
+++ b/lisp-build.lisp
@@ -20,7 +20,7 @@
    #:current-lisp-file-pathname #:lispize-pathname #:compile-file-type #:call-around-hook
    #:compile-file* #:compile-file-pathname*
    #:load* #:load-from-string #:combine-fasls)
-  (:intern #:defaults #:failure-p #:warnings-p))
+  (:intern #:defaults #:failure-p #:warnings-p #:s #:y #:body))
 (in-package :asdf/lisp-build)
 
 (defvar *compile-file-warnings-behaviour*
@@ -171,7 +171,7 @@ for processing later (possibly in a different process)."
   "pathname TYPE for lisp FASt Loading files"
   (declare (ignorable keys))
   #-(or ecl mkcl) (load-time-value (pathname-type (compile-file-pathname "foo.lisp")))
-  #+(or ecl mkcl) (pathname-type (apply 'compile-file-pathname "foo.lisp" keys)))
+  #+(or ecl mkcl) (pathname-type (apply 'compile-file-pathname "foo" keys)))
 
 (defun* call-around-hook (hook function)
   (call-function (or hook 'funcall) function))
diff --git a/package.lisp b/package.lisp
index 69a4aa4b..b88d05b6 100644
--- a/package.lisp
+++ b/package.lisp
@@ -343,42 +343,42 @@ or when loading the package is optional."
         (when-fishy (record-fishy name))
         (labels
             ((ensure-shadowing-import (name p)
-               (let ((import (find-symbol* name p)))
+               (let ((import-me (find-symbol* name p)))
                  (multiple-value-bind (existing status) (find-symbol name package)
                    (cond
                      ((gethash name shadowed)
-                      (unless (eq import existing)
+                      (unless (eq import-me existing)
                         (error "Conflicting shadowings for ~A" name)))
                      (t
                       (setf (gethash name shadowed) t)
                       (setf (gethash name imported) t)
                       (unless (or (null status)
                                   (and (member status '(:internal :external))
-                                       (eq existing import)
+                                       (eq existing import-me)
                                        (symbol-shadowing-p existing package)))
                         (fishy :shadowing-import
-                               name (package-name p) (symbol-package-name import)
+                               name (package-name p) (symbol-package-name import-me)
                                (and status (symbol-package-name existing)) status))
-                      (shadowing-import import package))))))
+                      (shadowing-import import-me package))))))
              (ensure-import (sym p)
                (let* ((name (string sym))
-                      (import (find-symbol* name p)))
+                      (import-me (find-symbol* name p)))
                  (multiple-value-bind (existing status) (find-symbol name package)
                    (cond
                      ((gethash name imported)
-                      (unless (eq import existing)
+                      (unless (eq import-me existing)
                         (error "Can't import ~S from both ~S and ~S"
                                name (package-name (symbol-package existing)) (package-name p))))
                      ((gethash name shadowed)
                       (error "Can't both shadow ~S and import it from ~S" name (package-name p)))
                      (t
                       (setf (gethash name imported) t)
-                      (unless (and status (eq import existing))
+                      (unless (and status (eq import-me existing))
                         (when status
                           (unintern* existing package)
-                          (fishy :import name (package-name p) (symbol-package-name import)
+                          (fishy :import name (package-name p) (symbol-package-name import-me)
                                  (and status (symbol-package-name existing)) status))
-                        (import import package)))))))
+                        (import import-me package)))))))
              (ensure-mix (name symbol p)
                (unless (gethash name shadowed)
                  (multiple-value-bind (existing status) (find-symbol name package)
@@ -588,7 +588,9 @@ or when loading the package is optional."
        (eval-when (:compile-toplevel :load-toplevel :execute)
          ,ensure-form)
        #+(or ecl gcl) (defpackage ,package (:use))
-       #+clisp ,(package-definition-form package :error nil)
+       #+clisp ,(package-definition-form
+                 package :nicknamesp nil :usep nil :internp nil :exportp nil
+                 :error nil)
        (eval-when (:compile-toplevel :load-toplevel :execute)
          ,ensure-form))))
 
diff --git a/pathname.lisp b/pathname.lisp
index 22b4c470..89a5e1b2 100644
--- a/pathname.lisp
+++ b/pathname.lisp
@@ -723,7 +723,7 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."
   #-allegro (truenamize path)
   #+allegro
   (if (physical-pathname-p path)
-      (excl:pathname-resolve-symbolic-links path)
+      (or (ignore-errors (excl:pathname-resolve-symbolic-links path)) path)
       path))
 
 (defun* resolve-symlinks* (path)
diff --git a/test/make-hello-world.lisp b/test/make-hello-world.lisp
index 68956513..f7644c96 100644
--- a/test/make-hello-world.lisp
+++ b/test/make-hello-world.lisp
@@ -5,4 +5,5 @@
 
 (with-test ()
   (register-directory *asdf-directory*) ;; we need asdf-driver, and ECL can dump.
+  (operate 'load-fasl-op :hello-world-example)
   (operate 'program-op :hello-world-example))
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 0c3e9cf7..ebeb5b64 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -208,8 +208,8 @@ create_config () {
     mkdir -p ../build/test-source-registry-conf.d ../build/test-asdf-output-translations-conf.d
 }
 upgrade_tags () {
-    if [ -n "$TEST_ASDF_TAGS" ] ; then
-        echo $TEST_ASDF_TAGS ; return
+    if [ -n "$ASDF_UPGRADE_TEST_TAGS" ] ; then
+        echo $ASDF_UPGRADE_TEST_TAGS ; return
     fi
     # REQUIRE is a magic tag meaning whatever your implementation provides
     # 1.37 is the last release by Daniel Barlow
@@ -222,8 +222,8 @@ upgrade_tags () {
     git tag -l '2.??'
 }
 upgrade_methods () {
-    if [ -n "$TEST_ASDF_METHODS" ] ; then
-        echo $TEST_ASDF_METHODS ; return
+    if [ -n "$ASDF_UPGRADE_TEST_METHODS" ] ; then
+        echo $ASDF_UPGRADE_TEST_METHODS ; return
     fi
     cat <<EOF
 'load-asdf-lisp'load-asdf-system
@@ -281,7 +281,10 @@ run_upgrade_tests () {
                 extract_tagged_asdf $tag
                 $command $eval \
                 "'(#.(load\"$su\")#.(in-package :asdf-test)#.(test-upgrade $method \"$tag\"))" ||
-                { echo "upgrade FAILED for $lisp from $tag using method $method" ; exit 1 ;}
+                { echo "upgrade FAILED for $lisp from $tag using method $method" ;
+                  echo "you can retry just that test with:" ;
+                  echo ASDF_UPGRADE_TEST_TAGS=\"$tag\" ADSF_UPGRADE_TEST_METHODS=\"$method\" ./test/run-tests.sh -u $lisp ;
+                    exit 1 ;}
     fi ; done ; done 2>&1 | tee build/results/${lisp}-upgrade.text
 }
 run_tests () {
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 4e0df0a8..728a0e2a 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -351,10 +351,10 @@ is bound, write a message and exit on an error.  If
   (with-test ()
     (when old-method
       (cond
-        ((equal tag "REQUIRE")
+        ((string-equal tag "REQUIRE")
          (format t "Requiring some previous asdf ~A~%" tag)
          (ignore-errors (funcall 'require "asdf"))
-         (unless (member "ASDF" *modules* :test 'equal)
+         (unless (member "ASDF" *modules* :test 'equalp)
            (leave-test "Your Lisp implementation does not provide ASDF. Skipping test.~%" 0)))
         (t
          (format t "Loading old asdf ~A via ~A~%" tag old-method)
diff --git a/test/test-encodings.script b/test/test-encodings.script
index 665cfa76..3305c636 100644
--- a/test/test-encodings.script
+++ b/test/test-encodings.script
@@ -46,6 +46,9 @@
   #-asdf-unicode
   (leave-test "No Unicode support to test on this lisp implementation" 0)
 
+  #+abcl
+  (leave-test "abcl is known to fail these tests. Go update asdf-encodings" 0)
+
   ;; NB: recent clozure can autodetect without asdf-encodings with :default (!)
 
   #+sbcl
diff --git a/upgrade.lisp b/upgrade.lisp
index 95760b8e..291ad472 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -45,7 +45,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.26.103")
+         (asdf-version "2.26.104")
          (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
diff --git a/version.lisp-expr b/version.lisp-expr
index d8abac4a..6c4ed9ef 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.103"
+"2.26.104"
-- 
GitLab