tcl: Phase 5d/5e/5f — file ops, clock locale+scan, socket -async
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Phase 5d (file metadata + ops): - 11 SX primitives: file-size/mtime/stat/isfile?/isdir?/readable?/writable?/ delete/mkdir/copy/rename — wrap Unix.stat/access/unlink/mkdir/rename - Tcl `file` subcommands real (were stubs): isfile, isdir, readable, writable, size, mtime, atime, type, mkdir, copy, rename, delete - file delete/copy/rename strip leading-`-` flags - +10 idiom tests Phase 5e (clock options + scan): - clock-format extended to (t fmt tz), tz ∈ utc|local - Added specifiers: %y, %I, %p, %w, %% - New clock-scan SX primitive — format-driven parser + manual timegm - Tcl clock format/scan accept -format, -timezone, -gmt 0|1 - +5 idiom tests Phase 5f (socket -async): - socket-connect-async SX primitive: Unix.set_nonblock + connect, catches EINPROGRESS; returns channel immediately - channel-async-error: Unix.getsockopt_error - Tcl `socket -async host port`; `fconfigure $sock -error` - Connection completes on writable; canonical fileevent pattern works - +3 idiom tests Bug fix: tcl-call-proc was discarding :fileevents/:timers/:procs updates made inside Tcl procs (only :commands forwarded). Now forwards full result-interp as base, restoring caller's frame/stack/result/output/code. This was masked until socket-async made fileevent-from-inside-proc the natural pattern. test.sh inner timeout bumped 1200s→2400s (post-merge JIT remains slow). 376/376 green. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -303,6 +303,118 @@
|
||||
:result)
|
||||
"3")
|
||||
|
||||
; 42-49. Phase 5d file metadata + ops
|
||||
(ok "file-isfile-true"
|
||||
(get
|
||||
(run
|
||||
"set f /tmp/tcl-phase5d-1.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset r [file isfile $f]\nfile delete $f\nreturn $r")
|
||||
:result)
|
||||
"1")
|
||||
|
||||
(ok "file-isfile-false-on-dir"
|
||||
(get (run "file isfile /tmp") :result)
|
||||
"0")
|
||||
|
||||
(ok "file-isdir-true"
|
||||
(get (run "file isdir /tmp") :result)
|
||||
"1")
|
||||
|
||||
(ok "file-size"
|
||||
(get
|
||||
(run
|
||||
"set f /tmp/tcl-phase5d-2.txt\nset c [open $f w]\nputs -nonewline $c hello\nclose $c\nset s [file size $f]\nfile delete $f\nreturn $s")
|
||||
:result)
|
||||
"5")
|
||||
|
||||
(ok "file-readable-true"
|
||||
(get (run "file readable /tmp") :result)
|
||||
"1")
|
||||
|
||||
(ok "file-readable-missing"
|
||||
(get (run "file readable /no/such/path/here") :result)
|
||||
"0")
|
||||
|
||||
(ok "file-mkdir-then-isdir"
|
||||
(get
|
||||
(run
|
||||
"set d /tmp/tcl-phase5d-mkdir/sub\nfile mkdir $d\nset r [file isdir $d]\nfile delete $d\nfile delete /tmp/tcl-phase5d-mkdir\nreturn $r")
|
||||
:result)
|
||||
"1")
|
||||
|
||||
(ok "file-copy-roundtrip"
|
||||
(get
|
||||
(run
|
||||
"set s /tmp/tcl-phase5d-src.txt\nset d /tmp/tcl-phase5d-dst.txt\nset c [open $s w]\nputs -nonewline $c copydata\nclose $c\nfile copy $s $d\nset c [open $d r]\nset out [read $c]\nclose $c\nfile delete $s\nfile delete $d\nreturn $out")
|
||||
:result)
|
||||
"copydata")
|
||||
|
||||
(ok "file-rename-then-exists"
|
||||
(get
|
||||
(run
|
||||
"set s /tmp/tcl-phase5d-r1.txt\nset d /tmp/tcl-phase5d-r2.txt\nset c [open $s w]\nputs -nonewline $c x\nclose $c\nfile rename $s $d\nset r [list [file exists $s] [file exists $d]]\nfile delete $d\nreturn $r")
|
||||
:result)
|
||||
"0 1")
|
||||
|
||||
(ok "file-mtime-positive"
|
||||
(get
|
||||
(run
|
||||
"set f /tmp/tcl-phase5d-mt.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset m [file mtime $f]\nfile delete $f\nexpr {$m > 0}")
|
||||
:result)
|
||||
"1")
|
||||
|
||||
; 52-56. Phase 5e clock format options + clock scan
|
||||
(ok "clock-format-utc"
|
||||
(get
|
||||
(run "clock format 0 -format {%Y-%m-%d %H:%M:%S} -gmt 1")
|
||||
:result)
|
||||
"1970-01-01 00:00:00")
|
||||
|
||||
(ok "clock-format-fmt-default"
|
||||
(get
|
||||
(run "clock format 1710513000 -format {%Y-%m-%d} -gmt 1")
|
||||
:result)
|
||||
"2024-03-15")
|
||||
|
||||
(ok "clock-scan-roundtrip"
|
||||
(get
|
||||
(run "set t [clock scan {2024-06-15 12:00:00} -format {%Y-%m-%d %H:%M:%S} -gmt 1]\nclock format $t -format {%Y-%m-%d %H:%M:%S} -gmt 1")
|
||||
:result)
|
||||
"2024-06-15 12:00:00")
|
||||
|
||||
(ok "clock-scan-returns-int"
|
||||
(get
|
||||
(run "expr {[clock scan {1970-01-01 00:00:00} -format {%Y-%m-%d %H:%M:%S} -gmt 1] == 0}")
|
||||
:result)
|
||||
"1")
|
||||
|
||||
(ok "clock-format-percent-pct"
|
||||
(get
|
||||
(run "clock format 0 -format {%Y%%%m} -gmt 1")
|
||||
:result)
|
||||
"1970%01")
|
||||
|
||||
; 57-59. Phase 5f socket -async (non-blocking connect)
|
||||
(ok "socket-async-completes-writable"
|
||||
(get
|
||||
(run
|
||||
"proc h {sock host port} { close $sock }\nset srv [socket -server h 18930]\nset c [socket -async localhost 18930]\nset ready 0\nfileevent $c writable {global ready; set ready 1}\nvwait ready\nclose $c\nclose $srv\nset ready")
|
||||
:result)
|
||||
"1")
|
||||
|
||||
(ok "socket-async-then-write"
|
||||
(get
|
||||
(run
|
||||
"proc accept {sock host port} { global accepted_sock; set accepted_sock $sock; fileevent $sock readable [list reader $sock] }\nproc reader {sock} { global received; gets $sock line; set received $line; close $sock }\nset srv [socket -server accept 18931]\nset c [socket -async localhost 18931]\nfileevent $c writable {global wready; set wready 1; fileevent $::ch writable {}}\nset ::ch $c\nvwait wready\nputs $c async-data\nflush $c\nvwait received\nclose $c\nclose $srv\nset received")
|
||||
:result)
|
||||
"async-data")
|
||||
|
||||
(ok "socket-async-no-error"
|
||||
(get
|
||||
(run
|
||||
"proc h {sock host port} { close $sock }\nset srv [socket -server h 18932]\nset c [socket -async localhost 18932]\nset r 0\nfileevent $c writable {global r; set r 1}\nvwait r\nset err [fconfigure $c -error]\nclose $c\nclose $srv\nreturn $err")
|
||||
:result)
|
||||
"")
|
||||
|
||||
(dict
|
||||
"passed"
|
||||
tcl-idiom-pass
|
||||
|
||||
Reference in New Issue
Block a user