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

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] Use plain awk and sort to create the file
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: 064b90cd by Raymond Toy at 2025-02-22T21:15:34-08:00 Use plain awk and sort to create the file Modify gen-errno-exports just to print the errno symbols in any order without the defpackage form. Modify create-errno-pkg.sh to sort the output from awk and print the defpackage form. Hopefully this will work on osx without having to install gawk. - - - - - 2 changed files: - bin/create-errno-pkg.sh - bin/gen-errno-exports.gawk Changes: ===================================== bin/create-errno-pkg.sh ===================================== @@ -6,5 +6,11 @@ case `uname -s` in Linux) ERRNO_FILES=/usr/include/asm-generic/errno*.h ;; esac - -gawk -f bin/gen-errno-exports.gawk ${ERRNO_FILES} + +cat <<EOF +(defpackage "UNIX-ERRNO" + (:export +`awk -f bin/gen-errno-exports.gawk ${ERRNO_FILES} | sort ` + )) + +EOF ===================================== bin/gen-errno-exports.gawk ===================================== @@ -1,18 +1,3 @@ -BEGIN { - count = 0 -} - /^#define[ \t]+(E[A-Z0-9]+)[ \t]+([A-Z0-9]+).*$/ { - errlist[count] = $2; - ++count; -} - -END { - asort(errlist) - print "(defpackage \"UNIX-ERRNO\"" - print " (:export" - for (k = 1; k < count; ++k) { - printf " \"%s\"\n", errlist[k]; - } - print " ))\n" + printf " \"%s\"\n", $2 } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/064b90cd180467e1379827c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/064b90cd180467e1379827c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] Forgot to commit create-errno-pkg.sh
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: 5e031d45 by Raymond Toy at 2025-02-22T19:39:10-08:00 Forgot to commit create-errno-pkg.sh Script to create the errno package file. - - - - - 1 changed file: - + bin/create-errno-pkg.sh Changes: ===================================== bin/create-errno-pkg.sh ===================================== @@ -0,0 +1,10 @@ +#! /bin/sh + +# For each supported OS, ERRNO_FILES should be set to a list of all +# the files that contain the definitions of the errno values. +case `uname -s` in + Linux) ERRNO_FILES=/usr/include/asm-generic/errno*.h + ;; +esac + +gawk -f bin/gen-errno-exports.gawk ${ERRNO_FILES} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5e031d45478487f70234276… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5e031d45478487f70234276… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] Attempt to get CI to work
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: 987d9d61 by Raymond Toy at 2025-02-22T19:22:36-08:00 Attempt to get CI to work In the CI scripts, remove the build dirs before building. Update bootstrap file to unintern the conflicting symbols. Currently only done for the Linux symbols. - - - - - 2 changed files: - .gitlab-ci.yml - src/bootfiles/21e/boot-2024-08.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -49,6 +49,7 @@ linux:build: # Regular build using the cross-compiled result or snapshot. The # analyzer job requires gcc, so make sure we build with gcc here # instead of clang. + - rm -rf linux-? - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # When the result of `git describe` cannot be used as a version @@ -193,6 +194,7 @@ osx:build: #- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp # Regular build using the cross-compiled result or snapshot. # Need /opt/local/bin to get msgmerge and msgfmt programs. + - rm -rf darwin-? - PATH=/opt/local/bin:$PATH bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp # If needed use -V to specify the version in case some tag makes git # describe return something that make-dist.sh doesn't like. @@ -317,6 +319,7 @@ opensuse:build: # Regular build using the cross-compiled result or snapshot. The # analyzer job requires gcc, so make sure we build with gcc here # instead of clang. + - rm -rf linux-? - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # If needed use -V to specify the version in case some tag makes git ===================================== src/bootfiles/21e/boot-2024-08.lisp ===================================== @@ -8,3 +8,31 @@ (declare (ignore c)) (invoke-restart 'continue)))) (defconstant +ef-max+ 14)) + +;; Unintern all the symbols in the UNIX package that conflict with the +;; symbols in the UNIX-ERRNO package. +(in-package "UNIX") +(ext:without-package-locks + (dolist (s '(UNIX:ENOENT UNIX:EINPROGRESS UNIX:EBADF UNIX:EXDEV UNIX:EADDRINUSE + UNIX:EBADE UNIX:EIDRM UNIX:ENOTEMPTY UNIX:EISDIR UNIX:ESTRPIPE UNIX:EPERM + UNIX:ENOTCONN UNIX:EREMOTEIO UNIX:ESUCCESS UNIX:ETOOMANYREFS + UNIX:EPROTONOSUPPORT UNIX:EEXIST UNIX:ENOSR UNIX:EBADR UNIX:EHOSTUNREACH + UNIX:EADDRNOTAVAIL UNIX:ENOTDIR UNIX:ENETRESET UNIX:ENFILE UNIX:EALREADY + UNIX:EDEADLOCK UNIX:ELIBSCN UNIX:ESTALE UNIX:EISNAM UNIX:ETXTBSY UNIX:ENOSTR + UNIX:ETIME UNIX:ECHILD UNIX:EUCLEAN UNIX:EBADMSG UNIX:EINVAL UNIX:EFBIG + UNIX:EIO UNIX:EAFNOSUPPORT UNIX:ELIBBAD UNIX:EILSEQ UNIX:ECONNREFUSED + UNIX:EBUSY UNIX:ECONNRESET UNIX:ENOTUNIQ UNIX:E2BIG UNIX:EL2HLT + UNIX:EDESTADDRREQ UNIX:ENETUNREACH UNIX:EUSERS UNIX:ENOPKG UNIX:EFAULT + UNIX:ENODEV UNIX:ERANGE UNIX:EROFS UNIX:EPROTO UNIX:ENONET UNIX:ESRMNT + UNIX:ENOMSG UNIX:EPROTOTYPE UNIX:EREMOTE UNIX:ESPIPE UNIX:EL3RST + UNIX:ENOLINK UNIX:EREMCHG UNIX:ERESTART UNIX:ESRCH UNIX:ELIBMAX UNIX:ENOSYS + UNIX:ECOMM UNIX:ECONNABORTED UNIX:ENXIO UNIX:ELIBEXEC UNIX:EMLINK + UNIX:ENAMETOOLONG UNIX:ELNRNG UNIX:EMULTIHOP UNIX:ENOLCK UNIX:EDOM + UNIX:EAGAIN UNIX:EDOTDOT UNIX:EL2NSYNC UNIX:EADV UNIX:ENOEXEC UNIX:ELIBACC + UNIX:ENOTBLK UNIX:EDEADLK UNIX:ENOBUFS UNIX:ECHRNG UNIX:EDQUOT UNIX:EBADFD + UNIX:EPIPE UNIX:EMSGSIZE UNIX:ENETDOWN UNIX:EWOULDBLOCK UNIX:ESHUTDOWN + UNIX:EOPNOTSUPP UNIX:EL3HLT UNIX:EINTR UNIX:ENOTTY UNIX:ENOPROTOOPT + UNIX:EPFNOSUPPORT UNIX:ENOSPC UNIX:EBFONT UNIX:EISCONN UNIX:EMFILE + UNIX:ESOCKTNOSUPPORT UNIX:EHOSTDOWN UNIX:EACCES UNIX:ENOTSOCK UNIX:EBADRQC + UNIX:ELOOP UNIX:ETIMEDOUT UNIX:ENAVAIL UNIX:EBADSLT UNIX:ENOANO UNIX:ENOMEM)) + (unintern s "UNIX"))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/987d9d6153ac3a9219809a5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/987d9d6153ac3a9219809a5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-365-add-strerror-with-generated-errno-pkg] 19 commits: Forgot to export "STRING-OCTET-COUNT" from STREAM package
by Raymond Toy (＠rtoy) 23 Feb '25

23 Feb '25

Raymond Toy pushed to branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl Commits: d80924da by Raymond Toy at 2025-02-12T15:54:22-08:00 Forgot to export "STRING-OCTET-COUNT" from STREAM package - - - - - 009e1382 by Raymond Toy at 2025-02-13T16:00:10+00:00 Fix #363: Add version number to files and directories - - - - - 5269a666 by Raymond Toy at 2025-02-13T16:00:10+00:00 Merge branch 'issue-363-add-version-number' into 'master' Fix #363: Add version number to files and directories Closes #363 See merge request cmucl/cmucl!261 - - - - - 67cb15e6 by Raymond Toy at 2025-02-15T15:34:50+00:00 Fix #379: Support GNU-style command line option names - - - - - 38da65c4 by Raymond Toy at 2025-02-15T15:34:50+00:00 Merge branch 'issue-379-gnu-style-options' into 'master' Fix #379: Support GNU-style command line option names Closes #379 See merge request cmucl/cmucl!266 - - - - - 03081eeb by Raymond Toy at 2025-02-17T01:52:03+00:00 Fix #382: Make command-line options be case-sensitive instead of case-insenstive - - - - - ee669070 by Raymond Toy at 2025-02-17T01:52:04+00:00 Merge branch 'issue-382-command-line-options-case-sensitive' into 'master' Fix #382: Make command-line options be case-sensitive instead of case-insenstive Closes #382 See merge request cmucl/cmucl!267 - - - - - 459c91bc by Raymond Toy at 2025-02-18T02:53:23+00:00 Fix #375: Return the name of the temp file or directory - - - - - daf83c84 by Raymond Toy at 2025-02-18T02:53:23+00:00 Merge branch 'issue-375-mkstemp-return-filename' into 'master' Fix #375: Return the name of the temp file or directory Closes #375 See merge request cmucl/cmucl!265 - - - - - ef48eb2a by Carl Shapiro at 2025-02-18T22:46:55-08:00 Document sap-ref-64 and signed-sap-ref-64 These functions have existed on almost all targets for many years now. - - - - - 6c8861a0 by Raymond Toy at 2025-02-20T13:55:13+00:00 Fix #384: Use correct header guard in elf.h - - - - - 5b452f9a by Raymond Toy at 2025-02-20T13:55:13+00:00 Merge branch 'issue-384-use-correct-header-guard' into 'master' Fix #384: Use correct header guard in elf.h Closes #384 See merge request cmucl/cmucl!270 - - - - - a6846d44 by Raymond Toy at 2025-02-21T03:13:50+00:00 Fix #385: Fix compiler warning about type mismatch between %p and the arg in Linux-os.c - - - - - f21c6507 by Raymond Toy at 2025-02-21T03:13:51+00:00 Merge branch 'issue-385-fix-compiler-warning-linux-os' into 'master' Fix #385: Fix compiler warning about type mismatch between %p and the arg in Linux-os.c Closes #385 See merge request cmucl/cmucl!271 - - - - - f370206e by Raymond Toy at 2025-02-21T13:25:03+00:00 Fix #365: Add Unix interface to strerror and use in get-unix-error-msg - - - - - 8ea8e2a0 by Raymond Toy at 2025-02-21T13:25:03+00:00 Merge branch 'issue-365-get-unix-error-msg-uses-strerror' into 'master' Fix #365: Add Unix interface to strerror and use in get-unix-error-msg Closes #365 See merge request cmucl/cmucl!272 - - - - - 576f422e by Raymond Toy at 2025-02-21T05:42:51-08:00 Update pot file due to changes introduced in !272 Some docstrings changed, so the pot file needs updating. Don't need to run CI for this change. [SKIP-CI] - - - - - cb65bb7e by Raymond Toy at 2025-02-21T05:52:50-08:00 Add recently closed issues to release notes Don't need CI for this change [SKIP-CI] - - - - - afdb23d3 by Raymond Toy at 2025-02-22T17:57:05-08:00 Merge branch 'master' into issue-365-add-strerror-with-generated-errno-pkg - - - - - 28 changed files: - .gitlab-ci.yml - bin/build-utils.sh - bin/build.sh - bin/cross-build-world.sh - + bin/git-version.sh - bin/load-world.sh - bin/make-dist.sh - bin/make-extra-dist.sh - bin/make-main-dist.sh - bin/make-src-dist.sh - bin/run-unit-tests.sh - src/code/commandline.lisp - src/code/default-site-init.lisp - src/code/exports.lisp - src/code/unix.lisp - src/compiler/arm/parms.lisp - src/compiler/ppc/parms.lisp - src/compiler/sparc/parms.lisp - src/compiler/x86/parms.lisp - src/docs/cmu-user/unix.tex - src/general-info/release-21f.md - src/i18n/locale/cmucl-bsd-os.pot - src/i18n/locale/cmucl.pot - src/lisp/Linux-os.c - src/lisp/elf.h - src/lisp/lisp.c - src/tools/worldload.lisp - + tests/unix.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -51,9 +51,9 @@ linux:build: # instead of clang. - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp - # Use -V to specify the version in case some tag makes git - # describe return something that make-dist.sh doesn't like. - - bin/make-dist.sh -V `git describe --dirty` -I dist linux-4 + # When the result of `git describe` cannot be used as a version + # string, an alternative can be provided with the -V flag + - bin/make-dist.sh -I dist linux-4 linux:cross-build: stage: build @@ -80,8 +80,8 @@ linux:cross-build: - bin/create-target.sh xtarget - bin/create-target.sh xcross - bin/cross-build-world.sh -crl xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp dist/bin/lisp - - bin/build.sh -b xlinux $bootstrap -R -C "" -o xtarget/lisp/lisp - - bin/make-dist.sh -V `git describe --dirty` -I xdist xlinux-4 + - bin/build.sh -b xlinux $bootstrap -R -C "" -o "xtarget/lisp/lisp -lib xtarget/lisp" + - bin/make-dist.sh -I xdist xlinux-4 linux:test: stage: test @@ -194,9 +194,9 @@ osx:build: # Regular build using the cross-compiled result or snapshot. # Need /opt/local/bin to get msgmerge and msgfmt programs. - PATH=/opt/local/bin:$PATH bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp - # Use -V to specify the version in case some tag makes git + # If needed use -V to specify the version in case some tag makes git # describe return something that make-dist.sh doesn't like. - - bin/make-dist.sh -V `git describe --dirty` -I dist darwin-4 + - bin/make-dist.sh -I dist darwin-4 osx:test: stage: test @@ -319,9 +319,9 @@ opensuse:build: # instead of clang. - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp - # Use -V to specify the version in case some tag makes git + # If needed use -V to specify the version in case some tag makes git # describe return something that make-dist.sh doesn't like. - - bin/make-dist.sh -V `git describe --dirty` -I dist linux-4 + - bin/make-dist.sh -I dist linux-4 opensuse:test: stage: test ===================================== bin/build-utils.sh ===================================== @@ -16,7 +16,7 @@ TARGET="`echo $1 | sed 's:/*$::'`" shift $TARGET/lisp/lisp \ - -noinit -nositeinit -batch "$@" <<EOF || exit 3 + -lib $TARGET/lisp -noinit -nositeinit -batch "$@" <<EOF || exit 3 (in-package :cl-user) (setf lisp::*enable-package-locked-errors* nil) ===================================== bin/build.sh ===================================== @@ -110,6 +110,13 @@ case `uname -s` in esac ;; esac +# Set default version and generate lisp/cmucl-version.h +DEFAULT_VERSION="`bin/git-version.sh`" +export DEFAULT_VERISON +echo DEFAULT_VERSION = $DEFAULT_VERSION + +bin/git-version.sh -f > src/lisp/cmucl-version.h + export LANG=en_US.UTF-8 buildit () @@ -146,9 +153,10 @@ buildit () then $BUILDWORLD $TARGET $OLDLISP $BOOT || { echo "Failed: $BUILDWORLD"; exit 1; } fi - $TOOLDIR/load-world.sh $TARGET "$VERSION" || { echo "Failed: $TOOLDIR/load-world.sh"; exit 1; } + $TOOLDIR/load-world.sh $TARGET || { echo "Failed: $TOOLDIR/load-world.sh"; exit 1; } + + $TARGET/lisp/lisp -lib $TARGET/lisp -batch -noinit -nositeinit < /dev/null || { echo "Failed: $TARGET/lisp/lisp -batch -noinit"; exit 1; } - $TARGET/lisp/lisp -batch -noinit -nositeinit < /dev/null || { echo "Failed: $TARGET/lisp/lisp -batch -noinit"; exit 1; } return 0; fi } @@ -230,7 +238,7 @@ buildit bootfiles= TARGET=$BASE-3 -OLDLISP="${BASE}-2/lisp/lisp $OLDLISPFLAGS" +OLDLISP="${BASE}-2/lisp/lisp -lib ${BASE}-2/lisp $OLDLISPFLAGS" ENABLE=$ENABLE3 BUILD=2 @@ -241,7 +249,7 @@ buildit TARGET=$BASE-4 CLEAN_FLAGS="-K all" -OLDLISP="${BASE}-3/lisp/lisp $OLDLISPFLAGS" +OLDLISP="${BASE}-3/lisp/lisp -lib ${BASE}-3/lisp $OLDLISPFLAGS" ENABLE=$ENABLE4 if [ "${BUILD_POT}" = "yes" ]; then @@ -259,7 +267,7 @@ buildit # Asdf and friends are part of the base install, so we need to build # them now. -$TARGET/lisp/lisp -noinit -nositeinit -batch << EOF || exit 3 +$TARGET/lisp/lisp -lib $TARGET/lisp -noinit -nositeinit -batch << EOF || exit 3 (in-package :cl-user) (setf (ext:search-list "target:") '("$TARGET/" "src/")) @@ -279,7 +287,7 @@ EOF if [ "$SKIPUTILS" = "no" ]; then - OLDLISP="${BASE}-4/lisp/lisp $OLDLISPFLAGS" + OLDLISP="${BASE}-4/lisp/lisp -lib ${BASE}-4/lisp $OLDLISPFLAGS" time $TOOLDIR/build-utils.sh $TARGET fi ===================================== bin/cross-build-world.sh ===================================== @@ -141,10 +141,11 @@ EOF if [ "$BUILD_RUNTIME" = "yes" ]; then echo Building runtime + bin/git-version.sh -f > src/lisp/cmucl-version.h (cd $TARGET/lisp; ${MAKE}) fi if [ "$LOAD_KERNEL" = "yes" ]; then echo Load kernel.core - bin/load-world.sh -p $TARGET cross-compiled + bin/load-world.sh -p $TARGET fi ===================================== bin/git-version.sh ===================================== @@ -0,0 +1,39 @@ +#!/bin/sh + +# If FILE=yes, print out the version as a C file #define. Otherwise, +# just print the version to stdout and exit. +FILE="" + +while getopts "f" arg; do + case $arg in + f) FILE=yes + ;; + esac +done + +# Script to determine the cmucl version based on git describe +GIT_HASH="`(git describe --dirty 2>/dev/null || git describe 2>/dev/null)`" + +if [ `expr "X$GIT_HASH" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]'` != 0 ]; then + # The git hash looks like snapshot-yyyy-mm-<stuff>. Remove the + # "snapshot-" part. + DEFAULT_VERSION=`expr "$GIT_HASH" : "snapshot-$.*$"` +elif [ `expr "X$GIT_HASH" : 'X[0-9][0-9][a-f]'` != 0 ]; then + # The git hash looks like a release which is 3 hex digits. Use it as is. + DEFAULT_VERSION="${GIT_HASH}" +fi + +if [ -z "$FILE" ]; then + echo $DEFAULT_VERSION +else + cat <<EOF +/* + * Cmucl version + * + * DO NOT EDIT! This file is auto-generated via bin/git-version.sh. + */ + +#define CMUCL_VERSION "$DEFAULT_VERSION" +EOF +fi + ===================================== bin/load-world.sh ===================================== @@ -2,30 +2,14 @@ usage() { - echo "load-world.sh [-?p] target-directory [version-string]" + echo "load-world.sh [-?p] target-directory" echo " -p Skip loading of PCL (Mostly for cross-compiling)" echo " -? This help" - echo " If the version-string is not given, the current date and time is used" exit 1 } SKIP_PCL= NO_PCL_FEATURE= -# Default version is the date with the git hash. Older versions of -# git don't support --dirty, but the output in that case is what we -# want (except for ending with "dirty"), so we're set. -GIT_HASH="`(cd src; git describe --dirty 2>/dev/null || git describe 2>/dev/null)`" - -# If the git hash looks like a snapshot tag or release, don't add the date. -VERSION="`date '+%Y-%m-%d %H:%M:%S'`${GIT_HASH:+ $GIT_HASH}" -if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then - VERSION="${GIT_HASH}" -fi - -if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then - VERSION="${GIT_HASH}" -fi -echo $VERSION while getopts "p" arg do ===================================== bin/make-dist.sh ===================================== @@ -94,21 +94,6 @@ def_arch_os () { # Figure out the architecture and OS in case options aren't given def_arch_os -# Choose a version based on the git hash as the default version. We -# only compute a default if the git hash looks like a snapshot -# ("snapshot-yyyy-mm") or a release number.. -GIT_HASH="`(cd src; git describe --dirty 2>/dev/null)`" - -echo GIT_HASH = ${GIT_HASH} - -if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then - DEFAULT_VERSION=`expr "${GIT_HASH}" : "snapshot-$.*$"` -fi - -if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then - DEFAULT_VERSION="${GIT_HASH}" -fi - # Default compression is -J (xz). These variables are passed to the # other scripts via the environmen, so export them. COMPRESS=-J @@ -159,17 +144,6 @@ if [ -n "$COMPRESS_ARG" ]; then esac fi -if [ -z "$VERSION" ]; then - # If a default version exists, use it. Otherwise this is an - # error---at least one of these must not be empty. - if [ -z "${DEFAULT_VERSION}" ]; then - echo "Version (-V) must be specified because default version cannot be determined." - usage - else - VERSION=${DEFAULT_VERSION} - fi -fi - if [ ! -d "$1" ] then echo "$1 isn't a directory" @@ -190,10 +164,24 @@ fi TARGET="`echo $1 | sed 's:/*$::'`" -if [ -n "$INSTALL_DIR" ]; then - VERSION="today" +# Choose a version based on the git hash as the default version. We +# only compute a default if the git hash looks like a snapshot +# ("snapshot-yyyy-mm") or a release number.. +DEFAULT_VERSION="`$TARGET/lisp/lisp --version`" + +if [ -z "$VERSION" ]; then + # If a default version exists, use it. Otherwise this is an + # error---at least one of these must not be empty. + if [ -z "${DEFAULT_VERSION}" ]; then + echo "Version (-V) must be specified because default version cannot be determined." + usage + else + VERSION=${DEFAULT_VERSION} + fi fi +echo INSTALL_DIR = $INSTALL_DIR + echo cmucl-$VERSION-$ARCH-$OS ROOT=`dirname $0` ===================================== bin/make-extra-dist.sh ===================================== @@ -66,6 +66,8 @@ VERSION=$2 ARCH=$3 OS=$4 +CMUCLLIBVER="lib/cmucl/$VERSION" + case $ARCH in x86*) FASL="sse2f" ;; sparc*) FASL=sparcf ;; @@ -90,41 +92,29 @@ if [ -z "$INSTALL_DIR" ]; then fi echo Installing extra components -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/subsystems +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/subsystems -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/contrib for ext in $FASL do install ${GROUP} ${OWNER} -m 0644 $TARGET/clx/clx-library.$ext \ - $DESTDIR/lib/cmucl/lib/subsystems/ + $DESTDIR/$CMUCLLIBVER/lib/subsystems/ install ${GROUP} ${OWNER} -m 0644 $TARGET/hemlock/hemlock-library.$ext \ - $DESTDIR/lib/cmucl/lib/subsystems/ + $DESTDIR/$CMUCLLIBVER/lib/subsystems/ install ${GROUP} ${OWNER} -m 0644 $TARGET/interface/clm-library.$ext \ - $DESTDIR/lib/cmucl/lib/subsystems/ + $DESTDIR/$CMUCLLIBVER/lib/subsystems/ done -# Not sure we really need these, but we'll install them in the -# ext-formats directory. (Should they go somewhere else?) -#install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/ext-formats -#for f in src/i18n/NameAliases.txt src/i18n/UnicodeData.txt -#do -# echo $f -# install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/ext-formats/ -#done - -# install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/fonts/ -# install ${GROUP} ${OWNER} -m 0644 misc/8x13u.snf misc/fonts.dir \ -# $DESTDIR/lib/cmucl/lib/fonts/ install ${GROUP} ${OWNER} -m 0644 src/hemlock/XKeysymDB \ src/hemlock/hemlock11.cursor src/hemlock/hemlock11.mask \ $TARGET/hemlock/spell-dictionary.bin \ - $DESTDIR/lib/cmucl/lib/ -install ${GROUP} ${OWNER} -m 0755 src/hemlock/mh-scan $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ +install ${GROUP} ${OWNER} -m 0755 src/hemlock/mh-scan $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0755 $TARGET/motif/server/motifd \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ # Install the contrib stuff. Create the directories and then copy the files. # @@ -132,39 +122,29 @@ install ${GROUP} ${OWNER} -m 0755 $TARGET/motif/server/motifd \ # these directories. for d in `(cd src; find contrib -type d -print | grep -v "asdf\|defsystem")` do - install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/$d + install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/$d done for f in `(cd src/contrib; find . -type f -print | grep -v "asdf\|defsystem\|unix")` do - FILE=`basename $f` DIR=`dirname $f` - install ${GROUP} ${OWNER} -m 0644 src/contrib/$f $DESTDIR/lib/cmucl/lib/contrib/$DIR + install ${GROUP} ${OWNER} -m 0644 src/contrib/$f $DESTDIR/$CMUCLLIBVER/lib/contrib/$DIR done # Install all the locale data. for d in `(cd src/i18n/; find locale -type d -print)` do - install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/$d + install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/$d done # Install mo files. Ignore any emacs-style backup files. for f in `(cd $TARGET/i18n; find locale -type f -print | grep -v '~.*~\|.*~')` do - FILE=`basename $f` DIR=`dirname $f` - install ${GROUP} ${OWNER} -m 0644 $TARGET/i18n/$f $DESTDIR/lib/cmucl/lib/$DIR + install ${GROUP} ${OWNER} -m 0644 $TARGET/i18n/$f $DESTDIR/$CMUCLLIBVER/lib/$DIR done -# Install po files. (Do we really need to distribute the po files?) -#for f in `(cd $TARGET/i18n; find locale -type f -print | grep -v '~.*~\|.*~')` -#do -# FILE=`basename $f` -# DIR=`dirname $f` -# install ${GROUP} ${OWNER} -m 0644 $TARGET/i18n/$f $DESTDIR/lib/cmucl/lib/$DIR -#done - if [ -z "$INSTALL_DIR" ]; then sync ; sleep 1 ; sync ; sleep 1 ; sync echo Tarring extra components ===================================== bin/make-main-dist.sh ===================================== @@ -64,14 +64,24 @@ then exit 2 fi -DESTDIR=${INSTALL_DIR:-release-$$} -DOCDIR=${DOCDIR:-doc/cmucl} -MANDIR=${MANDIR:-man/man1} -TARGET="`echo $1 | sed 's:/*$::'`" VERSION=$2 ARCH=$3 OS=$4 +# Where to install the main library of cmucl files +CMUCLLIBVER="lib/cmucl/$VERSION" + +# Where to install everything +DESTDIR=${INSTALL_DIR:-release-$$} + +# Where to install docs +DOCDIR=${DOCDIR:-share/cmucl/$VERSION/doc} + +# Where to install man pages +MANDIR=${MANDIR:-share/man/man1} + +TARGET="`echo $1 | sed 's:/*$::'`" + # Core file to look for. CORE=lisp.core case $ARCH in @@ -123,52 +133,59 @@ fi # set -x echo Installing main components install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/bin -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/subsystems -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/ext-formats +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/subsystems +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/ext-formats install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/${DOCDIR} install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/${MANDIR} -install ${GROUP} ${OWNER} -m 0755 $TARGET/lisp/lisp $DESTDIR/bin/ +install ${GROUP} ${OWNER} -m 0755 $TARGET/lisp/lisp $DESTDIR/bin/lisp-$VERSION +# Install symlink for lisp +(cd $DESTDIR/bin; ln -fs lisp-$VERSION lisp) +# Install symlink for man pages +(cd $DESTDIR/${MANDIR} + ln -fs lisp-$VERSION.1 lisp.1 + ln -fs cmucl-$VERSION.1 cmucl.1) + if [ "$EXECUTABLE" = "true" ] then - install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/lisp.a $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-init.o $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-final.o $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0755 src/tools/linker.sh $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/lisp.a $DESTDIR/$CMUCLLIBVER/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-init.o $DESTDIR/$CMUCLLIBVER/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-final.o $DESTDIR/$CMUCLLIBVER/lib/ + install ${GROUP} ${OWNER} -m 0755 src/tools/linker.sh $DESTDIR/$CMUCLLIBVER/lib/ if [ -f src/tools/$SCRIPT-cmucl-linker-script ]; then - install ${GROUP} ${OWNER} -m 0755 src/tools/$SCRIPT-cmucl-linker-script $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0755 src/tools/$SCRIPT-cmucl-linker-script $DESTDIR/$CMUCLLIBVER/lib/ fi fi for corefile in $TARGET/lisp/$CORE do - install ${GROUP} ${OWNER} -m 0644 $corefile $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0644 $corefile $DESTDIR/$CMUCLLIBVER/lib/ done install ${GROUP} ${OWNER} -m 0755 src/tools/load-foreign.csh src/tools/config \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0644 src/tools/config.lisp \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0644 src/code/default-site-init.lisp \ - $DESTDIR/lib/cmucl/lib/ + $DESTDIR/$CMUCLLIBVER/lib/ install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/lisp.nm $TARGET/lisp/lisp.map \ - $TARGET/lisp/internals.h $TARGET/lisp/internals.inc $DESTDIR/lib/cmucl/ -install ${GROUP} ${OWNER} -m 0755 src/tools/sample-wrapper $DESTDIR/lib/cmucl/ + $TARGET/lisp/internals.h $TARGET/lisp/internals.inc $DESTDIR/$CMUCLLIBVER/ +install ${GROUP} ${OWNER} -m 0755 src/tools/sample-wrapper $DESTDIR/$CMUCLLIBVER/ for f in gray-streams gray-compat simple-streams iodefs do - install ${GROUP} ${OWNER} -m 0644 $TARGET/pcl/$f-library.$FASL $DESTDIR/lib/cmucl/lib/subsystems/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/pcl/$f-library.$FASL $DESTDIR/$CMUCLLIBVER/lib/subsystems/ done for f in src/pcl/simple-streams/external-formats/*.lisp src/pcl/simple-streams/external-formats/aliases src/i18n/unidata.bin do - install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/ext-formats/ + install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/$CMUCLLIBVER/lib/ext-formats/ done # set -x # Create the directories for asdf and defsystem for f in asdf defsystem asdf/doc do - install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/$f + install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/contrib/$f done case `uname -s` in @@ -176,34 +193,34 @@ case `uname -s` in *) UCONTRIB="unix" ;; esac -install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/unix -install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/unix/$UCONTRIB.$FASL $DESTDIR/lib/cmucl/lib/contrib/unix -install ${GROUP} ${OWNER} -m 0644 src/contrib/load-unix.lisp $DESTDIR/lib/cmucl/lib/contrib -install ${GROUP} ${OWNER} -m 0644 src/contrib/unix/${UCONTRIB}.lisp $DESTDIR/lib/cmucl/lib/contrib/unix +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/$CMUCLLIBVER/lib/contrib/unix +install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/unix/$UCONTRIB.$FASL $DESTDIR/$CMUCLLIBVER/lib/contrib/unix +install ${GROUP} ${OWNER} -m 0644 src/contrib/load-unix.lisp $DESTDIR/$CMUCLLIBVER/lib/contrib +install ${GROUP} ${OWNER} -m 0644 src/contrib/unix/${UCONTRIB}.lisp $DESTDIR/$CMUCLLIBVER/lib/contrib/unix # Copy the source files for asdf and defsystem for f in `(cd src; find contrib/asdf contrib/defsystem -type f -print | grep -v CVS)` do - install ${GROUP} ${OWNER} -m 0644 src/$f $DESTDIR/lib/cmucl/lib/$f + install ${GROUP} ${OWNER} -m 0644 src/$f $DESTDIR/$CMUCLLIBVER/lib/$f done # Install the fasl files for asdf and defsystem for f in asdf defsystem do - install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/lib/cmucl/lib/contrib/$f + install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/$CMUCLLIBVER/lib/contrib/$f done # Install the docs for asdf for f in src/contrib/asdf/doc/* do base=`basename $f` - install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/contrib/asdf/doc/$base + install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/$CMUCLLIBVER/lib/contrib/asdf/doc/$base done install ${GROUP} ${OWNER} -m 0644 src/general-info/cmucl.1 \ - $DESTDIR/${MANDIR}/ + $DESTDIR/${MANDIR}/cmucl-$VERSION.1 install ${GROUP} ${OWNER} -m 0644 src/general-info/lisp.1 \ - $DESTDIR/${MANDIR}/ + $DESTDIR/${MANDIR}/lisp-$VERSION.1 install ${GROUP} ${OWNER} -m 0644 src/general-info/README $DESTDIR/${DOCDIR} if [ -f src/general-info/release-$VERSION.txt ] then ===================================== bin/make-src-dist.sh ===================================== @@ -52,12 +52,18 @@ else VERSION="`date '+%Y-%m-%d-%H:%M:%S'`" fi +DESTDIR=${INSTALL_DIR:-release-$$} + echo Creating source distribution GTAR_OPTIONS="--exclude=.git --exclude='*.pot.~*~'" +install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/share/cmucl/$VERSION/ +install ${GROUP} ${OWNER} -m 0755 bin/run-unit-tests.sh $DESTDIR/bin +${GTAR} ${GTAR_OPTIONS} -cf - src tests | (cd $DESTDIR/share/cmucl/$VERSION; ${GTAR} xf -) if [ -z "$INSTALL_DIR" ]; then # echo " Compressing with $ZIP" - ${GTAR} ${GTAR_OPTIONS} ${COMPRESS} -cf cmucl-src-$VERSION.tar.$COMPRESS_EXT bin src tests + ls $DESTDIR/share/cmucl/$VERSION/ + ${GTAR} ${GTAR_OPTIONS} ${COMPRESS} -C $DESTDIR -cf cmucl-src-$VERSION.tar.$COMPRESS_EXT share/cmucl/$VERSION/src else # Install in the specified directory - ${GTAR} ${GTAR_OPTIONS} -cf - bin src tests | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) + ${GTAR} ${GTAR_OPTIONS} -cf - src tests | (cd $DESTDIR/share/cmucl/$VERSION; ${GTAR:-tar} xf -) fi ===================================== bin/run-unit-tests.sh ===================================== @@ -6,7 +6,8 @@ # then just those tests are run. usage() { - echo "run-tests.sh [?] [-l lisp] [tests]" + echo "run-tests.sh [?] [-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 " -? This help message" echo "" @@ -23,10 +24,11 @@ usage() { } LISP=lisp -while getopts "h?l:" arg +while getopts "h?l:d:" arg do case $arg in l) LISP=$OPTARG ;; + d) TESTDIR=$OPTARG ;; \?) usage ;; esac done @@ -47,14 +49,21 @@ function cleanup { trap cleanup EXIT +if [ -n "${TESTDIR}" ]; then + TESTDIRARG=" :test-directory \"$TESTDIR/\"" +else + TESTDIR="tests/" + TESTDIRARG="" +fi # Compile up the C file that is used for testing alien funcalls to # functions that return integer types of different lengths. We use # gcc since clang isn't always available. -(cd tests; gcc -m32 -O3 -c test-return.c) +(cd "$TESTDIR"; 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 tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-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="" @@ -63,6 +72,6 @@ else new=`echo $f | tr '[a-z]' '[A-Z]'` result="$result "\"$new-TESTS\" done - $LISP -nositeinit -noinit -load tests/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" + $LISP -nositeinit -noinit -load "$TESTDIR"/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" fi ===================================== src/code/commandline.lisp ===================================== @@ -109,7 +109,13 @@ (return (setf *command-line-switches* (nreverse *command-line-switches*)))) (let* ((position (position #\= (the simple-string str) :test #'char=)) - (switch (subseq (the simple-string str) 1 position)) + ;; Extract the name of the switch. The actual arg can be + ;; "-switch" or "--switch". + (switch (subseq (the simple-string str) + (position-if-not #'(lambda (c) + (char= c #\-)) + str) + position)) (value (if position (subseq (the simple-string str) (1+ position) (length (the simple-string str)))))) @@ -143,7 +149,14 @@ the switch. If no value was specified, then any following words are returned. If there are no following words, then t is returned. If the switch was not specified, then nil is returned." - (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname)) + (let* ((posn (position-if-not #'(lambda (ch) + (char= ch #\-)) + sname)) + ;; Strip up to 2 leading "-" to get the switch name. + ;; Otherwise, return the entire switch name. + (name (if (and posn (<= posn 2)) + (subseq sname posn) + sname)) (switch (find name *command-line-switches* :test #'string-equal :key #'cmd-switch-name))) @@ -177,17 +190,17 @@ (demons *command-switch-demons*)) (flet ((invoke-demon (switch) (let* ((name (cmd-switch-name switch)) - (demon (cdr (assoc name demons :test #'string-equal)))) + (demon (cdr (assoc name demons :test #'string=)))) (cond (demon (funcall demon switch)) - ((or (member name *legal-cmd-line-switches* :test #'string-equal :key #'car) + ((or (member name *legal-cmd-line-switches* :test #'string= :key #'car) (not *complain-about-illegal-switches*))) (t (warn (intl:gettext "~S is an illegal switch") switch))) (lisp::finish-standard-output-streams)))) ;; We want to process -help (or --help) first, if it's given. ;; Since we're asking for help, we don't want to process any of ;; the other switches. - (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string-equal) - (find "-help" switches :key #'cmd-switch-name :test #'string-equal)))) + (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string=) + (find "-help" switches :key #'cmd-switch-name :test #'string=)))) (if maybe-help (invoke-demon maybe-help) (dolist (switch switches t) @@ -230,12 +243,12 @@ (lisp::finish-standard-output-streams) (setf start next))))) -;; Docstrings should have lines longer than 72 characters so that we -;; can print out the docstrings nicely on one line for help. -;; | <-- char 72 +;; Docstrings MUST consist of simple text and punctuation and +;; newlines; no special markup is allowed. When help is printed, the +;; help string is automatically filled and wrapped to 80 columns. (defswitch "eval" #'eval-switch-demon "Evaluate the specified Lisp expression during the start up - sequence. the value of the form will not be printed unless it is + sequence. The value of the form will not be printed unless it is wrapped in a form that does output." "expression") @@ -325,7 +338,7 @@ (defswitch "quiet" nil "Causes Lisp to start up silently, disabling printing of the herald - and causing most unnecessary noise, like GC messages,load messages, + and causing most unnecessary noise, like GC messages, load messages, etc. to be suppressed.") (defswitch "debug-lisp-search" nil @@ -338,7 +351,8 @@ (defun help-switch-demon (switch) (declare (ignore switch)) - (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*) + (format t (intl:gettext "~&Usage: ~A <options> [-- [app-args]*]~2%") + *command-line-utility-name*) (flet ((get-words (s) (declare (string s)) @@ -366,7 +380,12 @@ :key #'car)) (destructuring-bind (name doc arg) s - (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg))) + ;; Print both -switch and --switch, and the optional arg + ;; value. + (format t " -~A|--~A ~@[~A~]~%" + name name + (if arg (intl:gettext arg))) + ;; Poor man's formatting of the help string (let ((*print-right-margin* 80)) ;; Extract all the words from the string and print them out @@ -392,19 +411,14 @@ (defswitch "help" #'help-switch-demon "Print out the command line options and exit") -(defswitch "-help" #'help-switch-demon - "Same as -help.") - (defun version-switch-demon (switch) (declare (ignore switch)) (format t "~A~%" (lisp-implementation-version)) (ext:quit)) +;; the switches "-version" and "--version" are never actually called +;; from lisp because main() handles it and returns before the lisp +;; initial function is ever run. It's here so that -help will print +;; it out so the user knows about it. (defswitch "version" #'version-switch-demon - "Prints the cmucl version and exits") - -;; Make --version work for the benefit of those who are accustomed to -;; GNU software. -(defswitch "-version" #'version-switch-demon - "Prints the cmucl version and exits; same as -version") - + "Prints the cmucl version and exits, without loading the lisp core.") ===================================== src/code/default-site-init.lisp ===================================== @@ -32,13 +32,22 @@ ;;; bin/ ;;; lib/ ;;; cmucl/ -;;; lib/ -;;; lisp*.coore -;;; man/ -;;; src/ +;;; <version>/ +;;; lib/ +;;; share/ +;;; cmucl/ +;;; <version>/ +;;; src/ +;;; tests/ +;;; man/ +;;; man1/ ;;; ;;; If your sources are located somewhere else, change this ;;; accordingly. -(setf (search-list "target:") - '("library:../src/")) +(push (pathname + (concatenate 'string + "library:../../../../share/cmucl/" + lisp::*lisp-implementation-version* + "/src/")) + (search-list "target:")) ===================================== src/code/exports.lisp ===================================== @@ -1910,6 +1910,7 @@ "STRING-TO-OCTETS" "OCTETS-TO-STRING" "*DEFAULT-EXTERNAL-FORMAT*" "STRING-ENCODE" "STRING-DECODE" + "STRING-OCTET-COUNT" "SET-SYSTEM-EXTERNAL-FORMAT" "+REPLACEMENT-CHARACTER-CODE+" "LIST-ALL-EXTERNAL-FORMATS" ===================================== src/code/unix.lisp ===================================== @@ -2600,37 +2600,82 @@ (defun unix-mkstemp (template) _N"Generates a unique temporary file name from TEMPLATE, and creates and opens the file. On success, the corresponding file descriptor - and name of the file is returned. - - The last six characters of the template must be \"XXXXXX\"." - ;; Hope this buffer is large enough! - (let ((octets (%name->file template))) - (syscall ("mkstemp" c-call:c-string) + and name of the file is returned. Otherwise, NIL and the UNIX error + code is returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Convert the string to octets using the + ;; *FILENAME-ENCODING*. Should we signal an error if the + ;; string can't be encoded? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (syscall ("mkstemp" (* c-call:char)) (values result - ;; Convert the file name back to a Lisp string. - (%file->name octets)) - octets))) + (progn + ;; Copy out the alien bytes and convert back + ;; to a lisp string. + (system:without-gcing + (kernel:system-area-copy (alien-sap buffer) 0 + (vector-sap octets) 0 + (* length vm:byte-bits))) + (stream:octets-to-string octets + :external-format format))) + (cast buffer (* c-call:char)))))) (defun unix-mkdtemp (template) - _N"Generate a uniquely named temporary directory from Template, - which must have \"XXXXXX\" as the last six characters. The + _N"Generate a uniquely named temporary directory from Template. The directory is created with permissions 0700. The name of the - directory is returned." - (let* ((octets (%name->file template)) - (result (alien-funcall - (extern-alien "mkdtemp" - (function (* char) - c-call:c-string)) - octets))) - (if (null-alien result) - (values nil (unix-errno)) - (%file->name octets)))) + directory is returned. + + If the directory cannot be created NIL and the UNIX error code is + returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Encode the string using the appropriate + ;; *filename-encoding*. Should we signal an error if the + ;; string can't be encoded in that format? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (let ((result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + (* char))) + (cast buffer (* char))))) + ;; If mkdtemp worked, a non-NIL value is returned, return the + ;; resulting name. Otherwise, return NIL and the errno. + (if (null-alien result) + (values nil (unix-errno)) + (%file->name (cast result c-call:c-string))))))) (defun unix-strerror (errno) _N"Returns a string that describes the error code Errno" - (cast - (alien-funcall - (extern-alien "strerror" - (function (* char) int)) - errno) - c-string)) + (let ((result + (alien-funcall + (extern-alien "strerror" + (function (* char) int)) + errno))) + ;; Result from strerror can be localized so we need to decode + ;; those octets to get a proper Lisp string. + (string-decode (cast result c-string) :default))) ===================================== src/compiler/arm/parms.lisp ===================================== @@ -343,11 +343,11 @@ :key-or-value lisp::*unidata-path* + lisp::*lisp-implementation-version* ;; Some spare static symbols. Useful for adding another static ;; symbol without having to do a cross-compile. Just rename one ;; of these to the desired name. - spare-9 spare-8 spare-7 spare-6 ===================================== src/compiler/ppc/parms.lisp ===================================== @@ -295,9 +295,9 @@ :key-and-value :key-or-value + lisp::*lisp-implementation-version* ;; Spare symbols. Rename these when you need to add some static ;; symbols and don't want to do a cross-compile. - sparc-9 spare-8 spare-7 spare-6 ===================================== src/compiler/sparc/parms.lisp ===================================== @@ -358,11 +358,11 @@ *fp-constant-0f0* lisp::*unidata-path* + lisp::*lisp-implementation-version* ;; Some spare static symbols. Useful for adding another static ;; symbol without having to do a cross-compile. Just rename one ;; of these to the desired name. - spare-9 spare-8 spare-7 spare-6 ===================================== src/compiler/x86/parms.lisp ===================================== @@ -380,9 +380,9 @@ :key-or-value lisp::*unidata-path* + lisp::*lisp-implementation-version* ;; Spare symbols. Rename these when you need to add some static ;; symbols and don't want to do a cross-compile. - spare-9 spare-8 spare-7 spare-6 ===================================== src/docs/cmu-user/unix.tex ===================================== @@ -244,9 +244,10 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{sap-ref-16}{\args{\var{sap} \var{offset}}} - \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}}} - - These functions return the 8, 16 or 32 bit unsigned integer at + \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}} + \defunx[system:]{sap-ref-64}{\args{\var{sap} \var{offset}}} + + These functions return the 8, 16, 32 or 64 bit unsigned integer at \var{offset} from \var{sap}. The \var{offset} is always a byte offset, regardless of the number of bits accessed. \code{setf} may be used with the these functions to deposit values into virtual @@ -256,7 +257,8 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{signed-sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-16}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-32}{\args{\var{sap} \var{offset}}} - + \defunx[system:]{signed-sap-ref-64}{\args{\var{sap} \var{offset}}} + These functions are the same as the above unsigned operations, except that they sign-extend, returning a negative number if the high bit is set. ===================================== src/general-info/release-21f.md ===================================== @@ -27,6 +27,8 @@ public domain. * The RNG has changed from an old version of xoroshiro128+ to xoroshiro128**. This means sequences of random numbers will be different from before. See ~~#276~~. + * The layout of the distribution has changed. Version numbers are + added to files and directories. For the exact layout, see !261. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: @@ -112,9 +114,15 @@ public domain. * ~~#360~~ Adding site-init file * ~~#361~~ Add herald item to mention where to report issues * ~~#362~~ Simplify "library:" search-list + * ~~#363~~ Version numbers added to files and directories. The + distribution layout has changed. * ~~#364~~ Add interface to `mkdtemp` and `mkstemp` - * ~~#367~~ Add stream:string-count-octets to count octets in a string + * ~~#367~~ Add `stream:string-count-octets` to count octets in a string * ~~#369~~ Improve docstring for `unix::unix-setlocale` + * ~~#375~~ `unix-mkstemp` and `unix-mkdtemp` actually returns the + file names now. + * ~~#379~~ Support GNU-style command-line option names + * ~~#382~~ Command-line options are case-sensitive * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-bsd-os.pot ===================================== @@ -15,10 +15,6 @@ msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" -#: src/code/bsd-os.lisp -msgid "Unix system call getrusage failed: ~A." -msgstr "" - #: src/code/signal.lisp msgid "Emt instruction" msgstr "" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6060,7 +6060,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Evaluate the specified Lisp expression during the start up\n" -" sequence. the value of the form will not be printed unless it is\n" +" sequence. The value of the form will not be printed unless it is\n" " wrapped in a form that does output." msgstr "" @@ -6182,7 +6182,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Causes Lisp to start up silently, disabling printing of the herald\n" -" and causing most unnecessary noise, like GC messages,load messages,\n" +" and causing most unnecessary noise, like GC messages, load messages,\n" " etc. to be suppressed." msgstr "" @@ -6197,7 +6197,7 @@ msgid "Specify the unidata.bin file to be used." msgstr "" #: src/code/commandline.lisp -msgid "~&Usage: ~A <options>~2%" +msgid "~&Usage: ~A <options> [-- [app-args]*]~2%" msgstr "" #: src/code/commandline.lisp @@ -6205,15 +6205,7 @@ msgid "Print out the command line options and exit" msgstr "" #: src/code/commandline.lisp -msgid "Same as -help." -msgstr "" - -#: src/code/commandline.lisp -msgid "Prints the cmucl version and exits" -msgstr "" - -#: src/code/commandline.lisp -msgid "Prints the cmucl version and exits; same as -version" +msgid "Prints the cmucl version and exits, without loading the lisp core." msgstr "" #: src/code/env-access.lisp ===================================== src/lisp/Linux-os.c ===================================== @@ -476,7 +476,7 @@ sigsegv_handler(HANDLER_ARGS) #endif if (gc_write_barrier(code->si_addr)) return; - DPRINTF(0, (stderr, "sigsegv: PC: %p\n", SC_PC(os_context))); + DPRINTF(0, (stderr, "sigsegv: PC: %#lx\n", SC_PC(os_context))); #ifdef RED_ZONE_HIT { ===================================== src/lisp/elf.h ===================================== @@ -9,7 +9,7 @@ * interface to both elf and mach-o support. I (rtoy) was too lazy to * change the name to something more descriptive. */ -#if !defined(_ELF_H_INCLUDED_) +#if !defined(ELF_H_INCLUDED) #define ELF_H_INCLUDED ===================================== src/lisp/lisp.c ===================================== @@ -42,6 +42,12 @@ #include <time.h> #endif +#include "cmucl-version.h" + +#ifndef CMUCL_VERSION +#error CMUCL_VERSION not defined! +#endif + /* SIGINT handler that invokes the monitor. */ @@ -89,10 +95,11 @@ alloc_str_list(const char *list[]) } /* Default paths for CMUCLLIB */ + +static char cmucl_version[] = CMUCL_VERSION; + static char *cmucllib_search_list[] = { - "./.", - "./../lib/cmucl/lib", - "./../lib", + "./../lib/cmucl/" CMUCL_VERSION "/lib", NULL }; @@ -335,7 +342,7 @@ search_core(const char *lib, const char *default_core) return buf; } else { if (debug_lisp_search) { - fprintf(stderr, "Found it, but we can't read it!\n"); + fprintf(stderr, "Does not exist, or can't read it if it does!\n"); } } } while (*lib++ == ':'); @@ -453,6 +460,41 @@ core_failure(const char* core, const char* argv[]) exit(1); } +/* + * Match the actual command line option "arg" with the arg name in + * "argname". The option matches if it is exacty the arg name + * prefixed by either one or two "-" characters. + * + * Returns non-zero if it matches. + */ +int match_option(const char* arg, const char* argname) +{ + if ((strlen(arg) < 2) || strlen(argname) < 1) { + /* + * The actual arg must be at least 2 characters. The argname + * must have at least 1. + */ + return 0; + } + + /* Must start with a "-" */ + if (arg[0] != '-') { + return 0; + } + + if (strcmp(arg + 1, argname) == 0) { + /* We have "-" followed by the argname. That's a match. */ + return 1; + } + + if ((arg[1] == '-') && (strcmp(arg + 2, argname) == 0)) { + /* We have "--" followed by the argname. That's a match. */ + return 1; + } + + return 0; +} + int main(int argc, const char *argv[], const char *envp[]) { @@ -522,7 +564,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-core") == 0) { + if (match_option(arg, "core")) { if (builtin_image_flag) { fprintf(stderr, "Warning: specifying a core file with an executable image is unusual,\nbut should work.\n"); @@ -536,87 +578,98 @@ main(int argc, const char *argv[], const char *envp[]) core = *++argptr; if (core == NULL) { fprintf(stderr, - "-core must be followed by the name of the core file to use.\n"); + "%s must be followed by the name of the core file to use.\n", + arg); exit(1); } - } else if (strcmp(arg, "-lib") == 0) { + } else if (match_option(arg, "lib")) { lib = *++argptr; if (lib == NULL) { fprintf(stderr, - "-lib must be followed by a string denoting the CMUCL library path.\n"); + "%s must be followed by a string denoting the CMUCL library path.\n", + arg); exit(1); } - } else if (strcmp(arg, "-read-only-space-size") == 0) { + } else if (match_option(arg, "read-only-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-read-only-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } read_only_space_size = atoi(str) * 1024 * 1024; if (read_only_space_size > READ_ONLY_SPACE_SIZE) { fprintf(stderr, - "-read-only-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, READ_ONLY_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); read_only_space_size = READ_ONLY_SPACE_SIZE; } - } else if (strcmp(arg, "-static-space-size") == 0) { + } else if (match_option(arg, "static-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-static-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } static_space_size = atoi(str) * 1024 * 1024; if (static_space_size > STATIC_SPACE_SIZE) { fprintf(stderr, - "-static-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, STATIC_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); static_space_size = STATIC_SPACE_SIZE; } - } else if (strcmp(arg, "-binding-stack-size") == 0) { + } else if (match_option(arg, "binding-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-binding-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } binding_stack_size = atoi(str) * 1024 * 1024; if (binding_stack_size > BINDING_STACK_SIZE) { fprintf(stderr, - "-binding-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, BINDING_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); binding_stack_size = BINDING_STACK_SIZE; } - } else if (strcmp(arg, "-control-stack-size") == 0) { + } else if (match_option(arg, "control-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-control-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } control_stack_size = atoi(str) * 1024 * 1024; if (control_stack_size > CONTROL_STACK_SIZE) { fprintf(stderr, - "-control-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, CONTROL_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); control_stack_size = CONTROL_STACK_SIZE; } - } else if (strcmp(arg, "-dynamic-space-size") == 0) { + } else if (match_option(arg, "dynamic-space-size")) { const char *str; str = *++argptr; if (str == NULL) { fprintf(stderr, - "-dynamic-space-size must be followed by the size to use in MBytes.\n"); + "%s must be followed by the size to use in MBytes.\n", + arg); exit(1); } #ifndef sparc @@ -662,17 +715,26 @@ main(int argc, const char *argv[], const char *envp[]) #endif if (dynamic_space_size > DYNAMIC_SPACE_SIZE) { fprintf(stderr, - "-dynamic-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, DYNAMIC_SPACE_SIZE / (1024 * 1024UL)); exit(1); } - } else if (strcmp(arg, "-monitor") == 0) { + } else if (match_option(arg, "monitor")) { monitor = TRUE; - } else if (strcmp(arg, "-debug-lisp-search") == 0) { + } else if (match_option(arg, "debug-lisp-search")) { debug_lisp_search = TRUE; - } else if (strcmp(arg, "-unidata") == 0) { + } else if (match_option(arg, "unidata")) { unidata = *++argptr; - } + } else if ((strcmp(arg, "-version") == 0) || + (strcmp(arg, "--version") == 0)) { + /* + * Print the version and exit; we don't want to do + * anything else! + */ + printf("%s\n", cmucl_version); + return 0; + } } default_core = arch_init(fpu_mode); @@ -889,7 +951,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-batch") == 0) + if (match_option(arg, "batch")) SetSymbolValue(BATCH_MODE, T); } @@ -899,6 +961,10 @@ main(int argc, const char *argv[], const char *envp[]) } #endif +#ifdef LISP_IMPLEMENTATION_VERSION + SetSymbolValue(LISP_IMPLEMENTATION_VERSION, alloc_string(cmucl_version)); +#endif + /* * Pick off sigint until the lisp system gets far enough along to * install it's own. ===================================== src/tools/worldload.lisp ===================================== @@ -31,12 +31,6 @@ ;(setf lisp::*enable-dynamic-space-code* t) -;;; Get some data on this core. -;;; -(write-string "What is the current lisp-implementation-version? ") -(force-output) -(set '*lisp-implementation-version* (read-line)) - ;;; Load the rest of the reader (maybe byte-compiled.) (maybe-byte-load "target:code/sharpm") (maybe-byte-load "target:code/backq") ===================================== tests/unix.lisp ===================================== @@ -0,0 +1,91 @@ +;;; Tests for the unix interface + +(defpackage :unix-tests + (:use :cl :lisp-unit)) + +(in-package "UNIX-TESTS") + +(define-test mkstemp.name-returned + (:tag :issues) + (let (fd filename) + (unwind-protect + (progn + (let ((template "test-XXXXXX")) + (multiple-value-setq (fd filename) + (unix::unix-mkstemp (copy-seq template))) + (assert-true fd) + (assert-true (equalp (length filename) (length template))) + (assert-false (equalp filename template)) + (assert-true (>= 5 (mismatch filename template)))))) + (when fd + (unix:unix-unlink filename))))) + +(define-test mkstemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + fd name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "test-XXXXXX")) + (x-posn (position #\X template))) + (multiple-value-setq (fd name) + (unix::unix-mkstemp template)) + (assert-true fd) + (assert-false (search "XXXXXX" name) + name) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name))) + (when fd + (unix:unix-unlink name))))) + +(define-test mkstemp.bad-path + (:tag :issues) + (multiple-value-bind (fd errno) + ;; Assumes that the directory "random-dir" doesn't exist + (unix::unix-mkstemp "random-dir/test-XXXXXX") + ;; Can't create and open the file so the FD should be NIL, and a + ;; positive Unix errno value should be returned. + (assert-false fd) + (assert-true (and (integerp errno) (plusp errno))))) + +(define-test mkdtemp.name-returned + (:tag :issues) + (let (name) + (unwind-protect + (progn + (setf name (unix::unix-mkdtemp "dir-XXXXXX")) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "dir-XXXXXX")) + (x-posn (position #\X template))) + (setf name (unix::unix-mkdtemp template)) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name)) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name x-posn))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.bad-path + (:tag :issues) + (multiple-value-bind (result errno) + (unix::unix-mkdtemp "random-dir/dir-XXXXXX") + (assert-false result) + (assert-true (and (integerp errno) (plusp errno))))) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4af77606dab4504c65943c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4af77606dab4504c65943c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-365-add-strerror-with-generated-errno-pkg
by Raymond Toy (＠rtoy) 22 Feb '25

22 Feb '25

Raymond Toy pushed new branch issue-365-add-strerror-with-generated-errno-pkg at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-365-add-strerror-wi… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-381-cmucl-unix-os-specific] 15 commits: Fix #382: Make command-line options be case-sensitive instead of case-insenstive
by Raymond Toy (＠rtoy) 21 Feb '25

21 Feb '25

Raymond Toy pushed to branch issue-381-cmucl-unix-os-specific at cmucl / cmucl Commits: 03081eeb by Raymond Toy at 2025-02-17T01:52:03+00:00 Fix #382: Make command-line options be case-sensitive instead of case-insenstive - - - - - ee669070 by Raymond Toy at 2025-02-17T01:52:04+00:00 Merge branch 'issue-382-command-line-options-case-sensitive' into 'master' Fix #382: Make command-line options be case-sensitive instead of case-insenstive Closes #382 See merge request cmucl/cmucl!267 - - - - - 459c91bc by Raymond Toy at 2025-02-18T02:53:23+00:00 Fix #375: Return the name of the temp file or directory - - - - - daf83c84 by Raymond Toy at 2025-02-18T02:53:23+00:00 Merge branch 'issue-375-mkstemp-return-filename' into 'master' Fix #375: Return the name of the temp file or directory Closes #375 See merge request cmucl/cmucl!265 - - - - - ef48eb2a by Carl Shapiro at 2025-02-18T22:46:55-08:00 Document sap-ref-64 and signed-sap-ref-64 These functions have existed on almost all targets for many years now. - - - - - 6c8861a0 by Raymond Toy at 2025-02-20T13:55:13+00:00 Fix #384: Use correct header guard in elf.h - - - - - 5b452f9a by Raymond Toy at 2025-02-20T13:55:13+00:00 Merge branch 'issue-384-use-correct-header-guard' into 'master' Fix #384: Use correct header guard in elf.h Closes #384 See merge request cmucl/cmucl!270 - - - - - a6846d44 by Raymond Toy at 2025-02-21T03:13:50+00:00 Fix #385: Fix compiler warning about type mismatch between %p and the arg in Linux-os.c - - - - - f21c6507 by Raymond Toy at 2025-02-21T03:13:51+00:00 Merge branch 'issue-385-fix-compiler-warning-linux-os' into 'master' Fix #385: Fix compiler warning about type mismatch between %p and the arg in Linux-os.c Closes #385 See merge request cmucl/cmucl!271 - - - - - f370206e by Raymond Toy at 2025-02-21T13:25:03+00:00 Fix #365: Add Unix interface to strerror and use in get-unix-error-msg - - - - - 8ea8e2a0 by Raymond Toy at 2025-02-21T13:25:03+00:00 Merge branch 'issue-365-get-unix-error-msg-uses-strerror' into 'master' Fix #365: Add Unix interface to strerror and use in get-unix-error-msg Closes #365 See merge request cmucl/cmucl!272 - - - - - 576f422e by Raymond Toy at 2025-02-21T05:42:51-08:00 Update pot file due to changes introduced in !272 Some docstrings changed, so the pot file needs updating. Don't need to run CI for this change. [SKIP-CI] - - - - - cb65bb7e by Raymond Toy at 2025-02-21T05:52:50-08:00 Add recently closed issues to release notes Don't need CI for this change [SKIP-CI] - - - - - 705a8753 by Raymond Toy at 2025-02-21T07:06:41-08:00 Merge branch 'master' into issue-381-cmucl-unix-os-specific - - - - - 5fb73c95 by Raymond Toy at 2025-02-21T07:20:13-08:00 Just prefix docstring with _N Instead of trying to create a new text domain, prefix the docstring for `*enable-darwin-path-normalization*` with `_N` so that it's included even when not compiling on macos. Update cmucl.pot with the new docstring. - - - - - 10 changed files: - src/code/commandline.lisp - src/code/pathname.lisp - src/code/unix.lisp - src/docs/cmu-user/unix.tex - src/general-info/release-21f.md - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - src/lisp/Linux-os.c - src/lisp/elf.h - + tests/unix.lisp Changes: ===================================== src/code/commandline.lisp ===================================== @@ -190,17 +190,17 @@ (demons *command-switch-demons*)) (flet ((invoke-demon (switch) (let* ((name (cmd-switch-name switch)) - (demon (cdr (assoc name demons :test #'string-equal)))) + (demon (cdr (assoc name demons :test #'string=)))) (cond (demon (funcall demon switch)) - ((or (member name *legal-cmd-line-switches* :test #'string-equal :key #'car) + ((or (member name *legal-cmd-line-switches* :test #'string= :key #'car) (not *complain-about-illegal-switches*))) (t (warn (intl:gettext "~S is an illegal switch") switch))) (lisp::finish-standard-output-streams)))) ;; We want to process -help (or --help) first, if it's given. ;; Since we're asking for help, we don't want to process any of ;; the other switches. - (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string-equal) - (find "-help" switches :key #'cmd-switch-name :test #'string-equal)))) + (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string=) + (find "-help" switches :key #'cmd-switch-name :test #'string=)))) (if maybe-help (invoke-demon maybe-help) (dolist (switch switches t) ===================================== src/code/pathname.lisp ===================================== @@ -268,13 +268,12 @@ ;;; from parsed arguments. #+darwin -(intl:with-textdomain ("cmucl-darwin-os") (defvar *enable-darwin-path-normalization* nil - "When non-NIL, pathnames are on Darwin are normalized when created. + _N"When non-NIL, pathnames are on Darwin are normalized when created. Otherwise, the pathnames are unchanged. This must be NIL during bootstrapping because Unicode is not yet - available.")) + available.") (defun %make-pathname-object (host device directory name type version) (if (typep host 'logical-host) ===================================== src/code/unix.lisp ===================================== @@ -2053,9 +2053,7 @@ _N"Returns a string describing the error number which was returned by a UNIX system call." (declare (type integer error-number)) - (if (array-in-bounds-p *unix-errors* error-number) - (svref *unix-errors* error-number) - (format nil _"Unknown error [~d]" error-number))) + (unix::unix-strerror error-number)) ;;;; Lisp types used by syscalls. @@ -2913,28 +2911,82 @@ (defun unix-mkstemp (template) _N"Generates a unique temporary file name from TEMPLATE, and creates and opens the file. On success, the corresponding file descriptor - and name of the file is returned. - - The last six characters of the template must be \"XXXXXX\"." - ;; Hope this buffer is large enough! - (let ((octets (%name->file template))) - (syscall ("mkstemp" c-call:c-string) + and name of the file is returned. Otherwise, NIL and the UNIX error + code is returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Convert the string to octets using the + ;; *FILENAME-ENCODING*. Should we signal an error if the + ;; string can't be encoded? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (syscall ("mkstemp" (* c-call:char)) (values result - ;; Convert the file name back to a Lisp string. - (%file->name octets)) - octets))) + (progn + ;; Copy out the alien bytes and convert back + ;; to a lisp string. + (system:without-gcing + (kernel:system-area-copy (alien-sap buffer) 0 + (vector-sap octets) 0 + (* length vm:byte-bits))) + (stream:octets-to-string octets + :external-format format))) + (cast buffer (* c-call:char)))))) (defun unix-mkdtemp (template) - _N"Generate a uniquely named temporary directory from Template, - which must have \"XXXXXX\" as the last six characters. The + _N"Generate a uniquely named temporary directory from Template. The directory is created with permissions 0700. The name of the - directory is returned." - (let* ((octets (%name->file template)) - (result (alien-funcall - (extern-alien "mkdtemp" - (function (* char) - c-call:c-string)) - octets))) - (if (null-alien result) - (values nil (unix-errno)) - (%file->name octets)))) + directory is returned. + + If the directory cannot be created NIL and the UNIX error code is + returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Encode the string using the appropriate + ;; *filename-encoding*. Should we signal an error if the + ;; string can't be encoded in that format? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (let ((result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + (* char))) + (cast buffer (* char))))) + ;; If mkdtemp worked, a non-NIL value is returned, return the + ;; resulting name. Otherwise, return NIL and the errno. + (if (null-alien result) + (values nil (unix-errno)) + (%file->name (cast result c-call:c-string))))))) + +(defun unix-strerror (errno) + _N"Returns a string that describes the error code Errno" + (let ((result + (alien-funcall + (extern-alien "strerror" + (function (* char) int)) + errno))) + ;; Result from strerror can be localized so we need to decode + ;; those octets to get a proper Lisp string. + (string-decode (cast result c-string) :default))) ===================================== src/docs/cmu-user/unix.tex ===================================== @@ -244,9 +244,10 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{sap-ref-16}{\args{\var{sap} \var{offset}}} - \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}}} - - These functions return the 8, 16 or 32 bit unsigned integer at + \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}} + \defunx[system:]{sap-ref-64}{\args{\var{sap} \var{offset}}} + + These functions return the 8, 16, 32 or 64 bit unsigned integer at \var{offset} from \var{sap}. The \var{offset} is always a byte offset, regardless of the number of bits accessed. \code{setf} may be used with the these functions to deposit values into virtual @@ -256,7 +257,8 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{signed-sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-16}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-32}{\args{\var{sap} \var{offset}}} - + \defunx[system:]{signed-sap-ref-64}{\args{\var{sap} \var{offset}}} + These functions are the same as the above unsigned operations, except that they sign-extend, returning a negative number if the high bit is set. ===================================== src/general-info/release-21f.md ===================================== @@ -117,9 +117,12 @@ public domain. * ~~#363~~ Version numbers added to files and directories. The distribution layout has changed. * ~~#364~~ Add interface to `mkdtemp` and `mkstemp` - * ~~#367~~ Add stream:string-count-octets to count octets in a string + * ~~#367~~ Add `stream:string-count-octets` to count octets in a string * ~~#369~~ Improve docstring for `unix::unix-setlocale` + * ~~#375~~ `unix-mkstemp` and `unix-mkdtemp` actually returns the + file names now. * ~~#379~~ Support GNU-style command-line option names + * ~~#382~~ Command-line options are case-sensitive * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1284,10 +1284,6 @@ msgid "" " UNIX system call." msgstr "" -#: src/code/unix.lisp -msgid "Unknown error [~d]" -msgstr "" - #: src/code/unix.lisp msgid "" "Perform the UNIX select(2) system call.\n" @@ -1434,16 +1430,21 @@ msgstr "" msgid "" "Generates a unique temporary file name from TEMPLATE, and creates\n" " and opens the file. On success, the corresponding file descriptor\n" -" and name of the file is returned.\n" -"\n" -" The last six characters of the template must be \"XXXXXX\"." +" and name of the file is returned. Otherwise, NIL and the UNIX error\n" +" code is returned." msgstr "" #: src/code/unix.lisp msgid "" -"Generate a uniquely named temporary directory from Template,\n" -" which must have \"XXXXXX\" as the last six characters. The\n" +"Generate a uniquely named temporary directory from Template. The\n" " directory is created with permissions 0700. The name of the\n" -" directory is returned." +" directory is returned.\n" +"\n" +" If the directory cannot be created NIL and the UNIX error code is\n" +" returned." +msgstr "" + +#: src/code/unix.lisp +msgid "Returns a string that describes the error code Errno" msgstr "" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -9667,6 +9667,15 @@ msgid "" " an otherwise undefined logical host." msgstr "" +#: src/code/pathname.lisp +msgid "" +"When non-NIL, pathnames are on Darwin are normalized when created.\n" +" Otherwise, the pathnames are unchanged.\n" +"\n" +" This must be NIL during bootstrapping because Unicode is not yet\n" +" available." +msgstr "" + #: src/code/pathname.lisp msgid "A path specification, either a string, file-stream or pathname." msgstr "" ===================================== src/lisp/Linux-os.c ===================================== @@ -476,7 +476,7 @@ sigsegv_handler(HANDLER_ARGS) #endif if (gc_write_barrier(code->si_addr)) return; - DPRINTF(0, (stderr, "sigsegv: PC: %p\n", SC_PC(os_context))); + DPRINTF(0, (stderr, "sigsegv: PC: %#lx\n", SC_PC(os_context))); #ifdef RED_ZONE_HIT { ===================================== src/lisp/elf.h ===================================== @@ -9,7 +9,7 @@ * interface to both elf and mach-o support. I (rtoy) was too lazy to * change the name to something more descriptive. */ -#if !defined(_ELF_H_INCLUDED_) +#if !defined(ELF_H_INCLUDED) #define ELF_H_INCLUDED ===================================== tests/unix.lisp ===================================== @@ -0,0 +1,91 @@ +;;; Tests for the unix interface + +(defpackage :unix-tests + (:use :cl :lisp-unit)) + +(in-package "UNIX-TESTS") + +(define-test mkstemp.name-returned + (:tag :issues) + (let (fd filename) + (unwind-protect + (progn + (let ((template "test-XXXXXX")) + (multiple-value-setq (fd filename) + (unix::unix-mkstemp (copy-seq template))) + (assert-true fd) + (assert-true (equalp (length filename) (length template))) + (assert-false (equalp filename template)) + (assert-true (>= 5 (mismatch filename template)))))) + (when fd + (unix:unix-unlink filename))))) + +(define-test mkstemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + fd name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "test-XXXXXX")) + (x-posn (position #\X template))) + (multiple-value-setq (fd name) + (unix::unix-mkstemp template)) + (assert-true fd) + (assert-false (search "XXXXXX" name) + name) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name))) + (when fd + (unix:unix-unlink name))))) + +(define-test mkstemp.bad-path + (:tag :issues) + (multiple-value-bind (fd errno) + ;; Assumes that the directory "random-dir" doesn't exist + (unix::unix-mkstemp "random-dir/test-XXXXXX") + ;; Can't create and open the file so the FD should be NIL, and a + ;; positive Unix errno value should be returned. + (assert-false fd) + (assert-true (and (integerp errno) (plusp errno))))) + +(define-test mkdtemp.name-returned + (:tag :issues) + (let (name) + (unwind-protect + (progn + (setf name (unix::unix-mkdtemp "dir-XXXXXX")) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "dir-XXXXXX")) + (x-posn (position #\X template))) + (setf name (unix::unix-mkdtemp template)) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name)) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name x-posn))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.bad-path + (:tag :issues) + (multiple-value-bind (result errno) + (unix::unix-mkdtemp "random-dir/dir-XXXXXX") + (assert-false result) + (assert-true (and (integerp errno) (plusp errno))))) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/767a5f09aab6bbd29437ff… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/767a5f09aab6bbd29437ff… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Convert more tests to use with-temporary-foo
by Raymond Toy (＠rtoy) 21 Feb '25

21 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 63fdbf0b by Raymond Toy at 2025-02-21T06:14:57-08:00 Convert more tests to use with-temporary-foo - - - - - c8b9082b by Raymond Toy at 2025-02-21T06:21:49-08:00 Convert test to use with-temporary-file - - - - - 2 changed files: - tests/fd-streams.lisp - tests/trac.lisp Changes: ===================================== tests/fd-streams.lisp ===================================== @@ -17,6 +17,7 @@ (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t)) +#+nil (define-test clear-output-1 (:tag :trac) (assert-eql @@ -34,3 +35,20 @@ (setf s (open *test-file*)) (file-length s)) (delete-file *test-file*)))) + +(define-test clear-output-1 + (:tag :trac) + (assert-eql + 0 + (ext:with-temporary-file (test-file) + (let ((s (open test-file + :direction :output + :if-exists :supersede))) + ;; Write a character to the (fully buffered) output + ;; stream. Clear the output and close the file. Nothing + ;; should have been written to the file. + (write-char #\a s) + (clear-output s) + (close s) + (setf s (open test-file)) + (file-length s))))) ===================================== tests/trac.lisp ===================================== @@ -123,6 +123,7 @@ (assert-equal (values #\H 8) (bug :utf32))))) +#+nil (define-test trac.36 (:tag :trac) (flet ((bug (&optional (format :utf16)) @@ -137,6 +138,24 @@ (assert-equal (values #\H 8) (bug :utf32)))) +(define-test trac.36 + (:tag :trac) + (flet ((bug (&optional (format :utf16)) + (ext:with-temporary-file (path) + (with-open-file (s path + :direction :output + :external-format format) + (format s "Hello~%")) + (with-open-file (s path + :direction :input + :external-format format) + (let ((ch (read-char s))) + (values ch (file-position s))))))) + (assert-equal (values #\H 4) + (bug :utf16)) + (assert-equal (values #\H 8) + (bug :utf32))))) + #+nil (define-test trac.43 (:tag :trac) @@ -157,6 +176,7 @@ (let ((p0* (file-position stream))) (eql p0* p0))))))))) +#+nil (define-test trac.43 (:tag :trac) (assert-true @@ -174,11 +194,25 @@ (let ((p0* (file-position stream))) (eql p0* p0))))))) +(define-test trac.43 + (:tag :trac) + (assert-true + (ext:with-temporary-stream (stream :direction :io :external-format :utf-8) + (dotimes (i 1000) + (write-char (code-char #x1234) stream)) + (file-position stream 0) + (let ((p0 (file-position stream)) + (ch (read-char stream))) + (unread-char ch stream) + (let ((p0* (file-position stream))) + (eql p0* p0)))))) + (define-test trac.50 (:tag :trac) (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))" (princ-to-string (make-pathname :directory '(:absolute "tmp" "" "a" "" "b"))))) +#+nil (define-test trac.58 (:tag :trac) (assert-false @@ -198,6 +232,23 @@ failures) (delete-file path))))) +(define-test trac.58 + (:tag :trac) + (assert-false + (let (failures) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :external-format :utf-16) + (dotimes (i 300) + (write-char (code-char i) s))) + + (with-open-file (s path :direction :input :external-format :utf-16) + (dotimes (i 300) + (let ((ch (read-char s nil nil))) + (unless (= i (char-code ch)) + (push (list i ch (char-code ch)) failures))))) + failures)) + failures)) + (define-test trac.63 (:tag :trac) (assert-eql @@ -282,6 +333,7 @@ (assert-equal "A1234AAAA" (subseq (trac.70-test *trac.70* "a12345") 0 9))) +#+nil (define-test trac.79 (:tag :trac) ;; Create a temp file full of latin1 characters. @@ -301,12 +353,29 @@ (file-position s))))) (delete-file path))))) +(define-test trac.79 + (:tag :trac) + ;; Create a temp file full of latin1 characters. + (assert-equal + '(0 1) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (dotimes (k 255) + (write-char (code-char k) s))) + (with-open-file (s path :direction :input :external-format :latin1) + (list (file-position s) + (progn + (read-char s) + (file-position s))))))) + (define-test trac.80 (:tag :trac) ;; The following formats should not signal an error. (assert-true (ignore-errors (format nil "~ve" 21 5d-234))) (assert-true (ignore-errors (format nil "~ve" 100 5d-234)))) +#+nil (define-test trac.87.output (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -330,6 +399,27 @@ octets))) (delete-file path)))) +(define-test trac.87.output + (:tag :trac) + ;; Test that run-program accepts :element-type and produces the + ;; correct output. + (let ((string "Hello")) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (write-string string s)) + (let* ((expected (stream:string-to-octets string :external-format :latin1)) + (octets (make-array (length expected) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list path) + :output :stream + :element-type '(unsigned-byte 8)))) + (read-sequence octets (ext:process-output proc)) + (assert-equalp + expected + octets))))) + +#+nil (define-test trac.87.input (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -354,6 +444,28 @@ octets output))) (delete-file path)))) + +(define-test trac.87.input + (:tag :trac) + ;; Test that run-program accepts :element-type and produces the + ;; correct input (and output). + (let ((string "Hello")) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (write-string string s)) + (let ((octets (stream:string-to-octets string :external-format :latin1)) + (output (make-array (length string) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list path) + :input :stream + :output :stream + :element-type '(unsigned-byte 8)))) + (write-sequence octets (ext:process-input proc)) + (read-sequence output (ext:process-output proc)) + (assert-equalp + octets + output))))) (define-test trac.92 (:tag :trac) @@ -413,6 +525,7 @@ ;; Not quite what ticket 101 is about, but it came up in investigating ;; CLEAR-OUTPUT on a Gray stream. Verify CLEAR-OUTPUT actually ;; does. Previously, it did nothing. +#+nil (define-test trac.101 (:tag :trac) (assert-eql @@ -430,6 +543,20 @@ (close s) (delete-file *test-file*))))) +(define-test trac.101 + (:tag :trac) + (assert-eql + 0 + (ext:with-temporary-file (test-file) + (let ((s (open test-file + :direction :output + :if-exists :supersede))) + (write-char #\a s) + (clear-output s) + (close s) + (setf s (open test-file)) + (file-length s))))) + (defun read-string-fn (str) (handler-case (let ((acc nil)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6698b2c13cc39a0c7c7a08… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6698b2c13cc39a0c7c7a08… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Update pot file due to changes introduced in !272
by Raymond Toy (＠rtoy) 21 Feb '25

21 Feb '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 576f422e by Raymond Toy at 2025-02-21T05:42:51-08:00 Update pot file due to changes introduced in !272 Some docstrings changed, so the pot file needs updating. Don't need to run CI for this change. [SKIP-CI] - - - - - cb65bb7e by Raymond Toy at 2025-02-21T05:52:50-08:00 Add recently closed issues to release notes Don't need CI for this change [SKIP-CI] - - - - - 2 changed files: - src/general-info/release-21f.md - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -117,9 +117,12 @@ public domain. * ~~#363~~ Version numbers added to files and directories. The distribution layout has changed. * ~~#364~~ Add interface to `mkdtemp` and `mkstemp` - * ~~#367~~ Add stream:string-count-octets to count octets in a string + * ~~#367~~ Add `stream:string-count-octets` to count octets in a string * ~~#369~~ Improve docstring for `unix::unix-setlocale` + * ~~#375~~ `unix-mkstemp` and `unix-mkdtemp` actually returns the + file names now. * ~~#379~~ Support GNU-style command-line option names + * ~~#382~~ Command-line options are case-sensitive * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1284,10 +1284,6 @@ msgid "" " UNIX system call." msgstr "" -#: src/code/unix.lisp -msgid "Unknown error [~d]" -msgstr "" - #: src/code/unix.lisp msgid "" "Perform the UNIX select(2) system call.\n" @@ -1454,3 +1450,7 @@ msgid "" " returned." msgstr "" +#: src/code/unix.lisp +msgid "Returns a string that describes the error code Errno" +msgstr "" + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8ea8e2a08ae0ed5f1579f3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8ea8e2a08ae0ed5f1579f3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #365: Add Unix interface to strerror and use in get-unix-error-msg
by Raymond Toy (＠rtoy) 21 Feb '25

21 Feb '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f370206e by Raymond Toy at 2025-02-21T13:25:03+00:00 Fix #365: Add Unix interface to strerror and use in get-unix-error-msg - - - - - 8ea8e2a0 by Raymond Toy at 2025-02-21T13:25:03+00:00 Merge branch 'issue-365-get-unix-error-msg-uses-strerror' into 'master' Fix #365: Add Unix interface to strerror and use in get-unix-error-msg Closes #365 See merge request cmucl/cmucl!272 - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2053,9 +2053,7 @@ _N"Returns a string describing the error number which was returned by a UNIX system call." (declare (type integer error-number)) - (if (array-in-bounds-p *unix-errors* error-number) - (svref *unix-errors* error-number) - (format nil _"Unknown error [~d]" error-number))) + (unix::unix-strerror error-number)) ;;;; Lisp types used by syscalls. @@ -2975,3 +2973,14 @@ (if (null-alien result) (values nil (unix-errno)) (%file->name (cast result c-call:c-string))))))) + +(defun unix-strerror (errno) + _N"Returns a string that describes the error code Errno" + (let ((result + (alien-funcall + (extern-alien "strerror" + (function (* char) int)) + errno))) + ;; Result from strerror can be localized so we need to decode + ;; those octets to get a proper Lisp string. + (string-decode (cast result c-string) :default))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f21c6507bda7fd20f7f327… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f21c6507bda7fd20f7f327… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 3 commits: Add some comments for os_temp_path.
by Raymond Toy (＠rtoy) 21 Feb '25

21 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 921b2043 by Raymond Toy at 2025-02-20T19:01:54-08:00 Add some comments for os_temp_path. - - - - - 221fa0ae by Raymond Toy at 2025-02-20T19:02:31-08:00 Fix error in creating default template name; clarify docstrings If the prefix arg is no supplied, we choose a default value for the template. It was previously incorrectly computed so make it right. Clarify some docstrings. - - - - - 6698b2c1 by Raymond Toy at 2025-02-20T19:47:44-08:00 Add function to create the template from the prefix or a default name. All of the temporary file/stream/directory macros had common code to create the actual template. Move this into a common function so that we do it the same for everyone. - - - - - 2 changed files: - src/code/extensions.lisp - src/lisp/os-common.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -632,6 +632,19 @@ (unless (alien:null-alien path) (alien:free-alien path))))) +;; Create a template suitable for mkstemp and mkdtemp. PREFIX is +;; string (or NIL) provided by the macros and is used as is as the +;; template prefix. If PREFIX is NIL, the prefix is obtained by +;; appending DEFAULT-NAME to the OS-dependent temporary path. In all +;; cases, we append exactly 6 X's to create the finale template. +(defun create-template (prefix default-name) + (concatenate 'string + (or prefix + (concatenate 'string + (get-os-temp-path) + default-name)) + "XXXXXX")) + ;;; WITH-TEMPORARY-STREAM -- Public ;;; (defmacro with-temporary-stream ((s &key @@ -641,7 +654,7 @@ decoding-error encoding-error) &parse-body (forms decls)) - "Return a stream to a temporary file that is automatically created." + _N"Return a stream to a temporary file that is automatically created." (let ((fd (gensym "FD-")) (filename (gensym "FILENAME-")) (dir (gensym "DIRECTION-")) @@ -652,10 +665,7 @@ (unless (member ,direction '(:output :io)) (error ":direction must be one of :output or :io, not ~S" ,direction)) - (let ((,file-template (concatenate 'string - (get-os-temp-path) - "cmucl-temp-stream-" - "XXXXXX")) + (let ((,file-template (create-template nil "cmucl-temp-stream-")) ,fd ,filename ,s) (unwind-protect (progn @@ -689,13 +699,13 @@ ;;; WITH-TEMPORARY-FILE -- Public (defmacro with-temporary-file ((filename &key prefix) &parse-body (forms decls)) + _N"Creates a temporary file with a name bound to Filename which a + namestring. If Prefix is not provided, the temporary file is created + in a OS-dependent location. Otherwise the prefix is used as a prefix + for the name. On completion, the file is automatically removed." (let ((fd (gensym "FD-")) (file-template (gensym "TEMP-PATH-"))) - `(let ((,file-template (concatenate 'string - (or ,prefix - (get-os-temp-path) - "cmucl-temp-file-") - "XXXXXX")) + `(let ((,file-template (create-template ,prefix "cmucl-temp-file-")) ,filename) (unwind-protect (let (,fd) @@ -715,17 +725,14 @@ ;;; WITH-TEMPORARY-DIRECTORY -- Public (defmacro with-temporary-directory ((dirname &key prefix) &parse-body (forms decls)) - "Return a pathname to a temporary directory. TEMPLATE is a string that - is used as a prefix for the name of the temporary directory. The - directory and all its contents are automatically removed afterward." + _N"Return a namestring to a temporary directory. If Prefix is not + provided, the directory is created in an OS-dependent location. + Otherwise, the Prefix is a string that is used as a prefix for the + name of the temporary directory. The directory and all its contents + are automatically removed afterward." (let ((err (gensym "ERR-")) - (dir-path (gensym "DIR-PATH")) (dir-template (gensym "DIR-TEMPLATE-"))) - `(let ((,dir-template (concatenate 'string - (or ,prefix - (get-os-temp-path) - "cmucl-temp-dir-") - "XXXXXX")) + `(let ((,dir-template (create-template ,prefix "cmucl-temp-dir-")) ,dirname ,err) (unwind-protect (progn ===================================== src/lisp/os-common.c ===================================== @@ -939,12 +939,22 @@ os_get_user_homedir(const char* name, int *status) return NULL; } +/* + * Return a new string containing the path to an OS-dependent location + * where temporary files/directories can be stored. If NULL is + * returned, such a location could not be found or some other error + * happened. + * + * Caller must call free(0 on the string returned. + */ char * os_temp_path() { #if defined(DARWIN) - // macosx has a secure per-user temporary directory. - // Don't cache the result as this is only called once. + /* + * macosx has a secure per-user temporary directory. + * Don't cache the result as this is only called once. + */ char path[PATH_MAX]; int pathSize = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); @@ -954,7 +964,10 @@ os_temp_path() return strdup(path); #else - char *result; + /* + * If the TMP envvar is set, use that as the temporary directory. + * Otherwise, just assume "/tmp" will work. + */ char *tmp_path = getenv("TMP"); if (tmp_path == NULL) { View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1a051ff335a2efdbbfe7b8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1a051ff335a2efdbbfe7b8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0