From 17250a8c971d2e93f19ae05a5ece366496bb7a3a Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 24 Jul 2026 02:16:32 +1000 Subject: [PATCH] tclsh subcommand G-118 items 3/4/5/9: argv0 stock parity, clean not-found, console fail-fast, project_main parity (0.20.0) - no-script forms set ::argv0 to the executable path (was the kit boot script) - missing script file: file-exists pre-check, clean message, exit 1 (existing-file source errors keep their full trace) - no piperepl machinery (unpatched runtime or TCLSH_PIPEREPL=0): terminal stdin fails fast with usage guidance (app-punkscript probe) instead of blocking in a raw read; piped degraded eval unchanged; patch-missing notice now 'note:' and a deliberate TCLSH_PIPEREPL=0 opt-out is quiet (old debug lines deleted) - project_main.tcl mirrors the full tclsh dispatch (script-arg/dash/-encoding/ lib: forms; was single-arg-only with stale gate default 0); layout _config copies byte-synced (interim duplication pending G-031) - tclshcmd.test 17 -> 19 (tclsh_noscript_argv0, tclsh_script_notfound); shell subtree 64 pass / 2 goal-gated skips / 0 fail against rebuilt kits Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- CHANGELOG.md | 13 + punkproject.toml | 2 +- .../src/vfs/_config/project_main.tcl | 133 +++- .../project-0.1/src/vfs/_config/punk_main.tcl | 600 ++++++++++++++++-- .../shell/testsuites/punkexe/tclshcmd.test | 24 + src/vfs/_config/project_main.tcl | 114 +++- src/vfs/_config/punk_main.tcl | 58 +- 7 files changed, 827 insertions(+), 117 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d4800660..ab271fcd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,19 @@ The latest `## [X.Y.Z]` header must match the `version` field in `punkproject.to Entries are newest-first; one bullet per notable change. See the root `AGENTS.md` "Project Versioning" section for the bump policy. +## [0.20.0] - 2026-07-24 + +- `tclsh` subcommand review fixes (G-118 items 3/4/5/9): no-script forms set `::argv0` to the + executable path (stock parity - previously leaked the kit boot script path); a missing script + file gets a clean `script file not found` message with exit 1 instead of a raw errorInfo trace; + on runtimes without the piperepl patch (or with `TCLSH_PIPEREPL=0`) a console-interactive + `tclsh` invocation now fails fast with usage guidance instead of blocking in a raw stdin read + (piped degraded-mode evaluation unchanged; the patch-missing notice is now `note:` and a + deliberate `TCLSH_PIPEREPL=0` opt-out is quiet); `project_main.tcl` (generated-project kits) + now carries the full tclsh dispatch in parity with `punk_main.tcl` (script-arg/leading-dash/ + `-encoding`/`lib:`-refusal forms included) and the project-layout `_config` copies are + refreshed to byte-parity. + ## [0.19.0] - 2026-07-23 - `bin/punk-runtime.cmd`: sha1 hashing (fetch verification, `list -remote` comparison) no longer depends on `Get-FileHash` - a script-defined function in Windows PowerShell 5.1 that vanishes on machines with a damaged PSModulePath while compiled cmdlets keep working (observed in the field: "Get-FileHash ... not recognized" under PS 5, making `list -remote` report spurious UPDATE AVAILABLE and fetch verification fail closed). Hashing now uses .NET directly (`Get-PunkFileSha1`), working on any PowerShell edition/state, with a one-time informational note when the damaged condition is detected. The bash payload's multi-tool sha1 probing was already robust and is unchanged. diff --git a/punkproject.toml b/punkproject.toml index 76beb019..27c09155 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,4 +1,4 @@ [project] name = "punkshell" -version = "0.19.0" +version = "0.20.0" license = "BSD-2-Clause" diff --git a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl index bcf54540..df81c784 100644 --- a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl +++ b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl @@ -1,4 +1,6 @@ +#source is at /src/vfs/_config/project_main.tcl + #This main script will consume a first argument of the form dev|os|internal # or any dash-delimited combination such as dev-os # @@ -122,6 +124,23 @@ apply { args { return "${plat}-${cpu}" } + proc platform_punk {} { + #canonical punkshell platform-dir name: platform_generic normalized. + #INLINE COPY of punk::platform::normalize (src/modules/punk/platform-*.tm; + #'help platforms' documents the canon) - the boot stage cannot package + #require, so keep this mapping in sync with that module: + #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64. + set parts [split [platform_generic] -] + set cpu [lindex $parts end] + set os [join [lrange $parts 0 end-1] -] + if {$os eq "macos"} {set os macosx} + switch -- $cpu { + amd64 {set cpu x86_64} + aarch64 {set cpu arm64} + arm {if {$os eq "macosx"} {set cpu arm64}} + } + return "${os}-${cpu}" + } } set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] @@ -607,7 +626,7 @@ apply { args { #so we prepend to auto_path using a slightly inefficient method. Should be fine on relatively small list like this #eventually it should just be something like 'ledit ::auto_path -1 -1 $libfolder' if {"dev" in $package_modes} { - set platform [::punkboot::platform_generic] + set platform [::punkboot::platform_punk] #on windows - case differences dont matter - but can stop us finding path in auto_path #on other platforms, case differences could represent different paths #review @@ -859,32 +878,114 @@ apply { args { #assert arglist has had 'dev|os|os-dev etc' first arg removed if it was present. - if {[llength $arglist] == 1 && [lindex $arglist 0] eq "tclsh"} { - #called as dev tclsh or tclsh + if {[lindex $arglist 0] eq "tclsh"} { + #called as dev tclsh ?script? ?args...? or tclsh ... #we would like to drop through to standard tclsh repl without launching another process - #tclMain.c doesn't allow it unless patched. + #tclMain.c doesn't allow it unless patched (TCLSH_PIPEREPL piperepl patch). + #This branch mirrors the punk_main.tcl tclsh subcommand dispatch (G-118 parity). + set subcommand_arglist [lrange $arglist 1 end] + set ::argv $subcommand_arglist + set ::argc [llength $subcommand_arglist] if {![info exists ::env(TCLSH_PIPEREPL)]} { - set is_tclsh_piperepl_env_true 0 + set is_tclsh_piperepl_env_true 1 } else { if {[string is boolean -strict $::env(TCLSH_PIPEREPL)]} { set is_tclsh_piperepl_env_true $::env(TCLSH_PIPEREPL) } else { - set is_tclsh_piperepl_env_true 0 + set is_tclsh_piperepl_env_true 1 } } - if {!$is_tclsh_piperepl_env_true} { - puts stderr "tcl_interactive: $::tcl_interactive" - puts stderr "stdin: [chan configure stdin]" - puts stderr "Environment variable TCLSH_PIPEREPL is not set or is false or is not a boolean" + if {$is_tclsh_piperepl_env_true && ![info exists ::tclsh(istty)]} { + #runtime lacks the piperepl patch (a patched runtime with the gate open + #publishes ::tclsh(istty) before this script runs). Informational only: + #script-arg and piped forms work regardless; the interactive repl form + #fails fast below. A deliberate TCLSH_PIPEREPL=0 opt-out stays quiet. + puts stderr "note: the runtime doesn't appear to have been compiled with the piperepl patch" + } + #stock tclsh argument forms (tclMain.c): the only recognised leading option is + #'-encoding name fileName' (and only when fileName does not begin with '-'); + #any other leading '-' argument means NO script file - all arguments stay in + #::argv (already set above) and tclsh proceeds to the repl (tty) or stdin + #evaluation (piped). + set tclsh_have_script 0 + set tclsh_encoding "" + if {[llength $subcommand_arglist] >= 3 && [lindex $subcommand_arglist 0] eq "-encoding" && ![string match -* [lindex $subcommand_arglist 2]]} { + set tclsh_encoding [lindex $subcommand_arglist 1] + set tclsh_script [lindex $subcommand_arglist 2] + set tclsh_scriptargs [lrange $subcommand_arglist 3 end] + set tclsh_have_script 1 + } elseif {[llength $subcommand_arglist] && ![string match -* [lindex $subcommand_arglist 0]]} { + set tclsh_script [lindex $subcommand_arglist 0] + set tclsh_scriptargs [lrange $subcommand_arglist 1 end] + set tclsh_have_script 1 + } + if {$tclsh_have_script} { + if {[string match -nocase lib:* $tclsh_script]} { + #scriptlib resolution is a punk facility - the tclsh subcommand keeps plain + #tclsh semantics (no punk modules loaded), so point at the 'script' subcommand + #instead of failing on a literal 'lib:...' path (illegal on windows filesystems + #anyway; reachable via ./lib:... or an absolute path on other platforms). + set exebase [file rootname [file tail [info nameofexecutable]]] + puts stderr "punk tclsh: 'lib:' scriptlib resolution is not supported by the tclsh subcommand (plain tclsh semantics)" + puts stderr " use: $exebase script $tclsh_script ?args...?" + exit 1 + } + set normscript [file normalize $tclsh_script] + if {![file exists $normscript]} { + #not-found gets a clean message ('script' subcommand coherence); errors + #from an existing script keep their full trace + puts stderr "punk tclsh: script file not found: '$normscript'" + exit 1 + } + info script $normscript + set ::argv0 $normscript + set ::argv $tclsh_scriptargs + set ::argc [llength $::argv] + #we are in an apply context here - so we need to uplevel to get the source to work as expected + if {$tclsh_encoding ne ""} { + uplevel 1 [list source -encoding $tclsh_encoding $tclsh_script] + } else { + uplevel 1 [list source $tclsh_script] + } + + #default tclsh behaviour is to run the script and exit + #the script can set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run } else { - #according to env TCLSH_PIPEREPL and our commandline argument - tclsh repl is desired - #check if tclsh/punk has had the piperepl patch applied - in which case tclsh(istty) should exist - if {![info exists ::tclsh(istty)]} { - puts stderr "error: the runtime doesn't appear to have been compiled with the piperepl patch" + #no script file: all arguments (if any) are already in ::argv, matching + #stock tclsh; argv0 is the executable itself, not the kit boot script + set ::argv0 [info nameofexecutable] + if {[info exists ::tclsh(istty)]} { + if {$::tclsh(istty)} { + #tclsh piperepl patch applied - stdin is a tty - we can run the tclsh repl + set ::tclsh(dorepl) 1 + set ::tcl_interactive 1 + } else { + #stdin is not a tty - piped input is evaluated as a script, then exit + set ::tclsh(dorepl) 0 + set ::tcl_interactive 0 + #script on stdin could set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run + set data [read stdin] + uplevel 1 [list eval $data] + } + } else { + #no piperepl machinery (unpatched runtime, or TCLSH_PIPEREPL=0): the + #interactive repl is unavailable. Fail fast on terminal stdin instead of + #blocking in a raw console read (app-punkscript terminal-probe precedent); + #piped/redirected stdin keeps the evaluate-and-exit behaviour. + set conf "" + catch {set conf [chan configure stdin]} + if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} { + set exebase [file rootname [file tail [info nameofexecutable]]] + puts stderr "punk tclsh: the interactive tclsh repl requires a piperepl-capable runtime (this runtime lacks the patch, or TCLSH_PIPEREPL=0)" + puts stderr "usage: | $exebase tclsh" + puts stderr " or: $exebase tclsh ?args...?" + exit 1 + } + set ::tcl_interactive 0 + set data [read stdin] + uplevel 1 [list eval $data] } } - set ::tcl_interactive 1 - set ::tclsh(dorepl) 1 } elseif {[lindex $arglist 0] eq "shell"} { if {[llength $arglist] == 1} { package require app_shell diff --git a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl index bc853604..bb981307 100644 --- a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl +++ b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl @@ -1,4 +1,6 @@ +#source is at src/vfs/_config/punk_main.tcl + #This main script will consume a first argument of the form dev|os|internal # or any dash-delimited combination such as dev-os # @@ -21,7 +23,102 @@ # - and restrict package paths to those coming from a vfs (if not launched with 'dev' or 'os' first arg which allows external paths to remain) apply { args { + set ::punkargv $args set tclmajorv [lindex [split [info tclversion] .] 0] + + # -- runtime static/builtin package capture (G-058) -------------------------------------- + #Runtimes may statically link packages (e.g tcl-sfe: Thread,twapi,sqlite3,tdbc). + #Static registrations are process-global ('load {} ' works in any interp/thread) + #but 'package require' needs a package-name -> load mapping in EACH interp. A kit's + #appended vfs replaces the runtime's own //zipfs:/app mount, so any pkgIndex.tcl the + #runtime shipped for its statics is gone - and the path setup below controls resolution + #anyway. Capture the static prefixes now, discover the package names/versions each + #provides by loading into a throwaway interp, and record the results in ::punkboot so + #that (a) this interp and (b) every interp/thread punkshell fabricates can seed + #'package ifneeded {load {} }' entries. + #(see punk::lib::interp_sync_package_paths / snapshot_package_paths and the + # punk::packagepreference static-vs-bundled policy) + #Probe-loading is safe for self-contained extensions; static_probe_denylist excludes + #prefixes whose init has side effects (tk* creates '.') or whose package is known to be + #composite (C part + on-disk scripts: vfs, tdbc*, and kit machinery mk4tcl/vlerq) - + #those keep their existing resolution behaviour. Composite statics are ALSO excluded + #naturally: only packages a probe-load actually PROVIDES are recorded, so an init that + #defers to script files which no longer exist (e.g static twapi whose script layer + #lived in the runtime's replaced zip) is never seeded, and any bundled complete copy + #resolves as before. + namespace eval ::punkboot { + variable static_prefixes [list] + variable static_packages [dict create] ;#pkgname -> {version prefix

} + variable static_probe_denylist [list tk* vfs mk4tcl vlerq tdbc*] + } + apply {{} { + foreach rec [info loaded] { + lassign $rec fpath prefix + if {$fpath eq "" && $prefix ne ""} { + lappend ::punkboot::static_prefixes $prefix + } + } + if {![llength $::punkboot::static_prefixes]} { + return + } + set probeable [list] + foreach prefix $::punkboot::static_prefixes { + set denied 0 + foreach dpat $::punkboot::static_probe_denylist { + if {[string match -nocase $dpat $prefix]} { + set denied 1 + break + } + } + if {!$denied} { + lappend probeable $prefix + } + } + set probe __punkboot_staticprobe + catch {interp delete $probe} + interp create $probe + #diff on PROVIDED packages (not 'package names' - a probe load can trigger an index + #scan that registers many names as ifneeded without providing them) + set provided_in_probe {{probe} { + set pdict [dict create] + foreach n [interp eval $probe {package names}] { + set pv [interp eval $probe [list package provide $n]] + if {$pv ne ""} { + dict set pdict $n $pv + } + } + return $pdict + }} + #an init may depend on another static - retry failures once + set attempts [list {*}$probeable {*}$probeable] + set done [list] + foreach prefix $attempts { + if {$prefix in $done} { + continue + } + set before_prov [apply $provided_in_probe $probe] + if {[catch {load {} $prefix $probe}]} { + continue + } + lappend done $prefix + dict for {pkgname v} [apply $provided_in_probe $probe] { + if {![dict exists $before_prov $pkgname]} { + dict set ::punkboot::static_packages $pkgname [dict create version $v prefix $prefix] + } + } + } + interp delete $probe + #seed this interp's package db so requires here can resolve to the runtime's own + #copy. Coexisting ifneeded entries (static + any vfs/module copies registered by + #index scans) resolve version-aware under the standard package machinery. + dict for {pkgname pinfo} $::punkboot::static_packages { + if {[package provide $pkgname] eq ""} { + package ifneeded $pkgname [dict get $pinfo version] [list load {} [dict get $pinfo prefix]] + } + } + }} + # -- end runtime static/builtin package capture ------------------------------------------- + namespace eval ::punkboot { #This is somewhat ugly - but we don't want to do any 'package require' operations at this stage # even for something that is available in tcl_library. @@ -122,6 +219,59 @@ apply { args { return "${plat}-${cpu}" } + proc platform_punk {} { + #canonical punkshell platform-dir name: platform_generic normalized. + #INLINE COPY of punk::platform::normalize (src/modules/punk/platform-*.tm; + #'help platforms' documents the canon) - the boot stage cannot package + #require, so keep this mapping in sync with that module: + #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64. + set parts [split [platform_generic] -] + set cpu [lindex $parts end] + set os [join [lrange $parts 0 end-1] -] + if {$os eq "macos"} {set os macosx} + switch -- $cpu { + amd64 {set cpu x86_64} + aarch64 {set cpu arm64} + arm {if {$os eq "macosx"} {set cpu arm64}} + } + return "${os}-${cpu}" + } + proc is_interactive {} { + if {"windows" eq $::tcl_platform(platform) && [package vcompare [info patchlevel] 9.0] == -1} { + #tcl 8.6 etc + if {![catch {package require twapi}]} { + set h_console [twapi::GetStdHandle -10] ;#STD_INPUT_HANDLE + if {[catch {twapi::GetConsoleMode $h_console} result]} { + return 0 + } else { + return 1 + } + } else { + #TODO + #REVIEW + #we have no current way to detect if we are running in a console in tcl 8 on windows without twapi - so we'll assume not interactive for now. + #This implies there is no mechanism for this in early Tcl versions. + #https://stackoverflow.com/questions/43660612/how-to-check-if-stdin-stdout-are-connected-to-a-terminal-in-tcl + #set tcl_interactive 0 + puts stderr "WARNING: is_interactive cannot detect console on Windows Tcl [info patchlevel] without twapi package - probably not interactive" + } + } + + # ----------------------------------- + set stdin_info [chan configure stdin] + if {[dict exists $stdin_info -inputmode]} { + #this is the only way I currently know to detect console on windows.. doesn't work on Alma linux. + # tcl_interactive used by repl to determine if stderr output prompt to be printed. + # (that way, piping commands into stdin should not produce prompts for each command) + #set tcl_interactive 1 + return 1 + } + #however, the -mode option only seems to appear on linux when a terminal exists.. + if {[dict exists $stdin_info -mode]} { + return 1 + } + return 0 + } } set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] @@ -234,8 +384,10 @@ apply { args { set tm_additions_internal [list] set tm_additions_dev [list] + set tm_additions_src [list] set auto_path_additions_internal [list] set auto_path_additions_dev [list] + set auto_path_additions_src [list] set lc_auto_path [string tolower $::auto_path] @@ -318,46 +470,50 @@ apply { args { # dev - refers to module and library paths relative to the project (executable path) # os - refers to modules and library paths gleaned from ::env (TCLLIBPATH and TCL__TM_PATH) # internal - refers to modules and libraries supplied from the mounted filesystem of a kit or zipfs based executable + # src - refers to unbuilt modules and libraries under the project's src/ tree (src/modules, src/lib, src/bootsupport, src/vendormodules) # ----------------------------------------------------------------------------------------------------------- # Note that unlike standard 'package unknown' punk::libunknown does not stop searching for packages when a .tm file is found that matches requirements, # The auto_path is still examined. (avoids quirks where higher versioned pkgIndex based package not always found) # ----------------------------------------------------------------------------------------------------------- - set all_package_modes [list dev os internal] + set all_package_modes [list dev os internal src] #package_mode is specified as a dash-delimited ordered value e.g dev-os #"internal" is the default and if not present is always added to the list #i.e "dev-os" is equivalent to "dev-os-internal" #"os" is equivalent to "os-internal" #"internal-os" and "internal" are left as is. - #The effective package_mode has 1 2 or 3 members. + #The effective package_mode has 1 2 3 or 4 members. # The only case where it has 1 member is if just "internal" is specified. - #This gives the number of permutations as how many ways to choose 3 items plus how many ways to choose 2 of the 3 items (one must be 'internal') plus the sole allowable way to choose 1 - #for a total of 11 possible final orderings. - #(16 possible values for package_mode argument when you include the short-forms "",os,dev,os-dev,dev-os which always have 'internal' appended) set test_package_mode [lindex $args 0] - - switch -exact -- $test_package_mode { - internal - - os-internal - dev-internal - internal-os - internal-dev - - os-dev-internal - os-internal-dev - dev-os-internal - dev-internal-os - internal-os-dev - internal-dev-os { - #fully specified ('internal' is present) - set package_modes [split $test_package_mode -] - set arglist [lrange $args 1 end] + #puts stderr "main.tcl test_package_mode: '$test_package_mode'" + + #Token-by-token validation: instead of exhaustively listing all permutations, + #split the first arg on dash and validate each token against the known mode set. + #This scales to any number of modes without enumerating every permutation. + set package_modes "" + set arglist "" + if {$test_package_mode eq ""} { + #empty first arg consumed as equivalent of 'internal' + set package_modes internal + set arglist [lrange $args 1 end] + } else { + set tokens [split $test_package_mode -] + set valid 1 + foreach t $tokens { + if {$t ni $all_package_modes} { + set valid 0 + break + } } - os - dev - os-dev - dev-os { - #partially specified - 'internal' ommitted but implied at tail - set package_modes [list {*}[split $test_package_mode -] internal] + if {$valid && [llength $tokens] >= 1} { + set package_modes $tokens + if {"internal" ni $package_modes} { + lappend package_modes internal + } set arglist [lrange $args 1 end] - } - default { - #empty first arg - or some unrelated arg + } else { + #not a package_mode - treat as subcommand set package_modes internal - if {$test_package_mode eq ""} { - #consume the empty first arg as an equivalent of 'internal' - #don't consume any first arg that isn't recognised as a package_mode - set arglist [lrange $args 1 end] - } else { - set arglist $args - } + set arglist $args } } #assert: arglist has had any first arg that is a package_mode (including empty string) stripped. @@ -492,6 +648,54 @@ apply { args { } } + #src mode: discover the project's src/ tree and add unbuilt module paths. + #Unlike dev mode (which points at built output in /modules), + #src mode points at the unbuilt source in /src/modules etc. + if {"src" in $package_modes} { + #reuse the dev-mode project root discovery (exe in bin/ -> backtrack 1) + set src_project_root "" + set normexe_dir_for_src [file dirname $normexe] + if {[file tail $normexe_dir_for_src] eq "bin"} { + set src_project_root [file dirname $normexe_dir_for_src] + } else { + set src_project_root $normexe_dir_for_src + } + #also check symlink target + if {$src_project_root eq ""} { + set nameexe_dir_for_src [file dirname [file normalize [info nameofexecutable]]] + if {[file tail $nameexe_dir_for_src] eq "bin"} { + set src_project_root [file dirname $nameexe_dir_for_src] + } else { + set src_project_root $nameexe_dir_for_src + } + } + + if {$src_project_root ne "" && [file isdirectory [file join $src_project_root src]]} { + foreach p [list modules modules_tcl$tclmajorv] { + set modpath [file join $src_project_root src $p] + if {[file isdirectory $modpath] && $modpath ni $tm_additions_src} { + lappend tm_additions_src $modpath + } + } + #bootsupport modules (for boot-critical packages like punkcheck, punk::mix etc) + foreach p [list modules modules_tcl$tclmajorv] { + set modpath [file join $src_project_root src bootsupport $p] + if {[file isdirectory $modpath] && $modpath ni $tm_additions_src} { + lappend tm_additions_src $modpath + } + } + #vendormodules (vendored dependencies like voo) + foreach p [list vendormodules vendormodules_tcl$tclmajorv] { + set modpath [file join $src_project_root src $p] + if {[file isdirectory $modpath] && $modpath ni $tm_additions_src} { + lappend tm_additions_src $modpath + } + } + } else { + puts stderr "Warning - src mode: no src/ directory found relative to executable ($normexe_dir_for_src)" + } + } + @@ -555,6 +759,13 @@ apply { args { } } } + src { + foreach n $tm_additions_src { + if {$n ni $new_tm_path} { + lappend new_tm_path $n + } + } + } os { foreach n $external_tm_dirs { if {$n ni $new_tm_path} { @@ -607,7 +818,7 @@ apply { args { #so we prepend to auto_path using a slightly inefficient method. Should be fine on relatively small list like this #eventually it should just be something like 'ledit ::auto_path -1 -1 $libfolder' if {"dev" in $package_modes} { - set platform [::punkboot::platform_generic] + set platform [::punkboot::platform_punk] #on windows - case differences dont matter - but can stop us finding path in auto_path #on other platforms, case differences could represent different paths #review @@ -658,6 +869,42 @@ apply { args { } } + + #src mode: add unbuilt source library paths from the project's src/ tree. + if {"src" in $package_modes && [info exists src_project_root] && $src_project_root ne ""} { + set platform [::punkboot::platform_punk] + set src_lib_base [file join $src_project_root src] + #src/lib and src/lib_tcl (editable library source) + foreach libsub [list lib_tcl$tclmajorv lib] { + set libfolder [file join $src_lib_base $libsub] + if {[file isdirectory $libfolder]} { + if {[string match lib_tcl* [file tail $libfolder]]} { + if {[file exists $libfolder/allplatforms]} { + lappend auto_path_additions_src $libfolder/allplatforms + } + if {[file exists $libfolder/$platform]} { + lappend auto_path_additions_src $libfolder/$platform + } + } else { + lappend auto_path_additions_src $libfolder + } + } + } + #src/bootsupport/lib (bootstrap libraries) + set src_bs_lib [file join $src_lib_base bootsupport lib] + if {[file isdirectory $src_bs_lib]} { + if {$src_bs_lib ni $auto_path_additions_src} { + lappend auto_path_additions_src $src_bs_lib + } + } + #src/bootsupport/lib/tcl/ (platform-specific bootstrap libraries) + set src_bs_lib_arch [file join $src_lib_base bootsupport lib tcl$tclmajorv $platform] + if {[file isdirectory $src_bs_lib_arch]} { + if {$src_bs_lib_arch ni $auto_path_additions_src} { + lappend auto_path_additions_src $src_bs_lib_arch + } + } + } # -- --- --- --- --- --- --- --- #split existing ::auto_path entries into internal & external set internal_ap_dirs [list] ;# @@ -703,6 +950,13 @@ apply { args { } } } + src { + foreach n $auto_path_additions_src { + if {$n ni $new_auto_path} { + lappend new_auto_path $n + } + } + } os { foreach n $external_ap_dirs { if {$n ni $new_auto_path} { @@ -857,49 +1111,261 @@ apply { args { #-------------------------------------------------------- #Now that new 'package unknown' mechanism is in place - we can use package require - #assert arglist has had 'dev|os|os-dev etc' first arg removed if it was present. - if {[llength $arglist] == 1 && [lindex $arglist 0] eq "tclsh"} { - #called as dev tclsh or tclsh - #we would like to drop through to standard tclsh repl without launching another process - #tclMain.c doesn't allow it unless patched. - if {![info exists ::env(TCLSH_PIPEREPL)]} { - set is_tclsh_piperepl_env_true 0 - } else { - if {[string is boolean -strict $::env(TCLSH_PIPEREPL)]} { - set is_tclsh_piperepl_env_true $::env(TCLSH_PIPEREPL) + + + #-------------------------------------------------------- + #src mode: register #modpod modules from src/modules via package ifneeded + #and set package prefer latest so 999999.0a1.0 dev modules are preferred + #over stable bootsupport/vendored copies on unversioned package require. + #Uses only Tcl builtins (glob, file, string) since no punk modules are loaded yet. + #-------------------------------------------------------- + if {"src" in $package_modes && [info exists src_project_root] && $src_project_root ne ""} { + #package prefer latest is set here so 999999.0a1.0 dev modules are preferred + #over stable bootsupport/vendored copies on unversioned package require. + #This must be set after libunknown::init (which may reset the preference to stable) + #and before any package require calls in the subcommand handler below. + #We set it again just before subcommand dispatch to ensure it isn't overridden. + + #inline #modpod scanner — equivalent to punk::tcltestrun::tm_path_additional_ifneeded + #but using only Tcl builtins since punk::path isn't loaded at boot time. + set src_modules_dir [file join $src_project_root src modules] + set modpod_count 0 + if {[file isdirectory $src_modules_dir]} { + #recursive glob for #modpod-* directories (Tcl 8.6+ supports ** in glob) + set modpod_dirs [list] + foreach found [glob -nocomplain -type d -directory $src_modules_dir ** #modpod-*] { + #skip _build subdirectories + if {[string match "*_build*" $found]} { continue } + lappend modpod_dirs $found + } + foreach modpod_dir $modpod_dirs { + set tail [file tail $modpod_dir] + #directory name format: #modpod-- + #strip leading "#modpod-" (8 chars), then split on last "-" to separate modname from version + set rest [string range $tail 8 end] + set last_dash [string last "-" $rest] + if {$last_dash < 0} { continue } + set modname [string range $rest 0 [expr {$last_dash - 1}]] + set modver [string range $rest [expr {$last_dash + 1}] end] + set modpath [file join $modpod_dir "$modname-$modver.tm"] + #compute fully qualified module name from path relative to src/modules + #file relative isn't available in all Tcl builds at boot time, so compute manually + set reldir "" + set checkdir $modpod_dir + set base $src_modules_dir + #walk up from modpod_dir until we reach src/modules, collecting path components + while {$checkdir ne $base && $checkdir ne ""} { + set reldir [linsert $reldir 0 [file tail $checkdir]] + set checkdir [file dirname $checkdir] + } + if {$reldir eq ""} { + set fullmodname $modname + } else { + set fullmodname [join $reldir ::]::$modname + } + if {[file exists $modpath]} { + eval [list package ifneeded $fullmodname $modver [list source $modpath]] + incr modpod_count + } + } + if {$modpod_count > 0} { + puts stderr "src mode: registered $modpod_count #modpod module[expr {$modpod_count == 1 ? "" : "s"}] from $src_modules_dir" + } + } + } + #-------------------------------------------------------- + + + #src mode: set package prefer latest as late as possible (after libunknown::init + #which may reset it to stable) so 999999.0a1.0 dev modules are preferred over + #stable bootsupport/vendored copies on unversioned package require. + if {"src" in $package_modes} { + package prefer latest + # Force a scan of all tcl::tm::list paths by triggering package unknown. + # The VFS-bundled stable versions (e.g punk 0.1.1) are already registered + # from Tcl's init, so package require for those packages would never call + # package unknown — meaning 999999.0a1.0 dev versions in src/modules would + # never be discovered. This dummy require forces package unknown to scan + # all tm paths and register all ifneeded scripts, including the dev versions. + # After this, package prefer latest will select 999999.0a1.0 over 0.1.1. + catch {package require __src_mode_tm_scan__} + } + + #tclsh,shellspy,punk,script,shell + set subcommand [lindex $arglist 0] + switch -- $subcommand { + tclsh - shellspy - punk - shell - script { + set subcommand_arglist [lrange $arglist 1 end] + } + default { + set subcommand_arglist $arglist + if {[llength $subcommand_arglist]} { + set subcommand script } else { - set is_tclsh_piperepl_env_true 0 + set subcommand shell } } - if {!$is_tclsh_piperepl_env_true} { - puts stderr "tcl_interactive: $::tcl_interactive" - puts stderr "stdin: [chan configure stdin]" - puts stderr "Environment variable TCLSH_PIPEREPL is not set or is false or is not a boolean" - } else { - #according to env TCLSH_PIPEREPL and our commandline argument - tclsh repl is desired - #check if tclsh/punk has had the piperepl patch applied - in which case tclsh(istty) should exist - if {![info exists ::tclsh(istty)]} { - puts stderr "error: the runtime doesn't appear to have been compiled with the piperepl patch" - } - } - set ::tcl_interactive 1 - set ::tclsh(dorepl) 1 - } elseif {[lindex $arglist 0] eq "shellspy"} { - #pass through to shellspy commandline processor - #puts stdout "main.tcl launching app-shellspy" - package require app-shellspy - } elseif {[llength $arglist]} { - package require app-punkshell - } else { - #punk shell - #todo logger ? - #puts stdout "main.tcl launching app-punk. pkg names count:[llength [package names]]" - #puts ">> $::auto_path" - #puts ">>> [tcl::tm::list]" - #puts ">>>> [package unknown]" - package require app-punk - #app-punk starts repl - #repl::start stdin -title "main.tcl" } + set ::argv $subcommand_arglist + set ::argc [llength $subcommand_arglist] + + switch -- $subcommand { + tclsh { + #called as dev tclsh or tclsh + #we would like to drop through to standard tclsh repl without launching another process + #tclMain.c doesn't allow it unless patched. + if {![info exists ::env(TCLSH_PIPEREPL)]} { + set is_tclsh_piperepl_env_true 1 + } else { + if {[string is boolean -strict $::env(TCLSH_PIPEREPL)]} { + set is_tclsh_piperepl_env_true $::env(TCLSH_PIPEREPL) + } else { + set is_tclsh_piperepl_env_true 1 + } + } + if {$is_tclsh_piperepl_env_true && ![info exists ::tclsh(istty)]} { + #runtime lacks the piperepl patch (a patched runtime with the gate open + #publishes ::tclsh(istty) before this script runs). Informational only: + #script-arg and piped forms work regardless; the interactive repl form + #fails fast below. A deliberate TCLSH_PIPEREPL=0 opt-out stays quiet. + puts stderr "note: the runtime doesn't appear to have been compiled with the piperepl patch" + } + #stock tclsh argument forms (tclMain.c): the only recognised leading option is + #'-encoding name fileName' (and only when fileName does not begin with '-'); + #any other leading '-' argument means NO script file - all arguments stay in + #::argv (already set above) and tclsh proceeds to the repl (tty) or stdin + #evaluation (piped). + set tclsh_have_script 0 + set tclsh_encoding "" + if {[llength $subcommand_arglist] >= 3 && [lindex $subcommand_arglist 0] eq "-encoding" && ![string match -* [lindex $subcommand_arglist 2]]} { + set tclsh_encoding [lindex $subcommand_arglist 1] + set tclsh_script [lindex $subcommand_arglist 2] + set tclsh_scriptargs [lrange $subcommand_arglist 3 end] + set tclsh_have_script 1 + } elseif {[llength $subcommand_arglist] && ![string match -* [lindex $subcommand_arglist 0]]} { + set tclsh_script [lindex $subcommand_arglist 0] + set tclsh_scriptargs [lrange $subcommand_arglist 1 end] + set tclsh_have_script 1 + } + if {$tclsh_have_script} { + if {[string match -nocase lib:* $tclsh_script]} { + #scriptlib resolution is a punk facility - the tclsh subcommand keeps plain + #tclsh semantics (no punk modules loaded), so point at the 'script' subcommand + #instead of failing on a literal 'lib:...' path (illegal on windows filesystems + #anyway; reachable via ./lib:... or an absolute path on other platforms). + set exebase [file rootname [file tail [info nameofexecutable]]] + puts stderr "punk tclsh: 'lib:' scriptlib resolution is not supported by the tclsh subcommand (plain tclsh semantics)" + puts stderr " use: $exebase script $tclsh_script ?args...?" + exit 1 + } + set normscript [file normalize $tclsh_script] + if {![file exists $normscript]} { + #not-found gets a clean message ('script' subcommand coherence); errors + #from an existing script keep their full trace + puts stderr "punk tclsh: script file not found: '$normscript'" + exit 1 + } + info script $normscript + set ::argv0 $normscript + set ::argv $tclsh_scriptargs + set ::argc [llength $::argv] + #we are in an apply context here - so we need to uplevel to get the source to work as expected + if {$tclsh_encoding ne ""} { + uplevel 1 [list source -encoding $tclsh_encoding $tclsh_script] + } else { + uplevel 1 [list source $tclsh_script] + } + + #default tclsh behaviour is to run the script and exit + #the script can set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run + } else { + #no script file: all arguments (if any) are already in ::argv, matching + #stock tclsh; argv0 is the executable itself, not the kit boot script + set ::argv0 [info nameofexecutable] + if {[info exists ::tclsh(istty)]} { + if {$::tclsh(istty)} { + #tclsh piperepl patch applied - stdin is a tty - we can run the tclsh repl + set ::tclsh(dorepl) 1 + set ::tcl_interactive 1 + } else { + #stdin is not a tty - piped input is evaluated as a script, then exit + set ::tclsh(dorepl) 0 + set ::tcl_interactive 0 + #script on stdin could set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run + set data [read stdin] + uplevel 1 [list eval $data] + } + } else { + #no piperepl machinery (unpatched runtime, or TCLSH_PIPEREPL=0): the + #interactive repl is unavailable. Fail fast on terminal stdin instead of + #blocking in a raw console read (app-punkscript terminal-probe precedent); + #piped/redirected stdin keeps the evaluate-and-exit behaviour. + set conf "" + catch {set conf [chan configure stdin]} + if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} { + set exebase [file rootname [file tail [info nameofexecutable]]] + puts stderr "punk tclsh: the interactive tclsh repl requires a piperepl-capable runtime (this runtime lacks the patch, or TCLSH_PIPEREPL=0)" + puts stderr "usage: | $exebase tclsh" + puts stderr " or: $exebase tclsh ?args...?" + exit 1 + } + set ::tcl_interactive 0 + set data [read stdin] + uplevel 1 [list eval $data] + } + } + } + shellspy { + #pass through to shellspy commandline processor + package require app-shellspy + } + punk { + #The punk executable must also support running commands piped into stdin. + #e.g echo "puts hello" | punk + #e.g from another tclsh-based shell: + # exec punk << {puts hello} + #Note that if the punk executable outputs anything to stderr - exec by default will treat the command as having failed and will throw an error. + #So the punk executable should avoid outputting to stderr unless it is an actual error condition. + #You can work around this by passing -ignorestderr to exec, but for tools like 'bench::locate' we need clean output. + #(e.g bench::locate uses: + # if {[catch {exec $ip << "exit"} result]} {...} + #) + + if {[llength $subcommand_arglist]} { + #puts stdout "main.tcl launching app-punkshell with args: $subcommand_arglist" + package require app-punkshell + } else { + #punk interactive shell + package require app-repl + } + } + script { + #run a script (file argument, or piped stdin when no argument) and exit - goal G-015 + #lean dedicated app package: default punk shell module/alias environment, + #no shellfilter stacks/transforms, no interactive fallback, honest exit codes. + #The launch plumbing must emit nothing on stdout/stderr (exec-style callers). + set ::tcl_interactive 0 + package require app-punkscript + } + shell { + #app-punkshell supports running a script and maintaining an interactive shell afterwards + # or just launching an interactive shell if no script is specified + package require app-punkshell + #if {[llength $subcommand_arglist]} { + # #run script and maintain interactive shell. + # package require app-punkshell + #} else { + # #punk interactive shell + # package require app-repl + #} + } + } + + + #if {[llength $arglist] == 1 && [lindex $arglist 0] eq "tclsh"} { + #} elseif {[lindex $arglist 0] eq "shellspy"} { + #} elseif {[llength $arglist]} { + #} else { + #} }} {*}$::argv diff --git a/src/tests/shell/testsuites/punkexe/tclshcmd.test b/src/tests/shell/testsuites/punkexe/tclshcmd.test index ed6eec14..b6197172 100644 --- a/src/tests/shell/testsuites/punkexe/tclshcmd.test +++ b/src/tests/shell/testsuites/punkexe/tclshcmd.test @@ -312,6 +312,30 @@ puts "PRGOT:[string trim $d]"} pr_consume.tcl] lappend result [dict get $rd exitcode] } -result [list 0 1 1 1 1] + # -- G-118 dispatch fixes: argv0 stock parity, clean missing-file error ------------------------ + + #added 2026-07-24 (agent, G-118) - no-script argv0 = executable path; missing script file clean error + test tclsh_noscript_argv0 {no-script forms set ::argv0 to the executable path (stock parity, not the kit boot script)}\ + -constraints punkexeavailable -setup $common -body { + variable punkexe + set expected [file tail $punkexe] + set a [punk_run $punkexe [list tclsh] "puts \[list A0TAIL \[file tail \$::argv0\]\]\n"] + set b [punk_run $punkexe [list tclsh - hmm etc] "puts \[list A0TAIL \[file tail \$::argv0\]\]\n"] + lappend result [expr {[string first "A0TAIL $expected" [dict get $a output]] >= 0}] + lappend result [expr {[string first "A0TAIL $expected" [dict get $b output]] >= 0}] + } -result [list 1 1] + + test tclsh_script_notfound {'tclsh ' fails with a clean not-found message, exit 1, no internals trace}\ + -constraints punkexeavailable -setup $common -body { + variable punkexe + set rd [punk_run $punkexe [list tclsh c:/punktest_nosuchdir/nosuch_fixture.tcl] ""] + lappend result [dict get $rd timedout] + lappend result [expr {[string first "script file not found" [dict get $rd output]] >= 0}] + #the raw source errorInfo trace (leaks launcher internals) must not appear + lappend result [expr {[string first "uplevel" [dict get $rd output]] < 0}] + lappend result [dict get $rd exitcode] + } -result [list 0 1 1 1] + # -- piperepl launch-state contract (patched runtime kits) ------------------------------------- #added 2026-07-23 (agent) - piperepl ::tclsh launch-state contract via the tclsh subcommand (G-096/G-103 patched kits) diff --git a/src/vfs/_config/project_main.tcl b/src/vfs/_config/project_main.tcl index 46234ccb..df81c784 100644 --- a/src/vfs/_config/project_main.tcl +++ b/src/vfs/_config/project_main.tcl @@ -878,32 +878,114 @@ apply { args { #assert arglist has had 'dev|os|os-dev etc' first arg removed if it was present. - if {[llength $arglist] == 1 && [lindex $arglist 0] eq "tclsh"} { - #called as dev tclsh or tclsh + if {[lindex $arglist 0] eq "tclsh"} { + #called as dev tclsh ?script? ?args...? or tclsh ... #we would like to drop through to standard tclsh repl without launching another process - #tclMain.c doesn't allow it unless patched. + #tclMain.c doesn't allow it unless patched (TCLSH_PIPEREPL piperepl patch). + #This branch mirrors the punk_main.tcl tclsh subcommand dispatch (G-118 parity). + set subcommand_arglist [lrange $arglist 1 end] + set ::argv $subcommand_arglist + set ::argc [llength $subcommand_arglist] if {![info exists ::env(TCLSH_PIPEREPL)]} { - set is_tclsh_piperepl_env_true 0 + set is_tclsh_piperepl_env_true 1 } else { if {[string is boolean -strict $::env(TCLSH_PIPEREPL)]} { set is_tclsh_piperepl_env_true $::env(TCLSH_PIPEREPL) } else { - set is_tclsh_piperepl_env_true 0 + set is_tclsh_piperepl_env_true 1 + } + } + if {$is_tclsh_piperepl_env_true && ![info exists ::tclsh(istty)]} { + #runtime lacks the piperepl patch (a patched runtime with the gate open + #publishes ::tclsh(istty) before this script runs). Informational only: + #script-arg and piped forms work regardless; the interactive repl form + #fails fast below. A deliberate TCLSH_PIPEREPL=0 opt-out stays quiet. + puts stderr "note: the runtime doesn't appear to have been compiled with the piperepl patch" + } + #stock tclsh argument forms (tclMain.c): the only recognised leading option is + #'-encoding name fileName' (and only when fileName does not begin with '-'); + #any other leading '-' argument means NO script file - all arguments stay in + #::argv (already set above) and tclsh proceeds to the repl (tty) or stdin + #evaluation (piped). + set tclsh_have_script 0 + set tclsh_encoding "" + if {[llength $subcommand_arglist] >= 3 && [lindex $subcommand_arglist 0] eq "-encoding" && ![string match -* [lindex $subcommand_arglist 2]]} { + set tclsh_encoding [lindex $subcommand_arglist 1] + set tclsh_script [lindex $subcommand_arglist 2] + set tclsh_scriptargs [lrange $subcommand_arglist 3 end] + set tclsh_have_script 1 + } elseif {[llength $subcommand_arglist] && ![string match -* [lindex $subcommand_arglist 0]]} { + set tclsh_script [lindex $subcommand_arglist 0] + set tclsh_scriptargs [lrange $subcommand_arglist 1 end] + set tclsh_have_script 1 + } + if {$tclsh_have_script} { + if {[string match -nocase lib:* $tclsh_script]} { + #scriptlib resolution is a punk facility - the tclsh subcommand keeps plain + #tclsh semantics (no punk modules loaded), so point at the 'script' subcommand + #instead of failing on a literal 'lib:...' path (illegal on windows filesystems + #anyway; reachable via ./lib:... or an absolute path on other platforms). + set exebase [file rootname [file tail [info nameofexecutable]]] + puts stderr "punk tclsh: 'lib:' scriptlib resolution is not supported by the tclsh subcommand (plain tclsh semantics)" + puts stderr " use: $exebase script $tclsh_script ?args...?" + exit 1 + } + set normscript [file normalize $tclsh_script] + if {![file exists $normscript]} { + #not-found gets a clean message ('script' subcommand coherence); errors + #from an existing script keep their full trace + puts stderr "punk tclsh: script file not found: '$normscript'" + exit 1 + } + info script $normscript + set ::argv0 $normscript + set ::argv $tclsh_scriptargs + set ::argc [llength $::argv] + #we are in an apply context here - so we need to uplevel to get the source to work as expected + if {$tclsh_encoding ne ""} { + uplevel 1 [list source -encoding $tclsh_encoding $tclsh_script] + } else { + uplevel 1 [list source $tclsh_script] } - } - if {!$is_tclsh_piperepl_env_true} { - puts stderr "tcl_interactive: $::tcl_interactive" - puts stderr "stdin: [chan configure stdin]" - puts stderr "Environment variable TCLSH_PIPEREPL is not set or is false or is not a boolean" + + #default tclsh behaviour is to run the script and exit + #the script can set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run } else { - #according to env TCLSH_PIPEREPL and our commandline argument - tclsh repl is desired - #check if tclsh/punk has had the piperepl patch applied - in which case tclsh(istty) should exist - if {![info exists ::tclsh(istty)]} { - puts stderr "error: the runtime doesn't appear to have been compiled with the piperepl patch" + #no script file: all arguments (if any) are already in ::argv, matching + #stock tclsh; argv0 is the executable itself, not the kit boot script + set ::argv0 [info nameofexecutable] + if {[info exists ::tclsh(istty)]} { + if {$::tclsh(istty)} { + #tclsh piperepl patch applied - stdin is a tty - we can run the tclsh repl + set ::tclsh(dorepl) 1 + set ::tcl_interactive 1 + } else { + #stdin is not a tty - piped input is evaluated as a script, then exit + set ::tclsh(dorepl) 0 + set ::tcl_interactive 0 + #script on stdin could set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run + set data [read stdin] + uplevel 1 [list eval $data] + } + } else { + #no piperepl machinery (unpatched runtime, or TCLSH_PIPEREPL=0): the + #interactive repl is unavailable. Fail fast on terminal stdin instead of + #blocking in a raw console read (app-punkscript terminal-probe precedent); + #piped/redirected stdin keeps the evaluate-and-exit behaviour. + set conf "" + catch {set conf [chan configure stdin]} + if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} { + set exebase [file rootname [file tail [info nameofexecutable]]] + puts stderr "punk tclsh: the interactive tclsh repl requires a piperepl-capable runtime (this runtime lacks the patch, or TCLSH_PIPEREPL=0)" + puts stderr "usage: | $exebase tclsh" + puts stderr " or: $exebase tclsh ?args...?" + exit 1 + } + set ::tcl_interactive 0 + set data [read stdin] + uplevel 1 [list eval $data] } } - set ::tcl_interactive 1 - set ::tclsh(dorepl) 1 } elseif {[lindex $arglist 0] eq "shell"} { if {[llength $arglist] == 1} { package require app_shell diff --git a/src/vfs/_config/punk_main.tcl b/src/vfs/_config/punk_main.tcl index bdb28438..bb981307 100644 --- a/src/vfs/_config/punk_main.tcl +++ b/src/vfs/_config/punk_main.tcl @@ -1224,16 +1224,12 @@ apply { args { set is_tclsh_piperepl_env_true 1 } } - if {!$is_tclsh_piperepl_env_true} { - puts stderr "tcl_interactive: $::tcl_interactive" - #puts stderr "stdin: [chan configure stdin]" - puts stderr "Environment variable TCLSH_PIPEREPL is not set or is false or is not a boolean" - } else { - #according to env TCLSH_PIPEREPL and our commandline argument - tclsh repl is desired - #check if tclsh/punk has had the piperepl patch applied - in which case tclsh(istty) should exist - if {![info exists ::tclsh(istty)]} { - puts stderr "error: the runtime doesn't appear to have been compiled with the piperepl patch" - } + if {$is_tclsh_piperepl_env_true && ![info exists ::tclsh(istty)]} { + #runtime lacks the piperepl patch (a patched runtime with the gate open + #publishes ::tclsh(istty) before this script runs). Informational only: + #script-arg and piped forms work regardless; the interactive repl form + #fails fast below. A deliberate TCLSH_PIPEREPL=0 opt-out stays quiet. + puts stderr "note: the runtime doesn't appear to have been compiled with the piperepl patch" } #stock tclsh argument forms (tclMain.c): the only recognised leading option is #'-encoding name fileName' (and only when fileName does not begin with '-'); @@ -1264,6 +1260,12 @@ apply { args { exit 1 } set normscript [file normalize $tclsh_script] + if {![file exists $normscript]} { + #not-found gets a clean message ('script' subcommand coherence); errors + #from an existing script keep their full trace + puts stderr "punk tclsh: script file not found: '$normscript'" + exit 1 + } info script $normscript set ::argv0 $normscript set ::argv $tclsh_scriptargs @@ -1278,15 +1280,37 @@ apply { args { #default tclsh behaviour is to run the script and exit #the script can set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run } else { - if {[info exists ::tclsh(istty)] && $::tclsh(istty)} { - #tclsh piperepl patch applied - stdin is a tty - we can run the tclsh repl - set ::tclsh(dorepl) 1 - set ::tcl_interactive 1 + #no script file: all arguments (if any) are already in ::argv, matching + #stock tclsh; argv0 is the executable itself, not the kit boot script + set ::argv0 [info nameofexecutable] + if {[info exists ::tclsh(istty)]} { + if {$::tclsh(istty)} { + #tclsh piperepl patch applied - stdin is a tty - we can run the tclsh repl + set ::tclsh(dorepl) 1 + set ::tcl_interactive 1 + } else { + #stdin is not a tty - piped input is evaluated as a script, then exit + set ::tclsh(dorepl) 0 + set ::tcl_interactive 0 + #script on stdin could set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run + set data [read stdin] + uplevel 1 [list eval $data] + } } else { - #stdin is not a tty - we are being run with input piped in - we will evaluate stdin as a script and exit - set ::tclsh(dorepl) 0 + #no piperepl machinery (unpatched runtime, or TCLSH_PIPEREPL=0): the + #interactive repl is unavailable. Fail fast on terminal stdin instead of + #blocking in a raw console read (app-punkscript terminal-probe precedent); + #piped/redirected stdin keeps the evaluate-and-exit behaviour. + set conf "" + catch {set conf [chan configure stdin]} + if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} { + set exebase [file rootname [file tail [info nameofexecutable]]] + puts stderr "punk tclsh: the interactive tclsh repl requires a piperepl-capable runtime (this runtime lacks the patch, or TCLSH_PIPEREPL=0)" + puts stderr "usage: | $exebase tclsh" + puts stderr " or: $exebase tclsh ?args...?" + exit 1 + } set ::tcl_interactive 0 - #script on stdin could set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run set data [read stdin] uplevel 1 [list eval $data] }