Raymond Toy pushed to branch issue-259-use-right-software-version at cmucl / cmucl

Commits:

10 changed files:

Changes:

  • src/bootfiles/21e/boot-2023-08.lisp
    ... ... @@ -2,4 +2,5 @@
    2 2 
     ;;
    3 3 
     ;; Build with -B boot-2023-08 from the 21e release.
    4 4 
     (ext:without-package-locks
    5 
    -  (unintern 'lisp::*software-version* "LISP"))
    5 
    +  (unintern 'lisp::*software-version* "LISP")
    6 
    +  (unexport 'system::*software-type* "SYSTEM"))

  • src/code/exports.lisp
    ... ... @@ -2057,8 +2057,6 @@
    2057 2057 
     	   "%SP-REVERSE-FIND-CHARACTER-WITH-ATTRIBUTE" "%STANDARD-CHAR-P"
    2058 2058 
     	   "*BEEP-FUNCTION*"
    2059 2059 
     	   "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*"
    2060 
    -	   "*SOFTWARE-TYPE*"
    2061 
    -           "*SOFTWARE-VERSION*"
    2062 2060 
                "*STDERR*" "*STDIN*" "*STDOUT*" "*TASK-DATA*"
    2063 2061 
     	   "*TASK-NOTIFY*" "*TASK-SELF*" "*TTY*" "*TYPESCRIPTPORT*"
    2064 2062 
     	   "*XWINDOW-TABLE*"

  • src/code/linux-os.lisp
    ... ... @@ -32,16 +32,3 @@
    32 32 
     ;;;
    33 33 
     (defun os-init ()
    34 34 
       (setf *software-version* nil))
    35 
    -
    36 
    -
    37 
    -;;; GET-PAGE-SIZE  --  Interface
    38 
    -;;;
    39 
    -;;;    Return the system page size.
    40 
    -;;;
    41 
    -(defun get-page-size ()
    42 
    -  (multiple-value-bind (val err)
    43 
    -      (unix:unix-getpagesize)
    44 
    -    (unless val
    45 
    -      (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err)))
    46 
    -    val))
    47 
    -

  • src/code/list.lisp
    ... ... @@ -928,7 +928,7 @@
    928 928
    929 929 
     (defun set-exclusive-or (list1 list2 &key key
    930 930 
                              (test #'eql testp) (test-not nil notp))
    931 
    -  "Return new list of elements appearing exactly once in LIST1 and LIST2."
    931 
    +  "Return new list of elements appearing exactly one of LIST1 and LIST2."
    932 932 
       (declare (inline member))
    933 933 
       (let ((result nil)
    934 934 
             (key (when key (coerce key 'function)))
    ... ... @@ -936,19 +936,38 @@
    936 936 
             (test-not (if test-not (coerce test-not 'function) #'eql)))
    937 937 
         (declare (type (or function null) key)
    938 938 
                  (type function test test-not))
    939 
    -    (dolist (elt list1)
    940 
    -      (unless (with-set-keys (member (apply-key key elt) list2))
    941 
    -	(setq result (cons elt result))))
    942 
    -    (let ((test (if testp
    943 
    -                    (lambda (x y) (funcall test y x))
    944 
    -                    test))
    945 
    -          (test-not (if notp
    946 
    -                        (lambda (x y) (funcall test-not y x))
    947 
    -                        test-not)))
    948 
    -      (dolist (elt list2)
    949 
    -        (unless (with-set-keys (member (apply-key key elt) list1))
    950 
    -          (setq result (cons elt result)))))
    951 
    -    result))
    939 
    +    ;; Find the elements in list1 that do not appear in list2 and add
    940 
    +    ;; them to the result.
    941 
    +    (macrolet
    942 
    +        ((compute-membership (item-list test-form)
    943 
    +           `(dolist (elt ,item-list)
    944 
    +              (unless ,test-form
    945 
    +                (setq result (cons elt result))))))
    946 
    +      (let ((hashtable (list-to-hashtable list2 key test test-not)))
    947 
    +        (cond
    948 
    +          (hashtable
    949 
    +           (compute-membership list1
    950 
    +                               (nth-value 1 (gethash (apply-key key elt) hashtable))))
    951 
    +          (t
    952 
    +           (compute-membership list1
    953 
    +                               (with-set-keys (member (apply-key key elt) list2))))))
    954 
    +      ;; Now find the elements in list2 that do not appear in list1 and
    955 
    +      ;; them to the result.
    956 
    +      (let ((hashtable (list-to-hashtable list1 key test test-not)))
    957 
    +        (cond
    958 
    +          (hashtable
    959 
    +           (compute-membership list2
    960 
    +                               (nth-value 1 (gethash (apply-key key elt) hashtable))))
    961 
    +          (t
    962 
    +           (let ((test (if testp
    963 
    +                           (lambda (x y) (funcall test y x))
    964 
    +                           test))
    965 
    +                 (test-not (if notp
    966 
    +                               (lambda (x y) (funcall test-not y x))
    967 
    +                               test-not)))
    968 
    +             (compute-membership list2
    969 
    +                                 (with-set-keys (member (apply-key key elt) list1)))))))
    970 
    +      result)))
    952 971
    953 972
    954 973 
     ;;; The outer loop examines list1 while the inner loop examines list2. If an

  • src/code/misc.lisp
    ... ... @@ -23,7 +23,12 @@
    23 23 
     	  short-site-name long-site-name dribble compiler-macro))
    24 24
    25 25 
     (in-package "SYSTEM")
    26 
    -(export '(*software-type* *short-site-name* *long-site-name*))
    26 
    +(export '(*short-site-name* *long-site-name*))
    27 
    +(defvar *software-type* "Unix"
    28 
    +  _N"The value of SOFTWARE-TYPE.  Set in FOO-os.lisp.")
    29 
    +
    30 
    +(defvar *software-version* nil
    31 
    +  _N"Version string for supporting software")
    27 32
    28 33 
     (in-package "EXT")
    29 34 
     (export 'featurep)
    ... ... @@ -80,20 +85,14 @@
    80 85 
       "Returns a string giving the name of the local machine."
    81 86 
       (unix:unix-gethostname))
    82 87
    83 
    -(defvar *software-type* "Unix"
    84 
    -  _N"The value of SOFTWARE-TYPE.  Set in FOO-os.lisp.")
    85 
    -
    86 88 
     (defun software-type ()
    87 89 
       "Returns a string describing the supporting software."
    88 
    -  *software-type*)
    89 
    -
    90 
    -(defvar *software-version* nil
    91 
    -  _N"Version string for supporting software")
    90 
    +  system::*software-type*)
    92 91
    93 92 
     (defun software-version ()
    94 93 
       _N"Returns a string describing version of the supporting software."
    95 
    -  (unless *software-version*
    96 
    -    (setf *software-version*
    94 
    +  (unless system::*software-version*
    95 
    +    (setf system::*software-version*
    97 96 
     	  (let (version result)
    98 97 
     	    (unwind-protect
    99 98 
     		 (progn
    ... ... @@ -105,7 +104,7 @@
    105 104 
     	    (if (zerop (length result))
    106 105 
     		"Unknown"
    107 106 
     		result)))
    108 
    -    *software-version*))
    107 
    +    system::*software-version*))
    109 108
    110 109 
     (defvar *short-site-name* nil
    111 110 
       "The value of SHORT-SITE-NAME.  Set in library:site-init.lisp.")

  • src/general-info/release-21f.md
    1 
    +# CMUCL 21f
    2 
    +
    1 3 
     # Work in progress
    2 4
    3 5 
     The CMUCL project is pleased to announce the release of CMUCL 21f.
    ... ... @@ -24,9 +26,16 @@ public domain.
    24 26 
       * Gitlab tickets:
    25 27 
         * ~~#154~~ piglatin translation does not work anymore
    26 28 
     	* ~~#171~~ Readably print `(make-pathname :name :unspecfic)`
    27 
    -	* ~~#242~~ Fix bug in `alien-funcall` with `c-call:char` as result type
    29 
    +    * ~~#196~~ Fix issues with mapping and nconc accumulation (mapcan)
    30 
    +    * ~~#216~~ `enough-namestring` with relative pathname fails
    31 
    +    * ~~#234~~ Make :ASCII external format builtin
    32 
    +    * ~~#240~~ Speed up set operations
    33 
    +    * ~~#242~~ Fix bug in `alien-funcall` with `c-call:char` as result type
    28 34 
         * ~~#244~~ Add `c-call:signed-char`
    29 35 
         * ~~#248~~ Print MOVS instruction with correct case
    36 
    +    * ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86
    37 
    +    * ~~#253~~ Block-compile list-to-hashtable and callers
    38 
    +    * ~~#258~~ Remove `get-page-size` from linux-os.lisp
    30 39 
       * Other changes:
    31 40 
       * Improvements to the PCL implementation of CLOS:
    32 41 
       * Changes to building procedure:

  • src/i18n/locale/cmucl-linux-os.pot
    ... ... @@ -15,10 +15,6 @@ msgstr ""
    15 15 
     "Content-Type: text/plain; charset=UTF-8\n"
    16 16 
     "Content-Transfer-Encoding: 8bit\n"
    17 17
    18 
    -#: src/code/linux-os.lisp
    19 
    -msgid "Getpagesize failed: ~A"
    20 
    -msgstr ""
    21 
    -
    22 18 
     #: src/code/signal.lisp
    23 19 
     msgid "Stack fault on coprocessor"
    24 20 
     msgstr ""

  • src/i18n/locale/cmucl.pot
    ... ... @@ -3236,7 +3236,7 @@ msgid "Destructively returns the elements of list1 which are not in list2."
    3236 3236 
     msgstr ""
    3237 3237
    3238 3238 
     #: src/code/list.lisp
    3239 
    -msgid "Return new list of elements appearing exactly once in LIST1 and LIST2."
    3239 
    +msgid "Return new list of elements appearing exactly one of LIST1 and LIST2."
    3240 3240 
     msgstr ""
    3241 3241
    3242 3242 
     #: src/code/list.lisp
    ... ... @@ -5619,6 +5619,14 @@ msgid ""
    5619 5619 
     "  NIL if no such character exists."
    5620 5620 
     msgstr ""
    5621 5621
    5622 
    +#: src/code/misc.lisp
    5623 
    +msgid "The value of SOFTWARE-TYPE.  Set in FOO-os.lisp."
    5624 
    +msgstr ""
    5625 
    +
    5626 
    +#: src/code/misc.lisp
    5627 
    +msgid "Version string for supporting software"
    5628 
    +msgstr ""
    5629 
    +
    5622 5630 
     #: src/code/misc.lisp
    5623 5631 
     msgid ""
    5624 5632 
     "If X is an atom, see if it is present in *FEATURES*.  Also\n"
    ... ... @@ -5645,18 +5653,10 @@ msgstr ""
    5645 5653 
     msgid "Returns a string giving the name of the local machine."
    5646 5654 
     msgstr ""
    5647 5655
    5648 
    -#: src/code/misc.lisp
    5649 
    -msgid "The value of SOFTWARE-TYPE.  Set in FOO-os.lisp."
    5650 
    -msgstr ""
    5651 
    -
    5652 5656 
     #: src/code/misc.lisp
    5653 5657 
     msgid "Returns a string describing the supporting software."
    5654 5658 
     msgstr ""
    5655 5659
    5656 
    -#: src/code/misc.lisp
    5657 
    -msgid "Version string for supporting software"
    5658 
    -msgstr ""
    5659 
    -
    5660 5660 
     #: src/code/misc.lisp
    5661 5661 
     msgid "Returns a string describing version of the supporting software."
    5662 5662 
     msgstr ""

  • tests/environ.lisp
    1 
    +;; Tests for environment dictionary
    2 
    +
    3 
    +(defpackage :environ-tests
    4 
    +  (:use :cl :lisp-unit))
    5 
    +
    6 
    +(in-package "ENVIRON-TESTS")
    7 
    +
    8 
    +(define-test software-type
    9 
    +    (:tag :issues)
    10 
    +  (let ((type (software-type)))
    11 
    +    ;; Can't really test anything, so just verify we get a non-empty
    12 
    +    ;; string.
    13 
    +    (assert-true (typep type 'string))
    14 
    +    (assert-true (plusp (length type)))))
    15 
    +
    16 
    +(define-test software-version
    17 
    +    (:tag :issues)
    18 
    +  (let ((version (software-version)))
    19 
    +    ;; Can't really test anything, so just verify we get a non-empty
    20 
    +    ;; string.
    21 
    +    (assert-true (typep version 'string))
    22 
    +    (assert-true (plusp (length version)))))
    23 
    +

  • tests/sets.lisp
    ... ... @@ -279,3 +279,26 @@
    279 279 
                              '(3 4)
    280 280 
                              :test 'eql
    281 281 
                              :test-not 'equal)))
    282 
    +
    283 
    +(define-test set-exclusive-or.1
    284 
    +  (:tag :issues)
    285 
    +  (flet
    286 
    +      ((test (min-length)
    287 
    +         ;; From CLHS
    288 
    +         (let ((lisp::*min-list-length-for-hashtable* min-length))
    289 
    +           (assert-equal '("b" "A" "b" "a")
    290 
    +                         (set-exclusive-or '(1 "a" "b")
    291 
    +                                           '(1 "A" "b")))
    292 
    +           (assert-equal '("A" "a")
    293 
    +                         (set-exclusive-or '(1 "a" "b")
    294 
    +                                           '(1 "A" "b")
    295 
    +                                           :test #'equal))
    296 
    +           (assert-equal nil
    297 
    +                         (set-exclusive-or '(1 "a" "b")
    298 
    +                                           '(1 "A" "b")
    299 
    +                                           :test #'equalp)))))
    300 
    +    ;; Test the list impl by making the min length large.  Then test
    301 
    +    ;; the hashtable impl with a very short min length
    302 
    +    (test 100)
    303 
    +    (test 2)))
    304 
    +

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help