Browse Source
New punk::buildinfo 0.1.0 = the single implementation (dependency-free; works in kit shells, the script env, repl code interp and tclsh-hosted shells): punkkit-stamp.toml kit stamp + live facts + governing punkproject.toml version (live_vs_stamp=same|differs) + inherited G-117 punkbin-artifact.toml record, emitted as key=value lines; absence explicit (stamp_present=0), never fabricated. make.tcl bake writes the stamp at the payload root after the G-125 gate - deterministic (NO time-of-bake field, per the G-117 embedded-record precedent; identical inputs stamp byte-identically). Boot core 0.2.0: buildinfo builtin (exit 2 on args, exit 1 unavailable, else prints report + exit 0) and publishes ::punkboot::boot_state (core_version, main_script, package_modes, proj_scope, proj_root, kit_payload_base, src_project_root) - the single boot running-state surface G-089 anticipated. Wiring: aliascore 0.2.0 buildinfo alias, repl 0.5.4 preloads punk::buildinfo (bootsupport include_modules.config gains punk::buildinfo - a repl 0.5.4 snapshot without it broke tclsh-hosted shells, caught and fixed), moduledoc::punkexe 0.3.0 documents the subcommand. New punk::args::moduledoc::punkboot 0.1.0 (G-031): thin-main contract + registration model + live defs for the persistent ::punkboot procs - all six ids resolve in-kit via punk::args::get_ids after update_definitions. Verified: module fixtures 8/8 (report.test); punkexe suite 118 total 114 pass 0 fail incl new buildinfo.test (stdout-only + exit 0, stamp fields, RENAMED-COPY reports its stamp, args rejected exit 2); punk902z + punk9_beta bakes stamped (punk9_beta cites runtime build_id 635e7951... + r2 artifact name from the inherited record); tclsh-hosted 'make.tcl shell' reports stamp_present=0 with real host exe + live project version; double-bake stamp sha1-identical. Layout _config/_vfscommon core copies refreshed 0.2.0. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
19 changed files with 1153 additions and 14 deletions
@ -1,3 +1,4 @@
|
||||
0.1.0 |
||||
0.2.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.2.0 - added buildinfo -> ::punk::buildinfo::report (G-025 in-shell self-report; punk::repl preloads punk::buildinfo before init so the alias target exists) |
||||
|
||||
@ -0,0 +1,221 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2026 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::args::moduledoc::punkboot 999999.0a1.0 |
||||
# Meta platform tcl |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
package require Tcl 8.6- |
||||
|
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
tcl::namespace::eval punk::args::moduledoc::punkboot { |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# punk::args definitions for the G-031 componentized kit boot: the thin |
||||
# project-owned main.tcl contract and the layout-owned boot core's |
||||
# post-boot ::punkboot surface. Runtime-queryable from any kit carrying |
||||
# this moduledoc (delivered via _vfscommon like moduledoc::punkexe). |
||||
# The launch surface itself (package modes + subcommands) is documented |
||||
# by punk::args::moduledoc::punkexe; THIS package documents the API an |
||||
# application developer or probe writes against. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::args::moduledoc::punkboot}] |
||||
#[para] punk::args definitions for the punkshell kit boot core (G-031) |
||||
#[list_begin definitions] |
||||
|
||||
variable PUNKARGS |
||||
|
||||
namespace eval argdoc { |
||||
#Overview + thin-main authoring contract. Display-first: the thin main |
||||
#is a file convention, not a command. |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
lappend PUNKARGS [list { |
||||
@id -id (script)::punkboot |
||||
@cmd -name punkboot\ |
||||
-summary\ |
||||
"Componentized kit boot: thin main + shared boot core (G-031)."\ |
||||
-help\ |
||||
"Every punkshell-style kit boots through a THIN project-owned |
||||
main.tcl that declares the kit's launch surface and hands over |
||||
to the shared, layout-owned boot core - delivered inside the |
||||
kit at <vfsroot>/punkboot/core.tcl by the _vfscommon merge |
||||
(master: src/vfs/_config/punkboot_core.tcl, regenerated by |
||||
'make.tcl vfscommonupdate'; version: ::punkboot::core_version, |
||||
also stamped into kits and reported by 'buildinfo' - G-025). |
||||
|
||||
THIN MAIN OBLIGATIONS (inside 'apply {args {...}}' invoked |
||||
from the toplevel, so dispatch 'uplevel 1' reaches the global |
||||
level) - publish in ::punkboot before sourcing the core: |
||||
launch_args the launch arguments (default: \$::argv) |
||||
main_script normalized path of the kit's root |
||||
main.tcl - vfs-root derivations key on |
||||
its location |
||||
project_subcommands optional dict: subcommand name -> |
||||
handler script (see the registration |
||||
definition id (script)::punkboot::registration) |
||||
launch_defaults optional dict: noargs / unknownfirst |
||||
then source the core, first hit of: |
||||
<maindir>/punkboot/core.tcl (baked kit) |
||||
<parent>/punkboot/core.tcl (nested app/main.tcl runtimes) |
||||
<maindir>/punkboot_core.tcl (sibling master - source-tree |
||||
execution of the main) |
||||
|
||||
POST-BOOT SURFACE the core leaves defined for probes, tests |
||||
and modules: the ::punkboot procs documented in this package |
||||
(zipfs_mount_pairs, zipfs_kit_mountbase, path_within, |
||||
proj_root_find) and the variables ::punkboot::core_version, |
||||
::punkboot::boot_state (dict: core_version, main_script, |
||||
package_modes, proj_scope, proj_root, kit_payload_base, and - |
||||
src mode only - src_project_root), plus the G-058 static |
||||
package captures (static_packages, static_prefixes). |
||||
|
||||
The template thin main with worked examples is |
||||
src/vfs/_config/project_main.tcl (seeded into generated |
||||
projects); boot-entry placement rules (fauxlink vs plain |
||||
main.tcl, one-startup-script collision refusal) are in |
||||
src/vfs/README.md." |
||||
}] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
|
||||
#Registration model detail (display-first). |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
lappend PUNKARGS [list { |
||||
@id -id (script)::punkboot::registration |
||||
@cmd -name "punkboot registration"\ |
||||
-summary\ |
||||
"Thin-main declarations: project subcommands and launch defaults."\ |
||||
-help\ |
||||
"::punkboot::project_subcommands - dict mapping subcommand |
||||
name -> Tcl handler script. Consulted by the boot core's |
||||
default dispatch AFTER the built-ins (tclsh shellspy punk |
||||
shell script buildinfo): a declared name extends the launch |
||||
surface; a name colliding with a built-in is reported on |
||||
stderr and ignored (built-ins cannot be shadowed). The |
||||
handler runs in the boot frame with ::argv/::argc already |
||||
holding the subcommand's arguments - typically a one-line |
||||
'package require app-yourapp'. |
||||
|
||||
::punkboot::launch_defaults - dict with optional keys: |
||||
noargs subcommand assumed for a bare launch |
||||
(default: shell) |
||||
unknownfirst 'script' treats a non-subcommand first |
||||
argument as a script invocation (default), or |
||||
the name of a known subcommand to receive the |
||||
whole arglist (tool-style kits) |
||||
|
||||
Both dicts default to empty: an undeclared thin main yields |
||||
exactly the punkshell launch behaviour." |
||||
}] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
|
||||
#Persistent ::punkboot procs (live definitions - the procs remain |
||||
#defined after boot; G-129 derivations). |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::zipfs_mount_pairs |
||||
@cmd -name ::punkboot::zipfs_mount_pairs\ |
||||
-summary\ |
||||
"zipfs mount table as a flat mountpoint,archivefile pair list."\ |
||||
-help\ |
||||
"Returns the zipfs mount table as a flat list of |
||||
mountpoint,archivefile pairs - the pairing 'tcl::zipfs::mount' |
||||
(no args) reports in every zipfs generation supported as a kit |
||||
runtime (8.7/9 core zipfs and the androwish/undroidwish 8.6 |
||||
backport; G-129 measured both). Empty list when zipfs is |
||||
absent, nothing is mounted, or the table shape is unknown |
||||
(callers treat that as 'cannot attribute any mount')." |
||||
@form -synopsis "::punkboot::zipfs_mount_pairs" |
||||
@values -min 0 -max 0 |
||||
}] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::zipfs_kit_mountbase |
||||
@cmd -name ::punkboot::zipfs_kit_mountbase\ |
||||
-summary\ |
||||
"Mountpoint of THIS executable's attached zipfs archive, or empty."\ |
||||
-help\ |
||||
"G-129: where did this executable's attached archive mount? |
||||
Returns the mountpoint whose archive file is |
||||
[info nameofexecutable] - //zipfs:/app on modern runtimes, |
||||
the executable's own path on the 8.6 backport family (whose |
||||
archive-file column may drop the windows drive prefix; that |
||||
spelling is accepted). Fallback: a mountpoint containing |
||||
[info script]. Empty string when no mount can be attributed - |
||||
the boot reports that case on stderr and configures no |
||||
kit-internal paths." |
||||
@form -synopsis "::punkboot::zipfs_kit_mountbase" |
||||
@values -min 0 -max 0 |
||||
}] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::path_within |
||||
@cmd -name ::punkboot::path_within\ |
||||
-summary\ |
||||
"1 if path equals base or lies under it (segment-aware)."\ |
||||
-help\ |
||||
"Path-segment-aware containment test (windows compares |
||||
case-insensitively). Both arguments are expected |
||||
pre-normalized with forward slashes. An empty base never |
||||
contains anything." |
||||
@form -synopsis "::punkboot::path_within path base" |
||||
@leaders |
||||
path -type string -optional 0 -help\ |
||||
"Path to test." |
||||
base -type string -optional 0 -help\ |
||||
"Candidate containing base path." |
||||
@values -min 0 -max 0 |
||||
}] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::proj_root_find |
||||
@cmd -name ::punkboot::proj_root_find\ |
||||
-summary\ |
||||
"Walk up to the nearest punkshell-style project root, or empty."\ |
||||
-help\ |
||||
"G-033: lean boot mirror of punk::repo's project discovery |
||||
using only Tcl builtins. Walks up from startdir to the nearest |
||||
VCS repo root (git or fossil control markers) that also looks |
||||
like a punkshell-style project: not an unwise location, has |
||||
./src, and one of ./src/modules, ./src/vfs, ./src/scriptapps |
||||
or ./punkproject.toml. Returns the project root or an empty |
||||
string. Semantics deliberately aligned with punk::repo so a |
||||
project findable at boot is findable by the runtime layer and |
||||
vice versa." |
||||
@form -synopsis "::punkboot::proj_root_find startdir" |
||||
@leaders |
||||
startdir -type string -optional 0 -help\ |
||||
"Directory to start the walk-up from." |
||||
@values -min 0 -max 0 |
||||
}] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||
} |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::args::moduledoc::punkboot ---}] |
||||
} |
||||
|
||||
# ----------------------------------------------------------------------------- |
||||
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked |
||||
# ----------------------------------------------------------------------------- |
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
lappend ::punk::args::register::NAMESPACES ::punk::args::moduledoc::punkboot ::punk::args::moduledoc::punkboot::argdoc |
||||
} |
||||
|
||||
## Ready |
||||
package provide punk::args::moduledoc::punkboot [tcl::namespace::eval punk::args::moduledoc::punkboot { |
||||
variable version |
||||
set version 999999.0a1.0 |
||||
}] |
||||
return |
||||
@ -0,0 +1,4 @@
|
||||
0.1.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.1.0 - initial (G-031 runtime-queryable boot-core API doc): (script)::punkboot overview + thin-main obligations, (script)::punkboot::registration (project_subcommands / launch_defaults), live definitions for the persistent ::punkboot procs (zipfs_mount_pairs, zipfs_kit_mountbase, path_within, proj_root_find); boot_state surface documented |
||||
@ -1,4 +1,5 @@
|
||||
0.2.0 |
||||
0.3.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.3.0 - buildinfo subcommand documented (G-025): (script)::punkexe::buildinfo definition + choices entry; stamp/live/source distinction + in-shell equivalent noted |
||||
#0.2.0 - package_mode 'dev' renamed 'minted' (clean break, no alias - stage-true vocabulary follow-on to G-155): mode docs updated; the built-output mode now names what it consumes (mint output trees) |
||||
|
||||
@ -0,0 +1,334 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2026 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::buildinfo 999999.0a1.0 |
||||
# Meta platform tcl |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
## Deliberately NONE beyond core Tcl: this module must load and answer in any |
||||
## context - kit main interp, repl code interp, tclsh-hosted punk shell |
||||
## (tclsh src/make.tcl shell), plain tclsh with punk modules on the path. |
||||
package require Tcl 8.6- |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#G-025: punk executables self-report project version and build provenance. |
||||
#This module is the SINGLE IMPLEMENTATION - the kit launch subcommand |
||||
#'buildinfo' (boot core dispatch) is a thin wrapper over punk::buildinfo::main, |
||||
#and the bare 'buildinfo' shell command is an aliascore alias to |
||||
#punk::buildinfo::report. Three notions kept distinct, never fabricated: |
||||
# 1. build stamp - punkkit-stamp.toml at the kit payload base, written by |
||||
# 'make.tcl bake' (project version, vfs folder, runtime, |
||||
# kit/target names, boot-core version, bake utc) |
||||
# 2. live facts - info nameofexecutable / patchlevel / derived payload base |
||||
# 3. source tree - punkproject.toml version of the governing project, when |
||||
# one is findable (boot-published root, exe-relative, or |
||||
# cwd walk-up) |
||||
#Also read: the G-117 runtime-layer record punkbin-artifact.toml inherited |
||||
#from the input runtime's attached image (schema v1/v2 [artifact] section). |
||||
namespace eval punk::buildinfo { |
||||
namespace export report get_dict main |
||||
variable stamp_filename punkkit-stamp.toml |
||||
variable runtime_record_filename punkbin-artifact.toml |
||||
|
||||
namespace eval argdoc { |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punk::buildinfo::get_dict |
||||
@cmd -name "::punk::buildinfo::get_dict"\ |
||||
-summary\ |
||||
"Build/identity facts as a nested dict (stamp, live, source, runtime_record)"\ |
||||
-help\ |
||||
"Returns a dict with keys: |
||||
stamp dict: present 0|1 + the punkkit-stamp.toml |
||||
fields when present (project_version, vfs, |
||||
runtime, runtime_build_id, kit, target, |
||||
boot_core_version - deliberately no |
||||
time-of-bake field: stamps are |
||||
deterministic for identical inputs) |
||||
live dict: executable, patchlevel, payload_base, |
||||
and (when the boot core published state) |
||||
package_modes / boot_core_version |
||||
source dict: present 0|1 + project_root and |
||||
project_version when a governing |
||||
punkproject.toml was found |
||||
runtime_record dict: present 0|1 + name/build_id/revision |
||||
from the runtime-layer punkbin-artifact.toml |
||||
inherited in the kit payload (G-117) |
||||
Nothing is fabricated: absent notions report present 0 and |
||||
omit their fields." |
||||
}] |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punk::buildinfo::report |
||||
@cmd -name "::punk::buildinfo::report"\ |
||||
-summary\ |
||||
"Machine-parseable key=value build/identity report (G-025)"\ |
||||
-help\ |
||||
"Returns the get_dict facts flattened to one key=value pair |
||||
per line (split each line on the FIRST '=' - values may |
||||
contain '='). stamp_present is always emitted; stamp_*, |
||||
live_project_*, runtime_record_* lines appear only when |
||||
their notion is present, so absence is explicit rather |
||||
than fabricated. The kit launch subcommand 'buildinfo' |
||||
prints exactly this report on stdout and exits 0." |
||||
}] |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punk::buildinfo::main |
||||
@cmd -name "::punk::buildinfo::main"\ |
||||
-summary\ |
||||
"Print the report to stdout; returns 0 (launch subcommand body)"\ |
||||
-help\ |
||||
"Prints punk::buildinfo::report to stdout with no other |
||||
output and returns 0 - the boot core's 'buildinfo' |
||||
subcommand exits with that value (G-015-compatible: |
||||
machine-parseable stdout, honest exit code, no repl |
||||
fallthrough)." |
||||
}] |
||||
} |
||||
|
||||
#minimal line reader for OUR OWN controlled flat files (punkkit-stamp.toml, |
||||
#punkbin-artifact.toml): [section] tracking + key = "quoted" | bare values. |
||||
#NOT a general TOML parser - the punkshell TOML surface is tomlish; these |
||||
#records are schema-controlled here precisely so boot-adjacent code needs |
||||
#no package. |
||||
proc toml_section_kv {tomlfile section} { |
||||
set d [dict create] |
||||
if {![file isfile $tomlfile]} { |
||||
return $d |
||||
} |
||||
set fd [open $tomlfile r] |
||||
try { |
||||
set data [read $fd] |
||||
} finally { |
||||
close $fd |
||||
} |
||||
set insection 0 |
||||
foreach line [split $data \n] { |
||||
set trimmed [string trim $line] |
||||
if {[string index $trimmed 0] eq "\["} { |
||||
set insection [expr {$trimmed eq "\[$section\]"}] |
||||
continue |
||||
} |
||||
if {!$insection} {continue} |
||||
if {[regexp {^([A-Za-z0-9_]+)\s*=\s*"([^"]*)"} $trimmed -> k v]} { |
||||
dict set d $k $v |
||||
} elseif {[regexp {^([A-Za-z0-9_]+)\s*=\s*(\S+)} $trimmed -> k v]} { |
||||
dict set d $k $v |
||||
} |
||||
} |
||||
return $d |
||||
} |
||||
|
||||
#the running kit's payload base ("" when not a kit / not attributable). |
||||
#Boot-published state wins (the boot core derived it authoritatively); |
||||
#self-derivation is a lite mirror of the core's zipfs_kit_mountbase |
||||
#(authority: src/vfs/_config/punkboot_core.tcl - keep in sync) for |
||||
#contexts without ::punkboot (code interp, plain tclsh). |
||||
proc payload_base {} { |
||||
if {[info exists ::punkboot::boot_state] |
||||
&& [dict exists $::punkboot::boot_state kit_payload_base]} { |
||||
return [dict get $::punkboot::boot_state kit_payload_base] |
||||
} |
||||
if {[info commands ::tcl::zipfs::mount] ne "" |
||||
&& ![catch {::tcl::zipfs::mount} mtable] |
||||
&& [llength $mtable] % 2 == 0 && [llength $mtable]} { |
||||
set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] |
||||
set on_windows [expr {"windows" eq $::tcl_platform(platform)}] |
||||
if {$on_windows} { |
||||
set exe_forms [list [string tolower $normexe]] |
||||
if {[string match {[a-zA-Z]:/*} $normexe]} { |
||||
#8.6 backport quirk: archive-file column may drop the drive prefix |
||||
lappend exe_forms [string tolower [string range $normexe 2 end]] |
||||
} |
||||
} else { |
||||
set exe_forms [list $normexe] |
||||
} |
||||
foreach {mountpoint archivefile} $mtable { |
||||
set f [string map [list \\ /] $archivefile] |
||||
if {$on_windows} { |
||||
set f [string tolower $f] |
||||
} |
||||
if {$f in $exe_forms} { |
||||
return $mountpoint |
||||
} |
||||
} |
||||
} |
||||
if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { |
||||
return $::tcl::kitpath |
||||
} |
||||
if {"//cookit:/" in [file volumes] && [file exists //cookit:/lib]} { |
||||
return //cookit:/ |
||||
} |
||||
return "" |
||||
} |
||||
|
||||
#the governing project root for LIVE punkproject.toml reporting ("" when |
||||
#none): boot-published roots win (proj: scope, then src mode), else the |
||||
#executable's own project (bin/ convention), else a cwd walk-up. The test |
||||
#here is punkproject.toml presence only - live version reporting has no |
||||
#VCS-marker requirement (an exported tree still has a version). |
||||
proc project_root {} { |
||||
if {[info exists ::punkboot::boot_state]} { |
||||
foreach k {proj_root src_project_root} { |
||||
if {[dict exists $::punkboot::boot_state $k]} { |
||||
set r [dict get $::punkboot::boot_state $k] |
||||
if {$r ne "" && [file isfile [file join $r punkproject.toml]]} { |
||||
return $r |
||||
} |
||||
} |
||||
} |
||||
} |
||||
set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] |
||||
if {[file tail [file dirname $normexe]] eq "bin"} { |
||||
set cand [file dirname [file dirname $normexe]] |
||||
} else { |
||||
set cand [file dirname $normexe] |
||||
} |
||||
if {[file isfile [file join $cand punkproject.toml]]} { |
||||
return $cand |
||||
} |
||||
set unwise [list "/" "c:/" "c:/windows"] |
||||
set dir [pwd] |
||||
while 1 { |
||||
if {[string tolower $dir] ni $unwise && [file isfile [file join $dir punkproject.toml]]} { |
||||
return $dir |
||||
} |
||||
set parent [file dirname $dir] |
||||
if {$parent eq $dir} { |
||||
return "" |
||||
} |
||||
set dir $parent |
||||
} |
||||
} |
||||
|
||||
#read the [project] version from a punkproject.toml (same lite scan as |
||||
#punkboot::utils::parse_punkproject_version - kept local so this module |
||||
#stays dependency-free; punkboot::utils is not present in all contexts) |
||||
proc project_version_read {tomlfile} { |
||||
set d [toml_section_kv $tomlfile project] |
||||
if {[dict exists $d version]} { |
||||
return [dict get $d version] |
||||
} |
||||
return "" |
||||
} |
||||
|
||||
proc get_dict {} { |
||||
variable stamp_filename |
||||
variable runtime_record_filename |
||||
set base [payload_base] |
||||
|
||||
set stamp [dict create present 0] |
||||
if {$base ne ""} { |
||||
set sd [toml_section_kv [file join $base $stamp_filename] punkkit] |
||||
if {[dict size $sd]} { |
||||
set stamp [dict merge [dict create present 1] $sd] |
||||
} |
||||
} |
||||
|
||||
set live [dict create \ |
||||
executable [file normalize [info nameofexecutable]] \ |
||||
patchlevel [info patchlevel] \ |
||||
payload_base $base \ |
||||
] |
||||
if {[info exists ::punkboot::boot_state]} { |
||||
if {[dict exists $::punkboot::boot_state package_modes]} { |
||||
dict set live package_modes [dict get $::punkboot::boot_state package_modes] |
||||
} |
||||
} |
||||
if {[info exists ::punkboot::core_version]} { |
||||
dict set live boot_core_version $::punkboot::core_version |
||||
} |
||||
|
||||
set source [dict create present 0] |
||||
set proot [project_root] |
||||
if {$proot ne ""} { |
||||
set pver [project_version_read [file join $proot punkproject.toml]] |
||||
if {$pver ne ""} { |
||||
set source [dict create present 1 project_root $proot project_version $pver] |
||||
} |
||||
} |
||||
|
||||
set rrec [dict create present 0] |
||||
if {$base ne ""} { |
||||
set rd [toml_section_kv [file join $base $runtime_record_filename] artifact] |
||||
if {[dict size $rd]} { |
||||
set rrec [dict create present 1] |
||||
foreach k {name build_id revision target} { |
||||
if {[dict exists $rd $k]} { |
||||
dict set rrec $k [dict get $rd $k] |
||||
} |
||||
} |
||||
} |
||||
} |
||||
return [dict create stamp $stamp live $live source $source runtime_record $rrec] |
||||
} |
||||
|
||||
proc report {} { |
||||
set d [get_dict] |
||||
set lines [list] |
||||
set stamp [dict get $d stamp] |
||||
lappend lines "stamp_present=[dict get $stamp present]" |
||||
if {[dict get $stamp present]} { |
||||
foreach k {project_version vfs runtime runtime_build_id runtime_artifact kit target boot_core_version} { |
||||
if {[dict exists $stamp $k]} { |
||||
lappend lines "stamp_$k=[dict get $stamp $k]" |
||||
} |
||||
} |
||||
} |
||||
set live [dict get $d live] |
||||
foreach k {executable patchlevel payload_base package_modes boot_core_version} { |
||||
if {[dict exists $live $k]} { |
||||
lappend lines "live_$k=[dict get $live $k]" |
||||
} |
||||
} |
||||
set source [dict get $d source] |
||||
if {[dict get $source present]} { |
||||
lappend lines "live_project_root=[dict get $source project_root]" |
||||
lappend lines "live_project_version=[dict get $source project_version]" |
||||
if {[dict get $stamp present] && [dict exists $stamp project_version]} { |
||||
if {[dict get $stamp project_version] eq [dict get $source project_version]} { |
||||
lappend lines "live_vs_stamp=same" |
||||
} else { |
||||
lappend lines "live_vs_stamp=differs" |
||||
} |
||||
} |
||||
} |
||||
set rrec [dict get $d runtime_record] |
||||
if {[dict get $rrec present]} { |
||||
foreach k {name build_id revision} { |
||||
if {[dict exists $rrec $k]} { |
||||
lappend lines "runtime_record_$k=[dict get $rrec $k]" |
||||
} |
||||
} |
||||
} |
||||
return [join $lines \n] |
||||
} |
||||
|
||||
proc main {} { |
||||
puts stdout [report] |
||||
return 0 |
||||
} |
||||
} |
||||
|
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
lappend ::punk::args::register::NAMESPACES ::punk::buildinfo ::punk::buildinfo::argdoc |
||||
} |
||||
|
||||
## Ready |
||||
package provide punk::buildinfo [tcl::namespace::eval punk::buildinfo { |
||||
variable version |
||||
#- this version number, exactly 999999.0a1.0, is a literal used in src module folders |
||||
#- we refer to this sometimes as the magic version number |
||||
set version 999999.0a1.0 |
||||
}] |
||||
return |
||||
@ -0,0 +1,4 @@
|
||||
0.1.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.1.0 - initial (G-025): single-implementation build/identity report - punkkit-stamp.toml kit stamp, live facts, governing punkproject.toml version, inherited G-117 punkbin-artifact.toml runtime record; report = key=value lines, main = print + return 0 (the boot core's 'buildinfo' subcommand body) |
||||
@ -0,0 +1,181 @@
|
||||
# -*- tcl -*- |
||||
# Tests for punk::buildinfo - the G-025 single-implementation build/identity report: |
||||
# - lite [section] key=value reading of the controlled stamp/record files |
||||
# - the three notions kept distinct (stamp / live / source) and never fabricated |
||||
# - boot_state override paths (payload base + governing project root) - the same |
||||
# seams the boot core publishes in a real kit |
||||
# - report shape: key=value lines, stamp_present always first, absence = omission |
||||
# Directory fixtures only; ::punkboot::boot_state is faked per-test and cleaned up. |
||||
# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths modules/punk/buildinfo/*** report.test |
||||
|
||||
package require tcltest |
||||
package require punk::buildinfo |
||||
|
||||
#added 2026-08-02 (agent, G-025) |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable BASE [makeDirectory g025_buildinfo] |
||||
|
||||
proc writefile {path content} { |
||||
file mkdir [file dirname $path] |
||||
set fd [open $path w] |
||||
puts -nonewline $fd $content |
||||
close $fd |
||||
} |
||||
proc mkkitbase {name stampcontent {rrcontent ""}} { |
||||
variable BASE |
||||
set root [file join $BASE $name] |
||||
file delete -force $root |
||||
file mkdir $root |
||||
if {$stampcontent ne ""} { |
||||
writefile [file join $root punkkit-stamp.toml] $stampcontent |
||||
} |
||||
if {$rrcontent ne ""} { |
||||
writefile [file join $root punkbin-artifact.toml] $rrcontent |
||||
} |
||||
return $root |
||||
} |
||||
proc fake_bootstate {pairs} { |
||||
namespace eval ::punkboot [list variable boot_state [dict create {*}$pairs]] |
||||
} |
||||
proc clear_bootstate {} { |
||||
catch {unset ::punkboot::boot_state} |
||||
} |
||||
|
||||
variable STAMP1 {#stamp fixture |
||||
schema = 1 |
||||
|
||||
[punkkit] |
||||
project_version = "0.46.0" |
||||
vfs = "punk9win.vfs" |
||||
runtime = "tclsh9.0.2-r2.exe" |
||||
runtime_build_id = "1234-abcd" |
||||
kit = "punk902z.exe" |
||||
target = "win32-x86_64" |
||||
boot_core_version = "0.2.0" |
||||
utc_bake = "2026-08-02T12:00:00Z" |
||||
} |
||||
variable RREC1 {#record fixture |
||||
schema = 1 |
||||
|
||||
[artifact] |
||||
name = "tclsh9.0.2-punk-r2.exe" |
||||
build_id = "1234-abcd" |
||||
revision = 2 |
||||
} |
||||
|
||||
variable common { |
||||
set result [list] |
||||
clear_bootstate |
||||
} |
||||
|
||||
# -- --- --- lite reader --- --- -- |
||||
|
||||
test buildinfo_toml_lite_quoted_and_bare {section tracking with quoted and bare values; other sections ignored}\ |
||||
-setup $common -body { |
||||
variable BASE |
||||
writefile [file join $BASE lite.toml] "schema = 1\n\[other\]\nkey = \"nope\"\n\[punkkit\]\nqv = \"a b c\"\nbare = 42\n" |
||||
set d [punk::buildinfo::toml_section_kv [file join $BASE lite.toml] punkkit] |
||||
lappend result [dict get $d qv] [dict get $d bare] [dict exists $d key] [dict exists $d schema] |
||||
}\ |
||||
-result {{a b c} 42 0 0} |
||||
|
||||
test buildinfo_toml_lite_missing_file {a missing file yields an empty dict, not an error}\ |
||||
-setup $common -body { |
||||
variable BASE |
||||
dict size [punk::buildinfo::toml_section_kv [file join $BASE no_such.toml] punkkit] |
||||
}\ |
||||
-result {0} |
||||
|
||||
# -- --- --- stamp notion --- --- -- |
||||
|
||||
test buildinfo_stamp_read_via_bootstate {a stamped payload base (published via boot_state) yields the stamp fields}\ |
||||
-setup $common -body { |
||||
variable STAMP1 |
||||
set root [mkkitbase stamped $STAMP1] |
||||
fake_bootstate [list kit_payload_base $root] |
||||
set stamp [dict get [punk::buildinfo::get_dict] stamp] |
||||
lappend result [dict get $stamp present] [dict get $stamp project_version] [dict get $stamp vfs] [dict get $stamp kit] [dict get $stamp boot_core_version] |
||||
}\ |
||||
-cleanup {clear_bootstate}\ |
||||
-result {1 0.46.0 punk9win.vfs punk902z.exe 0.2.0} |
||||
|
||||
test buildinfo_unstamped_explicit_absence {an unstamped payload base reports stamp present 0 with no stamp fields}\ |
||||
-setup $common -body { |
||||
set root [mkkitbase unstamped ""] |
||||
fake_bootstate [list kit_payload_base $root] |
||||
set stamp [dict get [punk::buildinfo::get_dict] stamp] |
||||
lappend result [dict get $stamp present] [dict size $stamp] |
||||
}\ |
||||
-cleanup {clear_bootstate}\ |
||||
-result {0 1} |
||||
|
||||
test buildinfo_runtime_record_inherited {the G-117 runtime record beside the stamp is reported when readable}\ |
||||
-setup $common -body { |
||||
variable STAMP1 |
||||
variable RREC1 |
||||
set root [mkkitbase withrecord $STAMP1 $RREC1] |
||||
fake_bootstate [list kit_payload_base $root] |
||||
set rrec [dict get [punk::buildinfo::get_dict] runtime_record] |
||||
lappend result [dict get $rrec present] [dict get $rrec name] [dict get $rrec build_id] [dict get $rrec revision] |
||||
}\ |
||||
-cleanup {clear_bootstate}\ |
||||
-result {1 tclsh9.0.2-punk-r2.exe 1234-abcd 2} |
||||
|
||||
# -- --- --- source notion + live_vs_stamp --- --- -- |
||||
|
||||
test buildinfo_source_same_and_differs {governing punkproject.toml version compares against the stamp - same and differs both label truthfully}\ |
||||
-setup $common -body { |
||||
variable STAMP1 |
||||
variable BASE |
||||
set root [mkkitbase cmp $STAMP1] |
||||
set ptree [file join $BASE ptree] |
||||
file delete -force $ptree |
||||
writefile [file join $ptree punkproject.toml] "\[project\]\nname = \"demo\"\nversion = \"0.46.0\"\n" |
||||
fake_bootstate [list kit_payload_base $root src_project_root $ptree] |
||||
set r1 [punk::buildinfo::report] |
||||
writefile [file join $ptree punkproject.toml] "\[project\]\nname = \"demo\"\nversion = \"0.47.0\"\n" |
||||
set r2 [punk::buildinfo::report] |
||||
lappend result [regexp -line {^live_vs_stamp=same$} $r1] |
||||
lappend result [regexp -line {^live_vs_stamp=differs$} $r2] |
||||
lappend result [regexp -line {^live_project_version=0\.47\.0$} $r2] |
||||
}\ |
||||
-cleanup {clear_bootstate}\ |
||||
-result {1 1 1} |
||||
|
||||
# -- --- --- report shape --- --- -- |
||||
|
||||
test buildinfo_report_shape {stamp_present leads; every line is key=value; live facts always present}\ |
||||
-setup $common -body { |
||||
variable STAMP1 |
||||
set root [mkkitbase shape $STAMP1] |
||||
fake_bootstate [list kit_payload_base $root] |
||||
set r [punk::buildinfo::report] |
||||
set lines [split $r \n] |
||||
lappend result [lindex $lines 0] |
||||
set allkv 1 |
||||
foreach l $lines { |
||||
if {![regexp {^[a-z_]+=} $l]} {set allkv 0} |
||||
} |
||||
lappend result $allkv |
||||
lappend result [regexp -line {^live_executable=.+$} $r] [regexp -line {^live_patchlevel=.+$} $r] |
||||
}\ |
||||
-cleanup {clear_bootstate}\ |
||||
-result {stamp_present=1 1 1 1} |
||||
|
||||
test buildinfo_main_returns_zero {main prints the report and returns 0}\ |
||||
-setup $common -body { |
||||
variable STAMP1 |
||||
set root [mkkitbase mainret $STAMP1] |
||||
fake_bootstate [list kit_payload_base $root] |
||||
set out "" |
||||
set rc [punk::buildinfo::main] |
||||
lappend result $rc |
||||
}\ |
||||
-cleanup {clear_bootstate}\ |
||||
-result {0} |
||||
|
||||
cleanupTests |
||||
} |
||||
@ -0,0 +1,123 @@
|
||||
# -*- tcl -*- |
||||
# Characterization of the G-025 buildinfo launch subcommand against a built punk kit: |
||||
# - machine-parseable key=value report on stdout, exit 0, NOTHING on stderr |
||||
# - stamp fields present on a currently-baked kit (punkkit-stamp.toml written by bake) |
||||
# - RENAMED/COPIED executable keeps reporting its stamp (identity from embedded data, |
||||
# not the filename) while live_executable tells the truth about the file |
||||
# - argument rejection is honest (exit 2, stderr usage, no report) |
||||
# Stamped-content tests are constrained on the probed kit actually carrying a stamp |
||||
# (kit_stamped) so a stale pre-G-025 bin/ kit skips rather than red-herrings. |
||||
# |
||||
# Target executable resolved from env(PUNK_SHELL_TEST_EXE), else <projectroot>/bin/punk902z.exe |
||||
# then <projectroot>/bin/punkshell902. Skipped (constraint punkexeavailable) if none found. |
||||
|
||||
package require tcltest |
||||
|
||||
#added 2026-08-02 (agent, G-025) |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable testdir [file dirname [file normalize [info script]]] |
||||
#<projectroot>/src/tests/shell/testsuites/punkexe -> 5 levels up to <projectroot> |
||||
variable projectroot [file normalize [file join $testdir .. .. .. .. ..]] |
||||
|
||||
variable punkexe "" |
||||
if {[info exists ::env(PUNK_SHELL_TEST_EXE)] && $::env(PUNK_SHELL_TEST_EXE) ne ""} { |
||||
set punkexe [file normalize $::env(PUNK_SHELL_TEST_EXE)] |
||||
} else { |
||||
foreach candidate [list [file join $projectroot bin punk902z.exe] [file join $projectroot bin punkshell902]] { |
||||
if {[file exists $candidate]} { |
||||
set punkexe $candidate |
||||
break |
||||
} |
||||
} |
||||
} |
||||
testConstraint punkexeavailable [expr {$punkexe ne "" && [file exists $punkexe]}] |
||||
|
||||
#run the exe with args; returns dict {exitcode stdout stderr} |
||||
proc exe_run {exe args} { |
||||
set outfile [makeFile "" exe_stdout.txt] |
||||
set errfile [makeFile "" exe_stderr.txt] |
||||
set exitcode 0 |
||||
if {[catch {exec -- $exe {*}$args > $outfile 2> $errfile} _ errdict]} { |
||||
set code [dict get $errdict -errorcode] |
||||
if {[lindex $code 0] eq "CHILDSTATUS"} { |
||||
set exitcode [lindex $code 2] |
||||
} else { |
||||
set exitcode -1 |
||||
} |
||||
} |
||||
set fd [open $outfile r]; set out [read $fd]; close $fd |
||||
set fd [open $errfile r]; set err [read $fd]; close $fd |
||||
return [dict create exitcode $exitcode stdout $out stderr $err] |
||||
} |
||||
|
||||
#probe once: does the target kit carry a stamp? (pre-G-025 kits report |
||||
#stamp_present=0 or lack the subcommand entirely - those skip stamped tests) |
||||
variable kit_stamped 0 |
||||
if {[testConstraint punkexeavailable]} { |
||||
if {![catch {exe_run $punkexe buildinfo} pr]} { |
||||
if {[dict get $pr exitcode] == 0 && [regexp -line {^stamp_present=1$} [dict get $pr stdout]]} { |
||||
set kit_stamped 1 |
||||
} |
||||
} |
||||
} |
||||
testConstraint kit_stamped $kit_stamped |
||||
|
||||
test buildinfo_exit0_stdout_only {report on stdout, exit 0, nothing on stderr}\ |
||||
-constraints {punkexeavailable kit_stamped} -body { |
||||
variable punkexe |
||||
set r [exe_run $punkexe buildinfo] |
||||
set result [list] |
||||
lappend result [dict get $r exitcode] |
||||
lappend result [expr {[dict get $r stderr] eq ""}] |
||||
lappend result [regexp -line {^stamp_present=1$} [dict get $r stdout]] |
||||
set result |
||||
}\ |
||||
-result {0 1 1} |
||||
|
||||
test buildinfo_stamp_fields {stamped kit reports project version, vfs, runtime, kit, target and boot-core version}\ |
||||
-constraints {punkexeavailable kit_stamped} -body { |
||||
variable punkexe |
||||
set out [dict get [exe_run $punkexe buildinfo] stdout] |
||||
set result [list] |
||||
foreach k {stamp_project_version stamp_vfs stamp_runtime stamp_kit stamp_target stamp_boot_core_version live_executable live_patchlevel} { |
||||
lappend result [regexp -line "^$k=.+\$" $out] |
||||
} |
||||
set result |
||||
}\ |
||||
-result {1 1 1 1 1 1 1 1} |
||||
|
||||
test buildinfo_renamed_copy_reports_stamp {a renamed COPY still reports its embedded stamp; live_executable reports the real file}\ |
||||
-constraints {punkexeavailable kit_stamped} -body { |
||||
variable punkexe |
||||
set scratchdir [makeDirectory g025_renamed] |
||||
set renamed [file join $scratchdir totally_other_name[file extension $punkexe]] |
||||
file copy -force $punkexe $renamed |
||||
set orig [dict get [exe_run $punkexe buildinfo] stdout] |
||||
set ren [dict get [exe_run $renamed buildinfo] stdout] |
||||
regexp -line {^stamp_kit=(.*)$} $orig -> orig_kit |
||||
set result [list] |
||||
lappend result [regexp -line {^stamp_present=1$} $ren] |
||||
lappend result [regexp -line "^stamp_kit=$orig_kit\$" $ren] |
||||
lappend result [regexp -line {^live_executable=.*totally_other_name.*$} $ren] |
||||
file delete -force $renamed |
||||
set result |
||||
}\ |
||||
-result {1 1 1} |
||||
|
||||
test buildinfo_rejects_arguments {arguments are rejected honestly: exit 2, stderr usage, no report on stdout}\ |
||||
-constraints {punkexeavailable kit_stamped} -body { |
||||
variable punkexe |
||||
set r [exe_run $punkexe buildinfo extra] |
||||
set result [list] |
||||
lappend result [dict get $r exitcode] |
||||
lappend result [string match "*takes no arguments*" [dict get $r stderr]] |
||||
lappend result [expr {[dict get $r stdout] eq ""}] |
||||
set result |
||||
}\ |
||||
-result {2 1 1} |
||||
|
||||
cleanupTests |
||||
} |
||||
Loading…
Reference in new issue