- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][rtoy-issue-76-add-ansi-tests-to-ci] Only run ansi-test on linux
by Raymond Toy 03 Nov '19

03 Nov '19

Raymond Toy pushed to branch rtoy-issue-76-add-ansi-tests-to-ci at cmucl / cmucl Commits: 5ed647e5 by Raymond Toy at 2019-11-03T22:55:38Z Only run ansi-test on linux The test fails on osx because the PRINT.1 and WRITE.1 tests use random tests that fail on osx. Let's just test on linux for now. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -25,7 +25,6 @@ osx-runner: tags: - osx before_script: - - git clone https://gitlab.common-lisp.net/ansi-test/ansi-test.git - (cd ansi-test; git checkout rtoy-cmucl-expected-failures) - curl -s -o cmucl-$version-darwin.tar.bz2 $download_url/cmucl-$version-darwin.tar.bz2 - mkdir snapshot @@ -34,6 +33,3 @@ osx-runner: - bin/build.sh $bootstrap -C "" -o snapshot/bin/lisp - bin/make-dist.sh -I dist darwin-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log - - cd ansi-test - - make LISP="../dist/bin/lisp -batch" - - grep 'No unexpected $successes\|failures$' test.out View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5ed647e5fa11a3e8a21e5d7e1… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5ed647e5fa11a3e8a21e5d7e1… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-issue-76-add-ansi-tests-to-ci] It's git checkout, not git co
by Raymond Toy 03 Nov '19

03 Nov '19

Raymond Toy pushed to branch rtoy-issue-76-add-ansi-tests-to-ci at cmucl / cmucl Commits: 8b071d1f by Raymond Toy at 2019-11-03T20:23:18Z It's git checkout, not git co - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -8,7 +8,7 @@ linux-runner: - linux before_script: - git clone https://gitlab.common-lisp.net/ansi-test/ansi-test.git - - (cd ansi-test; git co rtoy-cmucl-expected-failures) + - (cd ansi-test; git checkout rtoy-cmucl-expected-failures) - wget -nv $download_url/cmucl-$version-linux.tar.bz2 - wget -nv $download_url/cmucl-$version-linux.extra.tar.bz2 - mkdir snapshot @@ -26,7 +26,7 @@ osx-runner: - osx before_script: - git clone https://gitlab.common-lisp.net/ansi-test/ansi-test.git - - (cd ansi-test; git co rtoy-cmucl-expected-failures) + - (cd ansi-test; git checkout rtoy-cmucl-expected-failures) - curl -s -o cmucl-$version-darwin.tar.bz2 $download_url/cmucl-$version-darwin.tar.bz2 - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-$version-darwin.tar.bz2) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/8b071d1f272814450029578ec… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/8b071d1f272814450029578ec… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-issue-76-add-ansi-tests-to-ci
by Raymond Toy 03 Nov '19

03 Nov '19

Raymond Toy pushed new branch rtoy-issue-76-add-ansi-tests-to-ci at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-issue-76-add-ansi-test… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Clean up for fedora shell runner
by Raymond Toy 12 Aug '19

12 Aug '19

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 04d5d03f by Raymond Toy at 2019-08-12T04:44:32Z Clean up for fedora shell runner We're not using the fedora docker anymore (because I can't get it to work anymore and don't remember how I got it to work to begin with). Thus, use the fedora shell executor to run CI so we don't need the image or to wget lots of stuff because it's already installed. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -4,11 +4,9 @@ variables: bootstrap: "-B boot-21d.lisp" linux-runner: - image: ubuntu:16.04 tags: - linux before_script: - - apt-get update -qq && apt-get install -y wget bzip2 make gcc gcc-multilib time bc git - wget -nv $download_url/cmucl-$version-linux.tar.bz2 - wget -nv $download_url/cmucl-$version-linux.extra.tar.bz2 - mkdir snapshot View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/04d5d03ff14be78bbcfef4ef3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/04d5d03ff14be78bbcfef4ef3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Initial revision for 21e changes. WIP
by Raymond Toy 29 May '19

29 May '19

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 35ed80d7 by Raymond Toy at 2019-05-29T00:07:48Z Initial revision for 21e changes. WIP [skip ci] - - - - - 1 changed file: - + src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -0,0 +1,45 @@ +# CMUCL 21e + +## Work in prograss + +The CMUCL project is pleased to announce the release of CMUCL 21e. +This is a major release which contains numerous enhancements and bug +fixes from the 21a release. + +CMUCL is a free, high performance implementation of the Common Lisp +programming language which runs on most major Unix platforms. It +mainly conforms to the ANSI Common Lisp standard. CMUCL provides a +sophisticated native code compiler; a powerful foreign function +interface; an implementation of CLOS, the Common Lisp Object System, +which includes multi-methods and a meta-object protocol; a +source-level debugger and code profiler; and an Emacs-like editor +implemented in Common Lisp. CMUCL is maintained by a team of +volunteers collaborating over the Internet, and is mostly in the +public domain. + +## New in this release: + * Known issues: + * Building with gcc8 or later doesn't work with the default -O option. Use -O1 instead. This shouldn't really impact overall speed much. + * Added simple support to compile with clang instead, which works. (Use x86_linux_clang). + * Feature enhancements + * Update to ASDF 3.3.3 + * Changes + * ANSI compliance fixes: + * Bug fixes: + * Gitlab tickets: + * ~~#73~~ Update clx from upstream clx + * Other changes: + * Improvements to the PCL implementation of CLOS: + * Changes to building procedure: + +This release is not binary compatible with code compiled using CMUCL +21d; you will need to recompile FASL files. + +See http://www.cmucl.org or +https://gitlab.common-lisp.net/cmucl/cmucl for more information, +See +https://gitlab.common-lisp.net/cmucl/cmucl/wikis/GettingCmucl +for obtaining CMUCL, including sources and binaries.. + + +We hope you enjoy using this release of CMUCL! View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/35ed80d7902d42c4f2349c5e8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/35ed80d7902d42c4f2349c5e8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Revert "Strikethru #73 since it's done."
by Raymond Toy 29 May '19

29 May '19

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 099c70f2 by Raymond Toy at 2019-05-29T00:02:22Z Revert "Strikethru #73 since it's done." This reverts commit 1ca3f1554de6a91873132f0182226c2c2cc5805b. - - - - - d7ecf782 by Raymond Toy at 2019-05-29T00:03:37Z Revert "Update notes" This reverts commit 4dbd847afe39a4b84ba2ba0ae838c12eb72de5f8. release-21d.md was erroneously modified. It should have been done to release-21e.md, a new file. We've already released 21d. - - - - - 1 changed file: - src/general-info/release-21d.md Changes: ===================================== src/general-info/release-21d.md ===================================== @@ -17,10 +17,8 @@ public domain. ## New in this release: * Known issues: - * Building with gcc8 or later doesn't work with the default -O option. Use -O1 instead. This shouldn't really impact overall speed much. - * Added simple support to compile with clang instead, which works. (Use x86_linux_clang). * Feature enhancements - * Update to ASDF 3.3.3 + * Update to ASDF 3.3.2 * Changes * x86 and sparc have replaced the MT19937 RNG with xoroshiro128+ RNG. * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937. @@ -44,7 +42,6 @@ public domain. * ~~#62~~ Segfault when compiling `ARRAY-DISPLACEMENT` on a string constant * ~~#69~~ GC assertions compiled in and allow user to enable them. * ~~#71~~ More info for `MACHINE-TYPE` and `MACHINE-VERSION` for x86 - * ~~#73~~ Update clx from upstream clx * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/1ca3f1554de6a91873132f01… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/1ca3f1554de6a91873132f01… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-2019-06
by Raymond Toy 28 May '19

28 May '19

Raymond Toy pushed new tag snapshot-2019-06 at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/snapshot-2019-06 You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Strikethru #73 since it's done.
by Raymond Toy 28 May '19

28 May '19

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 1ca3f155 by Raymond Toy at 2019-05-28T16:02:28Z Strikethru #73 since it's done. [skip ci] - - - - - 1 changed file: - src/general-info/release-21d.md Changes: ===================================== src/general-info/release-21d.md ===================================== @@ -44,7 +44,7 @@ public domain. * ~~#62~~ Segfault when compiling `ARRAY-DISPLACEMENT` on a string constant * ~~#69~~ GC assertions compiled in and allow user to enable them. * ~~#71~~ More info for `MACHINE-TYPE` and `MACHINE-VERSION` for x86 - * #73 Update clx from upstream clx + * ~~#73~~ Update clx from upstream clx * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/1ca3f1554de6a91873132f018… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/1ca3f1554de6a91873132f018… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update notes
by Raymond Toy 28 May '19

28 May '19

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4dbd847a by Raymond Toy at 2019-05-28T15:57:13Z Update notes * Update to ASDF 3.3.3 * Note that gcc -O1 can build cmucl now for gcc 8.1.1 and later. * Added x86_linux_clang to build cmucl with clang on linux - - - - - 1 changed file: - src/general-info/release-21d.md Changes: ===================================== src/general-info/release-21d.md ===================================== @@ -17,8 +17,10 @@ public domain. ## New in this release: * Known issues: + * Building with gcc8 or later doesn't work with the default -O option. Use -O1 instead. This shouldn't really impact overall speed much. + * Added simple support to compile with clang instead, which works. (Use x86_linux_clang). * Feature enhancements - * Update to ASDF 3.3.2 + * Update to ASDF 3.3.3 * Changes * x86 and sparc have replaced the MT19937 RNG with xoroshiro128+ RNG. * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937. @@ -42,6 +44,7 @@ public domain. * ~~#62~~ Segfault when compiling `ARRAY-DISPLACEMENT` on a string constant * ~~#69~~ GC assertions compiled in and allow user to enable them. * ~~#71~~ More info for `MACHINE-TYPE` and `MACHINE-VERSION` for x86 + * #73 Update clx from upstream clx * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/4dbd847afe39a4b84ba2ba0ae… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/4dbd847afe39a4b84ba2ba0ae… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update to ASDF 3.3.3
by Raymond Toy 17 Apr '19

17 Apr '19

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 76fd7aef by Raymond Toy at 2019-04-17T19:20:16Z Update to ASDF 3.3.3 - - - - - 4 changed files: - src/contrib/asdf/asdf.lisp - src/contrib/asdf/doc/asdf.html - src/contrib/asdf/doc/asdf.info - src/contrib/asdf/doc/asdf.pdf Changes: ===================================== src/contrib/asdf/asdf.lisp ===================================== @@ -1,5 +1,5 @@ ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.3.2: Another System Definition Facility. +;;; This is ASDF 3.3.3: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel(a)common-lisp.net>. @@ -19,7 +19,7 @@ ;;; http://www.opensource.org/licenses/mit-license.html on or about ;;; Monday; July 13, 2009) ;;; -;;; Copyright (c) 2001-2016 Daniel Barlow and contributors +;;; Copyright (c) 2001-2019 Daniel Barlow and contributors ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining ;;; a copy of this software and associated documentation files (the @@ -45,6 +45,17 @@ ;;; The problem with writing a defsystem replacement is bootstrapping: ;;; we can't use defsystem to compile it. Hence, all in one file. +#+genera +(eval-when (:compile-toplevel :load-toplevel :execute) + (multiple-value-bind (system-major system-minor) + (sct:get-system-version) + (multiple-value-bind (is-major is-minor) + (sct:get-system-version "Intel-Support") + (unless (or (> system-major 452) + (and is-major + (or (> is-major 3) + (and (= is-major 3) (> is-minor 86))))) + (error "ASDF requires either System 453 or later or Intel Support 3.87 or later"))))) ;;;; --------------------------------------------------------------------------- ;;;; Handle ASDF package upgrade, including implementation-dependent magic. ;; @@ -818,10 +829,10 @@ UNINTERN -- Remove symbols here from PACKAGE." ;;;; Early meta-level tweaks -#+(or allegro clasp clisp clozure cmucl ecl mezzano mkcl sbcl) +#+(or allegro clasp clisp clozure cmucl ecl lispworks mezzano mkcl sbcl) (eval-when (:load-toplevel :compile-toplevel :execute) (when (and #+allegro (member :ics *features*) - #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*) + #+(or clasp clisp cmucl ecl lispworks mkcl) (member :unicode *features*) #+clozure (member :openmcl-unicode-strings *features*) #+sbcl (member :sb-unicode *features*)) ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode @@ -1043,7 +1054,9 @@ Return a string made of the parts not omitted or emitted by FROB." #:simple-style-warning #:style-warn ;; simple style warnings #:match-condition-p #:match-any-condition-p ;; conditions #:call-with-muffled-conditions #:with-muffled-conditions - #:not-implemented-error #:parameter-error)) + #:not-implemented-error #:parameter-error + #:symbol-test-to-feature-expression + #:boolean-to-feature-expression)) (in-package :uiop/utility) ;;;; Defining functions in a way compatible with hot-upgrade: @@ -1089,17 +1102,17 @@ to supersede any previous definition." ;;; Magic debugging help. See contrib/debug.lisp (with-upgradability () (defvar *uiop-debug-utility* - '(or (ignore-errors - (probe-file (symbol-call :asdf :system-relative-pathname :uiop "contrib/debug.lisp"))) - (probe-file (symbol-call :uiop/pathname :subpathname - (user-homedir-pathname) "common-lisp/asdf/uiop/contrib/debug.lisp"))) + '(symbol-call :uiop :subpathname (symbol-call :uiop :uiop-directory) "contrib/debug.lisp") "form that evaluates to the pathname to your favorite debugging utilities") (defmacro uiop-debug (&rest keys) + "Load the UIOP debug utility at compile-time as well as runtime" `(eval-when (:compile-toplevel :load-toplevel :execute) (load-uiop-debug-utility ,@keys))) (defun load-uiop-debug-utility (&key package utility-file) + "Load the UIOP debug utility in given PACKAGE (default *PACKAGE*). +Beware: The utility is located by EVAL'uating the UTILITY-FILE form (default *UIOP-DEBUG-UTILITY*)." (let* ((*package* (if package (find-package package) *package*)) (keyword (read-from-string (format nil ":DBG-~:@(~A~)" (package-name *package*))))) @@ -1658,6 +1671,18 @@ message, that takes the functionality as its first argument (that can be skipped :format-control format-control :format-arguments format-arguments))) +(with-upgradability () + (defun boolean-to-feature-expression (value) + "Converts a boolean VALUE to a form suitable for testing with #+." + (if value + '(:and) + '(:or))) + + (defun symbol-test-to-feature-expression (name package) + "Check if a symbol with a given NAME exists in PACKAGE and returns a +form suitable for testing with #+." + (boolean-to-feature-expression + (find-symbol* name package nil)))) (uiop/package:define-package :uiop/version (:recycle :uiop/version :uiop/utility :asdf) (:use :uiop/common-lisp :uiop/package :uiop/utility) @@ -1672,7 +1697,7 @@ message, that takes the functionality as its first argument (that can be skipped (in-package :uiop/version) (with-upgradability () - (defparameter *uiop-version* "3.3.2") + (defparameter *uiop-version* "3.3.3") (defun unparse-version (version-list) "From a parsed version (a list of natural numbers), compute the version string" @@ -2335,8 +2360,8 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ;; See CLHS make-pathname and 19.2.2.2.3. ;; This will be :unspecific if supported, or NIL if not. (defparameter *unspecific-pathname-type* - #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific - #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil + #+(or abcl allegro clozure cmucl lispworks sbcl scl) :unspecific + #+(or genera clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME") (defun make-pathname* (&rest keys &key directory host device name type version defaults @@ -2574,7 +2599,14 @@ actually-existing directory." (make-pathname :directory (append (or (normalize-pathname-directory-component (pathname-directory pathspec)) (list :relative)) - (list (file-namestring pathspec))) + (list #-genera (file-namestring pathspec) + ;; On Genera's native filesystem (LMFS), + ;; directories have a type and version + ;; which must be ignored when converting + ;; to a directory pathname + #+genera (if (typep pathspec 'fs:lmfs-pathname) + (pathname-name pathspec) + (file-namestring pathspec)))) :name nil :type nil :version nil :defaults pathspec) (error (c) (call-function on-error (compatfmt "~@<error while trying to create a directory pathname for ~S: ~A~@:>") pathspec c))))))) @@ -3056,7 +3088,13 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" (or (ignore-errors (truename p)) ;; this is here because trying to find the truename of a directory pathname WITHOUT supplying ;; a trailing directory separator, causes an error on some lisps. - #+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d))))))) + #+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d))) + ;; On Genera, truename of a directory pathname will probably fail as Genera + ;; will merge in a filename/type/version from *default-pathname-defaults* and + ;; will try to get the truename of a file that probably doesn't exist. + #+genera (when (directory-pathname-p p) + (let ((d (scl:send p :directory-pathname-as-file))) + (ensure-directory-pathname (ignore-errors (truename d)) nil))))))) (defun safe-file-write-date (pathname) "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error." @@ -4832,7 +4870,6 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." (shell-boolean-exit (restore-image)))))))) (when forms `(progn ,@forms)))))) - #+(or clasp ecl mkcl) (check-type kind (member :dll :shared-library :lib :static-library :fasl :fasb :program)) (apply #+clasp 'cmp:builder #+clasp kind @@ -5209,12 +5246,28 @@ Simple means made of symbols, numbers, characters, simple-strings, pathnames, co (sb-c::undefined-warning-kind warning) (sb-c::undefined-warning-name warning) (sb-c::undefined-warning-count warning) + ;; the COMPILER-ERROR-CONTEXT struct has changed in SBCL, which means how we + ;; handle deferred warnings must change... TODO: when enough time has + ;; gone by, just assume all versions of SBCL are adequately + ;; up-to-date, and cut this material.[2018/05/30:rpg] (mapcar #'(lambda (frob) ;; the lexenv slot can be ignored for reporting purposes - `(:enclosing-source ,(sb-c::compiler-error-context-enclosing-source frob) - :source ,(sb-c::compiler-error-context-source frob) - :original-source ,(sb-c::compiler-error-context-original-source frob) + `( + #- #.(uiop/utility:symbol-test-to-feature-expression '#:compiler-error-context-%source '#:sb-c) + ,@`(:enclosing-source + ,(sb-c::compiler-error-context-enclosing-source frob) + :source + ,(sb-c::compiler-error-context-source frob) + :original-source + ,(sb-c::compiler-error-context-original-source frob)) + #+ #.(uiop/utility:symbol-test-to-feature-expression '#:compiler-error-context-%source '#:sb-c) + ,@ `(:%enclosing-source + ,(sb-c::compiler-error-context-enclosing-source frob) + :%source + ,(sb-c::compiler-error-context-source frob) + :original-form + ,(sb-c::compiler-error-context-original-form frob)) :context ,(sb-c::compiler-error-context-context frob) :file-name ,(sb-c::compiler-error-context-file-name frob) ; a pathname :file-position ,(sb-c::compiler-error-context-file-position frob) ; an integer @@ -5565,9 +5618,10 @@ it will filter them appropriately." (with-saved-deferred-warnings (warnings-file :source-namestring (namestring input-file)) (with-muffled-compiler-conditions () (or #-(or clasp ecl mkcl) - (apply 'compile-file input-file :output-file tmp-file - #+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords) - #-sbcl keywords) + (let (#+genera (si:*common-lisp-syntax-is-ansi-common-lisp* t)) + (apply 'compile-file input-file :output-file tmp-file + #+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords) + #-sbcl keywords)) #+ecl (apply 'compile-file input-file :output-file (if object-file (list* object-file :system-p t keywords) @@ -5619,19 +5673,20 @@ it will filter them appropriately." (defun load* (x &rest keys &key &allow-other-keys) "Portable wrapper around LOAD that properly handles loading from a stream." (with-muffled-loader-conditions () - (etypecase x - ((or pathname string #-(or allegro clozure genera) stream #+clozure file-stream) - (apply 'load x keys)) - ;; Genera can't load from a string-input-stream - ;; ClozureCL 1.6 can only load from file input stream - ;; Allegro 5, I don't remember but it must have been broken when I tested. - #+(or allegro clozure genera) - (stream ;; make do this way - (let ((*package* *package*) - (*readtable* *readtable*) - (*load-pathname* nil) - (*load-truename* nil)) - (eval-input x)))))) + (let (#+genera (si:*common-lisp-syntax-is-ansi-common-lisp* t)) + (etypecase x + ((or pathname string #-(or allegro clozure genera) stream #+clozure file-stream) + (apply 'load x keys)) + ;; Genera can't load from a string-input-stream + ;; ClozureCL 1.6 can only load from file input stream + ;; Allegro 5, I don't remember but it must have been broken when I tested. + #+(or allegro clozure genera) + (stream ;; make do this way + (let ((*package* *package*) + (*readtable* *readtable*) + (*load-pathname* nil) + (*load-truename* nil)) + (eval-input x))))))) (defun load-from-string (string) "Portably read and evaluate forms from a STRING." @@ -6930,7 +6985,7 @@ or an indication of failure via the EXIT-CODE of the process" (uiop/package:define-package :uiop/configuration (:recycle :uiop/configuration :asdf/configuration) ;; necessary to upgrade from 2.27. - (:use :uiop/common-lisp :uiop/utility + (:use :uiop/package :uiop/common-lisp :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/lisp-build) (:export #:user-configuration-directories #:system-configuration-directories ;; implemented in backward-driver @@ -6945,7 +7000,8 @@ or an indication of failure via the EXIT-CODE of the process" #:report-invalid-form #:invalid-configuration #:*ignored-configuration-form* #:*user-cache* #:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook #:resolve-location #:location-designator-p #:location-function-p #:*here-directory* - #:resolve-relative-location #:resolve-absolute-location #:upgrade-configuration)) + #:resolve-relative-location #:resolve-absolute-location #:upgrade-configuration + #:uiop-directory)) (in-package :uiop/configuration) (with-upgradability () @@ -7337,7 +7393,28 @@ or just the first one (for direction :output or :io). "Compute (and return) the location of the default user-cache for translate-output objects. Side-effects for cached file location computation." (setf *user-cache* (xdg-cache-home "common-lisp" :implementation))) - (register-image-restore-hook 'compute-user-cache)) + (register-image-restore-hook 'compute-user-cache) + + (defun uiop-directory () + "Try to locate the UIOP source directory at runtime" + (labels ((pf (x) (ignore-errors (probe-file* x))) + (sub (x y) (pf (subpathname x y))) + (ssd (x) (ignore-errors (symbol-call :asdf :system-source-directory x)))) + ;; NB: conspicuously *not* including searches based on #.(current-lisp-pathname) + (or + ;; Look under uiop if available as source override, under asdf if avaiable as source + (ssd "uiop") + (sub (ssd "asdf") "uiop/") + ;; Look in recommended path for user-visible source installation + (sub (user-homedir-pathname) "common-lisp/asdf/uiop/") + ;; Look in XDG paths under known package names for user-invisible source installation + (xdg-data-pathname "common-lisp/source/asdf/uiop/") + (xdg-data-pathname "common-lisp/source/cl-asdf/uiop/") ; traditional Debian location + ;; The last one below is useful for Fare, primary (sole?) known user + (sub (user-homedir-pathname) "cl/asdf/uiop/") + (cerror "Configure source registry to include UIOP source directory and retry." + "Unable to find UIOP directory") + (uiop-directory))))) ;;; ------------------------------------------------------------------------- ;;; Hacks for backward-compatibility with older versions of UIOP @@ -7372,7 +7449,8 @@ DEPRECATED. Use UIOP:XDG-CONFIG-PATHNAMES instead." (xdg-config-pathnames "common-lisp")) (defun system-configuration-directories () "Return the list of system configuration directories for common-lisp. -DEPRECATED. Use UIOP:CONFIG-SYSTEM-PATHNAMES instead." +DEPRECATED. Use UIOP:SYSTEM-CONFIG-PATHNAMES (with argument \"common-lisp\"), +instead." (system-config-pathnames "common-lisp")) (defun in-first-directory (dirs x &key (direction :input)) "Finds the first appropriate file named X in the list of DIRS for I/O @@ -7521,7 +7599,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.3.2") + (asdf-version "3.3.3") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -7534,7 +7612,7 @@ previously-loaded version of ASDF." ;;; Upon upgrade, specially frob some functions and classes that are being incompatibly redefined (when-upgrading () (let* ((previous-version (first *previous-asdf-versions*)) - (redefined-functions ;; List of functions that changes incompatibly since 2.27: + (redefined-functions ;; List of functions that changed incompatibly since 2.27: ;; gf signature changed (should NOT happen), defun that became a generic function, ;; method removed that will mess up with new ones (especially :around :before :after, ;; more specific or call-next-method'ed method) and/or semantics otherwise modified. Oops. @@ -7545,8 +7623,8 @@ previously-loaded version of ASDF." ;; Also note that we don't include the defgeneric=>defun, because they are ;; done directly with defun* and need not trigger a punt on data. ;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36 - `(,@(when (version<= previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 - ,@(when (version<= previous-version "3.1.7.20") '(#:find-component)))) + `(,@(when (version< previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 + ,@(when (version< previous-version "3.1.7.20") '(#:find-component)))) (redefined-classes ;; redefining the classes causes interim circularities ;; with the old ASDF during upgrade, and many implementations bork @@ -7883,9 +7961,9 @@ or NIL for top-level components (a.k.a. systems)")) (defmethod component-parent ((component null)) nil) ;; Deprecated: Backward compatible way of computing the FILE-TYPE of a component. - ;; TODO: find users, have them stop using that, remove it for ASDF4. - (defgeneric source-file-type (component system) - (:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead.")) + (with-asdf-deprecation (:style-warning "3.4") + (defgeneric source-file-type (component system) + (:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead."))) (define-condition duplicate-names (system-definition-error) ((name :initarg :name :reader duplicate-names-name)) @@ -8222,6 +8300,7 @@ Use of INITARGS is not supported at this time." #:system-source-file #:system-source-directory #:system-relative-pathname #:system-description #:system-long-description #:system-author #:system-maintainer #:system-licence #:system-license + #:system-version #:definition-dependency-list #:definition-dependency-set #:system-defsystem-depends-on #:system-depends-on #:system-weakly-depends-on #:component-build-pathname #:build-pathname @@ -8243,8 +8322,10 @@ Use of INITARGS is not supported at this time." If no system is found, then signal an error if ERROR-P is true (the default), or else return NIL. A system designator is usually a string (conventionally all lowercase) or a symbol, designating the same system as its downcased name; it can also be a system object (designating itself).")) + (defgeneric system-source-file (system) (:documentation "Return the source file in which system is defined.")) + ;; This is bad design, but was the easiest kluge I found to let the user specify that ;; some special actions create outputs at locations controled by the user that are not affected ;; by the usual output-translations. @@ -8263,6 +8344,7 @@ NB: This interface is subject to change. Please contact ASDF maintainers if you (with no argument) when running an image dumped from the COMPONENT. NB: This interface is subject to change. Please contact ASDF maintainers if you use it.")) + (defmethod component-entry-point ((c component)) nil)) @@ -8287,19 +8369,21 @@ a SYSTEM is redefined and its class is modified.")) (defclass system (module proto-system) ;; Backward-compatibility: inherit from module. ASDF4: only inherit from parent-component. (;; {,long-}description is now inherited from component, but we add the legacy accessors - (description :accessor system-description) - (long-description :accessor system-long-description) - (author :accessor system-author :initarg :author :initform nil) - (maintainer :accessor system-maintainer :initarg :maintainer :initform nil) - (licence :accessor system-licence :initarg :licence - :accessor system-license :initarg :license :initform nil) - (homepage :accessor system-homepage :initarg :homepage :initform nil) - (bug-tracker :accessor system-bug-tracker :initarg :bug-tracker :initform nil) - (mailto :accessor system-mailto :initarg :mailto :initform nil) - (long-name :accessor system-long-name :initarg :long-name :initform nil) + (description :writer (setf system-description)) + (long-description :writer (setf system-long-description)) + (author :writer (setf system-author) :initarg :author :initform nil) + (maintainer :writer (setf system-maintainer) :initarg :maintainer :initform nil) + (licence :writer (setf system-licence) :initarg :licence + :writer (setf system-license) :initarg :license + :initform nil) + (homepage :writer (setf system-homepage) :initarg :homepage :initform nil) + (bug-tracker :writer (setf system-bug-tracker) :initarg :bug-tracker :initform nil) + (mailto :writer (setf system-mailto) :initarg :mailto :initform nil) + (long-name :writer (setf system-long-name) :initarg :long-name :initform nil) ;; Conventions for this slot aren't clear yet as of ASDF 2.27, but whenever they are, they will be enforced. ;; I'm introducing the slot before the conventions are set for maximum compatibility. - (source-control :accessor system-source-control :initarg :source-control :initform nil) + (source-control :writer (setf system-source-control) :initarg :source-control :initform nil) + (builtin-system-p :accessor builtin-system-p :initform nil :initarg :builtin-system-p) (build-pathname :initform nil :initarg :build-pathname :accessor component-build-pathname) @@ -8375,6 +8459,35 @@ NB: The onus is unhappily on the user to avoid clashes." (frob-substrings (coerce-name name) '("/" ":" "\\") "--"))) +;;; System virtual slot readers, recursing to the primary system if needed. +(with-upgradability () + (defvar *system-virtual-slots* '(long-name description long-description + author maintainer mailto + homepage source-control + licence version bug-tracker) + "The list of system virtual slot names.") + (defun system-virtual-slot-value (system slot-name) + "Return SYSTEM's virtual SLOT-NAME value. +If SYSTEM's SLOT-NAME value is NIL and SYSTEM is a secondary system, look in +the primary one." + (or (slot-value system slot-name) + (unless (primary-system-p system) + (slot-value (find-system (primary-system-name system)) + slot-name)))) + (defmacro define-system-virtual-slot-reader (slot-name) + `(defun* ,(intern (concatenate 'string (string :system-) + (string slot-name))) + (system) + (system-virtual-slot-value system ',slot-name))) + (defmacro define-system-virtual-slot-readers () + `(progn ,@(mapcar (lambda (slot-name) + `(define-system-virtual-slot-reader ,slot-name)) + *system-virtual-slots*))) + (define-system-virtual-slot-readers) + (defun system-license (system) + (system-virtual-slot-value system 'licence))) + + ;;;; Pathnames (with-upgradability () @@ -10786,8 +10899,9 @@ Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD." (defvar *old-asdf-systems* (make-hash-table :test 'equal)) ;; (Private) function to check that a system that was found isn't an asdf downgrade. - ;; Returns T if everything went right, NIL if the system was an ASDF of the same or older version, - ;; that shall not be loaded. Also issue a warning if it was a strictly older version of ASDF. + ;; Returns T if everything went right, NIL if the system was an ASDF at an older version, + ;; or UIOP of the same or older version, that shall not be loaded. + ;; Also issue a warning if it was a strictly older version of ASDF. (defun check-not-old-asdf-system (name pathname) (or (not (member name '("asdf" "uiop") :test 'equal)) (null pathname) @@ -10798,9 +10912,12 @@ Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD." (read-file-form version-pathname :at (if asdfp '(0) '(2 2 2))))) (old-version (asdf-version))) (cond - ;; Don't load UIOP of the exact same version: we already loaded it as part of ASDF. - ((and (equal old-version version) (equal name "uiop")) nil) - ((version<= old-version version) t) ;; newer or same version: Good! + ;; Same version is OK for ASDF, to allow loading from modified source. + ;; However, do *not* load UIOP of the exact same version: + ;; it was already loaded it as part of ASDF and would only be double-loading. + ;; Be quiet about it, though, since it's a normal situation. + ((equal old-version version) asdfp) + ((version< old-version version) t) ;; newer version: Good! (t ;; old version: bad (ensure-gethash (list (namestring pathname) version) *old-asdf-systems* @@ -10962,6 +11079,8 @@ PREVIOUS-PRIMARY when not null is the primary system for the PREVIOUS system." #:class-for-type #:*default-component-class* #:determine-system-directory #:parse-component-form #:non-toplevel-system #:non-system-system #:bad-system-name + #:*known-systems-with-bad-secondary-system-names* + #:known-system-with-bad-secondary-system-names-p #:sysdef-error-component #:check-component-input #:explain)) (in-package :asdf/parse-defsystem) @@ -11114,7 +11233,7 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ ;;; "inline methods" (with-upgradability () (defparameter* +asdf-methods+ - '(perform-with-restarts perform explain output-files operation-done-p)) + '(perform-with-restarts perform explain output-files operation-done-p)) (defun %remove-component-inline-methods (component) (dolist (name +asdf-methods+) @@ -11127,19 +11246,55 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ (component-inline-methods component))) (component-inline-methods component) nil) + (defparameter *standard-method-combination-qualifiers* + '(:around :before :after)) + +;;; Find inline method definitions of the form +;;; +;;; :perform (test-op :before (operation component) ...) +;;; +;;; in REST (which is the plist of all DEFSYSTEM initargs) and define the specified methods. (defun %define-component-inline-methods (ret rest) + ;; find key-value pairs that look like inline method definitions in REST. For each identified + ;; definition, parse it and, if it is well-formed, define the method. (loop* :for (key value) :on rest :by #'cddr :for name = (and (keywordp key) (find key +asdf-methods+ :test 'string=)) :when name :do - (destructuring-bind (op &rest body) value - (loop :for arg = (pop body) - :while (atom arg) - :collect arg :into qualifiers - :finally - (destructuring-bind (o c) arg - (pushnew - (eval `(defmethod ,name ,@qualifiers ((,o ,op) (,c (eql ,ret))) ,@body)) - (component-inline-methods ret))))))) + ;; parse VALUE as an inline method definition of the form + ;; + ;; (OPERATION-NAME [QUALIFIER] (OPERATION-PARAMETER COMPONENT-PARAMETER) &rest BODY) + (destructuring-bind (operation-name &rest rest) value + (let ((qualifiers '())) + ;; ensure that OPERATION-NAME is a symbol. + (unless (and (symbolp operation-name) (not (null operation-name))) + (sysdef-error "Ill-formed inline method: ~S. The first element is not a symbol ~ + designating an operation but ~S." + value operation-name)) + ;; ensure that REST starts with either a cons (potential lambda list, further checked + ;; below) or a qualifier accepted by the standard method combination. Everything else + ;; is ill-formed. In case of a valid qualifier, pop it from REST so REST now definitely + ;; has to start with the lambda list. + (cond + ((consp (car rest))) + ((not (member (car rest) + *standard-method-combination-qualifiers*)) + (sysdef-error "Ill-formed inline method: ~S. Only a single of the standard ~ + qualifiers ~{~S~^ ~} is allowed, not ~S." + value *standard-method-combination-qualifiers* (car rest))) + (t + (setf qualifiers (list (pop rest))))) + ;; REST must start with a two-element lambda list. + (unless (and (listp (car rest)) + (length=n-p (car rest) 2) + (null (cddar rest))) + (sysdef-error "Ill-formed inline method: ~S. The operation name ~S is not followed by ~ + a lambda-list of the form (OPERATION COMPONENT) and a method body." + value operation-name)) + ;; define the method. + (destructuring-bind ((o c) &rest body) rest + (pushnew + (eval `(defmethod ,name ,@qualifiers ((,o ,operation-name) (,c (eql ,ret))) ,@body)) + (component-inline-methods ret))))))) (defun %refresh-component-inline-methods (component rest) ;; clear methods, then add the new ones @@ -11253,6 +11408,13 @@ system names contained using COERCE-NAME. Return the result." (coerce-name (component-system component)))) component))) + (defparameter* *known-systems-with-bad-secondary-system-names* + (list-to-hash-set '("cl-ppcre"))) + (defun known-system-with-bad-secondary-system-names-p (asd-name) + ;; Does .asd file with name ASD-NAME contain known exceptions + ;; that should be screened out of checking for BAD-SYSTEM-NAME? + (gethash asd-name *known-systems-with-bad-secondary-system-names*)) + (defun register-system-definition (name &rest options &key pathname (class 'system) (source-file () sfp) defsystem-depends-on &allow-other-keys) @@ -11270,8 +11432,11 @@ system names contained using COERCE-NAME. Return the result." (let* ((asd-name (and source-file (equal "asd" (fix-case (pathname-type source-file))) (fix-case (pathname-name source-file)))) + ;; note that PRIMARY-NAME is a *syntactically* primary name (primary-name (primary-system-name name))) - (when (and asd-name (not (equal asd-name primary-name))) + (when (and asd-name + (not (equal asd-name primary-name)) + (not (known-system-with-bad-secondary-system-names-p asd-name))) (warn (make-condition 'bad-system-name :source-file source-file :name name)))) (let* (;; NB: handle defsystem-depends-on BEFORE to create the system object, ;; so that in case it fails, there is no incomplete object polluting the build. @@ -11833,8 +11998,17 @@ which is probably not what you want; you probably need to tweak your output tran :static-library (resolve-symlinks* pathname)))) (defun linkable-system (x) - (or (if-let (s (find-system x)) + (or ;; If the system is available as source, use it. + (if-let (s (find-system x)) + (and (output-files 'lib-op s) s)) + ;; If an ASDF upgrade is available from source, but not a UIOP upgrade to that, + ;; then use the asdf/driver system instead of + ;; the UIOP that was disabled by check-not-old-asdf-system. + (if-let (s (and (equal (coerce-name x) "uiop") + (output-files 'lib-op "asdf") + (find-system "asdf/driver"))) (and (output-files 'lib-op s) s)) + ;; If there was no source upgrade, look for modules provided by the implementation. (if-let (p (system-module-pathname (coerce-name x))) (make-prebuilt-system x p)))) @@ -12567,7 +12741,7 @@ after having found a .asd file? True by default.") (recurse-beyond-asds *recurse-beyond-asds*) ignore-cache) (let ((visited (make-hash-table :test 'equalp))) (flet ((collectp (dir) - (unless (and (not ignore-cache) (process-source-registry-cache directory collect)) + (unless (and (not ignore-cache) (process-source-registry-cache dir collect)) (let ((asds (collect-asds-in-directory dir collect))) (or recurse-beyond-asds (not asds))))) (recursep (x) ; x will be a directory pathname @@ -13225,6 +13399,7 @@ system or its dependencies if it has already been loaded." #:system-maintainer #:system-license #:system-licence + #:system-version #:system-source-file #:system-source-directory #:system-relative-pathname ===================================== src/contrib/asdf/doc/asdf.html ===================================== The diff for this file was not included because it is too large. ===================================== src/contrib/asdf/doc/asdf.info ===================================== The diff for this file was not included because it is too large. ===================================== src/contrib/asdf/doc/asdf.pdf ===================================== Binary files a/src/contrib/asdf/doc/asdf.pdf and b/src/contrib/asdf/doc/asdf.pdf differ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/76fd7aeffcee03106d710b311… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/76fd7aeffcee03106d710b311… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0