[Git][cmucl/cmucl][issue-158-darwin-pathnames-utf8] 4 commits: Undo unnecessary change to unidata.lisp
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Mon Feb 27 16:12:34 UTC 2023
Raymond Toy pushed to branch issue-158-darwin-pathnames-utf8 at cmucl / cmucl
Commits:
4fe2a3f4 by Raymond Toy at 2023-02-27T08:09:42-08:00
Undo unnecessary change to unidata.lisp
There was an unneeded indentation change here that should not have
been part of the MR.
- - - - -
80ac0130 by Tarn W. Burton at 2023-02-27T08:09:42-08:00
Avoid inserting NIL into simple LOOP from FORMAT
- - - - -
c2311453 by Raymond Toy at 2023-02-27T08:09:42-08:00
Fix #159: Don't use /tmp as a path for temp files
- - - - -
53803637 by Raymond Toy at 2023-02-27T08:11:20-08:00
Fix #166: integer-decode-float has incorrect type for exponent
- - - - -
10 changed files:
- .gitlab-ci.yml
- bin/build.sh
- + src/bootfiles/21d/boot-2021-07-1.lisp
- src/code/exports.lisp
- src/code/format.lisp
- src/code/unidata.lisp
- src/compiler/fndb.lisp
- src/compiler/generic/vm-type.lisp
- tests/issues.lisp
- tests/printer.lisp
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -1,7 +1,7 @@
variables:
download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2021/07"
version: "2021-07-x86"
- bootstrap: ""
+ bootstrap: "-B boot-2021-07-1"
stages:
- install
=====================================
bin/build.sh
=====================================
@@ -39,7 +39,7 @@ ENABLE2="yes"
ENABLE3="yes"
ENABLE4="yes"
-version=21c
+version=21d
SRCDIR=src
BINDIR=bin
TOOLDIR=$BINDIR
=====================================
src/bootfiles/21d/boot-2021-07-1.lisp
=====================================
@@ -0,0 +1,17 @@
+;; Bootstrap file
+;;
+;; Use "bin/build.sh -B boot-2021-07-1" to build this.
+;;
+;; We want to export the symbols from the KERNEL package which also
+;; exists in the C package, so we unintern the conflicting symbols from
+;; the C package.
+
+(in-package "KERNEL")
+(ext:without-package-locks
+ (handler-bind
+ ((error (lambda (c)
+ (declare (ignore c))
+ (invoke-restart 'lisp::unintern-conflicting-symbols))))
+ (export '(DOUBLE-FLOAT-INT-EXPONENT
+ SINGLE-FLOAT-INT-EXPONENT))))
+
=====================================
src/code/exports.lisp
=====================================
@@ -2329,10 +2329,11 @@
"DOUBLE-FLOAT-EXPONENT"
"DOUBLE-FLOAT-BITS"
"DOUBLE-FLOAT-HIGH-BITS"
+ "DOUBLE-FLOAT-INT-EXPONENT"
"DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT"
"DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME"
"FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS"
- "FLOAT-FORMAT-MAX" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P"
+ "FLOAT-FORMAT-MAX" "FLOAT-INT-EXPONENT" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P"
"FUNCTION-CODE-HEADER" "FUNCTION-TYPE" "FUNCTION-TYPE-ALLOWP"
"FUNCTION-TYPE-KEYP" "FUNCTION-TYPE-KEYWORDS"
"FUNCTION-TYPE-NARGS" "FUNCTION-TYPE-OPTIONAL" "FUNCTION-TYPE-P"
@@ -2426,6 +2427,7 @@
"SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P"
"SIMPLE-ARRAY-SIGNED-BYTE-32-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P"
"SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT"
+ "SINGLE-FLOAT-INT-EXPONENT"
"SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF"
"STD-COMPUTE-CLASS-PRECEDENCE-LIST"
"STREAMLIKE" "SIMPLE-STREAM-BUFFER" "STRINGABLE" "STRINGLIKE"
=====================================
src/code/format.lisp
=====================================
@@ -399,7 +399,8 @@
(form new-directives)
(expand-directive (car remaining-directives)
(cdr remaining-directives))
- (push form results)
+ (when form
+ (push form results))
(setf remaining-directives new-directives)))
(reverse results)))
=====================================
src/code/unidata.lisp
=====================================
@@ -514,7 +514,7 @@
(values split hvec mvec lvec))))
(declare (ignorable #'read16 #'read32 #'read-ntrie))
(with-open-file (,stm *unidata-path* :direction :input
- :element-type '(unsigned-byte 8))
+ :element-type '(unsigned-byte 8))
(unless (unidata-locate ,stm ,locn)
(error (intl:gettext "No data in file.")))
, at body)))))
=====================================
src/compiler/fndb.lisp
=====================================
@@ -319,7 +319,7 @@
(defknown (float-digits float-precision) (float) float-digits
(movable foldable flushable explicit-check))
(defknown integer-decode-float (float)
- (values integer float-exponent (member -1 1))
+ (values integer float-int-exponent (member -1 1))
(movable foldable flushable explicit-check))
(defknown complex (real &optional real) number
=====================================
src/compiler/generic/vm-type.lisp
=====================================
@@ -50,6 +50,8 @@
(deftype float-exponent ()
#-long-float 'double-float-exponent
#+long-float 'long-float-exponent)
+(deftype float-int-exponent ()
+ 'double-float-int-exponent)
(deftype float-digits ()
#-long-float `(integer 0 ,vm:double-float-digits)
#+long-float `(integer 0 ,vm:long-float-digits))
=====================================
tests/issues.lisp
=====================================
@@ -18,8 +18,10 @@
(declare (ignore arg))
form)
-(defparameter *test-path*
- (merge-pathnames (make-pathname :name :unspecific :type :unspecific
+(defparameter *tmp-dir*
+ (merge-pathnames (make-pathname :directory '(:relative "tmp")
+ :name :unspecific
+ :type :unspecific
:version :unspecific)
*load-truename*)
"Directory for temporary test files.")
@@ -777,10 +779,11 @@
(define-test issue.140.two-way-stream
(:tag :issues)
+ (ensure-directories-exist *tmp-dir*)
(with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
:direction :input
:external-format :utf-8)
- (with-open-file (out "/tmp/output.tst"
+ (with-open-file (out (merge-pathnames "output.tst" *tmp-dir*)
:direction :output
:external-format :utf-8
:if-exists :supersede)
@@ -803,15 +806,15 @@
;; Create 3 output streams. The exact external formats aren't
;; really important here as long as they're different for each file
;; so we can tell if we got the right answer.
- (with-open-file (s1 "/tmp/broad-1"
+ (with-open-file (s1 (merge-pathnames "broad-1" *tmp-dir*)
:direction :output
:if-exists :supersede
:external-format :latin1)
- (with-open-file (s2 "/tmp/broad-2"
+ (with-open-file (s2 (merge-pathnames "broad-2" *tmp-dir*)
:direction :output
:if-exists :supersede
:external-format :utf-8)
- (with-open-file (s3 "/tmp/broad-3"
+ (with-open-file (s3 (merge-pathnames "broad-3" *tmp-dir*)
:direction :output
:if-exists :supersede
:external-format :utf-16)
@@ -827,6 +830,7 @@
(assert-true (stream::find-external-format :euckr))
(assert-true (stream::find-external-format :cp949))))
+
(define-test issue.158
(:tag :issues)
(let* ((name (string #\Hangul_Syllable_Gyek))
@@ -872,3 +876,15 @@
#-darwin
(assert-equal (pathname-name f) expected-name))))
+
+
+
+(define-test issue.166
+ (:tag :issues)
+ ;; While this tests for the correct return value, the problem was
+ ;; that the compiler was miscompiling the function below and causing
+ ;; an error when the function run.
+ (let ((f (compile nil #'(lambda ()
+ (nth-value 1 (integer-decode-float least-positive-double-float))))))
+ (assert-equal -1126 (funcall f))))
+
=====================================
tests/printer.lisp
=====================================
@@ -113,3 +113,16 @@
(define-test sub-output-integer.1
(assert-prints "-536870912" (princ most-negative-fixnum)))
+
+;;; Simple LOOP requires only compound forms. Hence NIL is not
+;;; permitted. Some FORMAT directives (like newline) return NIL
+;;; as the form when they have nothing to add to the body.
+;;; Normally this is fine since BLOCK accepts NIL as a form. On
+;;; the other hand, when the newline directive is inside of an
+;;; iteration directive this will produce something like
+;;; (LOOP (fu) nil (bar)) which is not acceptable. To verify
+;;; that this is not happening we make sure we are not getting
+;;; (BLOCK NIL NIL) since this is easier to test for.
+(define-test format-no-nil-form.1
+ (assert-equal '(block nil) (third (second (macroexpand-1 '(formatter "~
+"))))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a4475ab65d0aebc845408bce4346afc811ce2b1c...53803637328531223a12e65b648d31434d5a3135
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a4475ab65d0aebc845408bce4346afc811ce2b1c...53803637328531223a12e65b648d31434d5a3135
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230227/d086898c/attachment-0001.html>
More information about the cmucl-cvs
mailing list