diff --git a/CHANGELOG.md b/CHANGELOG.md index 07bf746d7..210aa31b3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -55,6 +55,29 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- **`new File(uri)`, `Paths.get(uri)` and `Path.of(uri)` read the URI's path.** + They took the URI's string as the path, so `file:///tmp/a%20b` became the + relative path `file:/tmp/a%20b` and nothing under it existed. They now decode + the path of a `file:` URI and refuse the rest with the JDK's messages — an + authority (even `localhost`), a query, a fragment, an opaque or relative URI; + `Paths.get` of another scheme is a `FileSystemNotFoundException`. + `clojure.java.io/file` of a URI reads it the lenient way, through its URL, as + Clojure does (#1198). + +- **`java.time`'s `Month` overloads.** `LocalDate/of`, `LocalDateTime/of`, + `YearMonth/of`, `MonthDay/of` and `Year.atMonth` take a `java.time.Month` + where the month number goes, as the JDK's do; a `Month` was a + `ClassCastException`. `LocalDateTime/ofInstant` and an `ofEpochSecond` that + applies its offset come from jolt-lang/time, which owns zones (#1197). + +- **Spawned processes start with `SIGPIPE` at its default, as on the JVM.** + The runtime ignores `SIGPIPE` for its own writes, and an ignored signal + survives `exec`, so every child and everything it ran inherited it. A + producer whose consumer exited early (`yes | head`, `cmd | grep -q`) got + `EPIPE` and ran its error path — "Broken pipe" on stderr, a different exit + status — instead of being ended by the signal. A shell cannot undo that + itself, so the spawn now resets it (#1196). + - **A timed wait on a fiber no longer pins the fiber until its deadline.** The runtime's timer had no cancel, so a fiber's timed socket read, accept or connect, or a timed `deref`, left its deadline armed after the wait ended, diff --git a/host/chez/java/class-hierarchy.ss b/host/chez/java/class-hierarchy.ss index 2ac519a9d..3a2ee54f5 100644 --- a/host/chez/java/class-hierarchy.ss +++ b/host/chez/java/class-hierarchy.ss @@ -682,6 +682,7 @@ (jch-register-supers! "java.nio.file.NotDirectoryException" '("java.nio.file.FileSystemException")) (jch-register-supers! "java.nio.file.NotLinkException" '("java.nio.file.FileSystemException")) (jch-register-supers! "java.nio.file.DirectoryNotEmptyException" '("java.nio.file.FileSystemException")) +(jch-register-supers! "java.nio.file.FileSystemNotFoundException" '("java.lang.RuntimeException")) (jch-register-supers! "java.net.UnknownHostException" '("java.io.IOException")) (jch-register-supers! "java.net.SocketException" '("java.io.IOException")) (jch-register-supers! "java.net.ConnectException" '("java.net.SocketException")) diff --git a/host/chez/java/io.ss b/host/chez/java/io.ss index ec487996f..0ce6a7dd6 100644 --- a/host/chez/java/io.ss +++ b/host/chez/java/io.ss @@ -546,7 +546,12 @@ (if (null? cs) ;; (io/file url) strips the scheme — File of url.toURI on the JVM; only a ;; file: url names a path. url-file-coercion is defined below; call-time ref. - (if (and (null? rest) (jhost? path) (string=? (jhost-tag path) "url")) (url-file-coercion path) (make-jfile p)) + (cond ((null? rest) + (cond ((url-jhost? path) (url-file-coercion path)) + ;; as-file of a URI is as-file of its URL (clojure.java.io) + ((uri-jhost? path) (url-spec-file-coercion (uri-field path 'string))) + (else (make-jfile p)))) + (else (make-jfile p))) (loop (string-append p "/" (file-path-of (car cs))) (cdr cs))))) ;; the on-disk path of a value: a relative path resolves against JOLT_PWD. (define (jfile-fs f) (project-relative (file-path-of f))) @@ -652,15 +657,49 @@ (string-append "//" host path))) rest)) (p (uri-decode-lenient rest))) - (if (and windows? - (>= (string-length p) 3) - (char=? (string-ref p 0) #\/) - (windows-drive-prefix? (substring p 1 (string-length p))) - (or (= (string-length p) 3) (path-separator-char? (string-ref p 3)))) - (substring p 1 (string-length p)) - p))) + (uri-path->drive-path windows? p))) (define (file-url->path spec) (file-url->path-for (win32?) spec)) +;; A URI path names a drive as "/C:/..."; on Windows the path is "C:/...". +(define (uri-path->drive-path windows? p) + (if (and windows? + (>= (string-length p) 3) + (char=? (string-ref p 0) #\/) + (windows-drive-prefix? (substring p 1 (string-length p))) + (or (= (string-length p) 3) (path-separator-char? (string-ref p 3)))) + (substring p 1 (string-length p)) + p)) + +;; new File(URI), and the default filesystem's getPath(URI) under Paths.get and +;; Path.of (jolt-lang/jolt#1198). Unlike a file: URL, which clojure.java.io reads +;; leniently above, the JDK takes only an absolute, hierarchical file: URI with +;; no authority, query or fragment, and says which rule failed, in this order. +;; A localhost authority is refused here, not dropped. Both callers used to hand +;; the URI's string on as the path, so "file:///tmp/a%20b" became the relative +;; path "file:/tmp/a%20b". +(define (uri->file-path-for windows? u) + (define (bad msg) (throw-jvm 'IllegalArgumentException msg)) + (let ((scheme (uri-field u 'scheme))) + (when (jolt-nil? scheme) (bad "URI is not absolute")) + (when (uri-opaque? u) (bad "URI is not hierarchical")) + (unless (string-ci=? scheme "file") (bad "URI scheme is not \"file\"")) + (unless (jolt-nil? (uri-field u 'authority)) (bad "URI has an authority component")) + (unless (jolt-nil? (uri-field u 'fragment)) (bad "URI has a fragment component")) + (unless (jolt-nil? (uri-field u 'query)) (bad "URI has a query component")) + (let ((p (uri-field u 'dec-path))) + (when (or (jolt-nil? p) (string=? p "")) (bad "URI path component is empty")) + (uri-path->drive-path windows? p)))) +(define (uri->file-path u) (uri->file-path-for (win32?) u)) +;; Path.of(URI): the scheme picks the filesystem provider first, and only the +;; default one ("file") is installed. +(define (nio-uri->path u) + (let ((scheme (uri-field u 'scheme))) + (cond ((jolt-nil? scheme) (throw-jvm 'IllegalArgumentException "Missing scheme")) + ((string-ci=? scheme "file") (uri->file-path u)) + (else (jolt-throw (jolt-host-throwable + "java.nio.file.FileSystemNotFoundException" + (string-append "Provider \"" scheme "\" not installed"))))))) + ;; The path a STRING names as a clojure.java.io source or sink. Its Coercions ;; try (URL. s) before (File. s), so "file:/a/b" is the file /a/b rather than a ;; relative path whose first segment is "file:"; any other string is a path. @@ -2577,17 +2616,19 @@ ;; io/as-file of a file: URL yields the file it points at (JVM: new ;; File(url.toURI())); a URL with any other protocol has no filesystem path — ;; IllegalArgumentException, as the JVM's File(URI) throws. -(define (url-file-coercion u) - (if (string=? (url-protocol (url-spec u)) "file") - (make-jfile (file-url->path (url-spec u))) - (throw-jvm 'IllegalArgumentException (string-append "Not a file: " (url-spec u))))) +(define (url-file-coercion u) (url-spec-file-coercion (url-spec u))) +(define (url-spec-file-coercion spec) + (if (string=? (url-protocol spec) "file") + (make-jfile (file-url->path spec)) + (throw-jvm 'IllegalArgumentException (string-append "Not a file: " spec)))) (def-var! "clojure.java.io" "as-file" ;; Clojure extends Coercions to nil, so (io/as-file nil) is nil -- NOT a File ;; whose path is "". The difference is load-bearing one call downstream, where ;; the JVM raises on the nil and jolt was quietly reading the process's cwd. (lambda (x) (cond ((jolt-nil? x) x) ((jfile? x) x) - ((and (jhost? x) (string=? (jhost-tag x) "url")) (url-file-coercion x)) + ((url-jhost? x) (url-file-coercion x)) + ((uri-jhost? x) (url-spec-file-coercion (uri-field x 'string))) (else (make-jfile (file-path-of x)))))) ;; "reader" is bound by natives-array.ss (loaded later) so a char[] argument is ;; handled; that binding delegates here via jolt-io-reader for everything else. @@ -3048,6 +3089,7 @@ (define (jolt-file-ctor a . rest) (cond ((pair? rest) (jolt-make-file (jolt-file-join a (car rest)))) ((jolt-nil? a) (throw-jvm (quote NullPointerException) jolt-nil)) + ((uri-jhost? a) (make-jfile (uri->file-path a))) (else (jolt-make-file a)))) (register-class-ctor! "File" jolt-file-ctor) ;; File statics: the platform separators plus createTempFile / listRoots. diff --git a/host/chez/java/nio-file.ss b/host/chez/java/nio-file.ss index 787975728..d19829604 100644 --- a/host/chez/java/nio-file.ss +++ b/host/chez/java/nio-file.ss @@ -102,6 +102,10 @@ (else (string-append acc (path-join-sep windows? acc) p)))) "" parts)) (define (npath-get first . more) + (if (and (null? more) (uri-jhost? first)) + (make-nio-path (npath-join-for (nio-windows?) (list (nio-uri->path first)))) + (npath-get-strings first more))) +(define (npath-get-strings first more) (make-nio-path (npath-join-for (nio-windows?) (cons (npath-string-of first) (map npath-string-of (npath-spread-args more)))))) diff --git a/host/chez/java/process.ss b/host/chez/java/process.ss index e17236912..b5222fd80 100644 --- a/host/chez/java/process.ss +++ b/host/chez/java/process.ss @@ -556,6 +556,30 @@ (jolt-foreign-proc-safe "posix_spawn_file_actions_addinherit_np" '(void* int) 'int)) (define proc-POSIX-SPAWN-CLOEXEC-DEFAULT #x4000) ; , Darwin +;; A child starts with SIGPIPE at SIG_DFL, as the JVM's do (jolt-lang/jolt#1196). +;; This process ignores SIGPIPE — Chez's runtime does, so a write to a closed pipe +;; answers EPIPE instead of killing jolt — and an IGNORED disposition survives +;; exec, unlike a handler. Left alone, every child and everything it runs saw a +;; closed pipe as an error: `yes | head` printed "Broken pipe" from yes and exited +;; through its error path instead of dying of the signal. The shell cannot undo it +;; either; POSIX has a non-interactive sh keep a signal ignored on entry ignored. +;; POSIX_SPAWN_SETSIGDEF resets the signals in the attribute's set in the child, +;; between fork and exec. The flag is 4 and SIGPIPE 13 on every host that spawns +;; here (Linux glibc/musl/bionic, Darwin). sigset_t is 4 bytes on Darwin and 128 +;; on glibc; a posix_spawnattr_t is a pointer on Darwin and bionic and 336 bytes +;; on glibc — the allocations below cover the widest. +(define proc-attr-setsigdefault + (jolt-foreign-proc-safe "posix_spawnattr_setsigdefault" '(void* void*) 'int)) +(define proc-c-sigemptyset (jolt-foreign-proc-safe "sigemptyset" '(void*) 'int)) +(define proc-c-sigaddset (jolt-foreign-proc-safe "sigaddset" '(void* int) 'int)) +(define proc-POSIX-SPAWN-SETSIGDEF #x04) +(define proc-SIGPIPE 13) +(define proc-attr-bytes 512) +(define proc-sigset-bytes 256) +(define (proc-sigdefault-ok?) + (and proc-attr-init proc-attr-setflags proc-attr-destroy proc-attr-setsigdefault + proc-c-sigemptyset proc-c-sigaddset #t)) + ;; What posix_spawn-with-pipes needs, and nothing more. The R8 fiber-parking ;; extension's own bindings (fcntl, errno) are gated separately by ;; proc-nonblock-ok? above: losing parking is a performance story, losing this @@ -1021,14 +1045,24 @@ (err-p (and (not inherit-err?) (mk-pipe #t #f))) (barrier (proc-exec-barrier-pipe)) (fa (sa-foreign-alloc 128)) - ;; posix_spawnattr_t is one pointer on Darwin, the only place this - ;; is allocated; 64 bytes leaves room for a wider layout regardless. - (attr (and (proc-cloexec-default?) (sa-foreign-alloc 64))) + (cloexec? (proc-cloexec-default?)) + (sigdef? (proc-sigdefault-ok?)) + (attr (and (or cloexec? sigdef?) (sa-foreign-alloc proc-attr-bytes))) (pidbuf (sa-foreign-alloc 8))) (proc-fa-init fa) (when attr (proc-attr-init attr) - (proc-attr-setflags attr proc-POSIX-SPAWN-CLOEXEC-DEFAULT) + (proc-attr-setflags attr + (fxior (if cloexec? proc-POSIX-SPAWN-CLOEXEC-DEFAULT 0) + (if sigdef? proc-POSIX-SPAWN-SETSIGDEF 0))) + (when sigdef? + (let ((set (sa-foreign-alloc proc-sigset-bytes))) + (proc-c-sigemptyset set) + (proc-c-sigaddset set proc-SIGPIPE) + ;; the attribute keeps its own copy + (proc-attr-setsigdefault attr set) + (sa-foreign-free set)))) + (when cloexec? ;; An inherited stream has no dup2 naming it, so under the flag it ;; would be closed with everything else: name it. (when inherit-in? (proc-fa-inherit fa 0)) @@ -1045,7 +1079,7 @@ ;; LAST of the file actions, so the dup2s above have already moved the ;; child's ends onto 0/1/2 by the time everything else goes. Under ;; CLOEXEC_DEFAULT the kernel does this part. - (unless attr + (unless cloexec? (proc-close-inherited-fds! fa (append (if in-p (list (car in-p) (cdr in-p)) '()) (if out-p (list (car out-p) (cdr out-p)) '()) @@ -1056,7 +1090,7 @@ (envp (proc-marshal-argv (map (lambda (p) (string-append (car p) "=" (cdr p))) (proc-child-env-pairs)))) - ;; attrp is NULL — or carries only the CLOEXEC_DEFAULT flag, never + ;; attrp carries CLOEXEC_DEFAULT and SETSIGDEF at most, never ;; SETSIGMASK — so the child inherits this thread's signal mask, ;; which must carry none of jolt's own blocking (concurrency.ss). (rc (jolt-with-empty-sigmask diff --git a/host/chez/locks.ss b/host/chez/locks.ss index c608970d7..ad7159298 100644 --- a/host/chez/locks.ss +++ b/host/chez/locks.ss @@ -500,25 +500,34 @@ ;; deref 1.15x against a 1.1x ceiling (release binary, A/B/A). Threaded through, ;; the fast path is an `(if ibox ...)` that falls through (jolt-a0f1). (define (jolt-cv-wait/ibox mu cv deadline decide ibox who) - ;; Registered OUTSIDE mu, and only for a fiber. Outside because the timer's - ;; thunks run with timeout-mu released but registering takes it, so doing this - ;; under mu would order mu above timeout-mu here and below it there. + ;; The deadline wake is registered only for a fiber; a thread waits on cv with + ;; the deadline itself. It is cancelled as the wait ends, however it ends, so a + ;; timed deref answered in a millisecond does not leave its wake — and, through + ;; mu and cv, whatever those keep reachable — pending on the timer until the + ;; deadline. Arming and cancelling only take timeout-mu, a leaf (async.ss: no + ;; thunk runs under it), so the handler below may do either at the raise point, + ;; under mu or not. ;; - ;; The deadline is cancelled as the wait ends, however it ends, so a timed deref - ;; answered in a millisecond does not leave its wake — and, through mu and cv, - ;; whatever those keep reachable — pending on the timer until the deadline. The - ;; cancel on a raise runs at the raise point, possibly under mu; that is sound - ;; because cancelling only takes timeout-mu, which is a leaf (async.ss). + ;; A raise passing through is not necessarily the end of the wait: a handler + ;; further out may resume it. So the handler cancels, and if the raise comes + ;; back, re-arms — otherwise the resumed wait parks with nothing to wake it at + ;; its deadline. A wake that had already been collected to run is not re-armed; + ;; it is on its way. The park's own may-park! assertion (the park/lock gate + ;; wants it in jolt-cv-wait/park, next to the commit) runs after arming; when it + ;; refuses, its raise passes through the handler and the wake is cancelled. (if (and deadline (jolt-current-fiber)) - (begin - ;; before the deadline timer registers a wake for this wait - (jolt-fiber-may-park! who) - (let* ((timer (jolt-timer-at! deadline (lambda () (jolt-with-mutex mu (jolt-cv-wake! cv))))) - (r (with-exception-handler - (lambda (e) (jolt-timer-cancel! timer) (raise-continuable e)) - (lambda () (jolt-cv-wait/park mu cv deadline decide ibox who))))) - (jolt-timer-cancel! timer) - r)) + (let* ((arm (lambda () + (jolt-timer-at! deadline (lambda () (jolt-with-mutex mu (jolt-cv-wake! cv)))))) + (timer (arm)) + (r (with-exception-handler + (lambda (e) + (let* ((pending? (jolt-timer-cancel! timer)) + (v (raise-continuable e))) + (when pending? (set! timer (arm))) + v)) + (lambda () (jolt-cv-wait/park mu cv deadline decide ibox who))))) + (jolt-timer-cancel! timer) + r) (jolt-cv-wait/park mu cv deadline decide ibox who))) (define (jolt-cv-wait/park mu cv deadline decide ibox who) diff --git a/stdlib/jolt/time/enums.clj b/stdlib/jolt/time/enums.clj index 36c321e4a..bd9f23f57 100644 --- a/stdlib/jolt/time/enums.clj +++ b/stdlib/jolt/time/enums.clj @@ -14,6 +14,10 @@ (defn month [n] (impl/value :jolt.time/month {:value n})) (defn month-val [e] (impl/field e :value)) (defn- month-name [e] (nth u/month-names (dec (month-val e)))) +;; A month argument: the JDK overloads every `of` that takes a month number with +;; one that takes a Month (LocalDate, LocalDateTime, YearMonth, MonthDay). +(defn month-num [m] + (if (= :jolt.time/month (impl/type-of m)) (month-val m) (u/->long m))) (impl/register-type! :jolt.time/month {:eq (fn [a b] (= (month-val a) (month-val b))) diff --git a/stdlib/jolt/time/local.clj b/stdlib/jolt/time/local.clj index 327e4d292..91a20e34a 100644 --- a/stdlib/jolt/time/local.clj +++ b/stdlib/jolt/time/local.clj @@ -119,7 +119,7 @@ (declare ldt? ldt-epoch-day ldt-nod) (statics! ["LocalDate" "java.time.LocalDate"] - {"of" (fn [y m d] (ld-of (u/->long y) (u/->long m) (u/->long d))) + {"of" (fn [y m d] (ld-of (u/->long y) (e/month-num m) (u/->long d))) "ofEpochDay" (fn [n] (local-date (u/->long n))) "ofYearDay" (fn [y doy] (local-date (+ (days-from-civil (u/->long y) 1 1) (dec (u/->long doy))))) "parse" (fn [s & _] (local-date (parse-iso-date (str s)))) @@ -289,9 +289,9 @@ (statics! ["LocalDateTime" "java.time.LocalDateTime"] {"of" (fn ([d t] (local-dt (ld-epoch-day d) (lt-nano-of-day t))) - ([y mo d h mi] (local-dt (days-from-civil (u/->long y) (u/->long mo) (u/->long d)) (u/hmsn->nano (u/->long h) (u/->long mi) 0 0))) - ([y mo d h mi s] (local-dt (days-from-civil (u/->long y) (u/->long mo) (u/->long d)) (u/hmsn->nano (u/->long h) (u/->long mi) (u/->long s) 0))) - ([y mo d h mi s nano] (local-dt (days-from-civil (u/->long y) (u/->long mo) (u/->long d)) (u/hmsn->nano (u/->long h) (u/->long mi) (u/->long s) (u/->long nano))))) + ([y mo d h mi] (local-dt (days-from-civil (u/->long y) (e/month-num mo) (u/->long d)) (u/hmsn->nano (u/->long h) (u/->long mi) 0 0))) + ([y mo d h mi s] (local-dt (days-from-civil (u/->long y) (e/month-num mo) (u/->long d)) (u/hmsn->nano (u/->long h) (u/->long mi) (u/->long s) 0))) + ([y mo d h mi s nano] (local-dt (days-from-civil (u/->long y) (e/month-num mo) (u/->long d)) (u/hmsn->nano (u/->long h) (u/->long mi) (u/->long s) (u/->long nano))))) "ofEpochSecond" (fn [secs nano _off] (let [es (u/->long secs)] (local-dt (u/floor-div es 86400) (+ (* (u/floor-mod es 86400) nps) (u/->long nano))))) diff --git a/stdlib/jolt/time/year.clj b/stdlib/jolt/time/year.clj index 340506b15..2e9c624ae 100644 --- a/stdlib/jolt/time/year.clj +++ b/stdlib/jolt/time/year.clj @@ -33,7 +33,7 @@ "length" (fn [y] (if (u/leap? (year-val y)) 366 365)) "plusYears" (fn [y n] (year (+ (year-val y) (u/->long n)))) "minusYears" (fn [y n] (year (- (year-val y) (u/->long n)))) - "atMonth" (fn [y m] (year-month (year-val y) (u/->long m))) + "atMonth" (fn [y m] (year-month (year-val y) (e/month-num m))) "atDay" (fn [y doy] (l/local-date (+ (days-from-civil (year-val y) 1 1) (dec (u/->long doy))))) "isBefore" (fn [y o] (< (year-val y) (year-val o))) "isAfter" (fn [y o] (> (year-val y) (year-val o))) @@ -102,7 +102,7 @@ "toString" ym->string}) (statics! ["YearMonth" "java.time.YearMonth"] - {"of" (fn [y m] (year-month (u/->long y) (u/->long m))) + {"of" (fn [y m] (year-month (u/->long y) (e/month-num m))) "now" (fn [& args] (let [[y m _] (civil-from-days (u/floor-div (impl/clock-millis (first args)) 86400000))] (year-month y m))) "parse" (fn [s & _] (let [d (str s)] (year-month (or (u/digits-at d 0 4) (throw (ex-info "could not parse YearMonth" {}))) @@ -132,7 +132,7 @@ "hashCode" (fn [x] (+ (* (md-month x) 100) (md-day x))) "toString" md->string}) (statics! ["MonthDay" "java.time.MonthDay"] - {"of" (fn [m d] (month-day (u/->long m) (u/->long d))) + {"of" (fn [m d] (month-day (e/month-num m) (u/->long d))) "parse" (fn [s & _] (let [d (str s) o (if (= "--" (subs d 0 2)) 2 0)] (month-day (u/digits-at d o 2) (u/digits-at d (+ o 3) 2)))) "now" (fn [& args] (let [[_ m dd] (civil-from-days (u/floor-div (impl/clock-millis (first args)) 86400000))] (month-day m dd)))}) diff --git a/test/chez/async-timer-test.ss b/test/chez/async-timer-test.ss index 07a583a5e..fec6f128e 100644 --- a/test/chez/async-timer-test.ss +++ b/test/chez/async-timer-test.ss @@ -136,8 +136,8 @@ (ok "6g. and leaves far alone" (= 1 (pending-count)))) ;; --- 7. the heap order survives arbitrary removals ----------------------------- -;; Removing from the middle moves the last entry into the hole, which may have to -;; go up or down. Insert a scrambled band, cancel every third, and let the rest +;; A cancel leaves its entry in place with no thunk; the timer drops it when it +;; reaches the top. Insert a scrambled band, cancel every third, and let the rest ;; fire: every survivor fires, no cancelled one does, and they fire in deadline ;; order (each thunk records its deadline). (printf "\n== 7. cancels from the middle keep the heap ordered ==\n") diff --git a/test/chez/fibers-io-test.ss b/test/chez/fibers-io-test.ss index 79c064e7e..9ab557b93 100644 --- a/test/chez/fibers-io-test.ss +++ b/test/chez/fibers-io-test.ss @@ -307,5 +307,29 @@ (eq? (jolt-fiber-result t7-deref) (keyword #f "delivered"))) (ok "7d. and left no deadline pending" (= base-timers (pending-timers))) +;; --- 8. a raise the wait survives keeps its deadline ----------------------------- +;; The timed wait drops its deadline when a raise passes through it. A raise +;; that a handler further out RESUMES does not end the wait, so the deadline has +;; to come back, or the fiber parks with nothing left to wake it at the deadline. +(printf "\n== 8. a resumed raise inside a timed fiber wait keeps its deadline ==\n") +(define t8-mu (make-mutex)) +(define t8-cv (make-condition)) +(define t8-raised? #f) +(define t8 + (sa-fiber-spawn + (lambda () + (with-exception-handler + (lambda (c) 'resumed) + (lambda () + (jolt-cv-wait t8-mu t8-cv (+ (now-millis) 200) + (lambda (timed-out?) + (unless t8-raised? + (set! t8-raised? #t) + (raise-continuable 'passing-through)) + (if timed-out? 'timed-out jolt-cv-again)))))))) +(wait-until (lambda () (eq? (jolt-fiber-state t8) 'done)) 15.0 "8. resumed wait still timed out") +(ok "8a. the wait answered at its deadline" (eq? (jolt-fiber-result t8) 'timed-out)) +(ok "8b. and left no deadline pending" (= base-timers (pending-timers))) + (printf "\nfibers-io: ~a checks, ~a failures\n" total fails) (exit (if (zero? fails) 0 1)) diff --git a/test/chez/process-test.clj b/test/chez/process-test.clj index fb13c542e..c3290fc0f 100644 --- a/test/chez/process-test.clj +++ b/test/chez/process-test.clj @@ -791,6 +791,16 @@ (try (deref r 5000 :hung) (finally (.destroy pr)))) -1) +;; A child starts with SIGPIPE at SIG_DFL, as the JVM's do (jolt-lang/jolt#1196). +;; The runtime ignores SIGPIPE for its own writes, and an ignored disposition +;; survives exec, so a producer whose consumer quit early got EPIPE and took its +;; error path ("yes: stdout: Broken pipe") instead of dying quietly. No shell can +;; undo it: POSIX forbids a non-interactive sh resetting a signal ignored on entry. +(check-eq "a child's SIGPIPE is at its default" + (let [err (:err (sh ["sh" "-c" "yes e | head -c 100000 >&2"] {:err :string}))] + [(count err) (str/includes? err "Broken pipe")]) + [100000 false]) + (if (empty? @failures) (println "PROCESS-TEST OK") (do (doseq [f @failures] (println "FAIL:" f)) diff --git a/test/chez/unit.edn b/test/chez/unit.edn index 25035ad1b..d49b70e90 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -552,6 +552,9 @@ {:suite "insttime" :expr "(instance? java.time.LocalDateTime (LocalDateTime/parse \"2020-03-05T13:45:30\"))" :expected "true"} {:suite "insttime" :expr "(str (.toInstant #inst \"2020-03-05T13:45:30Z\"))" :expected "\"2020-03-05T13:45:30Z\""} {:suite "insttime" :expr "(str (LocalDate/of 2020 3 5))" :expected "\"2020-03-05\""} + ;; the JDK's Month overloads of `of` (jolt-lang/jolt#1197): a Month where the + ;; month number goes, on every type that takes one + {:suite "insttime" :expr "(mapv str [(LocalDate/of 2026 java.time.Month/SEPTEMBER 29) (LocalDateTime/of 2026 java.time.Month/SEPTEMBER 29 12 34) (LocalDateTime/of 2026 java.time.Month/SEPTEMBER 29 12 34 56) (LocalDateTime/of 2026 java.time.Month/SEPTEMBER 29 12 34 56 7) (java.time.YearMonth/of 2026 java.time.Month/FEBRUARY) (java.time.MonthDay/of java.time.Month/FEBRUARY 29) (.atMonth (java.time.Year/of 2026) java.time.Month/MAY)])" :expected "[\"2026-09-29\" \"2026-09-29T12:34\" \"2026-09-29T12:34:56\" \"2026-09-29T12:34:56.000000007\" \"2026-02\" \"--02-29\" \"2026-05\"]"} {:suite "insttime" :expr "(.toMillis (Duration/between (Instant/ofEpochMilli 0) (Instant/ofEpochMilli 5000)))" :expected "5000"} {:suite "insttime" :expr "(.toEpochMilli (Instant/parse \"2020-01-01T00:00:00Z\"))" :expected "1577836800000"} ;; A java.time.Instant is an inst through clojure.core's Inst protocol, which @@ -2262,6 +2265,20 @@ ;; the URL toURI gave for it; "file:///abs" is the JDK's other spelling. {:suite "file-url" :expr "(let [d (str (System/getProperty \"java.io.tmpdir\") \"/jolt url sp\") f (str d \"/x.txt\")] (.mkdirs (java.io.File. d)) (spit f \"payload\") [(slurp (.toURL (.toURI (java.io.File. f)))) (slurp (clojure.java.io/as-url (java.io.File. f))) (slurp (str \"file://\" (.getAbsolutePath (java.io.File. f)))) (boolean (re-find #\"%20\" (str (.toURI (java.io.File. f)))))])" :expected "[\"payload\" \"payload\" \"payload\" true]"} {:suite "file-url" :expr "(let [d (str (System/getProperty \"java.io.tmpdir\") \"/jolt url sp\") f (str d \"/x.txt\")] (.mkdirs (java.io.File. d)) (spit f \"payload\") (= (.getAbsolutePath (clojure.java.io/as-file (.toURL (.toURI (java.io.File. f))))) (.getAbsolutePath (java.io.File. f))))" :expected "true"} + ;; URI -> File/Path (jolt-lang/jolt#1198): File(URI), Paths.get(URI) and + ;; Path.of(URI) took the URI's string as the path, so "file:///tmp/a%20b" was + ;; the relative path "file:/tmp/a%20b". The JDK decodes the path of a file: URI + ;; and rejects everything else with its own message, in this order; Paths.get + ;; names a missing scheme and an unknown one differently from File. + {:suite "file-uri" :expr "(mapv (fn [s] (let [f (java.io.File. (java.net.URI. s))] [(.getPath f) (.getName f) (.isAbsolute f)])) [\"file:///data/tmp/a%20b\" \"file:/data/tmp/a%20b\" \"file:///a/b/\" \"file:///a%25b\" \"file:///\"])" :expected "[[\"/data/tmp/a b\" \"a b\" true] [\"/data/tmp/a b\" \"a b\" true] [\"/a/b\" \"b\" true] [\"/a%b\" \"a%b\" true] [\"/\" \"\" true]]"} + {:suite "file-uri" :expr "(mapv (fn [s] (try (java.io.File. (java.net.URI. s)) (catch Exception e [(.getName (class e)) (ex-message e)]))) [\"file://localhost/x\" \"http://example.com/x\" \"file:///x?q=1\" \"file:///x#f\" \"file:x\" \"/abs/x\"])" :expected "[[\"java.lang.IllegalArgumentException\" \"URI has an authority component\"] [\"java.lang.IllegalArgumentException\" \"URI scheme is not \\\"file\\\"\"] [\"java.lang.IllegalArgumentException\" \"URI has a query component\"] [\"java.lang.IllegalArgumentException\" \"URI has a fragment component\"] [\"java.lang.IllegalArgumentException\" \"URI is not hierarchical\"] [\"java.lang.IllegalArgumentException\" \"URI is not absolute\"]]"} + {:suite "file-uri" :expr "[(str (java.nio.file.Paths/get (java.net.URI. \"file:///data/tmp/a%20b\"))) (str (java.nio.file.Path/of (java.net.URI. \"file:/data/tmp/a%20b\"))) (str (java.nio.file.Paths/get (java.net.URI. \"file:///a/b/\")))]" :expected "[\"/data/tmp/a b\" \"/data/tmp/a b\" \"/a/b\"]"} + {:suite "file-uri" :expr "(mapv (fn [s] (try (java.nio.file.Paths/get (java.net.URI. s)) (catch Exception e [(.getName (class e)) (ex-message e)]))) [\"http://example.com/x\" \"/abs/x\" \"file://localhost/x\" \"file:x\"])" :expected "[[\"java.nio.file.FileSystemNotFoundException\" \"Provider \\\"http\\\" not installed\"] [\"java.lang.IllegalArgumentException\" \"Missing scheme\"] [\"java.lang.IllegalArgumentException\" \"URI has an authority component\"] [\"java.lang.IllegalArgumentException\" \"URI is not hierarchical\"]]"} + ;; the round trip the idiom is for: a real file through toURI and back + {:suite "file-uri" :expr "(let [d (str (System/getProperty \"java.io.tmpdir\") \"/jolt uri sp\") f (java.io.File. d \"x.txt\")] (.mkdirs (java.io.File. d)) (spit f \"payload\") [(.exists (java.io.File. (.toURI f))) (slurp (java.io.File. (.toURI f))) (= (.getAbsolutePath f) (str (java.nio.file.Paths/get (.toURI f))))])" :expected "[true \"payload\" true]"} + ;; io/file of a URI goes through URL on the JVM, which is the lenient reading: + ;; a localhost authority is dropped rather than refused + {:suite "file-uri" :expr "[(str (clojure.java.io/file (java.net.URI. \"file:///a%20b\"))) (str (clojure.java.io/file (java.net.URI. \"file://localhost/a%20b\"))) (try (clojure.java.io/file (java.net.URI. \"http://x/y\")) (catch IllegalArgumentException e (ex-message e)))]" :expected "[\"/a b\" \"/a b\" \"Not a file: http://x/y\"]"} ;; FileTime (jolt-lang/jolt#1119): from(Instant) looked up a Scheme inst-ms that ;; does not exist, so fs/set-last-modified-time with an Instant raised "variable ;; inst-ms is not bound"; from(long, TimeUnit) is the other JDK overload; and the diff --git a/test/chez/win-platform-test.ss b/test/chez/win-platform-test.ss index fbc87e78f..2d1174974 100644 --- a/test/chez/win-platform-test.ss +++ b/test/chez/win-platform-test.ss @@ -688,6 +688,13 @@ (same "url->path: UNC host" (file-url->path-for #t "file://srv/sh/a") "//srv/sh/a") (same "url->path: drive root" (file-url->path-for #t "file:/C:/") "C:/") (same "url->path: a stray % is literal" (file-url->path-for #t "file:/C:/100%/x") "C:/100%/x") + +;; new File(URI) / Path.of(URI) (jolt-lang/jolt#1198) share the drive rule with +;; the URL reader: the URI's "/C:/..." path is the Windows path "C:/...". +(same "uri->file: drive" (uri->file-path-for #t (uri-parse "file:///C:/Users/x/a.txt")) "C:/Users/x/a.txt") +(same "uri->file: escaped space" (uri->file-path-for #t (uri-parse "file:/C:/has%20space/x")) "C:/has space/x") +(same "uri->file: drive root" (uri->file-path-for #t (uri-parse "file:///C:/")) "C:/") +(same "uri->file: posix keeps /C:" (uri->file-path-for #f (uri-parse "file:///C:/x")) "/C:/x") (same "url->path: utf-8 escapes" (file-url->path-for #f "file:/a/%C3%A4") "/a/\x00e4;") ;; POSIX keeps the leading "/", and a path whose first segment merely LOOKS like ;; a drive is still a POSIX path