commit e6eae0468089573a77abb012145073dd8d1c4402
from: Sven M. Hallberg <pesco@khjk.org>
date: Sat May 24 18:10:54 2025 UTC

add command line options for patterns

Includes a minimal getopt(3) implementation.

commit - 8e4033faa2a65945f3eef825447e1685d6b31def
commit + e6eae0468089573a77abb012145073dd8d1c4402
blob - aa59087be78be413b07f5af0ba3b78b914b8266a
blob + 7e552eddfecbe0b782dec4fa11b58fe32d9d2124
--- exercise
+++ exercise
@@ -8,9 +8,9 @@ package require Tcl 8.4
 
 
 # config options
-set opts(-p)  {*.t}             ;# pattern for test executable files
-set opts(-ps) {*.tests}         ;# pattern for test suite executable files
-set opts(-pd) {*}               ;# pattern for test search directories
+set opts(-d) {*}                ;# pattern for test search directories
+set opts(-p) {*.t}              ;# pattern for test executable files
+set opts(-s) {*.tests}          ;# pattern for test suite executable files
 
 
 # executing tests
@@ -20,7 +20,7 @@ proc execute_test {countervar path} {
     upvar $countervar counters
 
     # Should the test result be integrated as a nested test suite?
-    set suite [string match $opts(-ps) [file tail $path]]
+    set suite [string match $opts(-s) [file tail $path]]
 
     # Call files in current dir with "./".
     set exe $path
@@ -140,9 +140,9 @@ proc find_files_iter {resultvar dirsvar paths} {
             if {[dict exists $dirs $normpath]} continue
             dict set dirs $normpath {}
                 
-            set subs   [glob -type d -nocomplain -directory $path $opts(-pd)]
-            set suites [glob -type f -nocomplain -directory $path $opts(-ps)]
+            set subs   [glob -type d -nocomplain -directory $path $opts(-d)]
             set tests  [glob -type f -nocomplain -directory $path $opts(-p)]
+            set suites [glob -type f -nocomplain -directory $path $opts(-s)]
 
             find_files_iter result dirs [lsort $subs]
             lappend result {*}[lsort $suites]
@@ -264,11 +264,70 @@ proc check_suite_counters {counters} {
 
 # main routine
 
+proc getopt {argvvar optstring optvar argvar} {
+    upvar $argvvar argv $optvar opt $argvar arg
+
+    set hd [lindex $argv 0]
+    set opt [string index $hd 1]
+    if {$opt eq "" || [string index $hd 0] ne "-"} {	;# no option argument
+        return 0
+    }
+    if {$hd eq "--"} {
+        set argv [lreplace $argv 0 0]           ;# remove hd
+        return 0
+    }
+
+    # consume option character
+    set hd [string replace $hd 1 1]
+    if {$hd ne "-"} {
+        set argv [lreplace $argv 0 0 $hd]       ;# replace hd
+    } else {
+        set argv [lreplace $argv 0 0]           ;# consume exhausted hd
+    }
+
+    set idx [string first $opt $optstring]
+    if {$idx == -1 || $opt eq ":"} {
+        puts stderr "$::argv0: unknown option -- $opt"
+        set opt "?"
+        return 1
+    }
+
+    # handle option arguments
+    if {[string index $optstring [expr $idx + 1]] ne ":"} {
+        return 1                                ;# no argument expected
+    }
+    if {$hd ne "-"} {
+        set arg [string replace $hd 0 0]        ;# rest of hd -> optarg
+        set argv [lreplace $argv 0 0]           ;# consume hd
+    } elseif {[llength $argv] > 0} {
+        set arg [lindex $argv 0]                ;# next arg -> optarg
+        set argv [lreplace $argv 0 0]           ;# consume arg
+    } else {
+        puts stderr "$::argv0: option requires an argument -- $opt"
+        if {[string index $optstring 0] eq ":"} {
+            set opt ":"
+        } else {
+            set opt "?"
+        }
+    }
+
+    return 1
+}
+
 proc main {argc argv} {
+    global opts
     set counters {run 0  ok 0  fail 0  error 0}
 
-    # TODO: accept opts on command line
-    # TODO: command-line --help
+    # handle command line options
+    set u {[-d pat] [-p pat] [-s pat] [path ...]}
+    while {[getopt argv {d:p:s:} opt arg]} {
+        if {$opt eq "?"} {
+            puts stderr "usage: [file tail $::argv0] $u"
+            exit 1
+        }
+        set opts(-$opt) $arg
+    }
+    set argc [llength $argv]
 
     set paths [expr {$argc == 0 ? "." : $argv}]
     set files [find_files $paths]
blob - 4d54c5639a0cffb8b75e634b9b9ad9880cf37c33
blob + 463ab25fde319dbe79fc192598eb3e0ace506e8a
--- exercise.1
+++ exercise.1
@@ -21,19 +21,38 @@ If given a directory argument,
 .Nm
 searches for tests therein.
 If given a file argument, it executes it as a single test (or test suite).
+To be recognized as tests, files must match the pattern
+.Pa *.t .
+To be run as test suites (see below), files must match the pattern
+.Pa *.tests .
 .Pp
-Tests are represented as executable files that are expected to exit 0 on
+The options are as follows:
+.Pp
+.Bl -tag
+.It Fl d Ar pattern
+When searching for tests,
+only descend into directories that match the given pattern.
+Defaults to
+.Dq *
+(all directories).
+.It Fl p Ar pattern
+Process (only) files matching the given pattern as tests.
+Defaults to
+.Dq *.t .
+.It Fl s Ar pattern
+Process (only) files matching the given pattern as test suites.
+Defaults to
+.Dq *.tests .
+.El
+.
+.Ss Test Files
+Tests are represented simply as executable files that are expected to exit 0 on
 success.
 Any output to standard error and non-zero exits are interpreted as negative
 results (test failures).
 Standard output is ignored.
 As a special case, exit status 127 is interpreted as an error during the test,
 implying an inconclusive result.
-.Pp
-To be recognized as tests, files must match the pattern
-.Pa *.t .
-To be run as test suites (see below), files must match the pattern
-.Pa *.tests .
 .
 .Ss Test Suites
 Multiple tests can be combined into one executable.