Commit 9b55c3e4 authored by Philip Fominykh's avatar Philip Fominykh

Merge branch 'master' into pfominykh-cmu-user-fixes

parents 7b9be9a8 52a93a05
variables:
download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2018/01"
version: "2018-01-x86"
download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2018/03"
version: "2018-03-x86"
linux-runner:
tags:
......
......@@ -34,12 +34,19 @@ done
# Shift out the options
shift $[$OPTIND - 1]
# Create the test directory needed issue.45 test.
# Create the test directory needed by the issue.45 test.
rm -rf test-tmp
mkdir test-tmp
ln -s /bin/ls test-tmp/ls-link
# Cleanup temp files and directories that we created during testing.
function cleanup {
rm -f /tmp/trac.36.bom.txt /tmp/trac.43.txt
rm -rf /tmp/foo
}
trap cleanup EXIT
if [ $# -eq 0 ]; then
# No args so run all the tests
$LISP -noinit -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)'
......
;; Get rid of incorrect symbol c::%unary-fround and just inherit
;; %unary-fround from the kernel package.
(ext:without-package-locks
(unintern 'c::%unary-fround "C"))
(export 'kernel::%unary-fround "KERNEL")
......@@ -23,7 +23,7 @@
%unary-ftruncate/single-float %unary-ftruncate/double-float))
#-x87
(export '(%unary-fround/single-float %unary-fround/double-float))
(export '(%unary-fround %unary-fround/single-float %unary-fround/double-float))
(in-package "LISP")
(export '(least-positive-normalized-short-float
......
......@@ -1903,7 +1903,7 @@
(deftransform upgraded-complex-real-contagion-arg1 ((x y) * * :defun-only t :node node)
;;(format t "upgraded-complex-real-contagion-arg1~%")
`(,(continuation-function-name (basic-combination-fun node))
(coerce x '(complex ,(type-specifier (continuation-type y))))
(coerce x '(complex ,(numeric-type-format (continuation-type y))))
y))
;;;
(deftransform upgraded-complex-real-contagion-arg2 ((x y) * * :defun-only t :node node)
......@@ -1912,7 +1912,7 @@
(continuation-type x) (continuation-type y))
`(,(continuation-function-name (basic-combination-fun node))
x
(coerce y '(complex ,(type-specifier (continuation-type x))))))
(coerce y '(complex ,(numeric-type-format (continuation-type x))))))
(dolist (x '(= + * / -))
......
......@@ -252,29 +252,32 @@
:ref-known (flushable foldable)
:set-trans (setf %array-fill-pointer)
:set-known (unsafe))
;; Don't let these ref-trans to be constant-folded because these
;; might get called on arrays that don't have these slots. (Because
;; the lisp functions might be inlined.)
(fill-pointer-p :type (member t nil)
:ref-trans %array-fill-pointer-p
:ref-known (flushable foldable)
:ref-known (flushable)
:set-trans (setf %array-fill-pointer-p)
:set-known (unsafe))
(elements :type index
:ref-trans %array-available-elements
:ref-known (flushable foldable)
:ref-known (flushable)
:set-trans (setf %array-available-elements)
:set-known (unsafe))
(data :type array
:ref-trans %array-data-vector
:ref-known (flushable foldable)
:ref-known (flushable)
:set-trans (setf %array-data-vector)
:set-known (unsafe))
(displacement :type (or index null)
:ref-trans %array-displacement
:ref-known (flushable foldable)
:ref-known (flushable)
:set-trans (setf %array-displacement)
:set-known (unsafe))
(displaced-p :type (member t nil)
:ref-trans %array-displaced-p
:ref-known (flushable foldable)
:ref-known (flushable)
:set-trans (setf %array-displaced-p)
:set-known (unsafe))
(dimensions :rest-p t))
......
......@@ -29,10 +29,14 @@ public domain.
* ANSI compliance fixes:
* Bug fixes:
* Gitlab tickets:
* ~~~#50~~~ CLX (Hemlock) fails to run.
* ~~~#49~~~ CLM crashes
* ~~~#47~~~ Backquate and multiple splices
* ~~~#59~~~ Incorrect type-derivation for `decode-float`
* ~~#50~~ CLX (Hemlock) fails to run.
* ~~#49~~ CLM crashes
* ~~#47~~ Backquate and multiple splices
* ~~#59~~ Incorrect type-derivation for `decode-float`
* ~~#60~~ The function `C::%UNARY-FROUND` is undefined
* ~~#58~~ Bogus type error in comparison of complex number with `THE` form
* ~~#61~~ Segfault when compiling call to `ARRAY-HAS-FILL-POINTER-P` on bit vector constant
* ~~#62~~ Segfault when compiling `ARRAY-DISPLACEMENT` on a string constant
* Other changes:
* Improvements to the PCL implementation of CLOS:
* Changes to building procedure:
......
......@@ -503,4 +503,35 @@
(c::decode-float-exp-derive-type-aux
(c::specifier-type `(single-float ,arg-lo ,arg-hi)))
arg-lo
arg-hi))))
\ No newline at end of file
arg-hi))))
(define-test issue.60
(:tag :issues)
(let ((c14 (compile nil #'(lambda (x)
(fround (the (member 1.0 2d0) x))))))
(assert-equalp
(values 1.0 0.0)
(funcall c14 1.0))
(assert-equalp
(values 2d0 0d0)
(funcall c14 2d0))))
(define-test issue.58
(:tag :issues)
(let ((c9 (compile nil #'(lambda (x)
(= (the (eql 1.0d0) x) #c(1/2 1/2))))))
(assert-false (funcall c9 1.d0))))
(define-test issue.61
(:tag :issues)
;; Verifies that the compiler doesn't segfault and that we return
;; the correct value.
(assert-false
(funcall (compile nil '(lambda () (array-has-fill-pointer-p #*10))))))
(define-test issue.62
(:tag :issues)
;; Verifies that the compiler doesn't segfault and that we return
;; the correct value.
(assert-false
(funcall (compile nil '(lambda () (array-displacement "aaaaaaaa"))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment