65 changed files with 35312 additions and 1215 deletions
@ -0,0 +1,2 @@
|
||||
#call exit with whatever we pass in. |
||||
exit {*}$::argv |
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,324 @@
|
||||
# -*- 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) 2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::mix::commandset::doc 0.1.1 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
##e.g package require frobz |
||||
|
||||
package require punk::path ;# for treefilenames, relative |
||||
package require punk::repo |
||||
package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc |
||||
package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call |
||||
#package require punkcheck ;#for path_relative |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval punk::mix::commandset::doc { |
||||
namespace export * |
||||
|
||||
proc _default {} { |
||||
puts "documentation subsystem" |
||||
puts "commands: doc.build" |
||||
puts " build documentation from src/doc to src/embedded using the kettle build tool" |
||||
puts "commands: doc.status" |
||||
} |
||||
|
||||
proc build {} { |
||||
puts "build docs" |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to build docs" |
||||
return |
||||
} |
||||
#user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite |
||||
#we still generate output in src/docgen so user can diff and manually update if thats what they prefer |
||||
set oldfiles [punk::path::treefilenames -dir $projectdir/src/doc _module_*.man] |
||||
foreach maybedoomed $oldfiles { |
||||
set fd [open $maybedoomed r] |
||||
chan conf $fd -translation binary |
||||
set data [read $fd] |
||||
close $fd |
||||
if {[string match "*--- punk::docgen overwrites *" $data]} { |
||||
file delete -force $maybedoomed |
||||
} |
||||
} |
||||
set generated [lib::do_docgen modules] |
||||
if {[dict get $generated count] > 0} { |
||||
#review |
||||
set doclist [dict get $generated docs] |
||||
set source_base [dict get $generated base] |
||||
set target_base $projectdir/src/doc |
||||
foreach dinfo $doclist { |
||||
lassign $dinfo module fpath |
||||
set relpath [punk::path::relative $source_base $fpath] |
||||
set relfolder [file dirname $relpath] |
||||
if {$relfolder eq "."} { |
||||
set relfolder "" |
||||
} |
||||
file mkdir [file join $target_base $relfolder] |
||||
set target [file join $target_base $relfolder _module_[file tail $fpath]] |
||||
puts stderr "target --> $target" |
||||
if {![file exists $target]} { |
||||
file copy $fpath $target |
||||
} |
||||
} |
||||
} |
||||
|
||||
if {[file exists $projectdir/src/doc]} { |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init VIRTUAL kettle_build_doc ;#VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
if {\ |
||||
[llength [dict get [$event targetset_source_changes] changed]]\ |
||||
} { |
||||
$event targetset_started |
||||
# -- --- --- --- --- --- |
||||
puts stdout "BUILDING DOCS at $projectdir/src/embedded from src/doc" |
||||
if {[catch { |
||||
if {"::meta" eq [info commands ::meta]} { |
||||
puts stderr "There appears to be a leftover ::meta command which is presumed to be from doctools. Destroying object" |
||||
::meta destroy |
||||
} |
||||
punk::mix::cli::lib::kettle_call lib doc |
||||
#Kettle doc |
||||
|
||||
} errM]} { |
||||
$event targetset_end FAILED -note "kettle_build_doc failed: $errM" |
||||
} else { |
||||
$event targetset_end OK |
||||
} |
||||
# -- --- --- --- --- --- |
||||
} else { |
||||
puts stderr "No change detected in src/doc" |
||||
$event targetset_end SKIPPED |
||||
} |
||||
$event end |
||||
$event destroy |
||||
$installer destroy |
||||
cd $original_wd |
||||
} else { |
||||
puts stderr "No doc folder found at $projectdir/src/doc" |
||||
} |
||||
} |
||||
proc status {} { |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
puts stdout "Testing status of doctools source location $projectdir/src/doc ..." |
||||
flush stdout |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init QUERY kettle_build_doc ;#usually VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated - but here we use QUERY to ensure no writes to .punkcheck |
||||
set last_completion [$event targetset_last_complete] |
||||
|
||||
if {[llength $last_completion]} { |
||||
#adding a source causes it to be checksummed |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
set changeinfo [$event targetset_source_changes] |
||||
if {\ |
||||
[llength [dict get $changeinfo changed]]\ |
||||
} { |
||||
puts stdout "changed" |
||||
puts stdout $changeinfo |
||||
} else { |
||||
puts stdout "No changes detected in $projectdir/src/doc tree" |
||||
} |
||||
} else { |
||||
#no previous completion-record for this target - must assume changed - no need to trigger checksumming |
||||
puts stdout "No existing record of doc build in .punkcheck. Assume it needs to be rebuilt." |
||||
} |
||||
|
||||
|
||||
$event destroy |
||||
$installer destroy |
||||
|
||||
cd $original_wd |
||||
} |
||||
proc validate {args} { |
||||
set argd [punk::args::parse $args withdef { |
||||
@id -id ::punk::mix::commandset::doc::validate |
||||
-- -type none -optional 1 -help "end of options marker --" |
||||
-individual -type boolean -default 1 |
||||
@values -min 0 -max -1 |
||||
patterns -default {*.man} -type any -multiple 1 |
||||
}] |
||||
set opt_individual [tcl::dict::get $argd opts -individual] |
||||
set patterns [tcl::dict::get $argd values patterns] |
||||
|
||||
|
||||
#todo - run and validate punk::docgen output |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
set docroot $projectdir/src/doc |
||||
cd $docroot |
||||
|
||||
if {!$opt_individual && "*.man" in $patterns} { |
||||
if {[catch { |
||||
dtplite validate $docroot |
||||
} errM]} { |
||||
puts stderr "commandset::doc::validate failed for projectdir '$projectdir'" |
||||
puts stderr "docroot '$docroot'" |
||||
puts stderr "dtplite error was: $errM" |
||||
} |
||||
} else { |
||||
foreach p $patterns { |
||||
set treefiles [punk::path::treefilenames $p] |
||||
foreach path $treefiles { |
||||
puts stdout "dtplite validate $path" |
||||
dtplite validate $path |
||||
} |
||||
} |
||||
} |
||||
|
||||
#punk::mix::cli::lib::kettle_call lib validate-doc |
||||
|
||||
cd $original_wd |
||||
} |
||||
|
||||
namespace eval collection { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
|
||||
namespace export * |
||||
namespace path [namespace parent] |
||||
|
||||
} |
||||
|
||||
namespace eval lib { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
proc do_docgen {{project_subpath modules}} { |
||||
#Extract doctools comments from source code |
||||
set projectdir [punk::repo::find_project] |
||||
set output_base [file join $projectdir src docgen] |
||||
set codesource_path [file join $projectdir $project_subpath] |
||||
if {![file isdirectory $codesource_path]} { |
||||
puts stderr "WARNING punk::mix::commandset::doc unable to find codesource_path $codesource_path during do_docgen - skipping inline doctools generation" |
||||
return |
||||
} |
||||
if {[file isdirectory $output_base]} { |
||||
if {[catch { |
||||
file delete -force $output_base |
||||
}]} { |
||||
error "do_docgen failed to delete existing output base folder: $output_base" |
||||
} |
||||
} |
||||
file mkdir $output_base |
||||
|
||||
set matched_paths [punk::path::treefilenames -dir $codesource_path -exclude-paths {**/mix/templates/** **/project_layouts/** **/decktemplates/** **/_aside **/_aside/**} *.tm] |
||||
set count 0 |
||||
set newdocs [list] |
||||
set docgen_header_comments "" |
||||
append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n |
||||
foreach fullpath $matched_paths { |
||||
puts stdout "do_docgen processing: $fullpath" |
||||
set doctools [punk::docgen::get_doctools_comments $fullpath] |
||||
if {$doctools ne ""} { |
||||
set fname [file tail $fullpath] |
||||
set mod_tail [file rootname $fname] |
||||
set relpath [punk::path::relative $codesource_path [file dirname $fullpath]] |
||||
if {$relpath eq "."} { |
||||
set relpath "" |
||||
} |
||||
set tailsegs [file split $relpath] |
||||
set module_fullname [join $tailsegs ::]::$mod_tail |
||||
set target_docname $fname.man |
||||
set this_outdir [file join $output_base $relpath] |
||||
|
||||
if {[string length $fname] > 99} { |
||||
#output needs to be tarballed to do checksum change tests in a reasonably straightforward and not-too-terribly slow way. |
||||
#hack - review. Determine exact limit - test if tcllib tar fixed or if it's a limit of the particular tar format |
||||
#work around tcllib tar filename length limit ( somewhere around 100?) This seems to be a limit on the length of a particular segment in the path.. not whole path length? |
||||
#this case only came up because docgen used to path munge to long filenames - but left because we know there is a limit and renaming fixes it - even if it's ugly - but still allows doc generation. |
||||
#review - if we're checking fname - should also test length of whole path and determine limits for tar |
||||
package require md5 |
||||
if {[package vsatisfies [package present md5] 2- ] } { |
||||
set md5opt "-hex" |
||||
} else { |
||||
set md5opt "" |
||||
} |
||||
set target_docname [md5::md5 {*}$md5opt [encoding convertto utf-8 $fullpath]]_overlongfilename.man |
||||
puts stderr "WARNING - overlong file name - renaming $fullpath" |
||||
puts stderr " to [file dirname $fullpath]/$target_docname" |
||||
} |
||||
|
||||
file mkdir $this_outdir |
||||
puts stdout "saving [string length $doctools] bytes of doctools output from file $relpath/$fname" |
||||
set outfile [file join $this_outdir $target_docname] |
||||
set fd [open $outfile w] |
||||
fconfigure $fd -translation binary |
||||
puts -nonewline $fd $docgen_header_comments$doctools |
||||
close $fd |
||||
incr count |
||||
lappend newdocs [list $module_fullname $outfile] |
||||
} |
||||
} |
||||
return [list count $count docs $newdocs base $output_base] |
||||
} |
||||
|
||||
} |
||||
} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::mix::commandset::doc [namespace eval punk::mix::commandset::doc { |
||||
variable pkg punk::mix::commandset::doc |
||||
variable version |
||||
set version 0.1.1 |
||||
}] |
||||
return |
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,3 +1,4 @@
|
||||
0.3.1 |
||||
0.4.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.4.0 - updated -max_depth to -max-depth at punkcheck::install call sites — call-site flag change warrants minor bump |
||||
|
||||
@ -1,3 +1,4 @@
|
||||
0.1.0 |
||||
0.1.1 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.1.1 - fixed treefilenames call using -antiglob_paths instead of -exclude-paths |
||||
|
||||
@ -1,3 +1,5 @@
|
||||
0.1.0 |
||||
0.2.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.2.0 - updated punkcheck::install call sites to use -exclude-paths / -exclude-paths-core (replaced -antiglob-paths + -exclude-dirsegments) — call-site API change warrants minor bump |
||||
#0.2.0 - updated call sites to use hyphenated flag names (-punkcheck-folder, -exclude-paths-core) |
||||
|
||||
@ -1,3 +1,5 @@
|
||||
0.1.0 |
||||
0.2.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#0.2.0 - treefilenames now matches hidden files and recurses into hidden directories on all platforms |
||||
#0.2.0 - added PUNKARGS documentation for punk::path::relative |
||||
|
||||
@ -1,3 +1,5 @@
|
||||
0.1.1 |
||||
0.2.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
#all other lines are ignored. |
||||
#0.2.0 - merged -exclude-dirsegments + -antiglob_paths into unified -exclude-paths (backward-compat aliases retained) |
||||
#0.2.0 - renamed all underscore flags to hyphenated forms (-max-depth, -source-checksum, -punkcheck-folder, etc.) with backward-compat alias pre-processing |
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,324 @@
|
||||
# -*- 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) 2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::mix::commandset::doc 0.1.1 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
##e.g package require frobz |
||||
|
||||
package require punk::path ;# for treefilenames, relative |
||||
package require punk::repo |
||||
package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc |
||||
package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call |
||||
#package require punkcheck ;#for path_relative |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval punk::mix::commandset::doc { |
||||
namespace export * |
||||
|
||||
proc _default {} { |
||||
puts "documentation subsystem" |
||||
puts "commands: doc.build" |
||||
puts " build documentation from src/doc to src/embedded using the kettle build tool" |
||||
puts "commands: doc.status" |
||||
} |
||||
|
||||
proc build {} { |
||||
puts "build docs" |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to build docs" |
||||
return |
||||
} |
||||
#user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite |
||||
#we still generate output in src/docgen so user can diff and manually update if thats what they prefer |
||||
set oldfiles [punk::path::treefilenames -dir $projectdir/src/doc _module_*.man] |
||||
foreach maybedoomed $oldfiles { |
||||
set fd [open $maybedoomed r] |
||||
chan conf $fd -translation binary |
||||
set data [read $fd] |
||||
close $fd |
||||
if {[string match "*--- punk::docgen overwrites *" $data]} { |
||||
file delete -force $maybedoomed |
||||
} |
||||
} |
||||
set generated [lib::do_docgen modules] |
||||
if {[dict get $generated count] > 0} { |
||||
#review |
||||
set doclist [dict get $generated docs] |
||||
set source_base [dict get $generated base] |
||||
set target_base $projectdir/src/doc |
||||
foreach dinfo $doclist { |
||||
lassign $dinfo module fpath |
||||
set relpath [punk::path::relative $source_base $fpath] |
||||
set relfolder [file dirname $relpath] |
||||
if {$relfolder eq "."} { |
||||
set relfolder "" |
||||
} |
||||
file mkdir [file join $target_base $relfolder] |
||||
set target [file join $target_base $relfolder _module_[file tail $fpath]] |
||||
puts stderr "target --> $target" |
||||
if {![file exists $target]} { |
||||
file copy $fpath $target |
||||
} |
||||
} |
||||
} |
||||
|
||||
if {[file exists $projectdir/src/doc]} { |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init VIRTUAL kettle_build_doc ;#VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
if {\ |
||||
[llength [dict get [$event targetset_source_changes] changed]]\ |
||||
} { |
||||
$event targetset_started |
||||
# -- --- --- --- --- --- |
||||
puts stdout "BUILDING DOCS at $projectdir/src/embedded from src/doc" |
||||
if {[catch { |
||||
if {"::meta" eq [info commands ::meta]} { |
||||
puts stderr "There appears to be a leftover ::meta command which is presumed to be from doctools. Destroying object" |
||||
::meta destroy |
||||
} |
||||
punk::mix::cli::lib::kettle_call lib doc |
||||
#Kettle doc |
||||
|
||||
} errM]} { |
||||
$event targetset_end FAILED -note "kettle_build_doc failed: $errM" |
||||
} else { |
||||
$event targetset_end OK |
||||
} |
||||
# -- --- --- --- --- --- |
||||
} else { |
||||
puts stderr "No change detected in src/doc" |
||||
$event targetset_end SKIPPED |
||||
} |
||||
$event end |
||||
$event destroy |
||||
$installer destroy |
||||
cd $original_wd |
||||
} else { |
||||
puts stderr "No doc folder found at $projectdir/src/doc" |
||||
} |
||||
} |
||||
proc status {} { |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
puts stdout "Testing status of doctools source location $projectdir/src/doc ..." |
||||
flush stdout |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init QUERY kettle_build_doc ;#usually VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated - but here we use QUERY to ensure no writes to .punkcheck |
||||
set last_completion [$event targetset_last_complete] |
||||
|
||||
if {[llength $last_completion]} { |
||||
#adding a source causes it to be checksummed |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
set changeinfo [$event targetset_source_changes] |
||||
if {\ |
||||
[llength [dict get $changeinfo changed]]\ |
||||
} { |
||||
puts stdout "changed" |
||||
puts stdout $changeinfo |
||||
} else { |
||||
puts stdout "No changes detected in $projectdir/src/doc tree" |
||||
} |
||||
} else { |
||||
#no previous completion-record for this target - must assume changed - no need to trigger checksumming |
||||
puts stdout "No existing record of doc build in .punkcheck. Assume it needs to be rebuilt." |
||||
} |
||||
|
||||
|
||||
$event destroy |
||||
$installer destroy |
||||
|
||||
cd $original_wd |
||||
} |
||||
proc validate {args} { |
||||
set argd [punk::args::parse $args withdef { |
||||
@id -id ::punk::mix::commandset::doc::validate |
||||
-- -type none -optional 1 -help "end of options marker --" |
||||
-individual -type boolean -default 1 |
||||
@values -min 0 -max -1 |
||||
patterns -default {*.man} -type any -multiple 1 |
||||
}] |
||||
set opt_individual [tcl::dict::get $argd opts -individual] |
||||
set patterns [tcl::dict::get $argd values patterns] |
||||
|
||||
|
||||
#todo - run and validate punk::docgen output |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
set docroot $projectdir/src/doc |
||||
cd $docroot |
||||
|
||||
if {!$opt_individual && "*.man" in $patterns} { |
||||
if {[catch { |
||||
dtplite validate $docroot |
||||
} errM]} { |
||||
puts stderr "commandset::doc::validate failed for projectdir '$projectdir'" |
||||
puts stderr "docroot '$docroot'" |
||||
puts stderr "dtplite error was: $errM" |
||||
} |
||||
} else { |
||||
foreach p $patterns { |
||||
set treefiles [punk::path::treefilenames $p] |
||||
foreach path $treefiles { |
||||
puts stdout "dtplite validate $path" |
||||
dtplite validate $path |
||||
} |
||||
} |
||||
} |
||||
|
||||
#punk::mix::cli::lib::kettle_call lib validate-doc |
||||
|
||||
cd $original_wd |
||||
} |
||||
|
||||
namespace eval collection { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
|
||||
namespace export * |
||||
namespace path [namespace parent] |
||||
|
||||
} |
||||
|
||||
namespace eval lib { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
proc do_docgen {{project_subpath modules}} { |
||||
#Extract doctools comments from source code |
||||
set projectdir [punk::repo::find_project] |
||||
set output_base [file join $projectdir src docgen] |
||||
set codesource_path [file join $projectdir $project_subpath] |
||||
if {![file isdirectory $codesource_path]} { |
||||
puts stderr "WARNING punk::mix::commandset::doc unable to find codesource_path $codesource_path during do_docgen - skipping inline doctools generation" |
||||
return |
||||
} |
||||
if {[file isdirectory $output_base]} { |
||||
if {[catch { |
||||
file delete -force $output_base |
||||
}]} { |
||||
error "do_docgen failed to delete existing output base folder: $output_base" |
||||
} |
||||
} |
||||
file mkdir $output_base |
||||
|
||||
set matched_paths [punk::path::treefilenames -dir $codesource_path -exclude-paths {**/mix/templates/** **/project_layouts/** **/decktemplates/** **/_aside **/_aside/**} *.tm] |
||||
set count 0 |
||||
set newdocs [list] |
||||
set docgen_header_comments "" |
||||
append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n |
||||
foreach fullpath $matched_paths { |
||||
puts stdout "do_docgen processing: $fullpath" |
||||
set doctools [punk::docgen::get_doctools_comments $fullpath] |
||||
if {$doctools ne ""} { |
||||
set fname [file tail $fullpath] |
||||
set mod_tail [file rootname $fname] |
||||
set relpath [punk::path::relative $codesource_path [file dirname $fullpath]] |
||||
if {$relpath eq "."} { |
||||
set relpath "" |
||||
} |
||||
set tailsegs [file split $relpath] |
||||
set module_fullname [join $tailsegs ::]::$mod_tail |
||||
set target_docname $fname.man |
||||
set this_outdir [file join $output_base $relpath] |
||||
|
||||
if {[string length $fname] > 99} { |
||||
#output needs to be tarballed to do checksum change tests in a reasonably straightforward and not-too-terribly slow way. |
||||
#hack - review. Determine exact limit - test if tcllib tar fixed or if it's a limit of the particular tar format |
||||
#work around tcllib tar filename length limit ( somewhere around 100?) This seems to be a limit on the length of a particular segment in the path.. not whole path length? |
||||
#this case only came up because docgen used to path munge to long filenames - but left because we know there is a limit and renaming fixes it - even if it's ugly - but still allows doc generation. |
||||
#review - if we're checking fname - should also test length of whole path and determine limits for tar |
||||
package require md5 |
||||
if {[package vsatisfies [package present md5] 2- ] } { |
||||
set md5opt "-hex" |
||||
} else { |
||||
set md5opt "" |
||||
} |
||||
set target_docname [md5::md5 {*}$md5opt [encoding convertto utf-8 $fullpath]]_overlongfilename.man |
||||
puts stderr "WARNING - overlong file name - renaming $fullpath" |
||||
puts stderr " to [file dirname $fullpath]/$target_docname" |
||||
} |
||||
|
||||
file mkdir $this_outdir |
||||
puts stdout "saving [string length $doctools] bytes of doctools output from file $relpath/$fname" |
||||
set outfile [file join $this_outdir $target_docname] |
||||
set fd [open $outfile w] |
||||
fconfigure $fd -translation binary |
||||
puts -nonewline $fd $docgen_header_comments$doctools |
||||
close $fd |
||||
incr count |
||||
lappend newdocs [list $module_fullname $outfile] |
||||
} |
||||
} |
||||
return [list count $count docs $newdocs base $output_base] |
||||
} |
||||
|
||||
} |
||||
} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::mix::commandset::doc [namespace eval punk::mix::commandset::doc { |
||||
variable pkg punk::mix::commandset::doc |
||||
variable version |
||||
set version 0.1.1 |
||||
}] |
||||
return |
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,324 @@
|
||||
# -*- 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) 2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::mix::commandset::doc 0.1.1 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
##e.g package require frobz |
||||
|
||||
package require punk::path ;# for treefilenames, relative |
||||
package require punk::repo |
||||
package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc |
||||
package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call |
||||
#package require punkcheck ;#for path_relative |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval punk::mix::commandset::doc { |
||||
namespace export * |
||||
|
||||
proc _default {} { |
||||
puts "documentation subsystem" |
||||
puts "commands: doc.build" |
||||
puts " build documentation from src/doc to src/embedded using the kettle build tool" |
||||
puts "commands: doc.status" |
||||
} |
||||
|
||||
proc build {} { |
||||
puts "build docs" |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to build docs" |
||||
return |
||||
} |
||||
#user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite |
||||
#we still generate output in src/docgen so user can diff and manually update if thats what they prefer |
||||
set oldfiles [punk::path::treefilenames -dir $projectdir/src/doc _module_*.man] |
||||
foreach maybedoomed $oldfiles { |
||||
set fd [open $maybedoomed r] |
||||
chan conf $fd -translation binary |
||||
set data [read $fd] |
||||
close $fd |
||||
if {[string match "*--- punk::docgen overwrites *" $data]} { |
||||
file delete -force $maybedoomed |
||||
} |
||||
} |
||||
set generated [lib::do_docgen modules] |
||||
if {[dict get $generated count] > 0} { |
||||
#review |
||||
set doclist [dict get $generated docs] |
||||
set source_base [dict get $generated base] |
||||
set target_base $projectdir/src/doc |
||||
foreach dinfo $doclist { |
||||
lassign $dinfo module fpath |
||||
set relpath [punk::path::relative $source_base $fpath] |
||||
set relfolder [file dirname $relpath] |
||||
if {$relfolder eq "."} { |
||||
set relfolder "" |
||||
} |
||||
file mkdir [file join $target_base $relfolder] |
||||
set target [file join $target_base $relfolder _module_[file tail $fpath]] |
||||
puts stderr "target --> $target" |
||||
if {![file exists $target]} { |
||||
file copy $fpath $target |
||||
} |
||||
} |
||||
} |
||||
|
||||
if {[file exists $projectdir/src/doc]} { |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init VIRTUAL kettle_build_doc ;#VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
if {\ |
||||
[llength [dict get [$event targetset_source_changes] changed]]\ |
||||
} { |
||||
$event targetset_started |
||||
# -- --- --- --- --- --- |
||||
puts stdout "BUILDING DOCS at $projectdir/src/embedded from src/doc" |
||||
if {[catch { |
||||
if {"::meta" eq [info commands ::meta]} { |
||||
puts stderr "There appears to be a leftover ::meta command which is presumed to be from doctools. Destroying object" |
||||
::meta destroy |
||||
} |
||||
punk::mix::cli::lib::kettle_call lib doc |
||||
#Kettle doc |
||||
|
||||
} errM]} { |
||||
$event targetset_end FAILED -note "kettle_build_doc failed: $errM" |
||||
} else { |
||||
$event targetset_end OK |
||||
} |
||||
# -- --- --- --- --- --- |
||||
} else { |
||||
puts stderr "No change detected in src/doc" |
||||
$event targetset_end SKIPPED |
||||
} |
||||
$event end |
||||
$event destroy |
||||
$installer destroy |
||||
cd $original_wd |
||||
} else { |
||||
puts stderr "No doc folder found at $projectdir/src/doc" |
||||
} |
||||
} |
||||
proc status {} { |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
puts stdout "Testing status of doctools source location $projectdir/src/doc ..." |
||||
flush stdout |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init QUERY kettle_build_doc ;#usually VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated - but here we use QUERY to ensure no writes to .punkcheck |
||||
set last_completion [$event targetset_last_complete] |
||||
|
||||
if {[llength $last_completion]} { |
||||
#adding a source causes it to be checksummed |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
set changeinfo [$event targetset_source_changes] |
||||
if {\ |
||||
[llength [dict get $changeinfo changed]]\ |
||||
} { |
||||
puts stdout "changed" |
||||
puts stdout $changeinfo |
||||
} else { |
||||
puts stdout "No changes detected in $projectdir/src/doc tree" |
||||
} |
||||
} else { |
||||
#no previous completion-record for this target - must assume changed - no need to trigger checksumming |
||||
puts stdout "No existing record of doc build in .punkcheck. Assume it needs to be rebuilt." |
||||
} |
||||
|
||||
|
||||
$event destroy |
||||
$installer destroy |
||||
|
||||
cd $original_wd |
||||
} |
||||
proc validate {args} { |
||||
set argd [punk::args::parse $args withdef { |
||||
@id -id ::punk::mix::commandset::doc::validate |
||||
-- -type none -optional 1 -help "end of options marker --" |
||||
-individual -type boolean -default 1 |
||||
@values -min 0 -max -1 |
||||
patterns -default {*.man} -type any -multiple 1 |
||||
}] |
||||
set opt_individual [tcl::dict::get $argd opts -individual] |
||||
set patterns [tcl::dict::get $argd values patterns] |
||||
|
||||
|
||||
#todo - run and validate punk::docgen output |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
set docroot $projectdir/src/doc |
||||
cd $docroot |
||||
|
||||
if {!$opt_individual && "*.man" in $patterns} { |
||||
if {[catch { |
||||
dtplite validate $docroot |
||||
} errM]} { |
||||
puts stderr "commandset::doc::validate failed for projectdir '$projectdir'" |
||||
puts stderr "docroot '$docroot'" |
||||
puts stderr "dtplite error was: $errM" |
||||
} |
||||
} else { |
||||
foreach p $patterns { |
||||
set treefiles [punk::path::treefilenames $p] |
||||
foreach path $treefiles { |
||||
puts stdout "dtplite validate $path" |
||||
dtplite validate $path |
||||
} |
||||
} |
||||
} |
||||
|
||||
#punk::mix::cli::lib::kettle_call lib validate-doc |
||||
|
||||
cd $original_wd |
||||
} |
||||
|
||||
namespace eval collection { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
|
||||
namespace export * |
||||
namespace path [namespace parent] |
||||
|
||||
} |
||||
|
||||
namespace eval lib { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
proc do_docgen {{project_subpath modules}} { |
||||
#Extract doctools comments from source code |
||||
set projectdir [punk::repo::find_project] |
||||
set output_base [file join $projectdir src docgen] |
||||
set codesource_path [file join $projectdir $project_subpath] |
||||
if {![file isdirectory $codesource_path]} { |
||||
puts stderr "WARNING punk::mix::commandset::doc unable to find codesource_path $codesource_path during do_docgen - skipping inline doctools generation" |
||||
return |
||||
} |
||||
if {[file isdirectory $output_base]} { |
||||
if {[catch { |
||||
file delete -force $output_base |
||||
}]} { |
||||
error "do_docgen failed to delete existing output base folder: $output_base" |
||||
} |
||||
} |
||||
file mkdir $output_base |
||||
|
||||
set matched_paths [punk::path::treefilenames -dir $codesource_path -exclude-paths {**/mix/templates/** **/project_layouts/** **/decktemplates/** **/_aside **/_aside/**} *.tm] |
||||
set count 0 |
||||
set newdocs [list] |
||||
set docgen_header_comments "" |
||||
append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n |
||||
foreach fullpath $matched_paths { |
||||
puts stdout "do_docgen processing: $fullpath" |
||||
set doctools [punk::docgen::get_doctools_comments $fullpath] |
||||
if {$doctools ne ""} { |
||||
set fname [file tail $fullpath] |
||||
set mod_tail [file rootname $fname] |
||||
set relpath [punk::path::relative $codesource_path [file dirname $fullpath]] |
||||
if {$relpath eq "."} { |
||||
set relpath "" |
||||
} |
||||
set tailsegs [file split $relpath] |
||||
set module_fullname [join $tailsegs ::]::$mod_tail |
||||
set target_docname $fname.man |
||||
set this_outdir [file join $output_base $relpath] |
||||
|
||||
if {[string length $fname] > 99} { |
||||
#output needs to be tarballed to do checksum change tests in a reasonably straightforward and not-too-terribly slow way. |
||||
#hack - review. Determine exact limit - test if tcllib tar fixed or if it's a limit of the particular tar format |
||||
#work around tcllib tar filename length limit ( somewhere around 100?) This seems to be a limit on the length of a particular segment in the path.. not whole path length? |
||||
#this case only came up because docgen used to path munge to long filenames - but left because we know there is a limit and renaming fixes it - even if it's ugly - but still allows doc generation. |
||||
#review - if we're checking fname - should also test length of whole path and determine limits for tar |
||||
package require md5 |
||||
if {[package vsatisfies [package present md5] 2- ] } { |
||||
set md5opt "-hex" |
||||
} else { |
||||
set md5opt "" |
||||
} |
||||
set target_docname [md5::md5 {*}$md5opt [encoding convertto utf-8 $fullpath]]_overlongfilename.man |
||||
puts stderr "WARNING - overlong file name - renaming $fullpath" |
||||
puts stderr " to [file dirname $fullpath]/$target_docname" |
||||
} |
||||
|
||||
file mkdir $this_outdir |
||||
puts stdout "saving [string length $doctools] bytes of doctools output from file $relpath/$fname" |
||||
set outfile [file join $this_outdir $target_docname] |
||||
set fd [open $outfile w] |
||||
fconfigure $fd -translation binary |
||||
puts -nonewline $fd $docgen_header_comments$doctools |
||||
close $fd |
||||
incr count |
||||
lappend newdocs [list $module_fullname $outfile] |
||||
} |
||||
} |
||||
return [list count $count docs $newdocs base $output_base] |
||||
} |
||||
|
||||
} |
||||
} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::mix::commandset::doc [namespace eval punk::mix::commandset::doc { |
||||
variable pkg punk::mix::commandset::doc |
||||
variable version |
||||
set version 0.1.1 |
||||
}] |
||||
return |
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,684 @@
|
||||
# -*- tcl -*- |
||||
# Characterization tests for punkcheck::install and punkcheck::summarize_install_resultdict |
||||
# These tests lock down CURRENT behavior with current flag names (underscores) before any refactoring. |
||||
# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths modules/punkcheck/** install.test |
||||
|
||||
package require tcltest |
||||
package require punkcheck |
||||
package require punk::lib |
||||
package require punk::path |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
# ------------------------------------------------------------------------- |
||||
# Helper: create a unique temp workspace with a source tree layout. |
||||
# Returns a dict with keys: root srcdir tgtdir |
||||
# Caller is responsible for cleanup via -cleanup {file delete -force $root} |
||||
# ------------------------------------------------------------------------- |
||||
proc make_workspace {layout} { |
||||
set root [punk::lib::tempdir_newfolder -prefix punkchecktest] |
||||
set srcdir [file join $root src] |
||||
set tgtdir [file join $root tgt] |
||||
file mkdir $srcdir $tgtdir |
||||
foreach {relpath content} $layout { |
||||
set f [file join $srcdir {*}[file split $relpath]] |
||||
file mkdir [file dirname $f] |
||||
set fd [open $f w] |
||||
chan configure $fd -translation lf |
||||
puts -nonewline $fd $content |
||||
close $fd |
||||
} |
||||
return [dict create root $root srcdir $srcdir tgtdir $tgtdir] |
||||
} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: basic copy behavior --- |
||||
# ========================================================================= |
||||
|
||||
test install_basic_copy {Basic copy of a single file to empty target}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir] -overwrite all-targets -createdir 1] |
||||
set copied [dict get $resultdict files_copied] |
||||
set got [string map [list [dict get $ws srcdir]/ ""] [lindex $copied 0]] |
||||
return $got |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {foo.txt} |
||||
|
||||
test install_missing_target_no_createdir {Error when target missing and -createdir 0}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
# tgtdir was created by make_workspace but we remove it to test the error path |
||||
file delete -force [dict get $ws tgtdir] |
||||
punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir] -overwrite all-targets |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-returnCodes error\ |
||||
-match glob\ |
||||
-result {punkcheck::install base target dir*doesn't exist*} |
||||
|
||||
test install_createdir_creates_target {Target dir is created when -createdir 1 and missing}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
file delete -force [dict get $ws tgtdir] |
||||
punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir] -overwrite all-targets -createdir 1 |
||||
file exists [dict get $ws tgtdir] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -overwrite modes --- |
||||
# ========================================================================= |
||||
|
||||
test install_no_targets_only_copies_missing {no-targets copies only files missing at target}\ |
||||
-body { |
||||
set ws [make_workspace [list a.txt "aaa" b.txt "bbb"]] |
||||
# Pre-create a.txt at target with different content |
||||
set fd [open [file join [dict get $ws tgtdir] a.txt] w] |
||||
puts -nonewline $fd "OLD_CONTENT" |
||||
close $fd |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir] -overwrite no-targets] |
||||
set copied_basenames [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend copied_basenames [file tail $f] |
||||
} |
||||
return $copied_basenames |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {b.txt} |
||||
|
||||
test install_all_targets_overwrites_existing {all-targets overwrites existing files}\ |
||||
-body { |
||||
set ws [make_workspace [list a.txt "new"]] |
||||
set fd [open [file join [dict get $ws tgtdir] a.txt] w] |
||||
puts -nonewline $fd "old" |
||||
close $fd |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir] -overwrite all-targets] |
||||
set fd [open [file join [dict get $ws tgtdir] a.txt] r] |
||||
set content [read -nonewline $fd] |
||||
close $fd |
||||
return $content |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {new} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -exclude-filetails --- |
||||
# ========================================================================= |
||||
|
||||
test install_exclude_filetails {Excluded file tails are not copied}\ |
||||
-body { |
||||
set ws [make_workspace [list keep.txt "k" skip.bad "x"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-filetails [list "*.bad"]] |
||||
set copied_basenames [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend copied_basenames [file tail $f] |
||||
} |
||||
return $copied_basenames |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -exclude-dirsegments --- |
||||
# ========================================================================= |
||||
|
||||
test install_exclude_dirsegments {Excluded dir segments are not descended into}\ |
||||
-body { |
||||
set ws [make_workspace [list keep.txt "k" _aside/secret.txt "s"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-dirsegments [list "_aside"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return $all_copied |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -antiglob_paths --- |
||||
# ========================================================================= |
||||
|
||||
test install_antiglob_paths {antiglob_paths excludes matching relative paths}\ |
||||
-body { |
||||
set ws [make_workspace [list keep.txt "k" blocked/secret.txt "s"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-antiglob_paths [list "blocked/**"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return $all_copied |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt} |
||||
|
||||
# ------------------------------------------------------------------------- |
||||
# Additional characterization tests to lock behaviour before merge of |
||||
# -exclude-dirsegments + -antiglob_paths into unified -exclude-paths. |
||||
# These tests verify: nested dir-seg match, _core defaults applied by |
||||
# default, _core override REPLACES (not appends), antiglob top-level |
||||
# filename, antiglob deep **/FILE, and combined mechanism. |
||||
# ------------------------------------------------------------------------- |
||||
|
||||
test install_exclude_dirsegments_nested {dir-seg exclusion applies at any directory level, not just top}\ |
||||
-body { |
||||
set ws [make_workspace [list keep.txt "k" parent/_aside/secret.txt "s" parent/keep2.txt "k2"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-dirsegments [list "_aside"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt parent/keep2.txt} |
||||
|
||||
test install_exclude_dirsegments_core_default_applied {default _core excludes _build and .git at any level}\ |
||||
-body { |
||||
# Without explicit -exclude-dirsegments_core, default core {#* _aside _build .git .fossil*} is applied |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
_build/intermediate.txt "i"\ |
||||
parent/_build/deep.txt "d"\ |
||||
.git/config "c"\ |
||||
keep2.txt "k2"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-dirsegments [list]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt keep2.txt} |
||||
|
||||
test install_exclude_dirsegments_core_override_replaces {passing -exclude-dirsegments_core REPLACES the defaults, not appends}\ |
||||
-body { |
||||
# Override core with {#* _aside .git} - removes .fossil* AND _build exclusion |
||||
# so .fossil-custom IS copied, _build IS copied, .git IS still excluded |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
_build/intermediate.txt "i"\ |
||||
.fossil-custom/menu "m"\ |
||||
.git/config "c"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-dirsegments_core [list "#*" "_aside" ".git"]\ |
||||
-exclude-dirsegments [list]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {.fossil-custom/menu _build/intermediate.txt keep.txt} |
||||
|
||||
test install_antiglob_paths_toplevel_filename {antiglob_paths with a bare filename excludes top-level file}\ |
||||
-body { |
||||
# bare filename (no path separators) - used by src/make.tcl call sites |
||||
set ws [make_workspace [list keep.txt "k" README.md "r" other.txt "o"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-antiglob_paths [list "README.md"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt other.txt} |
||||
|
||||
test install_antiglob_paths_deep_doublestar {antiglob_paths **/FILE matches nested files but NOT top-level (no leading slash)}\ |
||||
-body { |
||||
# **/AGENTS.md only matches nested AGENTS.md (those with a parent path segment) |
||||
# Top-level AGENTS.md requires the bare 'AGENTS.md' pattern to be excluded too. |
||||
# This is the actual globmatchpath semantics - confirmed by make.tcl using both forms. |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
AGENTS.md "a1"\ |
||||
sub/AGENTS.md "a2"\ |
||||
sub/deep/AGENTS.md "a3"\ |
||||
sub/deep/keep2.txt "k2"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-antiglob_paths [list "**/AGENTS.md"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {AGENTS.md keep.txt sub/deep/keep2.txt} |
||||
|
||||
test install_antiglob_paths_toplevel_and_deep {combining bare filename AND **/FILE excludes all occurrences}\ |
||||
-body { |
||||
# {AGENTS.md **/AGENTS.md} - covers both top-level and nested |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
AGENTS.md "a1"\ |
||||
sub/AGENTS.md "a2"\ |
||||
sub/deep/AGENTS.md "a3"\ |
||||
sub/deep/keep2.txt "k2"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-antiglob_paths [list "AGENTS.md" "**/AGENTS.md"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt sub/deep/keep2.txt} |
||||
|
||||
test install_antiglob_paths_dir_skip {antiglob_paths with pattern matching a directory path skips that dir's recursion}\ |
||||
-body { |
||||
# **/_aside excludes _aside at any level as a directory (skip recursion) |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
_aside/secret.txt "s1"\ |
||||
parent/_aside/secret2.txt "s2"\ |
||||
parent/keep3.txt "k3"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-antiglob_paths [list "**/_aside" "_aside"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt parent/keep3.txt} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -exclude-paths (unified mechanism) --- |
||||
# These tests verify the new -exclude-paths flag directly. |
||||
# The legacy flags above (-exclude-dirsegments, -antiglob_paths) are |
||||
# converted internally to -exclude-paths and must produce the same results. |
||||
# ========================================================================= |
||||
|
||||
test install_exclude_paths_basic {exclude-paths with simple top-level file pattern excludes that file}\ |
||||
-body { |
||||
set ws [make_workspace [list keep.txt "k" skip.me "s" other.txt "o"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-paths [list "skip.me"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt other.txt} |
||||
|
||||
test install_exclude_paths_dir_skip {exclude-paths with **/dir pattern skips that dir at any level}\ |
||||
-body { |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
_aside/secret.txt "s1"\ |
||||
parent/_aside/secret2.txt "s2"\ |
||||
parent/keep3.txt "k3"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-paths [list "**/_aside" "_aside"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt parent/keep3.txt} |
||||
|
||||
test install_exclude_paths_deep_doublestar {exclude-paths **/FILE matches nested files but not top-level}\ |
||||
-body { |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
AGENTS.md "a1"\ |
||||
sub/AGENTS.md "a2"\ |
||||
sub/deep/AGENTS.md "a3"\ |
||||
sub/deep/keep2.txt "k2"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-paths [list "**/AGENTS.md"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {AGENTS.md keep.txt sub/deep/keep2.txt} |
||||
|
||||
test install_exclude_paths_combined {exclude-paths with both bare and **/ forms excludes all occurrences}\ |
||||
-body { |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
AGENTS.md "a1"\ |
||||
sub/AGENTS.md "a2"\ |
||||
sub/deep/AGENTS.md "a3"\ |
||||
sub/deep/keep2.txt "k2"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-paths [list "AGENTS.md" "**/AGENTS.md"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {keep.txt sub/deep/keep2.txt} |
||||
|
||||
test install_exclude_paths_core_override {exclude-paths_core override REPLACES default core}\ |
||||
-body { |
||||
# Override core with only #* and _aside forms - removes .git and .fossil* exclusion |
||||
set ws [make_workspace [list\ |
||||
keep.txt "k"\ |
||||
_aside/secret.txt "s"\ |
||||
.git/config "c"\ |
||||
.fossil-custom/menu "m"]] |
||||
|
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-exclude-paths_core [list "#*" "**/#*" "_aside" "**/_aside"]] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {.fossil-custom/menu .git/config keep.txt} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: hyphenated flag names (Phase 5 rename) --- |
||||
# These tests verify that the new hyphenated flag names work directly. |
||||
# The old underscore forms are still accepted via backward-compat aliases. |
||||
# ========================================================================= |
||||
|
||||
test install_max_depth_hyphenated {-max-depth (hyphenated) limits recursion depth}\ |
||||
-body { |
||||
set ws [make_workspace [list top.txt "t" sub/deep.txt "d"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-max-depth 0] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {top.txt} |
||||
|
||||
test install_punkcheck_folder_hyphenated {-punkcheck-folder (hyphenated) places .punkcheck in target}\ |
||||
-body { |
||||
set ws [make_workspace [list keep.txt "k"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-punkcheck-folder target] |
||||
set punkcheck_exists [file exists [file join [dict get $ws tgtdir] .punkcheck]] |
||||
return $punkcheck_exists |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test install_source_checksum_hyphenated {-source-checksum (hyphenated) stores checksums}\ |
||||
-body { |
||||
set ws [make_workspace [list keep.txt "k"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-source-checksum comparestore] |
||||
set has_punkcheck [file exists [file join [dict get $ws tgtdir] .punkcheck]] |
||||
return $has_punkcheck |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -glob --- |
||||
# ========================================================================= |
||||
|
||||
test install_glob_pattern {Only files matching glob are copied}\ |
||||
-body { |
||||
set ws [make_workspace [list a.tm "a" b.txt "b"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-glob "*.tm"] |
||||
set copied_basenames [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend copied_basenames [file tail $f] |
||||
} |
||||
return $copied_basenames |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {a.tm} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -max_depth --- |
||||
# ========================================================================= |
||||
|
||||
test install_max_depth_limits_recursion {max_depth 0 limits to top-level only}\ |
||||
-body { |
||||
set ws [make_workspace [list top.txt "t" sub/deep.txt "d"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-max_depth 0] |
||||
set copied_basenames [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend copied_basenames [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return $copied_basenames |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {top.txt} |
||||
|
||||
test install_max_depth_1_allows_one_level {max_depth 1 allows one level of recursion}\ |
||||
-body { |
||||
set ws [make_workspace [list top.txt "t" sub/deep.txt "d"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1\ |
||||
-max_depth 1] |
||||
set all_copied [list] |
||||
foreach f [dict get $resultdict files_copied] { |
||||
lappend all_copied [string map [list [dict get $ws srcdir]/ ""] $f] |
||||
} |
||||
return [lsort $all_copied] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {sub/deep.txt top.txt} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -createempty --- |
||||
# ========================================================================= |
||||
|
||||
test install_createempty_creates_empty_dirs {createempty creates target dirs with no matching files}\ |
||||
-body { |
||||
set ws [make_workspace [list sub/empty.txt "e"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1 -createempty 1] |
||||
set empty_dir [file join [dict get $ws tgtdir] sub] |
||||
return [file isdirectory $empty_dir] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: resultdict shape --- |
||||
# ========================================================================= |
||||
|
||||
test install_resultdict_keys {resultdict has expected keys}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1] |
||||
set keys [lsort [dict keys $resultdict]] |
||||
return $keys |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {antiglob_paths_matched files_copied files_skipped punkcheck_folder punkcheck_records sources_unchanged srcdir tgtdir} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::summarize_install_resultdict --- |
||||
# ========================================================================= |
||||
|
||||
test summarize_basic {summarize returns a non-empty string for a resultdict with copies}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1] |
||||
set summary [punkcheck::summarize_install_resultdict $resultdict] |
||||
return [expr {[string length $summary] > 0}] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test summarize_with_title {summarize includes the title line when -title is set}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1] |
||||
set summary [punkcheck::summarize_install_resultdict -title "MY TITLE" $resultdict] |
||||
return [regexp {MY TITLE} $summary] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test summarize_no_copies {summarize handles resultdict with zero copied files}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
set resultdict [punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite no-targets] |
||||
set summary [punkcheck::summarize_install_resultdict $resultdict] |
||||
return [expr {[string length $summary] > 0}] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test summarize_empty_resultdict {summarize returns non-empty string even when no files copied}\ |
||||
-body { |
||||
set rd [dict create files_copied [list] files_skipped [list] sources_unchanged [list] antiglob_paths_matched [list] punkcheck_records [list] punkcheck_folder [pwd] srcdir [pwd] tgtdir [pwd]] |
||||
set summary [punkcheck::summarize_install_resultdict $rd] |
||||
return [regexp {Copied 0 files} $summary] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test summarize_unknown_option {summarize raises error on unknown option}\ |
||||
-body { |
||||
punkcheck::summarize_install_resultdict -bogus 1 [dict create files_copied [list] files_skipped [list] sources_unchanged [list] antiglob_paths_matched [list] punkcheck_records [list] punkcheck_folder [pwd] srcdir [pwd] tgtdir [pwd]] |
||||
}\ |
||||
-returnCodes error\ |
||||
-match glob\ |
||||
-result {*} |
||||
|
||||
# ========================================================================= |
||||
# --- punkcheck::install: -punkcheck_folder --- |
||||
# ========================================================================= |
||||
|
||||
test install_punkcheck_folder_target {punkcheck_folder=target places .punkcheck in tgtdir}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1 -punkcheck_folder target |
||||
file exists [file join [dict get $ws tgtdir] .punkcheck] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test install_punkcheck_folder_source {punkcheck_folder=source places .punkcheck in srcdir}\ |
||||
-body { |
||||
set ws [make_workspace [list foo.txt "hello"]] |
||||
punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir]\ |
||||
-overwrite all-targets -createdir 1 -punkcheck_folder source |
||||
file exists [file join [dict get $ws srcdir] .punkcheck] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
@ -0,0 +1,613 @@
|
||||
# -*- tcl -*- |
||||
# Characterization tests for punkcheck::installtrack object model API |
||||
# These tests lock down the installtrack/installevent OO interface before any refactoring. |
||||
# The installtrack class is used directly by punk::mix::cli and punk::mix::commandset modules. |
||||
# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths modules/punkcheck/** installtrack.test |
||||
|
||||
package require tcltest |
||||
package require punkcheck |
||||
package require punk::lib |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
# ------------------------------------------------------------------------- |
||||
# Helper: create a temp workspace with a .punkcheck folder context |
||||
# Returns a dict with keys: root punkcheck_file srcdir tgtdir |
||||
# ------------------------------------------------------------------------- |
||||
proc make_workspace {} { |
||||
set root [punk::lib::tempdir_newfolder -prefix pktracktest] |
||||
set punkcheck_file [file join $root .punkcheck] |
||||
set srcdir [file join $root src] |
||||
set tgtdir [file join $root tgt] |
||||
file mkdir $srcdir $tgtdir |
||||
return [dict create root $root punkcheck_file $punkcheck_file srcdir $srcdir tgtdir $tgtdir] |
||||
} |
||||
|
||||
# ------------------------------------------------------------------------- |
||||
# Helper: create a source file inside punkcheck_folder (root) and return abs path |
||||
# ------------------------------------------------------------------------- |
||||
proc make_source_file {root relpath content} { |
||||
set fpath [file join $root $relpath] |
||||
file mkdir [file dirname $fpath] |
||||
set fd [open $fpath w] |
||||
try { puts -nonewline $fd $content } finally { close $fd } |
||||
return $fpath |
||||
} |
||||
|
||||
# ------------------------------------------------------------------------- |
||||
# Helper: run a full VIRTUAL targetset lifecycle to seed a prior completed |
||||
# VIRTUAL-RECORD, so subsequent targetset_source_changes calls compare |
||||
# against it. Uses the same installer name "test" and same target name as |
||||
# the subsequent test code, so the FILEINFO record matches. |
||||
# ------------------------------------------------------------------------- |
||||
proc seed_virtual_record {punkcheck_file srcdir tgtdir target_name source_abspath} { |
||||
set installer [punkcheck::installtrack new "test" $punkcheck_file] |
||||
$installer set_source_target $srcdir $tgtdir |
||||
set event [$installer start_event {-install_step seed}] |
||||
$event targetset_init VIRTUAL $target_name |
||||
$event targetset_addsource $source_abspath |
||||
$event targetset_started |
||||
$event targetset_end OK |
||||
$event end |
||||
$installer destroy |
||||
} |
||||
|
||||
# ========================================================================= |
||||
# --- installtrack: constructor and basic accessors --- |
||||
# ========================================================================= |
||||
|
||||
test installtrack_construct {Constructor creates an installtrack object}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test-installer" [dict get $ws punkcheck_file]] |
||||
set is_object [expr {[info commands $installer] ne ""}] |
||||
$installer destroy |
||||
return $is_object |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installtrack_get_name {get_name returns installer name passed to constructor}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "my-installer" [dict get $ws punkcheck_file]] |
||||
set name [$installer get_name] |
||||
$installer destroy |
||||
return $name |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {my-installer} |
||||
|
||||
test installtrack_get_checkfile {get_checkfile returns punkcheck file path}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
set checkfile [$installer get_checkfile] |
||||
$installer destroy |
||||
return [string map [list [dict get $ws root] ""] $checkfile] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {/.punkcheck} |
||||
|
||||
test installtrack_get_debugchannel_default {get_debugchannel returns empty string by default}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
set debugchannel [$installer get_debugchannel] |
||||
$installer destroy |
||||
return $debugchannel |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {} |
||||
|
||||
# ========================================================================= |
||||
# --- installtrack: set_source_target --- |
||||
# ========================================================================= |
||||
|
||||
test installtrack_set_source_target {set_source_target stores source and target for events}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
set record [$event as_record] |
||||
$installer destroy |
||||
# The event record should contain -source key |
||||
return [dict exists $record -source] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- installtrack: start_event and installevent object --- |
||||
# ========================================================================= |
||||
|
||||
test installtrack_start_event_returns_event {start_event returns an installevent object}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
set is_object [expr {[info commands $event] ne ""}] |
||||
$installer destroy |
||||
return $is_object |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installevent_get_id {event get_id returns a non-empty UUID}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
set event_id [$event get_id] |
||||
$installer destroy |
||||
return [expr {[string length $event_id] > 0}] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installevent_as_record {event as_record returns a dict with tag EVENT}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
set record [$event as_record] |
||||
$installer destroy |
||||
return [dict get $record tag] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {EVENT} |
||||
|
||||
test installevent_as_record_keys {event as_record has expected keys}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
set record [$event as_record] |
||||
$installer destroy |
||||
set keys [lsort [dict keys $record]] |
||||
return $keys |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {-config -id -source -targets -ts_begin -ts_end -tsiso_begin -tsiso_end -types tag} |
||||
|
||||
# ========================================================================= |
||||
# --- installtrack: events list and get_event --- |
||||
# ========================================================================= |
||||
|
||||
test installtrack_events_list {events returns event collection after start_event}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
# events method uses tailcall to delegate to oolib::collection |
||||
set count [$installer events count] |
||||
$installer destroy |
||||
return $count |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installtrack_get_event {get_event retrieves the current event object}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
set retrieved [$installer get_event] |
||||
set same [expr {[$event get_id] eq [$retrieved get_id]}] |
||||
$installer destroy |
||||
return $same |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- installtrack: end_event and cleanup --- |
||||
# ========================================================================= |
||||
|
||||
test installtrack_end_event {end_event does not error after start_event}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$installer end_event |
||||
$installer destroy |
||||
return 1 |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installtrack_destroy {destroy cleans up object without error}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer destroy |
||||
return [expr {![info exists installer] || [info commands $installer] eq ""}] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- installtrack: save_all_records persists .punkcheck file --- |
||||
# ========================================================================= |
||||
|
||||
test installtrack_save_all_records {save_all_records creates .punkcheck file on disk}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$installer save_all_records |
||||
set exists [file exists [dict get $ws punkcheck_file]] |
||||
$installer destroy |
||||
return $exists |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- installevent: targetset lifecycle --- |
||||
# ========================================================================= |
||||
|
||||
test installevent_targetset_init {targetset_init accepts operation and targetset name}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init install "myfile.txt" |
||||
$installer destroy |
||||
return 1 |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installevent_targetset_started {targetset_started runs without error after init}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init install "myfile.txt" |
||||
$event targetset_started |
||||
$installer destroy |
||||
return 1 |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installevent_targetset_end {targetset_end accepts status argument}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init install "myfile.txt" |
||||
$event targetset_started |
||||
$event targetset_end ok |
||||
$installer destroy |
||||
return 1 |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test installevent_end {event end finalizes without error}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init install "myfile.txt" |
||||
$event targetset_started |
||||
$event targetset_end ok |
||||
$event end |
||||
$installer destroy |
||||
return 1 |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- installtrack: full lifecycle matching punk::mix::cli usage --- |
||||
# ========================================================================= |
||||
|
||||
test installtrack_full_lifecycle {Full lifecycle matching punk::mix::cli usage pattern}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set installer [punkcheck::installtrack new "project.new" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step teststep}] |
||||
set event_id [$event get_id] |
||||
$event targetset_init install "targetfile.txt" |
||||
$event targetset_started |
||||
$event targetset_end ok |
||||
$event end |
||||
$installer end_event |
||||
$installer save_all_records |
||||
set file_exists [file exists [dict get $ws punkcheck_file]] |
||||
$installer destroy |
||||
return [expr {$file_exists && [string length $event_id] > 0}] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
# ========================================================================= |
||||
# --- installevent: targetset_source_changes --- |
||||
# Used by punk::mix::cli and punk::mix::commandset to decide whether a |
||||
# rebuild is needed: source changed => rebuild. |
||||
# Return shape is {dict create changed <list> unchanged <list>}. |
||||
# A source is "changed" if it has no prior completed record to compare |
||||
# against, or its cksum/type/size differs from the prior record. |
||||
# ========================================================================= |
||||
|
||||
test targetset_source_changes_no_prior_record {First call with no prior completed record reports source as changed}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "content1"] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL "vtarg1" |
||||
$event targetset_addsource $src_abspath |
||||
set result [$event targetset_source_changes] |
||||
$event end |
||||
$installer destroy |
||||
return [list [llength [dict get $result changed]] [llength [dict get $result unchanged]]] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {1 0} |
||||
|
||||
test targetset_source_changes_after_record_unchanged {Re-adding same source after VIRTUAL-RECORD reports unchanged}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "content1"] |
||||
seed_virtual_record [dict get $ws punkcheck_file] [dict get $ws srcdir] [dict get $ws tgtdir] "vtarg1" $src_abspath |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL "vtarg1" |
||||
$event targetset_addsource $src_abspath |
||||
set result [$event targetset_source_changes] |
||||
$event end |
||||
$installer destroy |
||||
return [list [llength [dict get $result changed]] [llength [dict get $result unchanged]]] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {0 1} |
||||
|
||||
test targetset_source_changes_after_modified_source {Modifying source content reports changed}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "original"] |
||||
seed_virtual_record [dict get $ws punkcheck_file] [dict get $ws srcdir] [dict get $ws tgtdir] "vtarg1" $src_abspath |
||||
# modify source content (different size/cksum) |
||||
set fd [open $src_abspath w]; puts -nonewline $fd "modified-content"; close $fd |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL "vtarg1" |
||||
$event targetset_addsource $src_abspath |
||||
set result [$event targetset_source_changes] |
||||
$event end |
||||
$installer destroy |
||||
return [list [llength [dict get $result changed]] [llength [dict get $result unchanged]]] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {1 0} |
||||
|
||||
test targetset_source_changes_dict_keys {Return dict contains changed and unchanged keys}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "x"] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL "vtarg1" |
||||
$event targetset_addsource $src_abspath |
||||
set result [$event targetset_source_changes] |
||||
$event end |
||||
$installer destroy |
||||
return [lsort [dict keys $result]] |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {changed unchanged} |
||||
|
||||
# ========================================================================= |
||||
# --- installevent: get_targets and get_targets_exist --- |
||||
# Used together with targetset_source_changes in the rebuild-decision: |
||||
# rebuild = (any changed) OR (existing targets < total targets) |
||||
# ========================================================================= |
||||
|
||||
test installevent_get_targets {get_targets returns sorted targetlist passed to targetset_init}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "x"] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL [list "t2.txt" "t1.txt"] |
||||
set targets [$event get_targets] |
||||
$event end |
||||
$installer destroy |
||||
return $targets |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {t1.txt t2.txt} |
||||
|
||||
test installevent_get_targets_exist_none {get_targets_exist returns empty when no targets exist on disk}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL [list "missing1.txt"] |
||||
set existing [$event get_targets_exist] |
||||
$event end |
||||
$installer destroy |
||||
return $existing |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {} |
||||
|
||||
test installevent_get_targets_exist_partial {get_targets_exist returns only existing targets}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
# create one of the two targets at $root (which is the punkcheck_folder) |
||||
set fd [open [file join $root "exists.txt"] w]; close $fd |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL [list "missing.txt" "exists.txt"] |
||||
set existing [$event get_targets_exist] |
||||
$event end |
||||
$installer destroy |
||||
return $existing |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result {exists.txt} |
||||
|
||||
# ========================================================================= |
||||
# --- installevent: combined rebuild-decision matching punk::mix::cli --- |
||||
# ========================================================================= |
||||
|
||||
test targetset_combined_rebuild_changed_source {cli-style: changed source => rebuild needed}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "x"] |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL "vtarg1" |
||||
$event targetset_addsource $src_abspath |
||||
set needs_rebuild [expr { |
||||
[llength [dict get [$event targetset_source_changes] changed]] |
||||
|| [llength [$event get_targets_exist]] < [llength [$event get_targets]] |
||||
}] |
||||
$event end |
||||
$installer destroy |
||||
return $needs_rebuild |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test targetset_combined_rebuild_missing_target {cli-style: unchanged source but missing target => rebuild needed}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "x"] |
||||
seed_virtual_record [dict get $ws punkcheck_file] [dict get $ws srcdir] [dict get $ws tgtdir] "vtarg1" $src_abspath |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL "vtarg1" |
||||
$event targetset_addsource $src_abspath |
||||
set needs_rebuild [expr { |
||||
[llength [dict get [$event targetset_source_changes] changed]] |
||||
|| [llength [$event get_targets_exist]] < [llength [$event get_targets]] |
||||
}] |
||||
$event end |
||||
$installer destroy |
||||
return $needs_rebuild |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 1 |
||||
|
||||
test targetset_combined_no_rebuild {cli-style: unchanged source + existing target => no rebuild}\ |
||||
-body { |
||||
set ws [make_workspace] |
||||
set root [dict get $ws root] |
||||
set src_abspath [make_source_file $root "src1.txt" "x"] |
||||
seed_virtual_record [dict get $ws punkcheck_file] [dict get $ws srcdir] [dict get $ws tgtdir] "vtarg1" $src_abspath |
||||
# create the target file (same name as targetset) so get_targets_exist returns it |
||||
set fd [open [file join $root "vtarg1"] w]; close $fd |
||||
set installer [punkcheck::installtrack new "test" [dict get $ws punkcheck_file]] |
||||
$installer set_source_target [dict get $ws srcdir] [dict get $ws tgtdir] |
||||
set event [$installer start_event {-install_step test}] |
||||
$event targetset_init VIRTUAL "vtarg1" |
||||
$event targetset_addsource $src_abspath |
||||
set needs_rebuild [expr { |
||||
[llength [dict get [$event targetset_source_changes] changed]] |
||||
|| [llength [$event get_targets_exist]] < [llength [$event get_targets]] |
||||
}] |
||||
$event end |
||||
$installer destroy |
||||
return $needs_rebuild |
||||
}\ |
||||
-cleanup { |
||||
file delete -force [dict get $ws root] |
||||
}\ |
||||
-result 0 |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
@ -1,518 +0,0 @@
|
||||
|
||||
|
||||
#JMN 2021 - Public Domain |
||||
#cooperative command renaming |
||||
# |
||||
# REVIEW 2024 - code was originally for specific use in packageTrace |
||||
# - code should be reviewed for more generic utility. |
||||
# - API is obscure and undocumented. |
||||
# - unclear if intention was only for builtins |
||||
# - consider use of newer 'info cmdtype' - (but need also support for safe interps) |
||||
# - oo dispatch features may be a better implementation - especially for allowing undoing command renames in the middle of a stack. |
||||
# - document that replacement command should use 'commandstack::get_next_command <cmd> <renamer>' for delegating to command as it was prior to rename |
||||
#changes: |
||||
#2024 |
||||
# - mungecommand to support namespaced commands |
||||
# - fix mistake - hardcoded _originalcommand_package -> _originalcommand_<mungedcommand> |
||||
#2021-09-18 |
||||
# - initial version |
||||
# - e.g Support cooperation between packageSuppress and packageTrace which both rename the package command |
||||
# - They need to be able to load and unload in any order. |
||||
# |
||||
|
||||
#strive for no other package dependencies here. |
||||
|
||||
|
||||
namespace eval commandstack { |
||||
variable all_stacks |
||||
variable debug |
||||
set debug 0 |
||||
variable known_renamers [list ::packagetrace ::packageSuppress] |
||||
if {![info exists all_stacks]} { |
||||
#don't wipe it |
||||
set all_stacks [dict create] |
||||
} |
||||
} |
||||
|
||||
namespace eval commandstack::util { |
||||
#note - we can't use something like md5 to ID proc body text because we don't want to require additional packages. |
||||
#We could store the full text of the body to compare - but we need to identify magic strings from cooperating packages such as packageTrace |
||||
#A magic comment was chosen as the identifying method. |
||||
#The string IMPLEMENTOR_*! is searched for where the text between _ and ! is the name of the package that implemented the proc. |
||||
|
||||
#return unspecified if the command is a proc with a body but no magic comment ID |
||||
#return unknown if the command doesn't have a proc body to analyze |
||||
#otherwise return the package name identified in the magic comment |
||||
proc get_IMPLEMENTOR {command} { |
||||
#assert - command has already been resolved to a namespace ie fully qualified |
||||
if {[llength [info procs $command]]} { |
||||
#look for *IMPLEMENTOR_*! |
||||
set prefix IMPLEMENTOR_ |
||||
set suffix "!" |
||||
set body [uplevel 1 [list info body $command]] |
||||
if {[string match "*$prefix*$suffix*" $body]} { |
||||
set prefixposn [string first "$prefix" $body] |
||||
set pkgposn [expr {$prefixposn + [string length $prefix]}] |
||||
#set suffixposn [string first $suffix [string range $body $pkgposn $pkgposn+60]] |
||||
set suffixposn [string first $suffix $body $pkgposn] |
||||
return [string range $body $pkgposn $suffixposn-1] |
||||
} else { |
||||
return unspecified |
||||
} |
||||
} else { |
||||
if {[info commands tcl::info::cmdtype] ne ""} { |
||||
#tcl9 and maybe some tcl 8.7s ? |
||||
switch -- [tcl::info::cmdtype $command] { |
||||
native { |
||||
return builtin |
||||
} |
||||
default { |
||||
return undetermined |
||||
} |
||||
} |
||||
} else { |
||||
return undetermined |
||||
} |
||||
} |
||||
} |
||||
} |
||||
namespace eval commandstack::renamed_commands {} |
||||
namespace eval commandstack::temp {} ;#where we create proc initially before renaming into place |
||||
|
||||
namespace eval commandstack { |
||||
namespace export {[a-z]*} |
||||
proc help {} { |
||||
return { |
||||
|
||||
} |
||||
} |
||||
|
||||
proc debug {{on_off {}}} { |
||||
variable debug |
||||
if {$on_off eq ""} { |
||||
return $debug |
||||
} else { |
||||
if {[string is boolean -strict $debug]} { |
||||
set debug [expr {$on_off && 1}] |
||||
return $debug |
||||
} |
||||
} |
||||
} |
||||
|
||||
proc get_stack {{command ""}} { |
||||
variable all_stacks |
||||
if {$command eq ""} { |
||||
return $all_stacks |
||||
} |
||||
set command [uplevel 1 [list namespace which $command]] |
||||
if {[dict exists $all_stacks $command]} { |
||||
return [dict get $all_stacks $command] |
||||
} else { |
||||
return [list] |
||||
} |
||||
} |
||||
|
||||
#get the implementation to which the renamer (renamer is usually calling namespace) originally renamed it, or the implementation it now points to. |
||||
#review - performance impact. Possible to use oo for faster dispatch whilst allowing stack re-orgs? |
||||
#e.g if renaming builtin 'package' - this command is generally called 'a lot' |
||||
proc get_next_command {command renamer tokenid} { |
||||
variable all_stacks |
||||
if {[dict exists $all_stacks $command]} { |
||||
set stack [dict get $all_stacks $command] |
||||
#stack is a list of dicts, 1st entry is token {<cmd> <renamer> <tokenid>} |
||||
set posn [lsearch -index 1 $stack [list $command $renamer $tokenid]] |
||||
if {$posn > -1} { |
||||
set record [lindex $stack $posn] |
||||
return [dict get $record implementation] |
||||
} else { |
||||
error "(commandstack::get_next_command) ERROR: unable to determine next command for '$command' using token: $command $renamer $tokenid" |
||||
} |
||||
} else { |
||||
return $command |
||||
} |
||||
} |
||||
proc basecall {command args} { |
||||
variable all_stacks |
||||
set command [uplevel 1 [list namespace which $command]] |
||||
if {[dict exists $all_stacks $command]} { |
||||
set stack [dict get $all_stacks $command] |
||||
if {[llength $stack]} { |
||||
set rec1 [lindex $stack 0] |
||||
tailcall [dict get $rec1 implementation] {*}$args |
||||
} else { |
||||
tailcall $command {*}$args |
||||
} |
||||
} else { |
||||
tailcall $command {*}$args |
||||
} |
||||
} |
||||
|
||||
|
||||
#review. |
||||
#<renamer> defaults to calling namespace - but can be arbitrary string |
||||
proc rename_command {args} { |
||||
#todo: consider -forcebase 1 or similar to allow this rename to point to bottom of stack (original command) bypassing existing renames |
||||
# - need to consider that upon removing, that any remaining rename that was higher on the stack should not also be diverted to the base - but rather to the next lower in the stack |
||||
# |
||||
if {[lindex $args 0] eq "-renamer"} { |
||||
set renamer [lindex $args 1] |
||||
set arglist [lrange $args 2 end] |
||||
} else { |
||||
set renamer "" |
||||
set arglist $args |
||||
} |
||||
if {[llength $arglist] != 3} { |
||||
error "commandstack::rename_command usage: rename_command ?-renamer <string>? command procargs procbody" |
||||
} |
||||
lassign $arglist command procargs procbody |
||||
|
||||
set command [uplevel 1 [list namespace which $command]] |
||||
set mungedcommand [string map {:: _ns_} $command] |
||||
set mungedrenamer [string map {:: _ns_} $renamer] |
||||
variable all_stacks |
||||
variable known_renamers |
||||
variable renamer_command_tokens ;#monotonically increasing int per <mungedrenamer>::<mungedcommand> representing number of renames ever done. |
||||
if {$renamer eq ""} { |
||||
set renamer [uplevel 1 [list namespace current]] |
||||
} |
||||
if {$renamer ni $known_renamers} { |
||||
lappend known_renamers $renamer |
||||
dict set renamer_command_tokens [list $renamer $command] 0 |
||||
} |
||||
|
||||
#TODO - reduce emissions to stderr - flag for debug? |
||||
|
||||
#e.g packageTrace and packageSuppress packages use this convention. |
||||
set nextinfo [uplevel 1 [list\ |
||||
apply {{command renamer procbody} { |
||||
#todo - munge dash so we can make names in renamed_commands separable |
||||
# {- _dash_} ? |
||||
set mungedcommand [string map {:: _ns_} $command] |
||||
set mungedrenamer [string map {:: _ns_} $renamer] |
||||
set tokenid [lindex [dict incr renamer_command_tokens [list $renamer $command]] 1] |
||||
set next_target ::commandstack::renamed_commands::${mungedcommand}-original-$mungedrenamer-$tokenid ;#default is to assume we are the only one playing around with it, but we'll check for known associates too. |
||||
set do_rename 0 |
||||
if {[llength [info procs $command]] || [llength [info commands $next_target]]} { |
||||
#$command is not the standard builtin - something has replaced it, could be ourself. |
||||
set next_implementor [::commandstack::util::get_IMPLEMENTOR $command] |
||||
set munged_next_implementor [string map {:: _ns_} $next_implementor] |
||||
#if undetermined/unspecified it could be the latest renamer on the stack - but we can't know for sure something else didn't rename it. |
||||
if {[dict exists $::commandstack::all_stacks $command]} { |
||||
set comstacks [dict get $::commandstack::all_stacks $command] |
||||
} else { |
||||
set comstacks [list] |
||||
} |
||||
set this_renamer_previous_entries [lsearch -all -index 3 $comstacks $renamer] ;#index 3 is value for second dict entry - (value for key 'renamer') |
||||
if {[llength $this_renamer_previous_entries]} { |
||||
if {$next_implementor eq $renamer} { |
||||
#previous renamer was us. Rather than assume our job is done.. compare the implementations |
||||
#don't rename if immediate predecessor is same code. |
||||
#set topstack [lindex $comstacks end] |
||||
#set next_impl [dict get $topstack implementation] |
||||
set current_body [info body $command] |
||||
lassign [commandstack::lib::split_body $current_body] _ current_code |
||||
set current_code [string trim $current_code] |
||||
set new_code [string trim $procbody] |
||||
if {$current_code eq $new_code} { |
||||
puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command with same procbody - Aborting rename." |
||||
puts stderr [::commandstack::show_stack $command] |
||||
} else { |
||||
puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command - but appears to be with new code - proceeding." |
||||
puts stdout "----------" |
||||
puts stdout "$current_code" |
||||
puts stdout "----------" |
||||
puts stdout "$new_code" |
||||
puts stdout "----------" |
||||
set next_target ::commandstack::renamed_commands::${mungedcommand}-${munged_next_implementor}-$mungedrenamer-$tokenid |
||||
set do_rename 1 |
||||
} |
||||
} else { |
||||
puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command, but is not immediate predecessor - proceeding anyway... (untested)" |
||||
puts stderr |
||||
set next_target ::commandstack::renamed_commands::${mungedcommand}-${munged_next_implementor}-$mungedrenamer-$tokenid |
||||
set do_rename 1 |
||||
} |
||||
} elseif {$next_implementor in $::commandstack::known_renamers} { |
||||
set next_target ::commandstack::renamed_commands::${mungedcommand}-${munged_next_implementor}-$mungedrenamer-$tokenid |
||||
set do_rename 1 |
||||
} elseif {$next_implementor in {builtin}} { |
||||
#native/builtin could still have been renamed |
||||
set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid |
||||
set do_rename 1 |
||||
} elseif {$next_implementor in {unspecified undetermined}} { |
||||
#could be a standard tcl proc, or from application or package |
||||
set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid |
||||
set do_rename 1 |
||||
} else { |
||||
puts stderr "(commandstack::rename_command) Warning - pkg:'$next_implementor' has renamed the '$command' command. Attempting to cooperate. (untested)" |
||||
set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid |
||||
set do_rename 1 |
||||
} |
||||
} else { |
||||
#_originalcommand_<mungedcommand> |
||||
#assume builtin/original |
||||
set next_implementor original |
||||
#rename $command $next_target |
||||
set do_rename 1 |
||||
} |
||||
#There are of course other ways in which $command may have been renamed - but we can't detect. |
||||
set token [list $command $renamer $tokenid] |
||||
return [dict create next_target $next_target next_implementor $next_implementor token $token do_rename $do_rename] |
||||
} } $command $renamer $procbody] |
||||
] |
||||
|
||||
|
||||
variable debug |
||||
if {$debug} { |
||||
if {[dict exists $all_stacks $command]} { |
||||
set stack [dict get $all_stacks $command] |
||||
puts stderr "(commandstack::rename_command) Subsequent rename of command '$command'. (previous renames: [llength $stack]). Renaming to [dict get $nextinfo next_target]" |
||||
} else { |
||||
#assume this is the original |
||||
puts stderr "(commandstack::rename_command) 1st detected rename of command '$command'. Renaming to [dict get $nextinfo next_target]" |
||||
} |
||||
} |
||||
|
||||
#token is always first dict entry. (Value needs to be searched with lsearch -index 1 ) |
||||
#renamer is always second dict entry (Value needs to be searched with lsearch -index 3) |
||||
set new_record [dict create\ |
||||
token [dict get $nextinfo token]\ |
||||
renamer $renamer\ |
||||
next_implementor [dict get $nextinfo next_implementor]\ |
||||
next_getter [list ::commandstack::get_next_command {*}[dict get $nextinfo token]]\ |
||||
implementation [dict get $nextinfo next_target]\ |
||||
] |
||||
if {![dict get $nextinfo do_rename]} { |
||||
#review |
||||
puts stderr "no rename performed" |
||||
return [dict create implementation ""] |
||||
} |
||||
catch {rename ::commandstack::temp::testproc ""} |
||||
set nextinit [string map [list %command% $command %renamer% $renamer %next_getter% [dict get $new_record next_getter] %original_implementation% [dict get $new_record implementation]] { |
||||
#IMPLEMENTOR_%renamer%! (mechanism: 'commandstack::rename_command -renamer %renamer% %command% <procargs> <procbody> ) |
||||
set COMMANDSTACKNEXT_ORIGINAL %original_implementation% ;#informational/debug for overriding proc. |
||||
set COMMANDSTACKNEXT [%next_getter%] |
||||
#<commandstack_separator># |
||||
}] |
||||
set final_procbody "$nextinit$procbody" |
||||
#build the proc at a temp location so that if it raises an error we don't adjust the stack or replace the original command |
||||
#(e.g due to invalid argument specifiers) |
||||
proc ::commandstack::temp::testproc $procargs $final_procbody |
||||
uplevel 1 [list rename $command [dict get $nextinfo next_target]] |
||||
uplevel 1 [list rename ::commandstack::temp::testproc $command] |
||||
dict lappend all_stacks $command $new_record |
||||
|
||||
|
||||
return $new_record |
||||
} |
||||
|
||||
#todo - concept of 'pop' for renamer. Remove topmost entry specific to the renamer |
||||
#todo - removal by token to allow renamer to have multiple entries for one command but to remove one that is not the topmost |
||||
#todo - removal of all entries pertaining to a particular renamer |
||||
#todo - allow restore to bottom-most implementation (original) - regardless of what renamers have cooperated in the stack? |
||||
|
||||
#remove by token, or by commandname if called from same context as original rename_command |
||||
#If only a commandname is supplied, and there were multiple renames from the same context (same -renamer) only the topmost is removed. |
||||
#A call to remove_rename with no token or renamer, and from a namespace context which didn't perform a rename will not remove anything. |
||||
#similarly a nonexistant token or renamer will not remove anything and will just return the current stack |
||||
proc remove_rename {token_or_command} { |
||||
if {[llength $token_or_command] == 3} { |
||||
#is token |
||||
lassign $token_or_command command renamer tokenid |
||||
} elseif {[llength $token_or_command] == 2} { |
||||
#command and renamer only supplied |
||||
lassign $token_or_command command renamer |
||||
set tokenid "" |
||||
} elseif {[llength $token_or_command] == 1} { |
||||
#is command name only |
||||
set command $token_or_command |
||||
set renamer [uplevel 1 [list namespace current]] |
||||
set tokenid "" |
||||
} |
||||
set command [uplevel 1 [list namespace which $command]] |
||||
variable all_stacks |
||||
variable known_renamers |
||||
if {$renamer ni $known_renamers} { |
||||
error "(commandstack::remove_rename) ERROR: renamer $renamer not in list of known_renamers '$known_renamers' for command '$command'. Ensure remove_rename called from same context as rename_command was, or explicitly supply exact token or {<command> <renamer>}" |
||||
} |
||||
if {[dict exists $all_stacks $command]} { |
||||
set stack [dict get $all_stacks $command] |
||||
if {$tokenid ne ""} { |
||||
#token_or_command is a token as returned within the rename_command result dictionary |
||||
#search first dict value |
||||
set doomed_posn [lsearch -index 1 $stack $token_or_command] |
||||
} else { |
||||
#search second dict value |
||||
set matches [lsearch -all -index 3 $stack $renamer] |
||||
set doomed_posn [lindex $matches end] ;#we don't have a full token - pop last entry for this renamer |
||||
} |
||||
if {$doomed_posn ne "" && $doomed_posn > -1} { |
||||
set doomed_record [lindex $stack $doomed_posn] |
||||
if {[llength $stack] == ($doomed_posn + 1)} { |
||||
#last on stack - put the implemenation from the doomed_record back as the actual command |
||||
uplevel #0 [list rename $command ""] |
||||
uplevel #0 [list rename [dict get $doomed_record implementation] $command] |
||||
} elseif {[llength $stack] > ($doomed_posn + 1)} { |
||||
#there is at least one more record on the stack - rewrite it to point where the doomed_record pointed |
||||
set rewrite_posn [expr {$doomed_posn + 1}] |
||||
set rewrite_record [lindex $stack $rewrite_posn] |
||||
|
||||
if {[dict get $rewrite_record next_implementor] ne $renamer} { |
||||
puts stderr "(commandstack::remove_rename) WARNING: next record on the commandstack didn't record '$renamer' as the next_implementor - not deleting implementation [dict get $rewrite_record implementation]" |
||||
} else { |
||||
uplevel #0 [list rename [dict get $rewrite_record implementation] ""] |
||||
} |
||||
dict set rewrite_record next_implementor [dict get $doomed_record next_implementor] |
||||
#don't update next_getter - it always refers to self |
||||
dict set rewrite_record implementation [dict get $doomed_record implementation] |
||||
lset stack $rewrite_posn $rewrite_record |
||||
dict set all_stacks $command $stack |
||||
} |
||||
set stack [lreplace $stack $doomed_posn $doomed_posn] |
||||
dict set all_stacks $command $stack |
||||
|
||||
} |
||||
return $stack |
||||
} |
||||
return [list] |
||||
} |
||||
|
||||
proc show_stack {{commandname_glob *}} { |
||||
variable all_stacks |
||||
if {![regexp {[?*]} $commandname_glob]} { |
||||
#if caller is attempting exact match - use the calling context to resolve in case they didn't supply namespace |
||||
set commandname_glob [uplevel 1 [list namespace which $commandname_glob]] |
||||
} |
||||
if {[package provide punk::lib] ne "" && [package provide punk] ne ""} { |
||||
#punk pipeline also needed for patterns |
||||
return [punk::lib::pdict -channel none all_stacks $commandname_glob/@*/@*.@*] |
||||
} else { |
||||
set result "" |
||||
set matchedkeys [dict keys $all_stacks $commandname_glob] |
||||
#don't try to calculate widest on empty list |
||||
if {[llength $matchedkeys]} { |
||||
set widest [tcl::mathfunc::max {*}[lmap v $matchedkeys {tcl::string::length $v}]] |
||||
set indent [string repeat " " [expr {$widest + 3}]] |
||||
set indent2 "${indent} " ;#8 spaces for " i = " where i is 4 wide |
||||
set padkey [string repeat " " 20] |
||||
foreach k $matchedkeys { |
||||
append result "$k = " |
||||
set i 0 |
||||
foreach stackmember [dict get $all_stacks $k] { |
||||
if {$i > 0} { |
||||
append result "\n$indent" |
||||
} |
||||
append result [string range "$i " 0 4] " = " |
||||
set j 0 |
||||
dict for {k v} $stackmember { |
||||
if {$j > 0} { |
||||
append result "\n$indent2" |
||||
} |
||||
set displaykey [string range "$k$padkey" 0 20] |
||||
append result "$displaykey = $v" |
||||
incr j |
||||
} |
||||
incr i |
||||
} |
||||
append result \n |
||||
} |
||||
} |
||||
return $result |
||||
} |
||||
} |
||||
|
||||
#review |
||||
#document when this is to be called. Wiping stacks without undoing renames seems odd. |
||||
proc Delete_stack {command} { |
||||
variable all_stacks |
||||
if {[dict exists $all_stacks $command]} { |
||||
dict unset all_stacks $command |
||||
return 1 |
||||
} else { |
||||
return 1 |
||||
} |
||||
} |
||||
|
||||
#can be used to temporarily put a stack aside - should manually rename back when done. |
||||
#review - document how/when to use. example? intention? |
||||
proc Rename_stack {oldname newname} { |
||||
variable all_stacks |
||||
if {[dict exists $all_stacks $oldname]} { |
||||
if {[dict exists $all_stacks $newname]} { |
||||
error "(commandstack::rename_stack) cannot rename $oldname to $newname - $newname already exists in stack" |
||||
} else { |
||||
#set stackval [dict get $all_stacks $oldname] |
||||
#dict unset all_stacks $oldname |
||||
#dict set all_stacks $newname $stackval |
||||
dict set all_stacks $newname [lindex [list [dict get $all_stacks $oldname] [dict unset all_stacks $oldname]] 0] |
||||
} |
||||
} |
||||
} |
||||
} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
namespace eval commandstack::lib { |
||||
proc splitx {str {regexp {[\t \r\n]+}}} { |
||||
#snarfed from tcllib textutil::splitx to avoid the dependency |
||||
# Bugfix 476988 |
||||
if {[string length $str] == 0} { |
||||
return {} |
||||
} |
||||
if {[string length $regexp] == 0} { |
||||
return [::split $str ""] |
||||
} |
||||
if {[regexp $regexp {}]} { |
||||
return -code error "splitting on regexp \"$regexp\" would cause infinite loop" |
||||
} |
||||
|
||||
set list {} |
||||
set start 0 |
||||
while {[regexp -start $start -indices -- $regexp $str match submatch]} { |
||||
foreach {subStart subEnd} $submatch break |
||||
foreach {matchStart matchEnd} $match break |
||||
incr matchStart -1 |
||||
incr matchEnd |
||||
lappend list [string range $str $start $matchStart] |
||||
if {$subStart >= $start} { |
||||
lappend list [string range $str $subStart $subEnd] |
||||
} |
||||
set start $matchEnd |
||||
} |
||||
lappend list [string range $str $start end] |
||||
return $list |
||||
} |
||||
proc split_body {procbody} { |
||||
set marker "#<commandstack_separator>#" |
||||
set header "" |
||||
set code "" |
||||
set found_marker 0 |
||||
foreach ln [split $procbody \n] { |
||||
if {!$found_marker} { |
||||
if {[string trim $ln] eq $marker} { |
||||
set found_marker 1 |
||||
} else { |
||||
append header $ln \n |
||||
} |
||||
} else { |
||||
append code $ln \n |
||||
} |
||||
} |
||||
if {$found_marker} { |
||||
return [list $header $code] |
||||
} else { |
||||
return [list "" $procbody] |
||||
} |
||||
} |
||||
} |
||||
|
||||
package provide commandstack [namespace eval commandstack { |
||||
set version 0.3 |
||||
}] |
||||
|
||||
|
||||
@ -1,201 +0,0 @@
|
||||
#JMN - api should be kept in sync with package patternlib where possible |
||||
# |
||||
package provide oolib [namespace eval oolib { |
||||
variable version |
||||
set version 0.1.2 |
||||
}] |
||||
|
||||
namespace eval oolib { |
||||
oo::class create collection { |
||||
variable o_data ;#dict |
||||
#variable o_alias |
||||
constructor {} { |
||||
set o_data [dict create] |
||||
} |
||||
method info {} { |
||||
return [dict info $o_data] |
||||
} |
||||
method count {} { |
||||
return [dict size $o_data] |
||||
} |
||||
method isEmpty {} { |
||||
expr {[dict size $o_data] == 0} |
||||
} |
||||
method names {{globOrIdx {}}} { |
||||
if {[llength $globOrIdx]} { |
||||
if {[string is integer -strict $globOrIdx]} { |
||||
set idx $globOrIdx |
||||
if {$idx < 0} { |
||||
set idx "end-[expr {abs($idx + 1)}]" |
||||
} |
||||
if {[catch {lindex [dict keys $o_data] $idx} result]} { |
||||
error "[self object] no such index : '$idx'" |
||||
} else { |
||||
return $result |
||||
} |
||||
} else { |
||||
#glob |
||||
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx] |
||||
} |
||||
} else { |
||||
return [dict keys $o_data] |
||||
} |
||||
} |
||||
#like names but without globbing |
||||
method keys {} { |
||||
dict keys $o_data |
||||
} |
||||
method key {{posn 0}} { |
||||
if {$posn < 0} { |
||||
set posn "end-[expr {abs($posn + 1)}]" |
||||
} |
||||
if {[catch {lindex [dict keys $o_data] $posn} result]} { |
||||
error "[self object] no such index : '$posn'" |
||||
} else { |
||||
return $result |
||||
} |
||||
} |
||||
method hasKey {key} { |
||||
dict exists $o_data $key |
||||
} |
||||
method get {} { |
||||
return $o_data |
||||
} |
||||
method items {} { |
||||
return [dict values $o_data] |
||||
} |
||||
method item {key} { |
||||
if {[string is integer -strict $key]} { |
||||
if {$key >= 0} { |
||||
set valposn [expr {(2*$key) +1}] |
||||
return [lindex $o_data $valposn] |
||||
} else { |
||||
set key "end-[expr {abs($key + 1)}]" |
||||
return [lindex $o_data $key] |
||||
#return [lindex [dict keys $o_data] $key] |
||||
} |
||||
} |
||||
if {[dict exists $o_data $key]} { |
||||
return [dict get $o_data $key] |
||||
} |
||||
} |
||||
#inverse lookup |
||||
method itemKeys {value} { |
||||
set value_indices [lsearch -all [dict values $o_data] $value] |
||||
set keylist [list] |
||||
foreach i $value_indices { |
||||
set idx [expr {(($i + 1) *2) -2}] |
||||
lappend keylist [lindex $o_data $idx] |
||||
} |
||||
return $keylist |
||||
} |
||||
method search {value args} { |
||||
set matches [lsearch {*}$args [dict values $o_data] $value] |
||||
if {"-inline" in $args} { |
||||
return $matches |
||||
} else { |
||||
set keylist [list] |
||||
foreach i $matches { |
||||
set idx [expr {(($i + 1) *2) -2}] |
||||
lappend keylist [lindex $o_data $idx] |
||||
} |
||||
return $keylist |
||||
} |
||||
} |
||||
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists? |
||||
#review - what is the point of alias anyway? - why slow down other operations when a variable can hold a keyname perfectly well? |
||||
#method alias {newAlias existingKeyOrAlias} { |
||||
# if {[string is integer -strict $newAlias]} { |
||||
# error "[self object] collection key alias cannot be integer" |
||||
# } |
||||
# if {[string length $existingKeyOrAlias]} { |
||||
# set o_alias($newAlias) $existingKeyOrAlias |
||||
# } else { |
||||
# unset o_alias($newAlias) |
||||
# } |
||||
#} |
||||
#method aliases {{key ""}} { |
||||
# if {[string length $key]} { |
||||
# set result [list] |
||||
# foreach {n v} [array get o_alias] { |
||||
# if {$v eq $key} { |
||||
# lappend result $n $v |
||||
# } |
||||
# } |
||||
# return $result |
||||
# } else { |
||||
# return [array get o_alias] |
||||
# } |
||||
#} |
||||
##if the supplied index is an alias, return the underlying key; else return the index supplied. |
||||
#method realKey {idx} { |
||||
# if {[catch {set o_alias($idx)} key]} { |
||||
# return $idx |
||||
# } else { |
||||
# return $key |
||||
# } |
||||
#} |
||||
method add {value key} { |
||||
if {[string is integer -strict $key]} { |
||||
error "[self object] collection key must not be an integer. Use another structure if integer keys required" |
||||
} |
||||
if {[dict exists $o_data $key]} { |
||||
error "[self object] col_processors object error: key '$key' already exists in collection" |
||||
} |
||||
dict set o_data $key $value |
||||
return [expr {[dict size $o_data] - 1}] ;#return index of item |
||||
} |
||||
method remove {idx {endRange ""}} { |
||||
if {[string length $endRange]} { |
||||
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time" |
||||
} |
||||
if {[string is integer -strict $idx]} { |
||||
if {$idx < 0} { |
||||
set idx "end-[expr {abs($idx+1)}]" |
||||
} |
||||
set key [lindex [dict keys $o_data] $idx] |
||||
set posn $idx |
||||
} else { |
||||
set key $idx |
||||
set posn [lsearch -exact [dict keys $o_data] $key] |
||||
if {$posn < 0} { |
||||
error "[self object] no such index: '$idx' in this collection" |
||||
} |
||||
} |
||||
dict unset o_data $key |
||||
return |
||||
} |
||||
method clear {} { |
||||
set o_data [dict create] |
||||
return |
||||
} |
||||
method reverse_the_collection {} { |
||||
#named slightly obtusely because reversing the data when there may be references held is a potential source of bugs |
||||
#the name reverse_the_collection should make it clear that the object is being modified in place as opposed to simply 'reverse' which may imply a view/copy. |
||||
#todo - consider implementing a get_reverse which provides an interface to the same collection without affecting original references, yet both allowing delete/edit operations. |
||||
set dictnew [dict create] |
||||
foreach k [lreverse [dict keys $o_data]] { |
||||
dict set dictnew $k [dict get $o_data $k] |
||||
} |
||||
set o_data $dictnew |
||||
return |
||||
} |
||||
#review - cmd as list vs cmd as script? |
||||
method map {cmd} { |
||||
set seed [list] |
||||
dict for {k v} $o_data { |
||||
lappend seed [uplevel #0 [list {*}$cmd $v]] |
||||
} |
||||
return $seed |
||||
} |
||||
method objectmap {cmd} { |
||||
set seed [list] |
||||
dict for {k v} $o_data { |
||||
lappend seed [uplevel #0 [list $v {*}$cmd]] |
||||
} |
||||
return $seed |
||||
} |
||||
} |
||||
|
||||
} |
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,324 @@
|
||||
# -*- 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) 2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::mix::commandset::doc 0.1.1 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
##e.g package require frobz |
||||
|
||||
package require punk::path ;# for treefilenames, relative |
||||
package require punk::repo |
||||
package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc |
||||
package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call |
||||
#package require punkcheck ;#for path_relative |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval punk::mix::commandset::doc { |
||||
namespace export * |
||||
|
||||
proc _default {} { |
||||
puts "documentation subsystem" |
||||
puts "commands: doc.build" |
||||
puts " build documentation from src/doc to src/embedded using the kettle build tool" |
||||
puts "commands: doc.status" |
||||
} |
||||
|
||||
proc build {} { |
||||
puts "build docs" |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to build docs" |
||||
return |
||||
} |
||||
#user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite |
||||
#we still generate output in src/docgen so user can diff and manually update if thats what they prefer |
||||
set oldfiles [punk::path::treefilenames -dir $projectdir/src/doc _module_*.man] |
||||
foreach maybedoomed $oldfiles { |
||||
set fd [open $maybedoomed r] |
||||
chan conf $fd -translation binary |
||||
set data [read $fd] |
||||
close $fd |
||||
if {[string match "*--- punk::docgen overwrites *" $data]} { |
||||
file delete -force $maybedoomed |
||||
} |
||||
} |
||||
set generated [lib::do_docgen modules] |
||||
if {[dict get $generated count] > 0} { |
||||
#review |
||||
set doclist [dict get $generated docs] |
||||
set source_base [dict get $generated base] |
||||
set target_base $projectdir/src/doc |
||||
foreach dinfo $doclist { |
||||
lassign $dinfo module fpath |
||||
set relpath [punk::path::relative $source_base $fpath] |
||||
set relfolder [file dirname $relpath] |
||||
if {$relfolder eq "."} { |
||||
set relfolder "" |
||||
} |
||||
file mkdir [file join $target_base $relfolder] |
||||
set target [file join $target_base $relfolder _module_[file tail $fpath]] |
||||
puts stderr "target --> $target" |
||||
if {![file exists $target]} { |
||||
file copy $fpath $target |
||||
} |
||||
} |
||||
} |
||||
|
||||
if {[file exists $projectdir/src/doc]} { |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init VIRTUAL kettle_build_doc ;#VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
if {\ |
||||
[llength [dict get [$event targetset_source_changes] changed]]\ |
||||
} { |
||||
$event targetset_started |
||||
# -- --- --- --- --- --- |
||||
puts stdout "BUILDING DOCS at $projectdir/src/embedded from src/doc" |
||||
if {[catch { |
||||
if {"::meta" eq [info commands ::meta]} { |
||||
puts stderr "There appears to be a leftover ::meta command which is presumed to be from doctools. Destroying object" |
||||
::meta destroy |
||||
} |
||||
punk::mix::cli::lib::kettle_call lib doc |
||||
#Kettle doc |
||||
|
||||
} errM]} { |
||||
$event targetset_end FAILED -note "kettle_build_doc failed: $errM" |
||||
} else { |
||||
$event targetset_end OK |
||||
} |
||||
# -- --- --- --- --- --- |
||||
} else { |
||||
puts stderr "No change detected in src/doc" |
||||
$event targetset_end SKIPPED |
||||
} |
||||
$event end |
||||
$event destroy |
||||
$installer destroy |
||||
cd $original_wd |
||||
} else { |
||||
puts stderr "No doc folder found at $projectdir/src/doc" |
||||
} |
||||
} |
||||
proc status {} { |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
cd $projectdir/src |
||||
puts stdout "Testing status of doctools source location $projectdir/src/doc ..." |
||||
flush stdout |
||||
#---------- |
||||
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] |
||||
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded |
||||
set event [$installer start_event {-install_step kettledoc}] |
||||
#use same virtual id "kettle_build_doc" as project.new - review best way to keep identifiers like this in sync. |
||||
$event targetset_init QUERY kettle_build_doc ;#usually VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated - but here we use QUERY to ensure no writes to .punkcheck |
||||
set last_completion [$event targetset_last_complete] |
||||
|
||||
if {[llength $last_completion]} { |
||||
#adding a source causes it to be checksummed |
||||
$event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source |
||||
#---------- |
||||
set changeinfo [$event targetset_source_changes] |
||||
if {\ |
||||
[llength [dict get $changeinfo changed]]\ |
||||
} { |
||||
puts stdout "changed" |
||||
puts stdout $changeinfo |
||||
} else { |
||||
puts stdout "No changes detected in $projectdir/src/doc tree" |
||||
} |
||||
} else { |
||||
#no previous completion-record for this target - must assume changed - no need to trigger checksumming |
||||
puts stdout "No existing record of doc build in .punkcheck. Assume it needs to be rebuilt." |
||||
} |
||||
|
||||
|
||||
$event destroy |
||||
$installer destroy |
||||
|
||||
cd $original_wd |
||||
} |
||||
proc validate {args} { |
||||
set argd [punk::args::parse $args withdef { |
||||
@id -id ::punk::mix::commandset::doc::validate |
||||
-- -type none -optional 1 -help "end of options marker --" |
||||
-individual -type boolean -default 1 |
||||
@values -min 0 -max -1 |
||||
patterns -default {*.man} -type any -multiple 1 |
||||
}] |
||||
set opt_individual [tcl::dict::get $argd opts -individual] |
||||
set patterns [tcl::dict::get $argd values patterns] |
||||
|
||||
|
||||
#todo - run and validate punk::docgen output |
||||
set projectdir [punk::repo::find_project] |
||||
if {$projectdir eq ""} { |
||||
puts stderr "No current project dir - unable to check doc status" |
||||
return |
||||
} |
||||
if {![file exists $projectdir/src/doc]} { |
||||
set result "No documentation source found. Expected .man files in doctools format at $projectdir/src/doc" |
||||
return $result |
||||
} |
||||
set original_wd [pwd] |
||||
set docroot $projectdir/src/doc |
||||
cd $docroot |
||||
|
||||
if {!$opt_individual && "*.man" in $patterns} { |
||||
if {[catch { |
||||
dtplite validate $docroot |
||||
} errM]} { |
||||
puts stderr "commandset::doc::validate failed for projectdir '$projectdir'" |
||||
puts stderr "docroot '$docroot'" |
||||
puts stderr "dtplite error was: $errM" |
||||
} |
||||
} else { |
||||
foreach p $patterns { |
||||
set treefiles [punk::path::treefilenames $p] |
||||
foreach path $treefiles { |
||||
puts stdout "dtplite validate $path" |
||||
dtplite validate $path |
||||
} |
||||
} |
||||
} |
||||
|
||||
#punk::mix::cli::lib::kettle_call lib validate-doc |
||||
|
||||
cd $original_wd |
||||
} |
||||
|
||||
namespace eval collection { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
|
||||
namespace export * |
||||
namespace path [namespace parent] |
||||
|
||||
} |
||||
|
||||
namespace eval lib { |
||||
variable pkg |
||||
set pkg punk::mix::commandset::doc |
||||
proc do_docgen {{project_subpath modules}} { |
||||
#Extract doctools comments from source code |
||||
set projectdir [punk::repo::find_project] |
||||
set output_base [file join $projectdir src docgen] |
||||
set codesource_path [file join $projectdir $project_subpath] |
||||
if {![file isdirectory $codesource_path]} { |
||||
puts stderr "WARNING punk::mix::commandset::doc unable to find codesource_path $codesource_path during do_docgen - skipping inline doctools generation" |
||||
return |
||||
} |
||||
if {[file isdirectory $output_base]} { |
||||
if {[catch { |
||||
file delete -force $output_base |
||||
}]} { |
||||
error "do_docgen failed to delete existing output base folder: $output_base" |
||||
} |
||||
} |
||||
file mkdir $output_base |
||||
|
||||
set matched_paths [punk::path::treefilenames -dir $codesource_path -exclude-paths {**/mix/templates/** **/project_layouts/** **/decktemplates/** **/_aside **/_aside/**} *.tm] |
||||
set count 0 |
||||
set newdocs [list] |
||||
set docgen_header_comments "" |
||||
append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n |
||||
append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n |
||||
foreach fullpath $matched_paths { |
||||
puts stdout "do_docgen processing: $fullpath" |
||||
set doctools [punk::docgen::get_doctools_comments $fullpath] |
||||
if {$doctools ne ""} { |
||||
set fname [file tail $fullpath] |
||||
set mod_tail [file rootname $fname] |
||||
set relpath [punk::path::relative $codesource_path [file dirname $fullpath]] |
||||
if {$relpath eq "."} { |
||||
set relpath "" |
||||
} |
||||
set tailsegs [file split $relpath] |
||||
set module_fullname [join $tailsegs ::]::$mod_tail |
||||
set target_docname $fname.man |
||||
set this_outdir [file join $output_base $relpath] |
||||
|
||||
if {[string length $fname] > 99} { |
||||
#output needs to be tarballed to do checksum change tests in a reasonably straightforward and not-too-terribly slow way. |
||||
#hack - review. Determine exact limit - test if tcllib tar fixed or if it's a limit of the particular tar format |
||||
#work around tcllib tar filename length limit ( somewhere around 100?) This seems to be a limit on the length of a particular segment in the path.. not whole path length? |
||||
#this case only came up because docgen used to path munge to long filenames - but left because we know there is a limit and renaming fixes it - even if it's ugly - but still allows doc generation. |
||||
#review - if we're checking fname - should also test length of whole path and determine limits for tar |
||||
package require md5 |
||||
if {[package vsatisfies [package present md5] 2- ] } { |
||||
set md5opt "-hex" |
||||
} else { |
||||
set md5opt "" |
||||
} |
||||
set target_docname [md5::md5 {*}$md5opt [encoding convertto utf-8 $fullpath]]_overlongfilename.man |
||||
puts stderr "WARNING - overlong file name - renaming $fullpath" |
||||
puts stderr " to [file dirname $fullpath]/$target_docname" |
||||
} |
||||
|
||||
file mkdir $this_outdir |
||||
puts stdout "saving [string length $doctools] bytes of doctools output from file $relpath/$fname" |
||||
set outfile [file join $this_outdir $target_docname] |
||||
set fd [open $outfile w] |
||||
fconfigure $fd -translation binary |
||||
puts -nonewline $fd $docgen_header_comments$doctools |
||||
close $fd |
||||
incr count |
||||
lappend newdocs [list $module_fullname $outfile] |
||||
} |
||||
} |
||||
return [list count $count docs $newdocs base $output_base] |
||||
} |
||||
|
||||
} |
||||
} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::mix::commandset::doc [namespace eval punk::mix::commandset::doc { |
||||
variable pkg punk::mix::commandset::doc |
||||
variable version |
||||
set version 0.1.1 |
||||
}] |
||||
return |
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Loading…
Reference in new issue