GitLab

at 2025-12-03T18:30:46-08:00

Dummy commit to run pipeline

Just removed an extra line at the end of the file.

Undo previous change that deleted a blank line

Dummy commit to get CI to run to test out concurrent
builds. (concurrent=2).

Fix #455: Allow manual pipeline runs

Merge branch 'issue-455-manual-pipeline-run' into 'master'

Fix #455: Allow manual pipeline runs

Closes #455

See merge request cmucl/cmucl!334
Fix two important typos in unix-get-username and delete-directory

In `unix-get-username`, we were freeing `name` instead of `result`.
In `delete-directory`, we misspelled `recursive` as `recusive`.

Fix these typos.

Add some tests for unix-get-username and delete-directory

Add a simple test that unix-get-username returns something useful.

Add a test for delete-directory that tests it deletes directories as
specified, include recursively.

Fix #458:  Fix spurious overflow in double-double multiply

Merge branch 'issue-458-double-double-mult-overflow' into 'master'

Fix #458:  Fix spurious overflow in double-double multiply

Closes #458

See merge request cmucl/cmucl!337
Add fixed issue #458 to release notes

Forgot to do that.

[skip-ci]

Use (new) Ubuntu VM to run CI instead of OpenSUSE

Merge branch 'rtoy-add-ubuntu-runner' into 'master'

Use (new) Ubuntu VM to run CI instead of OpenSUSE

See merge request cmucl/cmucl!339
Fix #457:  delete-directory signals errors

Merge branch 'issue-457-delete-directory-signals-errors' into 'master'

Fix #457:  delete-directory signals errors

Closes #457

See merge request cmucl/cmucl!336
Remove extra blank lines

Addresses comment from !337:
https://gitlab.common-lisp.net/cmucl/cmucl/-/merge_requests/337#note_18529

Don't need to run CI for this.

[skip-ci]

Fix #460:  Exit with error if main unit-tests fail

Merge branch 'issue-460-ci-fails-if-unit-tests-do' into 'master'

Fix #460:  Exit with error if main unit-tests fail

Closes #460

See merge request cmucl/cmucl!340
Apply suggested change to use SOME and signal error not cerror

Merge branch 'master' into issue-454-signal-error-for-bad-pathname-parts

Fix merge conflict in tests/pathname.lisp

   script:

     - echo PATH = $PATH

     - ls -F /usr/local/bin

+    # Make sure gitlab-runner is available because it's needed by the

+    # VM to upload artifacts.

     - type -all gitlab-runner

     # Download binaries.  (Do we really need the extras tarball?)

     - $CURL -o cmucl-$version-$osname.tar.$tar_ext $download_url/cmucl-$version-$osname.tar.$tar_ext

     - if: $CI_PIPELINE_SOURCE == "push"

     - if: $CI_PIPELINE_SOURCE == "merge_request_event"

     - if: $CI_PIPELINE_SOURCE == "branch"

+    - if: $CI_PIPELINE_SOURCE == "web"

 linux:build:

   <<: *build_configuration

     - if: $CI_PIPELINE_SOURCE == "schedule"

     - if: $CI_PIPELINE_SOURCE == "push"

     - if: $CI_PIPELINE_SOURCE == "merge_request_event"

+    - if: $CI_PIPELINE_SOURCE == "web"

 linux:cross-build:

   stage: build

     - make -C build-4/lisp ANALYZER=-fanalyzer > analyzer.log 2>&1

 #### OpenSUSE jobs ####

-opensuse:install:

+ubuntu:install:

   <<: *install_configuration

   tags:

-    - opensuse

+    - ubuntu

   variables:

     osname: "linux"

     CURL: "curl"

-opensuse:build:

+ubuntu:build:

   <<: *build_configuration

   tags:

-    - opensuse

+    - ubuntu

   needs:

-    - job: opensuse:install

+    - job: ubuntu:install

       artifacts: true

-opensuse:test:

+ubuntu:test:

   <<: *unit_test_configuration

   tags:

-    - opensuse

+    - ubuntu

   needs:

     # Needs artifacts from build (dist/)

-    - job: opensuse:build

+    - job: ubuntu:build

       artifacts: true

-opensuse:ansi-test:

+ubuntu:ansi-test:

   <<: *ansi_test_configuration

   tags:

-    - opensuse

+    - ubuntu

   needs:

     # Needs artifacts from build (dist/)

-    - job: opensuse:build

+    - job: ubuntu:build

       artifacts: true

 # Optional job that runs the markdown link checker.  This is optional

     echo "run-tests.sh [-?h] [-d test-dir] [-l lisp] [tests]"

     echo "    -d test-dir  Directory containing the unit test files"

     echo "    -l lisp      Lisp to use for the tests; defaults to lisp"

+    echo "    -p           Skip package-local-nicknames test"

+    echo "    -u           Skip lisp-unit tests"

     echo "    -?           This help message"

     echo "    -h           This help message"

     echo ""

 }

 LISP=lisp

-while getopts "h?l:d:" arg

+while getopts "puh?l:d:" arg

 do

     case $arg in

       l) LISP=$OPTARG ;;

       d) TESTDIR=$OPTARG ;;

+      p) SKIP_PLN=yes ;;

+      u) SKIP_UNIT=yes ;;

       h|\?) usage ;;

     esac

 done

 ln -s /bin/ls test-tmp/ls-link

 # Set the timestamps on 64-bit-timestamp-2038.txt and

-# 64-bit-timestamp-2106.txt.  The time for the first file is a

-# negative value for a 32-bit time_t.  The second file won't fit in a

-# 32-bit time_t value.  It's ok if this doesn't work in general, as

-# long as it works on Linux for the stat test in tests/os.lisp.

-touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt

-touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt

+# 64-bit-timestamp-2106.txt, but only for OSes where we know this

+# works.  (This is so we don't an annoying error message from touch

+# that doesn't accept the -d option, like MacOS 10.13.)  The time for

+# the first file is a negative value for a 32-bit time_t.  The second

+# file won't fit in a 32-bit time_t value.  It's ok if this doesn't

+# work in general, as long as it works on Linux for the stat test in

+# tests/os.lisp.

+case `uname -s` in

+    Linux)

+	touch -d "1 April 2038" tests/resources/64-bit-timestamp-2038.txt

+	touch -d "1 April 2106" tests/resources/64-bit-timestamp-2106.txt

+	;;

+esac

 # Cleanup temp files and directories that we created during testing.

 function cleanup {

 # gcc since clang isn't always available.

 (cd "$TESTDIR" || exit 1 ; gcc -m32 -O3 -c test-return.c)

-if [ $# -eq 0 ]; then

-    # Test directory arg for run-all-tests if a non-default 

-    # No args so run all the tests

-    $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(cmucl-test-runner:run-all-tests ${TESTDIRARG})"

-else

-    # Run selected files.  Convert each file name to uppercase and append "-TESTS"

-    result=""

-    for f in "$@"

-    do

-	new=$(echo "$f" | tr '[:lower:]' '[:upper:]')

-        result="$result "\"$new-TESTS\"

-    done

-    $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))"

+if [ "$SKIP_UNIT" != "yes" ]; then

+    if [ $# -eq 0 ]; then

+	# Test directory arg for run-all-tests if a non-default 

+	# No args so run all the tests

+	$LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(cmucl-test-runner:run-all-tests ${TESTDIRARG})" ||

+	    exit 1

+    else

+	# Run selected files.  Convert each file name to uppercase and append "-TESTS"

+	result=""

+	for f in "$@"

+	do

+	    new=$(echo "$f" | tr '[:lower:]' '[:upper:]')

+            result="$result "\"$new-TESTS\"

+	done

+	# Run unit tests.  Exits with a non-zero code if there's a failure.

+

+	$LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" ||

+	    exit 1

+    fi

 fi

 ## Now run tests for trivial-package-local-nicknames

-REPO=trivial-package-local-nicknames

-BRANCH=cmucl-updates

+if [ "$SKIP_PLN" != "yes" ]; then

+    REPO=trivial-package-local-nicknames

+    BRANCH=cmucl-updates

-set -x

-if [ -d ../$REPO ]; then

-    (cd ../$REPO || exit 1; git stash; git checkout $BRANCH; git pull --rebase)

-else

-    (cd ..; git clone https://gitlab.common-lisp.net/cmucl/$REPO.git)

-fi

+    set -x

+    if [ -d ../$REPO ]; then

+	(cd ../$REPO || exit 1; git stash; git checkout $BRANCH; git pull --rebase)

+    else

+	(cd ..; git clone https://gitlab.common-lisp.net/cmucl/$REPO.git)

+    fi

-LISP=$PWD/$LISP

-cd ../$REPO || exit 1

-git checkout $BRANCH

+    LISP=$PWD/$LISP

+    cd ../$REPO || exit 1

+    git checkout $BRANCH

-# Run the tests.  Exits with a non-zero code if there's a failure.

-$LISP -noinit -nositeinit -batch <<'EOF'

+    # Run the tests.  Exits with a non-zero code if there's a failure.

+    $LISP -noinit -nositeinit -batch <<'EOF'

 (require :asdf)

 (push (default-directory) asdf:*central-registry*)

 (asdf:test-system :trivial-package-local-nicknames)

 EOF

+fi

 	     "INVALID-FASL"

 	     "WITH-TEMPORARY-DIRECTORY"

-	     "WITH-TEMPORARY-FILE")

+	     "WITH-TEMPORARY-FILE"

+	     "DELETE-DIRECTORY")

   ;; gencgc features

   #+gencgc

   (:export "GET-GC-ASSERTIONS"

 (defun delete-directory (dirname &key recursive)

   _N"Delete the directory Dirname.  If the Recursive is non-NIL,

   recursively delete the directory Dirname including all files and

-  subdirectories. Dirname must be a pathname to a directory.  Any NAME

-  or TYPE components in Dirname are ignored."

-  (declare (type pathname dirname))

-  (when recusive

+  subdirectories. Dirname must name a directory.  Any NAME or TYPE

+  components in Dirname are ignored.  A FILE-ERROR is signaled if any

+  directory cannot be deleted."

+  (when recursive

     ;; Find all the files or directories in DIRNAME.

     (dolist (path (directory (merge-pathnames "*.*" dirname)))

       ;; If the path is a directory, recursively delete the directory.

 	  (delete-directory path :recursive t)

 	  (delete-file path))))

   ;; Finally delete the directory.

-  (unix:unix-rmdir (namestring dirname))

-  (values))

+  (multiple-value-bind (ok errno)

+      (unix:unix-rmdir (namestring dirname))

+    (unless ok

+      (error 'kernel:simple-file-error

+	     :pathname dirname

+	     :format-control (intl:gettext "Could not remove directory \"~A\": ~A.")

+	     :format-arguments (list dirname

+				     (unix:get-unix-error-msg errno))))

+    ok))

 ;;; WITH-TEMPORARY-DIRECTORY  -- Public

     (flet ((check-component-validity (name name-or-type)

 	     (when (stringp name)

 	       (when (eq host (%pathname-host *default-pathname-defaults*))

-		 (when (find-if #'(lambda (c)

-				    ;; Illegal characters are a slash or NUL.

-				    (or (char= c #\/)

-					(char= c #\nul)))

+		 (when (some #'(lambda (c)

+				 ;; Illegal characters are a slash or NUL.

+				 (case c

+				   ((#\/ #\null) t)))

 				name)

-		   (cerror _"Continue anyway"

-			   _"Pathname component ~A cannot contain a slash or nul character: ~S"

+		   (error _"Pathname component ~A cannot contain a slash or nul character: ~S"

 			   name-or-type name))))))

       (check-component-validity name :pathname-name)

       (check-component-validity type :pathname-type)

 		  (cast result c-call:c-string)

 		  nil)

 	      status))

-	(free-alien name)))))

+	(free-alien result)))))

 	   (optimize (speed 3)))

   ;; If the numbers are too big, scale them done so SPLIT doesn't overflow.

   (multiple-value-bind (aa bb)

-      (values (if (> a +two970+)

+      (values (if (> (abs a) +two970+)

 		  (* a +two-53+)

 		  a)

-	      (if (> b +two970+)

+	      (if (> (abs b) +two970+)

 		  (* b +two-53+)

 		  b))

     (let ((p (* aa bb)))

 		(declare (optimize (inhibit-warnings 3)))

 	      ;; If the numbers was scaled down, we need to scale the

 	      ;; result back up.

-	      (when (> a +two970+)

+	      (when (> (abs a) +two970+)

 		(setf p (* p +two53+)

 		      e (* e +two53+)))

-	      (when (> b +two970+)

+	      (when (> (abs b) +two970+)

 		(setf p (* p +two53+)

 		      e (* e +two53+)))

 	      (values p e))))))))

     * #446: Use C compiler to get errno values to update UNIX

             defpackage with errno symbols

     * #453: Use correct flags for analyzer and always save logs.

+    * #458: Spurious overflow in double-double-float multiply

   * Other changes:

   * Improvements to the PCL implementation of CLOS:

   * Changes to building procedure:

 msgid ""

 "Delete the directory Dirname.  If the Recursive is non-NIL,\n"

 "  recursively delete the directory Dirname including all files and\n"

-"  subdirectories. Dirname must be a pathname to a directory.  Any NAME\n"

-"  or TYPE components in Dirname are ignored."

+"  subdirectories. Dirname must name a directory.  Any NAME or TYPE\n"

+"  components in Dirname are ignored.  A FILE-ERROR is signaled if any\n"

+"  directory cannot be deleted."

+msgstr ""

+

+#: src/code/extensions.lisp

+msgid "Could not remove directory \"~A\": ~A."

 msgstr ""

 #: src/code/extensions.lisp

 (in-package "FLOAT-X86-TESTS")

+;; This tests the floating-point modes for x86.  This works only if we

+;; have the feature :sse2 but not :darwin since darwin has always used

+;; sse2 and not x87.  But see also how FLOATING-POINT-MODES is

+;; implemented in src/code/float-trap.lisp.

+#+(and sse2 (not darwin))

 (define-test set-floating-point-modes

   (let ((old-x87-modes (x86::x87-floating-point-modes))

 	(old-sse2-modes (x86::sse2-floating-point-modes))

 			     (x86::x87-floating-point-modes)))))

     (assert-true (typep new-mode 'x86::float-modes))

     (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode))))

+

+;; Issue #458

+(define-test dd-mult-overflow

+  (:tag :issues)

+  (assert-equal -2w300

+		(* -2w300 1w0)))
       (assert-equal 2153718000 st-atime)

       (assert-equal 2153718000 st-mtime))))

+#+linux

 (define-test stat.64-bit-timestamp-2106

     (:tag :issues)

   (let ((test-file #.(merge-pathnames "resources/64-bit-timestamp-2106.txt"

                                  :truenamep nil :follow-links nil)))

       (assert-equal dir-tilde dir-home))))

+(define-test delete-directory

+  (:tag :issues)

+  (ext:with-temporary-directory (path)

+    (let ((dir (ensure-directories-exist (merge-pathnames "tmp/a/b/c/" path))))

+      ;; Try to delete the directory.  It should fail..

+      (assert-error 'kernel:simple-file-error

+		    (ext:delete-directory (merge-pathnames "tmp/" path)))

+      ;; Now recursively delete the directory.

+      (assert-true (ext:delete-directory (merge-pathnames "tmp/" path)

+					 :recursive t))

+      (assert-false (directory (merge-pathnames "tmp/" path))))))

+

 (define-test issue.454.illegal-pathname-chars

     (:tag :issues)

   ;; A slash (Unix directory separater) is not allowed.

 		(make-pathname :name "."))

   (assert-error 'simple-error

 		(make-pathname :name "..")))

+
     (assert-false result)

     (assert-true (and (integerp errno) (plusp errno)))))

-
+(define-test unix-get-username

+  (let ((uid (unix:unix-getuid)))

+    (assert-true uid)

+    (assert-true (unix::unix-get-username uid))))

Raymond Toy pushed to branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl

Commits:

14 changed files:

Changes: