Menu
▾
▴
[Sbcl-commits] master: tools-for-build: Do whitespace canonicalization in Lisp
|
From: Jan M. <sc...@us...> - 2016-02-07 14:39:54
|
The branch "master" has been updated in SBCL:
via 6b693fe00ddb12d7b5f0a19fc8bae1dc8c1190ba (commit)
from c9dc90f513439931294830f4ca90c2456105ce4e (commit)
- Log -----------------------------------------------------------------
commit 6b693fe00ddb12d7b5f0a19fc8bae1dc8c1190ba
Author: Jan Moringen <jmo...@te...>
Date: Tue Oct 13 21:48:12 2015 +0200
tools-for-build: Do whitespace canonicalization in Lisp
* Avoids dependency on the "expand" tool which is not available on some
platforms.
* Replaces tools-for-build/{canonicalize-whitespace[-1],
check-canonical-whitespace, grep-noncanonical-whitespace,
whitespacely-canonical-filenames} with
tools-for-build/canonicalize-whitespace.lisp
---
make.sh | 2 +-
tools-for-build/canonicalize-whitespace | 17 ----
tools-for-build/canonicalize-whitespace-1 | 30 ------
tools-for-build/canonicalize-whitespace.lisp | 110 ++++++++++++++++++++++
tools-for-build/check-canonical-whitespace | 6 -
tools-for-build/grep-noncanonical-whitespace | 9 --
tools-for-build/whitespacely-canonical-filenames | 45 ---------
7 files changed, 111 insertions(+), 108 deletions(-)
diff --git a/make.sh b/make.sh
index 0b496ed..9b29b45 100755
--- a/make.sh
+++ b/make.sh
@@ -35,7 +35,7 @@ echo "//Starting build: $build_started"
echo "//Options: --prefix='$SBCL_PREFIX' --xc-host='$SBCL_XC_HOST'"
# Enforce the source policy for no bogus whitespace
-tools-for-build/canonicalize-whitespace
+$SBCL_XC_HOST < tools-for-build/canonicalize-whitespace.lisp || exit 1
# The make-host-*.sh scripts are run on the cross-compilation host,
# and the make-target-*.sh scripts are run on the target machine. In
diff --git a/tools-for-build/canonicalize-whitespace b/tools-for-build/canonicalize-whitespace
deleted file mode 100755
index 0d39131..0000000
--- a/tools-for-build/canonicalize-whitespace
+++ /dev/null
@@ -1,17 +0,0 @@
-#!/bin/sh
-
-# (a script to be run in the root directory of the distribution)
-#
-# Convert tabs to spaces and delete trailing whitespace in files
-# which we can safely assume to be source files in appropriate languages.
-
-if ! expand -t 8 < $DEVNULL
-then
- # If we're building with MSYS on Windows GNU expand is not available,
- # and what we get is Microsoft Expand, which is something quite different,
- # so bail out.
- exit
-fi
-
-tools-for-build/whitespacely-canonical-filenames \
- | xargs tools-for-build/canonicalize-whitespace-1
diff --git a/tools-for-build/canonicalize-whitespace-1 b/tools-for-build/canonicalize-whitespace-1
deleted file mode 100755
index 431c1cb..0000000
--- a/tools-for-build/canonicalize-whitespace-1
+++ /dev/null
@@ -1,30 +0,0 @@
-#!/bin/sh
-
-# in-place "canonicalize-whitespace" conversion for files in $*:
-# * Convert tabs to spaces.
-# * Delete trailing whitespace.
-# (on $*, in place, overwriting the old file)
-
-scratchfilename=/tmp/canonicalize-whitespace-1.$$.tmp
-
-echo '/in canonicalize-whitespace-1'
-echo '/$*'=$*
-echo '/$scratchfilename='$scratchfilename
-
-for f in $*; do
- if egrep '( |[ ]+$)' $f >/dev/null
- then
- echo '/$f'=$f
-
- # We reuse the "expand" GNU utility to remove tabs, but if it turns out
- # not to be available everywhere (or someone has defined "expand" to
- # mean something else on some other class of system!) we could probably
- # hand-code a replacement in a few lines.
- expand $f > $scratchfilename
-
- sed 's/[ ]*$//' < $scratchfilename > $f
- fi
-
-done
-
-rm -f $scratchfilename
diff --git a/tools-for-build/canonicalize-whitespace.lisp b/tools-for-build/canonicalize-whitespace.lisp
new file mode 100644
index 0000000..f1e9d15
--- /dev/null
+++ b/tools-for-build/canonicalize-whitespace.lisp
@@ -0,0 +1,110 @@
+;;;; Convert tabs to spaces and delete trailing whitespace in files.
+;;;;
+;;;; To be run in the root directory of the distribution as part of
+;;;; make.sh.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+;;; Stream and single-file functions
+
+(defun whitespace-p (character)
+ (member character '(#\Space #\Tab) :test #'char=))
+
+(defun canonicalize-whitespace (input output)
+ (let (change-p)
+ (flet ((remove-trailing-whitespace (line)
+ (let ((non-ws-position (position-if-not #'whitespace-p line
+ :from-end t)))
+ (unless (and non-ws-position
+ (< non-ws-position (1- (length line))))
+ (return-from remove-trailing-whitespace line))
+ (setq change-p t)
+ (subseq line 0 (1+ non-ws-position))))
+ (remove-tabs (line)
+ (unless (find #\Tab line :test #'char=)
+ (return-from remove-tabs line))
+ (setq change-p t)
+ (with-output-to-string (stream)
+ (loop :for char :across line :do
+ (if (char= char #\Tab)
+ (write-string " " stream)
+ (write-char char stream))))))
+ (loop :for line = (read-line input nil :eof)
+ :until (eq line :eof)
+ :do (let ((clean (remove-tabs (remove-trailing-whitespace line))))
+ (write-line clean output))))
+ change-p))
+
+(defun canonicalize-whitespace/file (file)
+ (macrolet ((with-open-source-file ((stream pathname direction) &body body)
+ `(with-open-file (,stream ,pathname
+ :direction ,direction
+ :external-format #-clisp :utf-8 #+clisp charset:utf-8)
+ ,@body)))
+ (let* ((temporary (make-pathname :type "temp" :defaults file))
+ (change-p
+ (handler-case
+ (with-open-source-file (input file :input)
+ (with-open-source-file (output temporary :output)
+ (canonicalize-whitespace input output)))
+ (#+sbcl sb-int:stream-decoding-error #-sbcl error ()
+ (format t "// Ignoring non-UTF-8 source file ~S~%" file)
+ nil))))
+ (cond
+ (change-p
+ (delete-file file)
+ (rename-file temporary file))
+ ((probe-file temporary)
+ (delete-file temporary))))))
+
+;;; Timestamp functions
+
+(defvar *stamp-file* "whitespace-stamp")
+
+(defun read-stamp-file ()
+ (if (probe-file *stamp-file*)
+ (file-write-date *stamp-file*)
+ 0))
+
+(defun write-stamp-file ()
+ (with-open-file (stream *stamp-file*
+ :direction :output
+ :if-exists :supersede)
+ #-sbcl (declare (ignore stream))))
+
+;;; Repository-level functions
+
+(defvar *source-types* '("lisp" "lisp-expr" "c" "h" "asd"))
+
+(defvar *exceptions* '("compile-file-pos-utf16be"))
+
+(defun canonicalize-whitespace/directory
+ (&optional (directory *default-pathname-defaults*))
+ (let ((stamp-date (read-stamp-file)))
+ (labels ((older-than-stamp (file)
+ (< (file-write-date file) stamp-date))
+ (exception-p (file)
+ (member (pathname-name file) *exceptions*
+ :test #'string=))
+ (skip-p (file)
+ (or (older-than-stamp file) (exception-p file))))
+ (dolist (type *source-types*)
+ (let* ((pattern (merge-pathnames
+ (make-pathname :type type
+ :name :wild
+ :directory '(:relative :wild-inferiors))
+ directory))
+ (files (remove-if #'skip-p (directory pattern))))
+ (mapc #'canonicalize-whitespace/file files))))
+ (write-stamp-file)))
+
+;;; Entry point
+
+(canonicalize-whitespace/directory)
diff --git a/tools-for-build/check-canonical-whitespace b/tools-for-build/check-canonical-whitespace
deleted file mode 100644
index fec0a58..0000000
--- a/tools-for-build/check-canonical-whitespace
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/bin/sh
-
-# Look for violations of whitespace canonicalization. On the first
-# one found, print the line (mostly to help humans) and exit with
-# nonzero (mostly to help scripts).
-
diff --git a/tools-for-build/grep-noncanonical-whitespace b/tools-for-build/grep-noncanonical-whitespace
deleted file mode 100755
index a76dd1f..0000000
--- a/tools-for-build/grep-noncanonical-whitespace
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/bin/sh
-
-# Look for violations of whitespace canonicalization, handling them as
-# greppish matches:
-# * Print human-readable description of each one.
-# * Exit with 0 if >=1 found, or exit with 0 if none found.
-
-tools-for-build/whitespacely-canonical-filenames | \
- xargs egrep --with-filename ' | $'
\ No newline at end of file
diff --git a/tools-for-build/whitespacely-canonical-filenames b/tools-for-build/whitespacely-canonical-filenames
deleted file mode 100755
index 7830a1e..0000000
--- a/tools-for-build/whitespacely-canonical-filenames
+++ /dev/null
@@ -1,45 +0,0 @@
-#!/bin/sh
-
-# (a script to be run in the root directory of the distribution,
-# probably as part of an enclosing do-something-with-whitespace script)
-#
-# Print to stdout the names of files whose whitespace we (SBCLers)
-# try to keep canonical.
-
-# glob patterns for source files in languages for which the
-# canonicalization is safe (not affecting meaning, at least given the
-# conservative syntax used in SBCL sources)
-source_extensions='.lisp .lisp-expr .c .h .asd'
-# other candidates:
-# .sh: if ./make.sh is altered, Bad Things happen
-# ?
-
-stamp_file=whitespace-stamp
-
-if [ -e $stamp_file ]; then
- find_opt="-newer $stamp_file"
-else
- find_opt=""
-fi
-
-# SunOS find does not support -path. Try to find a binary which does.
-if [ -n "$GNUFIND" ]; then :
-elif command -v gfind >/dev/null; then GNUFIND=gfind
-elif command -v gnufind >/dev/null; then GNUFIND=gnufind
-else GNUFIND=find; fi
-if ! "$GNUFIND" /dev/null -path dummy 2>/dev/null; then
- echo "Warning: $GNUFIND might not be GNU: use of -path fails." 1>&2
-fi
-
-for source_extension in $source_extensions; do
- "$GNUFIND" . \( \
- -path contrib/asdf -o \
- -name _darcs -o \
- -name '{arch}' -o \
- -name CVS -o \
- -name .hg -o \
- -name .svn \) -type d -prune -o \
- $find_opt -name '*'$source_extension -print
-done
-
-touch $stamp_file
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|