Bug in Allegro 10 preview -- Was Re: Tests failing on Allegro 10 preview, Mac OS X

[Robert Goldman]

On 8/29/15 Aug 29 -3:53 AM, Faré wrote:
> I've tried the Allegro 10.0 release candidate, and the script-support
> bizarrely fails to override the configuration when it passes an
> argument initialize-source-registry, that gets lost on its way to
> FLATTEN-SOURCE-REGISTRY, being replaced by NIL:
> 
>  0[10]: (INITIALIZE-SOURCE-REGISTRY
>           (:SOURCE-REGISTRY :IGNORE-INHERITED-CONFIGURATION))
>    1[10]: (COMPUTE-SOURCE-REGISTRY
>             (:SOURCE-REGISTRY :IGNORE-INHERITED-CONFIGURATION))
>      2[10]: (ASDF/SOURCE-REGISTRY:FLATTEN-SOURCE-REGISTRY NIL)
> 
> I'm a bit too tired to reduce a test case, but look if this is what
> causes your issue.

This looks very weird:
Configuring ASDF
Tracing INITIALIZE-SOURCE-REGISTRY COMPUTE-SOURCE-REGISTRY
FLATTEN-SOURCE-REGISTRY
 0[2]: (ASDF/FIND-SYSTEM:INITIALIZE-SOURCE-REGISTRY
         (:SOURCE-REGISTRY :IGNORE-INHERITED-CONFIGURATION))
   1[2]: (ASDF/SOURCE-REGISTRY:COMPUTE-SOURCE-REGISTRY
           (:SOURCE-REGISTRY :IGNORE-INHERITED-CONFIGURATION))
;;; This is done by a format statement in COMPUTE-SOURCE-REGISTRY
;;; Looks like the variable is getting corrupted somehow
Before DOLIST, PARAMETER is: NIL
     2[2]: (ASDF/SOURCE-REGISTRY:FLATTEN-SOURCE-REGISTRY NIL)
     2[2]: returned
             ((#P"/Users/rpg/common-lisp/" :RECURSE T :EXCLUDE
               #1=(".bzr" ".cdv" ".git" ".hg" ".pc" ".svn" "CVS" "RCS"
                   "SCCS" "_darcs" "_sgbak" "autom4te.cache" "cover_db"
                   "_build" "debian"))
              (#P"/Users/rpg/.local/share/common-lisp/systems/"
               :RECURSE NIL :EXCLUDE NIL)
              (#P"/Users/rpg/.local/share/common-lisp/source/" :RECURSE
               T :EXCLUDE #1#)
              (#P"/usr/local/share/common-lisp/systems/" :RECURSE NIL
               :EXCLUDE NIL)
              (#P"/usr/local/share/common-lisp/source/" :RECURSE T
               :EXCLUDE #1#)
              (#P"/usr/share/common-lisp/systems/" :RECURSE NIL
               :EXCLUDE NIL)
              (#P"/usr/share/common-lisp/source/" :RECURSE T :EXCLUDE
               #1#))
;;; format statement in loop
In DOLIST, ENTRY is: NIL
In DOLIST, ENTRY is: NIL
In DOLIST, ENTRY is: NIL
In DOLIST, ENTRY is: NIL
In DOLIST, ENTRY is: NIL
In DOLIST, ENTRY is: NIL
In DOLIST, ENTRY is: NIL
   1[2]: returned
 0[2]: returned

The code for COMPUTE-SOURCE-REGISTRY is this:
 (defun compute-source-registry (&optional parameter (registry
*source-registry*))
    (format t "Before DOLIST, PARAMETER is: ~S~%" parameter)
    (dolist (entry (flatten-source-registry parameter))
      (format t "In DOLIST, ENTRY is: ~S~%" parameter)
      (destructuring-bind (directory &key recurse exclude) entry
        (let* ((h (make-hash-table :test 'equal))) ; table to detect
duplicates
          (register-asd-directory
           directory :recurse recurse :exclude exclude :collect
           #'(lambda (asd)
               (let* ((name (pathname-name asd))
                      (name (if (typep asd 'logical-pathname)
                                ;; logical pathnames are upper-case,
                                ;; at least in the CLHS and on SBCL,
                                ;; yet (coerce-name :foo) is lower-case.
                                ;; won't work well with (load-system "Foo")
                                ;; instead of (load-system 'foo)
                                (string-downcase name)
                                name)))
                 (cond
                   ((gethash name registry) ; already shadowed by
something else
                    nil)
                   ((gethash name h) ; conflict at current level
                    (when *verbose-out*
                      (warn (compatfmt "~@<In source-registry entry
~A~@[/~*~] ~
                                found several entries for ~A - picking
~S over ~S~:>")
                            directory recurse name (gethash name h) asd)))
                   (t
                    (setf (gethash name registry) asd)
                    (setf (gethash name h) asd))))))
          h)))
    (values))

it certainly looks like something is going wrong handling optional
arguments.