Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions at cmucl / cmucl

Commits:

8 changed files:

Changes:

  • bin/run-unit-tests.sh
    ... ... @@ -9,8 +9,8 @@ usage() {
    9 9 
         echo "run-tests.sh [-?h] [-d test-dir] [-l lisp] [tests]"
    10 10 
         echo "    -d test-dir  Directory containing the unit test files"
    11 11 
         echo "    -l lisp      Lisp to use for the tests; defaults to lisp"
    12 
    -    echo "    -u           Skip lisp-unit tests"
    13 12 
         echo "    -p           Skip package-local-nicknames test"
    13 
    +    echo "    -u           Skip lisp-unit tests"
    14 14 
         echo "    -?           This help message"
    15 15 
         echo "    -h           This help message"
    16 16 
         echo ""
    ... ... @@ -27,13 +27,13 @@ usage() {
    27 27 
     }
    28 28
    29 29 
     LISP=lisp
    30 
    -while getopts "uph?l:d:" arg
    30 
    +while getopts "puh?l:d:" arg
    31 31 
     do
    32 32 
         case $arg in
    33 33 
           l) LISP=$OPTARG ;;
    34 34 
           d) TESTDIR=$OPTARG ;;
    35 
    -      u) SKIP_UNIT=yes ;;
    36 35 
           p) SKIP_PLN=yes ;;
    36 
    +      u) SKIP_UNIT=yes ;;
    37 37 
           h|\?) usage ;;
    38 38 
         esac
    39 39 
     done
    ... ... @@ -47,12 +47,19 @@ mkdir test-tmp
    47 47 
     ln -s /bin/ls test-tmp/ls-link
    48 48
    49 49 
     # Set the timestamps on 64-bit-timestamp-2038.txt and
    50 
    -# 64-bit-timestamp-2106.txt.  The time for the first file is a
    51 
    -# negative value for a 32-bit time_t.  The second file won't fit in a
    52 
    -# 32-bit time_t value.  It's ok if this doesn't work in general, as
    53 
    -# long as it works on Linux for the stat test in tests/os.lisp.
    54 
    -touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt
    55 
    -touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt
    50 
    +# 64-bit-timestamp-2106.txt, but only for OSes where we know this
    51 
    +# works.  (This is so we don't an annoying error message from touch
    52 
    +# that doesn't accept the -d option, like MacOS 10.13.)  The time for
    53 
    +# the first file is a negative value for a 32-bit time_t.  The second
    54 
    +# file won't fit in a 32-bit time_t value.  It's ok if this doesn't
    55 
    +# work in general, as long as it works on Linux for the stat test in
    56 
    +# tests/os.lisp.
    57 
    +case `uname -s` in
    58 
    +    Linux)
    59 
    +	touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt
    60 
    +	touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt
    61 
    +	;;
    62 
    +esac
    56 63
    57 64 
     # Cleanup temp files and directories that we created during testing.
    58 65 
     function cleanup {
    ... ... @@ -95,8 +102,6 @@ if [ "$SKIP_UNIT" != "yes" ]; then
    95 102 
     fi
    96 103
    97 104 
     ## Now run tests for trivial-package-local-nicknames
    98 
    -echo SKIP_PLN = $SKIP_PLN
    99 
    -
    100 105 
     if [ "$SKIP_PLN" != "yes" ]; then
    101 106 
         REPO=trivial-package-local-nicknames
    102 107 
         BRANCH=cmucl-updates

  • src/code/exports.lisp
    ... ... @@ -1213,7 +1213,8 @@
    1213 1213
    1214 1214 
     	     "INVALID-FASL"
    1215 1215 
     	     "WITH-TEMPORARY-DIRECTORY"
    1216 
    -	     "WITH-TEMPORARY-FILE")
    1216 
    +	     "WITH-TEMPORARY-FILE"
    1217 
    +	     "DELETE-DIRECTORY")
    1217 1218 
       ;; gencgc features
    1218 1219 
       #+gencgc
    1219 1220 
       (:export "GET-GC-ASSERTIONS"

  • src/code/extensions.lisp
    ... ... @@ -673,9 +673,9 @@
    673 673 
     (defun delete-directory (dirname &key recursive)
    674 674 
       _N"Delete the directory Dirname.  If the Recursive is non-NIL,
    675 675 
       recursively delete the directory Dirname including all files and
    676 
    -  subdirectories. Dirname must be a pathname to a directory.  Any NAME
    677 
    -  or TYPE components in Dirname are ignored."
    678 
    -  (declare (type pathname dirname))
    676 
    +  subdirectories. Dirname must name a directory.  Any NAME or TYPE
    677 
    +  components in Dirname are ignored.  A FILE-ERROR is signaled if any
    678 
    +  directory cannot be deleted."
    679 679 
       (when recursive
    680 680 
         ;; Find all the files or directories in DIRNAME.
    681 681 
         (dolist (path (directory (merge-pathnames "*.*" dirname)))
    ... ... @@ -685,8 +685,15 @@
    685 685 
     	  (delete-directory path :recursive t)
    686 686 
     	  (delete-file path))))
    687 687 
       ;; Finally delete the directory.
    688 
    -  (unix:unix-rmdir (namestring dirname))
    689 
    -  (values))
    688 
    +  (multiple-value-bind (ok errno)
    689 
    +      (unix:unix-rmdir (namestring dirname))
    690 
    +    (unless ok
    691 
    +      (error 'kernel:simple-file-error
    692 
    +	     :pathname dirname
    693 
    +	     :format-control (intl:gettext "Could not remove directory \"~A\": ~A.")
    694 
    +	     :format-arguments (list dirname
    695 
    +				     (unix:get-unix-error-msg errno))))
    696 
    +    ok))
    690 697
    691 698
    692 699 
     ;;; WITH-TEMPORARY-DIRECTORY  -- Public

  • src/i18n/locale/cmucl.pot
    ... ... @@ -6011,8 +6011,13 @@ msgstr ""
    6011 6011 
     msgid ""
    6012 6012 
     "Delete the directory Dirname.  If the Recursive is non-NIL,\n"
    6013 6013 
     "  recursively delete the directory Dirname including all files and\n"
    6014 
    -"  subdirectories. Dirname must be a pathname to a directory.  Any NAME\n"
    6015 
    -"  or TYPE components in Dirname are ignored."
    6014 
    +"  subdirectories. Dirname must name a directory.  Any NAME or TYPE\n"
    6015 
    +"  components in Dirname are ignored.  A FILE-ERROR is signaled if any\n"
    6016 
    +"  directory cannot be deleted."
    6017 
    +msgstr ""
    6018 
    +
    6019 
    +#: src/code/extensions.lisp
    6020 
    +msgid "Could not remove directory \"~A\": ~A."
    6016 6021 
     msgstr ""
    6017 6022
    6018 6023 
     #: src/code/extensions.lisp

  • tests/float-x86.lisp
    ... ... @@ -5,6 +5,11 @@
    5 5
    6 6 
     (in-package "FLOAT-X86-TESTS")
    7 7
    8 
    +;; This tests the floating-point modes for x86.  This works only if we
    9 
    +;; have the feature :sse2 but not :darwin since darwin has always used
    10 
    +;; sse2 and not x87.  But see also how FLOATING-POINT-MODES is
    11 
    +;; implemented in src/code/float-trap.lisp.
    12 
    +#+(and sse2 (not darwin))
    8 13 
     (define-test set-floating-point-modes
    9 14 
       (let ((old-x87-modes (x86::x87-floating-point-modes))
    10 15 
     	(old-sse2-modes (x86::sse2-floating-point-modes))

  • tests/float.lisp
    ... ... @@ -343,8 +343,6 @@
    343 343 
         (assert-true (typep new-mode 'x86::float-modes))
    344 344 
         (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode))))
    345 345
    346 
    -
    347 
    -
    348 346 
     ;; Issue #458
    349 347 
     (define-test dd-mult-overflow
    350 348 
       (:tag :issues)

  • tests/os.lisp
    ... ... @@ -51,6 +51,7 @@
    51 51 
           (assert-equal 2153718000 st-atime)
    52 52 
           (assert-equal 2153718000 st-mtime))))
    53 53
    54 
    +#+linux
    54 55 
     (define-test stat.64-bit-timestamp-2106
    55 56 
         (:tag :issues)
    56 57 
       (let ((test-file #.(merge-pathnames "resources/64-bit-timestamp-2106.txt"

  • tests/pathname.lisp
    ... ... @@ -144,14 +144,13 @@
    144 144 
           (assert-equal dir-tilde dir-home))))
    145 145
    146 146 
     (define-test delete-directory
    147 
    -  (let ((dir (ensure-directories-exist "tmp/a/b/c/")))
    148 
    -    ;; Verify that the directories were created.
    149 
    -    (assert-equal "tmp/a/b/c/"
    150 
    -		  dir)
    151 
    -    ;; Try to delete the directory.  It should fail, which we verify
    152 
    -    ;; by noting the directory listing is not empty.
    153 
    -    (ext::delete-directory (pathname "tmp/"))
    154 
    -    (assert-true (directory "tmp/"))
    155 
    -    ;; Now recursively delete the directory.
    156 
    -    (ext::delete-directory (pathname "tmp/") :recursive t)
    157 
    -    (assert-false (directory "tmp/"))))
    147 
    +  (:tag :issues)
    148 
    +  (ext:with-temporary-directory (path)
    149 
    +    (let ((dir (ensure-directories-exist (merge-pathnames "tmp/a/b/c/" path))))
    150 
    +      ;; Try to delete the directory.  It should fail..
    151 
    +      (assert-error 'kernel:simple-file-error
    152 
    +		    (ext:delete-directory (merge-pathnames "tmp/" path)))
    153 
    +      ;; Now recursively delete the directory.
    154 
    +      (assert-true (ext:delete-directory (merge-pathnames "tmp/" path)
    155 
    +					 :recursive t))
    156 
    +      (assert-false (directory "tmp/")))))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help Notification message regarding https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9c16379a168976b4d96b2451ae6da87876cfb248...c97ae992b0d0fab28efceebca938f3fe5f4fab00 at 1767391397