cmucl-cvs December 2016

cmucl-cvs@common-lisp.net

1 participants
59 discussions

[Git][cmucl/cmucl][master] Copy cross-x86-sparc.lisp to cross-x86-sparcv9.lisp
by Raymond Toy 03 Dec '16

03 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 41838802 by Raymond Toy at 2016-12-03T13:15:43-08:00 Copy cross-x86-sparc.lisp to cross-x86-sparcv9.lisp - - - - - 1 changed file: - + src/tools/cross-scripts/cross-x86-sparcv9.lisp Changes: ===================================== src/tools/cross-scripts/cross-x86-sparcv9.lisp ===================================== --- /dev/null +++ b/src/tools/cross-scripts/cross-x86-sparcv9.lisp @@ -0,0 +1,305 @@ +;;; Cross-compile script to build a sparc core using x86 as the +;;; compiling system. This needs work! + +(in-package :cl-user) + +;;; Rename the X86 package and backend so that new-backend does the +;;; right thing. +(rename-package "X86" "OLD-X86" '("OLD-VM")) +(setf (c:backend-name c:*native-backend*) "OLD-X86") + +(c::new-backend "SPARC" + ;; Features to add here + '(:sparc + :sparc-v9 ; For Ultrasparc processors + :complex-fp-vops ; Some slightly faster FP vops on complex numbers + :linkage-table + :stack-checking ; Throw error if we run out of stack + :heap-overflow-check ; Throw error if we run out of + ; heap (This requires gencgc!) + :gencgc ; Generational GC + :relative-package-names ; Relative package names from Allegro + :conservative-float-type + :hash-new + :random-mt19937 ; MT-19937 generator + :cmu ; Announce this is CMUCL + :cmu20 :cmu20b ; Current version identifier + :modular-arith ; Modular arithmetic + :double-double ; Double-double float support + :executable + + :solaris + :svr4 + :sun4 + :sunos + :unix + ) + ;; Features to remove from current *features* here + '(:sparc-v8 :sparc-v7 ; Choose only one of :sparc-v7, :sparc-v8, :sparc-v9 + ;; Other architectures we aren't using. Particularly important + ;; to get rid of sse2 and x87 so we don't accidentally try to + ;; compile the x87/sse2 float support on sparc, which won't work. + :x86 :x86-bootstrap :sse2 :x87 :i486 + :alpha :osf1 :mips + ;; Really old stuff that should have been removed long ago. + :propagate-fun-type :propagate-float-type :constrain-float-type + ;; Other OSes were not using + :openbsd :freebsd :glibc2 :linux :mach-o :darwin :bsd + + :pentium + :long-float + :new-random + :small + :mp)) + +;;; Changes needed to bootstrap cross-compiling from x86 to sparc + +;; Set up the linkage space stuff appropriately for sparc. +(setf (c::backend-foreign-linkage-space-start c::*target-backend*) + #x0f800000 + (c::backend-foreign-linkage-entry-size c::*target-backend*) + 16) + +;; Get new fops so we can process fasls with big-endian unicode +;; strings on our little-endian compiling system. +#+unicode +(load "target:tools/cross-scripts/cross-unicode-big-endian.lisp") + +;;; End changes needed to bootstrap cross-compiling from x86 to sparc + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + ;;(format t "extern-alien-name: ~S~%" name) + ;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name)) + name) +(export 'extern-alien-name) +#+(or) +(defun fixup-code-object (code offset fixup kind) + (declare (type index offset)) + (unless (zerop (rem offset vm::word-bytes)) + (error (intl:gettext "Unaligned instruction? offset=#x~X.") offset)) + (system:without-gcing + (let ((sap (truly-the system-area-pointer + (%primitive c::code-instructions code)))) + (ecase kind + (:call + (error (intl:gettext "Can't deal with CALL fixups, yet."))) + (:sethi + (setf (ldb (byte 22 0) (sap-ref-32 sap offset)) + (ldb (byte 22 10) fixup))) + (:add + (setf (ldb (byte 10 0) (sap-ref-32 sap offset)) + (ldb (byte 10 0) fixup))))))) +(export 'fixup-code-object) +#+(or) +(defun sanctify-for-execution (component) + (without-gcing + (alien-funcall (extern-alien "os_flush_icache" + (function void + system-area-pointer + unsigned-long)) + (code-instructions component) + (* (code-header-ref component code-code-size-slot) + word-bytes))) + nil) +(export 'sanctify-for-execution) + +;;; Compile the new backend. +(pushnew :bootstrap *features*) +(pushnew :building-cross-compiler *features*) +(load "target:tools/comcom") + +;;; Load the new backend. +(setf (search-list "c:") + '("target:compiler/")) +(setf (search-list "vm:") + '("c:sparc/" "c:generic/")) +(setf (search-list "assem:") + '("target:assembly/" "target:assembly/sparc/")) + +;; Load the backend of the compiler. + +(in-package "C") + +(load "vm:vm-macs") +(load "vm:parms") +(load "vm:objdef") +(load "vm:interr") +(load "assem:support") + +(load "target:compiler/srctran") +(load "vm:vm-typetran") +(load "target:compiler/float-tran") +(load "target:compiler/saptran") + +(load "vm:macros") +(load "vm:utils") + +(load "vm:vm") +(load "vm:insts") +(load "vm:primtype") +(load "vm:move") +(load "vm:sap") +(load "vm:system") +(load "vm:char") +(load "vm:float") + +(load "vm:memory") +(load "vm:static-fn") +(load "vm:arith") +(load "vm:cell") +(load "vm:subprim") +(load "vm:debug") +(load "vm:c-call") +(load "vm:print") +(load "vm:alloc") +(load "vm:call") +(load "vm:nlx") +(load "vm:values") +(load "vm:array") +(load "vm:pred") +(load "vm:type-vops") + +(load "assem:assem-rtns") + +(load "assem:array") +(load "assem:arith") +(load "assem:alloc") + +(load "c:pseudo-vops") + +(check-move-function-consistency) + +(load "vm:new-genesis") + +;;; OK, the cross compiler backend is loaded. + +(setf *features* (remove :building-cross-compiler *features*)) + +;;; Info environment hacks. +(macrolet ((frob (&rest syms) + `(progn ,@(mapcar #'(lambda (sym) + `(defconstant ,sym + (symbol-value + (find-symbol ,(symbol-name sym) + :vm)))) + syms)))) + (frob OLD-VM:BYTE-BITS + OLD-VM:WORD-BITS + OLD-VM:CHAR-BITS + OLD-VM:CHAR-BYTES + OLD-VM:LOWTAG-BITS + #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE + #+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-BIT-VECTOR-TYPE + OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE + OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET + OLD-VM:DOUBLE-FLOAT-DIGITS + old-vm:single-float-digits + OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE + OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE + OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE + OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE + ) + #+double-double + (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE) + ) + +(let ((function (symbol-function 'kernel:error-number-or-lose))) + (let ((*info-environment* (c:backend-info-environment c:*target-backend*))) + (setf (symbol-function 'kernel:error-number-or-lose) function) + (setf (info function kind 'kernel:error-number-or-lose) :function) + (setf (info function where-from 'kernel:error-number-or-lose) :defined))) + +(defun fix-class (name) + (let* ((new-value (find-class name)) + (new-layout (kernel::%class-layout new-value)) + (new-cell (kernel::find-class-cell name)) + (*info-environment* (c:backend-info-environment c:*target-backend*))) + (remhash name kernel::*forward-referenced-layouts*) + (kernel::%note-type-defined name) + (setf (info type kind name) :instance) + (setf (info type class name) new-cell) + (setf (info type compiler-layout name) new-layout) + new-value)) +(fix-class 'c::vop-parse) +(fix-class 'c::operand-parse) + +#+random-mt19937 +(declaim (notinline kernel:random-chunk)) + +(setf c:*backend* c:*target-backend*) + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + ;;(format t "extern-alien-name: ~S~%" name) + ;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name)) + name) +(export 'extern-alien-name) +#+(or) +(defun fixup-code-object (code offset fixup kind) + (declare (type index offset)) + (unless (zerop (rem offset vm::word-bytes)) + (error (intl:gettext "Unaligned instruction? offset=#x~X.") offset)) + (system:without-gcing + (let ((sap (truly-the system-area-pointer + (%primitive c::code-instructions code)))) + (ecase kind + (:call + (error (intl:gettext "Can't deal with CALL fixups, yet."))) + (:sethi + (setf (ldb (byte 22 0) (sap-ref-32 sap offset)) + (ldb (byte 22 10) fixup))) + (:add + (setf (ldb (byte 10 0) (sap-ref-32 sap offset)) + (ldb (byte 10 0) fixup))))))) +(export 'fixup-code-object) +#+(or) +(defun sanctify-for-execution (component) + (without-gcing + (alien-funcall (extern-alien "os_flush_icache" + (function void + system-area-pointer + unsigned-long)) + (code-instructions component) + (* (code-header-ref component code-code-size-slot) + word-bytes))) + nil) +(export 'sanctify-for-execution) + +(in-package :cl-user) + +;;; Don't load compiler parts from the target compilation + +(defparameter *load-stuff* nil) + +;; hack, hack, hack: Make old-x86::any-reg the same as +;; x86::any-reg as an SC. Do this by adding old-x86::any-reg +;; to the hash table with the same value as x86::any-reg. + +(let ((ht (c::backend-sc-names c::*target-backend*))) + (setf (gethash 'old-vm::any-reg ht) + (gethash 'vm::any-reg ht))) + + +;;(pushnew :debug *features*) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/41838802a3e6cbf057be72dcb…

1 0

[Git][cmucl/cmucl][master] Copy sparc/* to sparcv9/*
by Raymond Toy 03 Dec '16

03 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: cdbb2388 by Raymond Toy at 2016-12-03T13:13:23-08:00 Copy sparc/* to sparcv9/* Pure copy of sparc files to sparcv9 directory and copy sparc-assem.S to sparcv9-assem.S No other changes made. - - - - - 7 changed files: - + src/assembly/sparcv9/alloc.lisp - + src/assembly/sparcv9/arith.lisp - + src/assembly/sparcv9/array.lisp - + src/assembly/sparcv9/assem-rtns.lisp - + src/assembly/sparcv9/support.lisp - + src/compiler/sparcv9/alloc.lisp - + src/compiler/sparcv9/arith.lisp The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/cdbb23883eb01a40b0d7b58f9…

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-2016-12
by Raymond Toy 03 Dec '16

03 Dec '16

Raymond Toy pushed new tag snapshot-2016-12 at cmucl / cmucl

1 0

[Git][cmucl/cmucl][master] 2 commits: Template for 21c release notes
by Raymond Toy 03 Dec '16

03 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 80242f5e by Raymond Toy at 2016-12-03T08:48:11-08:00 Template for 21c release notes - - - - - 86d5a6f9 by Raymond Toy at 2016-12-03T08:53:32-08:00 Update from logs - - - - - 1 changed file: - + src/general-info/release-21c.txt Changes: ===================================== src/general-info/release-21c.txt ===================================== --- /dev/null +++ b/src/general-info/release-21c.txt @@ -0,0 +1,57 @@ +Work in progress +========================== C M U C L 21 c ============================= + +The CMUCL project is pleased to announce the release of CMUCL 21c. +This is a major release which contains numerous enhancements and bug +fixes from the 21a release. + +CMUCL is a free, high performance implementation of the Common Lisp +programming language which runs on most major Unix platforms. It +mainly conforms to the ANSI Common Lisp standard. CMUCL provides a +sophisticated native code compiler; a powerful foreign function +interface; an implementation of CLOS, the Common Lisp Object System, +which includes multi-methods and a meta-object protocol; a +source-level debugger and code profiler; and an Emacs-like editor +implemented in Common Lisp. CMUCL is maintained by a team of +volunteers collaborating over the Internet, and is mostly in the +public domain. + +New in this release: + * Known issues: + + * Feature enhancements + + * Changes + + * ANSI compliance fixes: + + * Bug fixes: + * ENCODE-UNIVERSAL-TIME accepts dates from 1899 if the final date + after accounting for time zones results in a positive + value. (See ticket #36.) + * CL:SLEEP no longer gets interrupted (See ticket #26.) + + * Trac Tickets: + + * Gitlab tickets: + * Ticket #36: encode-universal-time signals error + * Ticket #26: The cmucl that never sleeps + + * Other changes: + + * Improvements to the PCL implementation of CLOS: + + * Changes to building procedure: + + +This release is not binary compatible with code compiled using CMUCL +21b; you will need to recompile FASL files. + +See <URL:http://www.cmucl.org> or +<URL:https://gitlab.common-lisp.net/cmucl/cmucl> for more information, +See +<URL:https://gitlab.common-lisp.net/cmucl/cmucl/wikis/GettingCmucl> +for obtaining CMUCL, including sources and binaries.. + + +We hope you enjoy using this release of CMUCL! View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/6131d7370849b2cc37c3ed62…

1 0

[Git][cmucl/cmucl][master] Link to the wiki for more info.
by Raymond Toy 02 Dec '16

02 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 6131d737 by Raymond Toy at 2016-12-02T06:22:25+00:00 Link to the wiki for more info. - - - - - 1 changed file: - README.md Changes: ===================================== README.md ===================================== --- a/README.md +++ b/README.md @@ -50,3 +50,4 @@ Here is a summary of its main features: maintained and improved by a team of volunteers collaborating over the Internet. +For the latest news and other information, see [the wiki](https://gitlab.common-lisp.net/cmucl/cmucl/wikis/home). \ No newline at end of file View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/6131d7370849b2cc37c3ed62d…

1 0

[Git][cmucl/cmucl][master] Use lisp-unit::assert-true instead of cl:assert
by Raymond Toy 02 Dec '16

02 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 042d8a07 by Raymond Toy at 2016-12-01T19:55:02-08:00 Use lisp-unit::assert-true instead of cl:assert Don't use cl:assert for the lisp-unit test; it should use lisp-unit assertions. - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -340,13 +340,13 @@ (if filename (push filename files) (push directory directories)))) - (assert (null (set-difference files - '("file" "link-to-dir" - "link-to-dir-in-dir" "link-to-file") - :test #'string-equal))) - (assert (null (set-difference directories - '(".dir" "dir") - :test #'string-equal))))) + (assert-true (null (set-difference files + '("file" "link-to-dir" + "link-to-dir-in-dir" "link-to-file") + :test #'string-equal))) + (assert-true (null (set-difference directories + '(".dir" "dir") + :test #'string-equal))))) (define-test issue.36 (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/042d8a077f6193faa67b0536f…

1 0

[Git][cmucl/cmucl][master] Apply cmucl style
by Raymond Toy 02 Dec '16

02 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 7e4f7eb9 by Raymond Toy at 2016-12-01T19:39:08-08:00 Apply cmucl style ieee754_rem_pio2 was not formatted according to cmucl style. Just re-indent. No other changes. - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -551,18 +551,19 @@ os_guard_control_stack(int zone, int guard) /* Simple interface to __ieee754_rem_pio2 */ -int ieee754_rem_pio2(double x, double *y0, double *y1) +int +ieee754_rem_pio2(double x, double *y0, double *y1) { - extern int __ieee754_rem_pio2(double x, double *y); + extern int __ieee754_rem_pio2(double x, double *y); - double y[2]; - int n; + double y[2]; + int n; - n = __ieee754_rem_pio2(x, y); - *y0 = y[0]; - *y1 = y[1]; + n = __ieee754_rem_pio2(x, y); + *y0 = y[0]; + *y1 = y[1]; - return n; + return n; } /* View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/7e4f7eb9c7b602de22f3244fb…

1 0

[Git][cmucl/cmucl][master] 9 commits: Fix #26: Use nanosleep to sleep
by Raymond Toy 02 Dec '16

02 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e5777ecb by Raymond Toy at 2016-11-28T20:29:33-08:00 Fix #26: Use nanosleep to sleep lisp/os-common.c: o Implement os_sleep(double) to sleep for the given number of seconds. Uses nanosleep on all platforms to sleep, taking care to sleep more if nanosleep was interrupted. code/lispinit.lisp: code/multi-proc.lisp: o Use the new os_sleep function to sleep for the requested amount of time. - - - - - 05585b8d by Raymond Toy at 2016-11-28T21:05:02-08:00 Minor cosmetic tweaks o Include math.h before netdb.h (from Carl) o Use ceil instead of trunc and add comment on why. o Conform to cmucl style. - - - - - 9e99edb8 by Raymond Toy at 2016-11-28T21:14:27-08:00 Add test for issue 26 Basically used the repro case from the issue. - - - - - f09db6e5 by Raymond Toy at 2016-11-28T22:14:26-08:00 Solaris needs -lrt library to get nanosleep. - - - - - 1aae3ef9 by Raymond Toy at 2016-11-29T19:01:54-08:00 Verify the process ran and exited successfully - - - - - 260c0e45 by Raymond Toy at 2016-11-29T19:03:17-08:00 Adjust comment - - - - - fb864a9b by Raymond Toy at 2016-11-30T19:53:44-08:00 Fix merge conflicts with master - - - - - 8743d581 by Raymond Toy at 2016-11-30T19:53:57-08:00 Fix merge conflicts - - - - - 5f7c4fea by Raymond Toy at 2016-12-02T03:37:16+00:00 Merge branch 'rtoy-issue-26' into 'master' Fix #26: Use nanosleep to sleep without being interrupted First, use nanosleep to sleep instead of using select. Then handle the case of nanosleep being interrupted wherein we keep calling nanosleep with the remaining time until the desired time has elapsed. See merge request !17 - - - - - 5 changed files: - src/code/lispinit.lisp - src/code/multi-proc.lisp - src/lisp/Config.sparc_common - src/lisp/os-common.c - tests/issues.lisp Changes: ===================================== src/code/lispinit.lisp ===================================== --- a/src/code/lispinit.lisp +++ b/src/code/lispinit.lisp @@ -515,12 +515,9 @@ :format-arguments (list n) :datum n :expected-type '(real 0))) - (multiple-value-bind (sec usec) - (if (integerp n) - (values n 0) - (multiple-value-bind (sec frac) (truncate n) - (values sec (truncate frac 1e-6)))) - (unix:unix-select 0 0 0 0 sec usec)) + (alien:alien-funcall + (alien:extern-alien "os_sleep" (function c-call:void double-float)) + (float n 1d0)) nil) ;;;; SCRUB-CONTROL-STACK ===================================== src/code/multi-proc.lisp ===================================== --- a/src/code/multi-proc.lisp +++ b/src/code/multi-proc.lisp @@ -1643,12 +1643,9 @@ ;; Can't call process-wait if the scheduling is inhibited. *inhibit-scheduling*) ;; The initial-process may block. - (multiple-value-bind (sec usec) - (if (integerp n) - (values n 0) - (multiple-value-bind (sec frac)(truncate n) - (values sec (truncate frac 1e-6)))) - (unix:unix-select 0 0 0 0 sec usec)) + (alien:alien-funcall + (alien:extern-alien "os_sleep" (function c-call:void double-float)) + (float n 1d0)) nil) (t (process-wait-with-timeout "Sleep" n (constantly nil))))) ===================================== src/lisp/Config.sparc_common ===================================== --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -48,5 +48,5 @@ ARCH_SRC = sparc-arch.c DEPEND=$(CC) OS_SRC = solaris-os.c os-common.c elf.c -OS_LIBS= -lsocket -lnsl -ldl +OS_LIBS= -lsocket -lnsl -ldl -lrt EXEC_FINAL_OBJ = exec-final.o ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -6,9 +6,11 @@ */ #include <errno.h> +#include <math.h> #include <netdb.h> #include <stdio.h> #include <string.h> +#include <time.h> #include "os.h" #include "internals.h" @@ -562,3 +564,27 @@ int ieee754_rem_pio2(double x, double *y0, double *y1) return n; } + +/* + * sleep for the given number of seconds, even if we're interrupted. + */ +void +os_sleep(double seconds) +{ + struct timespec requested; + struct timespec remaining; + double integral; + double fractional; + + fractional = modf(seconds, &integral); + requested.tv_sec = (time_t) integral; + /* + * Round up---better to sleep slightly too long than to sleep for + * too short a time. + */ + requested.tv_nsec = (long) ceil(fractional * 1e9); + + while (nanosleep(&requested, &remaining) == -1 && errno == EINTR) { + requested = remaining; + } +} ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -352,3 +352,18 @@ (:tag :issues) (loop for k from 1 to 24 do (assert-equal 0 (encode-universal-time 0 0 (- 24 k) 31 12 1899 k)))) + +(define-test issue.26 + (:tag :issues) + (let ((start-time (get-universal-time))) + (let ((p (ext:run-program "/usr/bin/env" '("sleep" "1") :wait nil))) + (sleep 5) + ;; For this test to be valid, the process must have finished + ;; with a successful exit. + (assert-true (eq (ext:process-status p) :exited)) + (assert-true (zerop (ext:process-exit-code p))) + + ;; We expect to have slept for at least 5 sec, but since + ;; get-universal-time only has an accuracy of 1 sec, just verify + ;; more than 3 sec have elapsed. + (assert-true (>= (- (get-universal-time) start-time) 3))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/0e172b4b2d6dc5a6dd016c08…

1 0

[Git][cmucl/cmucl][rtoy-issue-26] 3 commits: Fix #36: encode-universal-time errors on valid time
by Raymond Toy 01 Dec '16

01 Dec '16

Raymond Toy pushed to branch rtoy-issue-26 at cmucl / cmucl Commits: 0e172b4b by Raymond Toy at 2016-11-10T19:13:53-08:00 Fix #36: encode-universal-time errors on valid time Allow 1899 as a year, but also add a check that the resulting time is a non-negative integer. Add a test for this too in issues.lisp. - - - - - fb864a9b by Raymond Toy at 2016-11-30T19:53:44-08:00 Fix merge conflicts with master - - - - - 8743d581 by Raymond Toy at 2016-11-30T19:53:57-08:00 Fix merge conflicts - - - - - 2 changed files: - src/code/time.lisp - tests/issues.lisp Changes: ===================================== src/code/time.lisp ===================================== --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -223,8 +223,11 @@ (type (mod 24) hour) (type (integer 1 31) date) (type (integer 1 12) month) - (type (or (integer 0 99) (integer 1900)) year) - (type (or null rational) time-zone)) + ;; 1899 to account for time zones that are equivalent to 1900. + (type (or (integer 0 99) (integer 1899)) year) + (type (or null rational) time-zone) + ;; Result must be non-negative integer! + (values (integer 0))) (let* ((year (if (< year 100) (pick-obvious-year year) year)) ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -348,6 +348,11 @@ '(".dir" "dir") :test #'string-equal))))) +(define-test issue.36 + (:tag :issues) + (loop for k from 1 to 24 do + (assert-equal 0 (encode-universal-time 0 0 (- 24 k) 31 12 1899 k)))) + (define-test issue.26 (:tag :issues) (let ((start-time (get-universal-time))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/260c0e45be8064450a13608a…

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs December 2016