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 |
#First line must be a semantic version number |
||||||
#all other lines are ignored. |
#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 |
#First line must be a semantic version number |
||||||
#all other lines are ignored. |
#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.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