[US] 2003-04-10
 #
 # "fulfills" checks a string against a regular expression and
 #  a couple of criteria. It returns 1, if the regular expression
 #  matches and all criteria are fulfilled, else returns 0.
 #
 # It is useful for the check of test results,
 #  or for evaluation of reports.
 #
 # The first argument is the string to be checked
 # The second argument is a regex to split string into substrings
 #  (it defaults to .* that matches the entire string)
 #
 # If the given regex is incorrect, "fulfills" throws an error
 #
 # All following args contain criteria, that apply to the respective
 #  substring, the first to everything the regex matches, the second
 #  to the first parenthized subexpression,... (see regexp man page)
 #
 # "fulfills" returns a truth value as follows:
 #
 # regexp doesn't match --> 0
 # more criteria given than substrings delivered by regexp --> 0
 #
 # Criteria:
 #
 # An empty criterium means "don't check this substring" and evals to "true".
 # /string/ --> string match against "string"
 # %string% --> string match against "string" -nocase
 # ~string~ --> string equal "string" -nocase
 # =string= --> string equal "string"
 #
 # If the criterium begins with one of the following, it uses expr to check.
 #   -eq --> numerical check: substring is equal
 #   -gt --> numerical check: substring is greater than
 #   -lt --> numerical check: substring is less than
 #   -ne --> numerical check: substring is not equal
 #   -ge --> numerical check: substring is greater or equal
 #   -le --> numerical check: substring is less or equal
 #   These criteria may contain placeholders of the form @1 ... @9 which
 #    expand to the corresponding substring.
 #   --  --> expr evals substring to a truth value
 #
 # Any criterium, that doesn't have one of the forms described above,
 #  evals "string equal criterium substring"
 #
 # Evaluation stops with first false value
 # If the string fulfills all criteria, "fulfills" returns 1.
 #
 # Note, that the regex and the criteria must be quoted, if they
 #  contain whitespace or special characters.
 #

 proc fulfills {str {re .*} args} {
   set matcher [list regexp "$re" $str]
   set n 0
   foreach arg $args {
     lappend matcher p($n)
     incr n
   }
   if {[catch $matcher result]} {
   } else {
   if {!$result} {return 0}
   }
   set tv 1
   set n 0
   foreach arg $args {
     if {![string length $arg]} {
       # empty arg, always true
       continue
     }
     if {![string length $p($n)]} {
       # empty subexpr, always false
       set tv 0
       break
     }
     set f [string index $arg 0]
     set m [string range $arg 1 end-1]
     set l [string index $arg end]
     switch -- $f {
       /   {
         if {[string equal $f $l]} {
           # string match
           set tv [string match $m $p($n)]
         } else {
           # string equal
           set tv [string equal $arg $p($n)]
         }
       }
       %   {
         if {[string equal $f $l]} {
           # string match
           set tv [string match -nocase $m $p($n)]
         } else {
           # string equal
           set tv [string equal $arg $p($n)]
         }
       }
       =   {
         # string equal
         if {[string equal $f $l]} {
           # string equal
           set tv [string equal $m $p($n)]
         } else {
           # string equal
           set tv [string equal $arg $p($n)]
         }
       }
       ~   {
         if {[string equal $f $l]} {
           # string match
           set tv [string equal -nocase $m $p($n)]
         } else {
           # string equal
           set tv [string equal $arg $p($n)]
         }
       }
       -   {
         # expr check
         regsub -all {@([1-9])} [string range $arg 3 end] \$p(\\1) ec
         switch -glob -- $arg {
           --   {
             set e "($p($n)) != 0"
           }
           -eq* {
             set e "($p($n)) == ($ec)"
           }
           -ne* {
             set e "($p($n)) != ($ec)"
           }
           -gt* {
             set e "($p($n)) > ($ec)"
           }
           -ge* {
             set e "($p($n)) >= ($ec)"
           }
           -lt* {
             set e "($p($n)) < ($ec)"
           }
           -le* {
             set e "($p($n)) <= ($ec)"
           }
           default {
             set e [string equal $arg $p($n)]
           }
         }
         if {[catch "expr $e" tv]} {
           # error in expr
           puts "error in expr $e  ---  $tv"
         }
       }
       default {
         # string equal
         set tv [string equal $arg $p($n)]
       }
     }
     if {!$tv} break
     incr n
   }
   return $tv
 }

 # Examples (uncomment to try):
 #
 # puts "[fulfills abc\$123 {abc\$([0-9]+)$} /a*/ /*2*/ c d e f]"
 # puts "[fulfills abc\$123 {abc\$([0-9]+)$} /a*/ /*2*/]"
 # puts "[fulfills abc123 {abc([0-9]+)} a b]"
 # puts "[fulfills Abc123 {Abc([0-9]+)} %a*% 123]"
 # puts "[fulfills Abc123 {Abc([0-9]+)} %a*% -eq123]"
 # puts "[fulfills Abc123 {Abc([0-9]+)} %a*% "-lt 200"]"
 # puts "[fulfills Abc123 {Abc([0-9]+)} %a*% "-ge 200"]"
 # puts "[fulfills Abc123 {Abc([0-9]+)} %a*% -123]"
 # puts "[fulfills Abc123 {Abc([0-9]+)} %a*% -a23]"
 # puts "[fulfills Abc1+2+3 {^Abc(.+)$} %a*% --]"
 # puts "[fulfills Abc1+2-3 {^Abc(.+)$} %a*% --]"
 # puts "[fulfills Abc1+2-3 {^Abc(.+)$} %a*% -lt@1+1]"
 # puts "[fulfills Abc1+2x3 {^Abc(.+)x([0-9])$} %a*% -lt5 -eq@1]"
 # puts "[fulfills Abc123]"
 #