diff --git a/Makefile b/Makefile index 39663709d9cc8aa4c10343107f602a8787d435a6..8fa0304cb35276aac6c5b6acc28e2fdc57669f33 100644 --- a/Makefile +++ b/Makefile @@ -66,8 +66,6 @@ defsystem-files: @echo $(defsystem_lisp) archive: build/asdf.lisp - #${SBCL} --userinit /dev/null --sysinit /dev/null --load bin/make-helper.lisp \ - # --eval "(rewrite-license)" --eval "(quit)" ./bin/asdf-builder make-and-publish-archive ### Count lines separately for asdf-driver and asdf itself: diff --git a/TODO b/TODO index e98eb6a91874cd1e9868a6adf0289ffd5c33ed0a..248972fc2072f8c7d8441cb40673d9c403f203bf 100644 --- a/TODO +++ b/TODO @@ -1,3 +1,4 @@ +* have with-input-file use the encodings mechanism? * have a single test .asd that tests as many features as possible, use it for upgrade test. * implement deferred warnings support on abcl, allegro, clisp, cmucl, lispworks, scl) * fix upgrade on clisp diff --git a/asdf.asd b/asdf.asd index 8a77347856727f826aa8e5e4605b46fe73f0ea5b..a9b28055f47f912b11af0073161ac28ef2be340e 100644 --- a/asdf.asd +++ b/asdf.asd @@ -74,7 +74,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.29" ;; to be automatically updated by make bump-version + :version "2.29.1" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 ;; For most purposes, asdf itself specially counts as a builtin system. diff --git a/bin/make-helper.lisp b/bin/make-helper.lisp deleted file mode 100644 index b55dfedba257a3ce978580075e2eca65d7b30ee8..0000000000000000000000000000000000000000 --- a/bin/make-helper.lisp +++ /dev/null @@ -1,285 +0,0 @@ -(load (make-pathname :name "prelude" :type "lisp" :defaults *load-pathname*) - :verbose nil :print nil) - -(in-package :asdf) - -(defvar *make-helper-home* *load-truename*) - -;;; metatilities-base -;;; because sometimes copy and paste is just too easy - -(eval-when (:compile-toplevel :load-toplevel :execute) - (defmacro generate-time-part-function (part-name position) - (let ((function-name (intern (strcat (symbol-name 'time) "-" (symbol-name part-name))))) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (export ',function-name) - (defun ,function-name - (&optional (universal-time (get-universal-time)) - (time-zone nil)) - ,(format nil "Returns the ~(~A~) part of the given time." part-name) - (nth-value ,position (apply #'decode-universal-time universal-time time-zone)))))) - - (generate-time-part-function second 0) - (generate-time-part-function minute 1) - (generate-time-part-function hour 2) - (generate-time-part-function date 3) - (generate-time-part-function month 4) - (generate-time-part-function year 5) - (generate-time-part-function day-of-week 6) - (generate-time-part-function daylight-savings-time-p 7)) - -;;; format-date - -(defparameter +days-per-month+ - '(31 28 31 30 31 30 31 31 30 31 30 31)) - - -(defun days-in-month (month &optional leap-year?) - "Returns the number of days in the specified month. The month should be -between 1 and 12." - (+ (nth (1- month) +days-per-month+) (if (and (= month 2) leap-year?) 1 0))) - -(defun leap-year-p (year) - "Returns t if the specified year is a leap year. I.e. if the year -is divisible by four but not by 100 or if it is divisible by 400." - (or (and (= (mod year 4) 0) ; logand is faster but less perspicuous - (not (= (mod year 100) 0))) - (= (mod year 400) 0))) - -(defun day-of-year (date) - "Returns the day of the year [1 to 366] of the specified date [which must be \(CL\) universal time format.]" - (let ((leap-year? (leap-year-p (time-year date)))) - (+ (loop for month from 1 to (1- (time-month date)) sum - (days-in-month month leap-year?)) - (time-date date)))) - -(defconstant +longer-format-index+ 0) -(defconstant +shorter-format-index+ 1) - -(defparameter +month-output-list+ - '(("January" "February" "March" "April" "May" "June" "July" "August" "September" - "October" "November" "December") - ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) - -(defparameter +dow-output-list - '(("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") - ("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))) - -(defun day->string (day-of-the-week &optional (format :long)) - "Returns the name of `day-of-the-week`. The parameter should be a number between 0 and 6 where 0 represents Sunday and 6 repressents Saturday. The optional format argument can be either :long or :short. In the latter case, the return string will be of length three; in the former it will be the complete name of the appropriate day." - (check-type day-of-the-week (mod 7)) - (check-type format (member :long :short)) - (nth day-of-the-week - (case format - (:long (nth +longer-format-index+ +dow-output-list)) - (:short (nth +shorter-format-index+ +dow-output-list))))) - -(defun month->string (month &optional (format :long)) - "Returns the name \(in English\) of the month. Format can be :long or :short." - (check-type month (integer 1 12)) - (check-type format (member :long :short)) - (nth (1- month) - (case format - (:long (nth +longer-format-index+ +month-output-list+)) - (:short (nth +shorter-format-index+ +month-output-list+))))) - -(defun format-date (format date &optional stream time-zone) - "Formats universal dates using the same format specifiers as NSDateFormatter. The format is: - -%% - A '%' character -%a - Abbreviated weekday name -%A - Full weekday name -%b - Abbreviated month name -%B - Full month name -%c - Shorthand for \"%X %x\", the locale format for date and time -%d - Day of the month as a decimal number [01-31] -%e - Same as %d but does not print the leading 0 for days 1 through 9 - [unlike strftime[], does not print a leading space] -%F - Milliseconds as a decimal number [000-999] -%H - Hour based on a 24-hour clock as a decimal number [00-23] -%I - Hour based on a 12-hour clock as a decimal number [01-12] -%j - Day of the year as a decimal number [001-366] -%m - Month as a decimal number [01-12] -%M - Minute as a decimal number [00-59] -%p - AM/PM designation for the locale -%S - Second as a decimal number [00-59] -%w - Weekday as a decimal number [0-6], where Sunday is 0 -%x - Date using the date representation for the locale, including - the time zone [produces different results from strftime[]] -%X - Time using the time representation for the locale [produces - different results from strftime[]] -%y - Year without century [00-99] -%Y - Year with century [such as 1990] -%Z - Time zone name [such as Pacific Daylight Time; - produces different results from strftime[]] -%z - Time zone offset in hours and minutes from GMT [HHMM] - -None of %c, %F, %p, %x, %X, %Z, %z are implemented." - (declare (ignore time-zone)) - (let ((format-length (length format))) - (format - stream "~{~A~}" - (loop for index = 0 then (1+ index) - while (< index format-length) collect - (let ((char (aref format index))) - (cond - ((char= #\% char) - (setf char (aref format (incf index))) - (cond - ;; %% - A '%' character - ((char= char #\%) #\%) - - ;; %a - Abbreviated weekday name - ((char= char #\a) (day->string (time-day-of-week date) :short)) - - ;; %A - Full weekday name - ((char= char #\A) (day->string (time-day-of-week date) :long)) - - ;; %b - Abbreviated month name - ((char= char #\b) (month->string (time-month date) :short)) - - ;; %B - Full month name - ((char= char #\B) (month->string (time-month date) :long)) - - ;; %d - Day of the month as a decimal number [01-31] - ((char= char #\d) (format nil "~2,'0D" (time-date date))) - - ;; %e - Same as %d but does not print the leading 0 for days 1 through 9 - ;; Unlike strftime, does not print a leading space - ((char= char #\e) (format nil "~D" (time-date date))) - - ;; %H - Hour based on a 24-hour clock as a decimal number [00-23] - ((char= char #\H) (format nil "~2,'0D" (time-hour date))) - - ;; %I - Hour based on a 12-hour clock as a decimal number [01-12] - ((char= char #\I) (format nil "~2,'0D" (1+ (mod (time-hour date) 12)))) - - ;; %j - Day of the year as a decimal number [001-366] - ((char= char #\j) (format nil "~3,'0D" (day-of-year date))) - - ;; %m - Month as a decimal number [01-12] - ((char= char #\m) (format nil "~2,'0D" (time-month date))) - - ;; %M - Minute as a decimal number [00-59] - ((char= char #\M) (format nil "~2,'0D" (time-minute date))) - - ;; %S - Second as a decimal number [00-59] - ((char= char #\S) (format nil "~2,'0D" (time-second date))) - - ;; %w - Weekday as a decimal number [0-6], where Sunday is 0 - ((char= char #\w) (format nil "~D" (time-day-of-week date))) - - ;; %y - Year without century [00-99] - ((char= char #\y) - (let ((year-string (format nil "~,2A" (time-year date)))) - (subseq year-string (- (length year-string) 2)))) - - ;; %Y - Year with century [such as 1990] - ((char= char #\Y) (format nil "~D" (time-year date))) - - (t - (error "Ouch - unknown formatter '%~c" char)))) - (t char))))))) - -;;; metatilites-base - - -(defun extract-summary (pathname stream) - (with-open-file (in pathname :direction :input - :if-does-not-exist :error) - (let ((start nil)) - (loop for line = (read-line in nil :eof) - until (eq line :eof) do - (when (and (> (length line) 5) (string-equal "-#---" (subseq line 0 5))) - (setf start t)) - (when start - (format stream "~&~a~%" line)))))) - -(defun html-header (stream title style-sheet) - (format stream "~&<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" - \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">") - (format stream "~&<html>~&<head>") - (when title - (format stream "~&<title>~a</title>" title)) - (when style-sheet - (unless (search ".css" style-sheet) - (setf style-sheet (concatenate 'string style-sheet ".css"))) - (format stream "~&<link type='text/css' href='~a' rel='stylesheet' />" - style-sheet)) - (format stream "~&</head>~&<body>")) - -(defun html-footer (stream) - (format stream "<div id=\"footer\">") - (format stream "~&generated on ~a" - (format-date "%B %d, %Y" (get-universal-time))) - (format stream "</div>") - (format stream "~&</body></html>")) - - -(defun build-web-page (input-directory output-file &key (if-exists :error) - (title "ASDF test report") (style-sheet "styles.css")) - (with-open-file (stream output-file - :direction :output - :if-exists if-exists - :if-does-not-exist :create) - (html-header stream title style-sheet) - (format stream "~&~%<h1>ASDF Test results</h1>~%") - - (dolist (pathname (directory - (merge-pathnames (make-pathname :name :wild :type "text") - input-directory))) - (print pathname) - (format stream "~&~%<h2>~a</h2>~%" (pathname-name pathname)) - (format stream "~&<pre>~%") - (extract-summary pathname stream) - (format stream "~&</pre>~%")) - (html-footer stream) - )) - -(defun extract-license (input-pathname output-pathname) - (with-open-file (in input-pathname :direction :input - :if-does-not-exist :error) - (with-open-file (out output-pathname - :direction :output - :if-does-not-exist :create - :if-exists :error) - (let* ((state nil) - (flag ";;; -- LICENSE") - (flag-length (length flag))) - (loop for line = (read-line in nil :eof) - until (eq line :eof) do - (when (and (> (length line) flag-length) - (string-equal flag (subseq line 0 flag-length))) - (if (eq state :running) - (return) - (setf state :starting))) - (when (eq state :running) - (format out "~&~a~%" (subseq line (min (length line) 4)))) - (when (eq state :starting) - (setf state :running))))))) - -(defun rewrite-license () - (let* ((*default-pathname-defaults* - (make-pathname :name nil :type nil :defaults *make-helper-home*)) - (output (merge-pathnames (make-pathname :name "LICENSE" - :directory '(:relative :up))))) - (when (probe-file output) - (delete-file output)) - (extract-license - (merge-pathnames (make-pathname :name "header" :type "lisp" - :directory '(:relative :up))) - output))) - -(defun write-test-web-pages () - (let* ((*default-pathname-defaults* - (make-pathname :name nil :type nil :defaults *make-helper-home*)) - (source (merge-pathnames - (make-pathname - :directory '(:relative :up "test" "results")))) - (output (merge-pathnames (make-pathname - :directory '(:relative :up "website" "output") - :name "test-results" - :type "html")))) - (print (list source output)) - (build-web-page source output :if-exists :supersede))) - diff --git a/header.lisp b/header.lisp index 8b77cc7abde7a21ce88747e5a10bda46540fde51..06e22d8e01bc41400f48b5d8c687ad30cef07d24 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.29: Another System Definition Facility. +;;; This is ASDF 2.29.1: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/lisp-build.lisp b/lisp-build.lisp index 5c8ba1d718c3630b183f0974ac6fa3d0cee2c2be..a4fc6969dfc4e0ad8bf199a42e6698f3882cf6d5 100644 --- a/lisp-build.lisp +++ b/lisp-build.lisp @@ -190,12 +190,15 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when (etypecase sexp (symbol (reify-symbol sexp)) ((or number character simple-string pathname) sexp) - (cons (cons (reify-simple-sexp (car sexp)) (reify-simple-sexp (cdr sexp)))))) + (cons (cons (reify-simple-sexp (car sexp)) (reify-simple-sexp (cdr sexp)))) + (simple-vector (vector (mapcar 'reify-simple-sexp (coerce sexp 'list)))))) + (defun unreify-simple-sexp (sexp) (etypecase sexp ((or symbol number character simple-string pathname) sexp) (cons (cons (unreify-simple-sexp (car sexp)) (unreify-simple-sexp (cdr sexp)))) - ((simple-vector 2) (unreify-symbol sexp)))) + ((simple-vector 2) (unreify-symbol sexp)) + ((simple-vector 1) (coerce (mapcar 'unreify-simple-sexp (aref sexp 0)) 'vector)))) #+clozure (progn diff --git a/upgrade.lisp b/upgrade.lisp index e8def326f63e66d13957fff3973e8b4088f06d4a..79b7eafc9aac5e455abf47dcf144640123c87c44 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "2.29") + (asdf-version "2.29.1") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index 769825c2396ebc0486424ebe1701e34617c41771..614207e602f99802c7f38b64f411f26f0647f195 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.29" +"2.29.1"