Tcl Library Source Code

Check-in [36387739e6]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Beginnings of effort to rework validation to allow validators to see all results, not just the current value
Timelines: family | ancestors | amg-argparse-validation
Files: files | file ages | folders
SHA3-256: 36387739e63e2402a5fc1fe37ac939e00e56f8d3dc30d1750f1cb387a1f6546a
User & Date: andy 2019-04-26 17:52:54
Context
2019-04-26
17:52
Beginnings of effort to rework validation to allow validators to see all results, not just the current value Leaf check-in: 36387739e6 user: andy tags: amg-argparse-validation
17:51
Update to-do list Leaf check-in: 9064b9d02f user: andy tags: amg-argparse
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to modules/argparse/argparse.tcl.

   229    229   #
   230    230   # After switch processing, parameter allocation determines how many arguments to
   231    231   # assign to each parameter.  Arguments assigned to switches are not used in
   232    232   # parameter processing.  First, arguments are allocated to required parameters;
   233    233   # second, to optional, non-catchall parameters; and last to catchall parameters.
   234    234   # Finally, each parameter is assigned the allocated number of arguments.
   235    235   proc ::argparse {args} {
   236         -    # Common validation helper routine.
   237         -    set validateHelper {apply {{name opt args} {
          236  +    # Validation and enumeration processing helper routine.
          237  +    set enumHelper {apply {{name opt args} {
   238    238           if {[dict exists $opt enum]} {
   239    239               set command [list tcl::prefix match -message "$name value"\
   240    240                       {*}[if {[uplevel 1 {info exists exact}]} {list -exact}]\
   241    241                       [dict get $opt enum]]
   242         -            set args [lmap arg $args {{*}$command $arg}]
   243         -        } elseif {[dict exists $opt validate]} {
   244         -            foreach arg $args [list if [dict get $opt validate] {} else {
   245         -                return -code error -level 2\
   246         -                        "$name value \"$arg\" fails [dict get $opt validateMsg]"
   247         -            }]
          242  +            lmap arg $args {{*}$command $arg}
          243  +        } else {
          244  +            return $args
   248    245           }
   249         -        return $args
   250    246       }}}
   251    247   
   252    248       # Process arguments.
   253    249       set level 1
   254    250       set enum {}
   255    251       set validate {}
   256    252       for {set i 0} {$i < [llength $args]} {incr i} {
................................................................................
   329    325       # Parse element definition list.
   330    326       set def {}
   331    327       set aliases {}
   332    328       set order {}
   333    329       set switches {}
   334    330       set upvars {}
   335    331       set omitted {}
          332  +    set validations {}
   336    333       foreach elem $definition {
   337    334           # Read element definition switches.
   338    335           set opt {}
   339    336           for {set i 1} {$i < [llength $elem]} {incr i} {
   340    337               if {[set switch [regsub {^-} [tcl::prefix match {
   341    338                   -alias -argument -boolean -catchall -default -enum -forbid
   342    339                   -ignore -imply -keep -key -level -optional -parameter -pass
................................................................................
   426    423           foreach {switch others} {
   427    424               parameter {alias boolean value argument imply}
   428    425               ignore    {key pass}
   429    426               required  {boolean default}
   430    427               argument  {boolean value}
   431    428               upvar     {boolean inline catchall}
   432    429               boolean   {default value}
   433         -            enum      validate
   434    430           } {
   435    431               if {[dict exists $opt $switch]} {
   436    432                   foreach other $others {
   437    433                       if {[dict exists $opt $other]} {
   438    434                           return -code error "-$switch and -$other conflict"
   439    435                       }
   440    436                   }
................................................................................
   510    506               return -code error "element alias collision: [dict get $opt alias]"
   511    507           } else {
   512    508               # Build list of switches (with aliases), and link switch aliases.
   513    509               dict set aliases [dict get $opt alias] $name
   514    510               lappend switches -[dict get $opt alias]|$name
   515    511           }
   516    512   
   517         -        # Map from upvar keys back to element names, and forbid collisions.
          513  +        # Map from upvar keys back to element names.
   518    514           if {[dict exists $opt upvar] && [dict exists $opt key]} {
   519         -            if {[dict exists $upvars [dict get $opt key]]} {
   520         -                return -code error "multiple upvars to the same variable:\
   521         -                        [dict get $upvars [dict get $opt key]] $name"
   522         -            }
   523    515               dict set upvars [dict get $opt key] $name
   524    516           }
   525    517   
   526         -        # Look up named enumeration lists and validation expressions.
          518  +        # Resolve named enumeration lists.
   527    519           if {[dict exists $opt enum]
   528    520            && [dict exists $enum [dict get $opt enum]]} {
   529    521               dict set opt enum [dict get $enum [dict get $opt enum]]
   530         -        } elseif {[dict exists $opt validate]} {
          522  +        }
          523  +
          524  +        # Resolve validation expressions.
          525  +        if {[dict exists $opt validate]} {
   531    526               if {[dict exists $validate [dict get $opt validate]]} {
   532    527                   dict set opt validateMsg "[dict get $opt validate] validation"
   533    528                   dict set opt validate [dict get $validate\
   534    529                           [dict get $opt validate]]
   535    530               } else {
   536    531                   dict set opt validateMsg "validation: [dict get $opt validate]"
   537    532               }
          533  +            dict set validations $name {}
   538    534           }
   539    535   
   540    536           # Save element definition.
   541    537           dict set def $name $opt
   542    538   
   543    539           # Prepare to identify omitted elements.
   544    540           dict set omitted $name {}
................................................................................
   570    566   
   571    567           # Perform shared key logic.
   572    568           if {[dict exists $opt key]} {
   573    569               dict for {otherName otherOpt} $def {
   574    570                   if {$name ne $otherName && [dict exists $otherOpt key]
   575    571                    && [dict get $otherOpt key] eq [dict get $opt key]} {
   576    572                       # Limit when shared keys may be used.
   577         -                    if {[dict exists $opt parameter]} {
   578         -                        return -code error "$name cannot be a parameter because\
   579         -                                it shares a key with $otherName"
   580         -                    } elseif {[dict exists $opt argument]} {
   581         -                        return -code error "$name cannot use -argument because\
   582         -                                it shares a key with $otherName"
   583         -                    } elseif {[dict exists $opt catchall]} {
   584         -                        return -code error "$name cannot use -catchall because\
   585         -                                it shares a key with $otherName"
   586         -                    } elseif {[dict exists $opt default]
   587         -                           && [dict exists $otherOpt default]} {
   588         -                        return -code error "$name and $otherName cannot both\
   589         -                                use -default because they share a key"
          573  +                    foreach key {parameter argument catchall} {
          574  +                        if {[dict exists $opt $key]} {
          575  +                            return -code error "$name cannot use -$key because\
          576  +                                    it shares a key with $otherName"
          577  +                        }
          578  +                    }
          579  +                    foreach key {default validate upvar} {
          580  +                        if {[dict exists $opt $key]
          581  +                         && [dict exists $otherOpt $key]} {
          582  +                            return -code error "$name and $otherName cannot both\
          583  +                                    use -$key because they share a key"
          584  +                        }
   590    585                       }
   591    586   
   592    587                       # Create forbid constraints on shared keys.
   593    588                       if {![dict exists $otherOpt forbid]
   594    589                        || $name ni [dict get $otherOpt forbid]} {
   595    590                           dict update def $otherName otherOpt {
   596    591                               dict lappend otherOpt forbid $name
................................................................................
   620    615               }
   621    616           }
   622    617       }
   623    618       set force [lreplace $argv 0 $end]
   624    619       set argv [lrange $argv 0 $end]
   625    620   
   626    621       # Perform switch logic.
   627         -    set result {}
   628    622       set missing {}
   629    623       if {$switches ne {}} {
   630    624           # Build regular expression to match switches.
   631    625           set re ^-
   632    626           if {[info exists long]} {
   633    627               append re -?
   634    628           }
................................................................................
   728    722                       set $var [dict get $def $name $var]
   729    723                   }
   730    724               }
   731    725   
   732    726               # Keep track of which switches have been seen.
   733    727               dict unset omitted $name
   734    728   
   735         -            # Validate switch arguments and store values into the result dict.
          729  +            # Validate switch arguments and store values into the result array.
   736    730               if {[dict exists $def $name catchall]} {
   737    731                   # The switch is catchall, so store all remaining arguments.
   738         -                set argv [{*}$validateHelper $normal\
   739         -                        [dict get $def $name] {*}$argv]
          732  +                set argv [{*}$enumHelper $normal [dict get $def $name] {*}$argv]
   740    733                   if {[info exists key]} {
   741         -                    dict set result $key $argv
          734  +                    set result($key) $argv
   742    735                   }
   743    736                   if {[info exists pass]} {
   744    737                       if {[info exists normalize]} {
   745         -                        dict lappend result $pass $normal {*}$argv
          738  +                        lappend result($pass) $normal {*}$argv
   746    739                       } else {
   747         -                        dict lappend result $pass $arg {*}$argv
          740  +                        lappend result($pass) $arg {*}$argv
   748    741                       }
   749    742                   }
   750    743                   break
   751    744               } elseif {![dict exists $def $name argument]} {
   752    745                   # The switch expects no arguments.
   753    746                   if {$equal eq "="} {
   754    747                       return -code error "$normal doesn't allow an argument"
   755    748                   }
   756    749                   if {[info exists key]} {
   757    750                       if {[dict exists $def $name value]} {
   758         -                        dict set result $key [dict get $def $name value]
          751  +                        set result($key) [dict get $def $name value]
   759    752                       } else {
   760         -                        dict set result $key {}
          753  +                        set result($key) {}
   761    754                       }
   762    755                   }
   763    756                   if {[info exists pass]} {
   764    757                       if {[info exists normalize]} {
   765         -                        dict lappend result $pass $normal
          758  +                        lappend result($pass) $normal
   766    759                       } else {
   767         -                        dict lappend result $pass $arg
          760  +                        lappend result($pass) $arg
   768    761                       }
   769    762                   }
   770    763               } elseif {$argv ne {}} {
   771    764                   # The switch was given the expected argument.
   772         -                set argv0 [lindex [{*}$validateHelper $normal\
          765  +                set argv0 [lindex [{*}$enumHelper $normal\
   773    766                           [dict get $def $name] [lindex $argv 0]] 0]
   774    767                   if {[info exists key]} {
   775    768                       if {[dict exists $def $name optional]} {
   776         -                        dict set result $key [list {} $argv0]
          769  +                        set result($key) [list {} $argv0]
   777    770                       } else {
   778         -                        dict set result $key $argv0
          771  +                        set result($key) $argv0
   779    772                       }
   780    773                   }
   781    774                   if {[info exists pass]} {
   782    775                       if {[info exists normalize]} {
   783         -                        dict lappend result $pass $normal $argv0
          776  +                        lappend result($pass) $normal $argv0
   784    777                       } elseif {$equal eq "="} {
   785         -                        dict lappend result $pass $arg
          778  +                        lappend result($pass) $arg
   786    779                       } else {
   787         -                        dict lappend result $pass $arg [lindex $argv 0]
          780  +                        lappend result($pass) $arg [lindex $argv 0]
   788    781                       }
   789    782                   }
   790    783                   set argv [lrange $argv 1 end]
   791    784               } else {
   792    785                   # The switch was not given the expected argument.
   793    786                   if {![dict exists $def $name optional]} {
   794    787                       return -code error "$normal requires an argument"
   795    788                   }
   796    789                   if {[info exists key]} {
   797         -                    dict set result $key {}
          790  +                    set result($key) {}
   798    791                   }
   799    792                   if {[info exists pass]} {
   800    793                       if {[info exists normalize]} {
   801         -                        dict lappend result $pass $normal
          794  +                        lappend result($pass) $normal
   802    795                       } else {
   803         -                        dict lappend result $pass $arg
          796  +                        lappend result($pass) $arg
   804    797                       }
   805    798                   }
   806    799               }
   807    800   
   808    801               # Insert this switch's implied arguments into the argument list.
   809    802               if {[dict exists $def $name imply]} {
   810    803                   set argv [concat [dict get $def $name imply] $argv]
................................................................................
   926    919       # all omitted switches that have a pass-through key, accept an argument, and
   927    920       # have a default value.
   928    921       if {[info exists normalize]} {
   929    922           dict for {name opt} $def {
   930    923               if {[dict exists $opt switch] && [dict exists $opt pass]
   931    924                && [dict exists $opt argument] && [dict exists $opt default]
   932    925                && [dict exists $omitted $name]} {
   933         -                dict lappend result [dict get $opt pass]\
          926  +                lappend result([dict get $opt pass])\
   934    927                           -$name [dict get $opt default]
   935    928               }
   936    929           }
   937    930       }
   938    931   
   939         -    # Validate parameters and store in result dict.
          932  +    # Apply enumeration logic and store parameters in result array.
   940    933       set i 0
   941    934       foreach name $order {
   942    935           set opt [dict get $def $name]
   943    936           if {[dict exists $alloc $name]} {
   944    937               if {![dict exists $opt catchall] && $name ne {}} {
   945         -                set val [lindex [{*}$validateHelper $name\
          938  +                set val [lindex [{*}$enumHelper $name\
   946    939                           $opt [lindex $params $i]] 0]
   947    940                   if {[dict exists $opt pass]} {
   948    941                       if {[string index $val 0] eq "-"
   949         -                     && ![dict exists $result [dict get $opt pass]]} {
   950         -                        dict lappend result [dict get $opt pass] --
          942  +                     && ![info exists result([dict get $opt pass])]} {
          943  +                        lappend result([dict get $opt pass]) --
   951    944                       }
   952         -                    dict lappend result [dict get $opt pass] $val
          945  +                    lappend result([dict get $opt pass]) $val
   953    946                   }
   954    947                   incr i
   955    948               } else {
   956    949                   set step [dict get $alloc $name]
   957    950                   set val [lrange $params $i [expr {$i + $step - 1}]]
   958    951                   if {$name ne {}} {
   959         -                    set val [{*}$validateHelper $name $opt {*}$val]
          952  +                    set val [{*}$enumHelper $name $opt {*}$val]
   960    953                   }
   961    954                   if {[dict exists $opt pass]} {
   962    955                       if {[string index [lindex $val 0] 0] eq "-"
   963         -                     && ![dict exists $result [dict get $opt pass]]} {
   964         -                        dict lappend result [dict get $opt pass] --
          956  +                     && ![info exists result([dict get $opt pass])]} {
          957  +                        lappend result([dict get $opt pass]) --
   965    958                       }
   966         -                    dict lappend result [dict get $opt pass] {*}$val
          959  +                    lappend result([dict get $opt pass]) {*}$val
   967    960                   }
   968    961                   incr i $step
   969    962               }
   970    963               if {[dict exists $opt key]} {
   971         -                dict set result [dict get $opt key] $val
          964  +                set result([dict get $opt key]) $val
   972    965               }
   973    966           } elseif {[info exists normalize] && [dict exists $opt default]
   974    967                  && [dict exists $opt pass]} {
   975    968               # If normalization is enabled and this omitted parameter has both a
   976    969               # default value and a pass-through key, explicitly store the default
   977    970               # value in the pass-through key, located in the correct position so
   978    971               # that it can be recognized again later.
   979    972               if {[string index [dict get $opt default] 0] eq "-"
   980         -             && ![dict exists $result [dict get $opt pass]]} {
   981         -                dict lappend result [dict get $opt pass] --
          973  +             && ![info exists result([dict get $opt pass])]} {
          974  +                lappend result([dict get $opt pass]) --
   982    975               }
   983         -            dict lappend result [dict get $opt pass] [dict get $opt default]
          976  +            lappend result([dict get $opt pass]) [dict get $opt default]
   984    977           }
   985    978       }
   986    979   
   987    980       # Create default values for missing elements.
          981  +    # TODO: Build list of defaults that were added.  Skip validation for these
          982  +    # keys because defaults may well be intended to be outside the allowable
          983  +    # range for explicitly specified values.
   988    984       dict for {name opt} $def {
   989    985           if {[dict exists $opt key]
   990         -         && ![dict exists $result [dict get $opt key]]} {
          986  +         && ![info exists result([dict get $opt key])]} {
   991    987               if {[dict exists $opt default]} {
   992         -                dict set result [dict get $opt key] [dict get $opt default]
          988  +                set result([dict get $opt key]) [dict get $opt default]
   993    989               } elseif {[dict exists $opt catchall]} {
   994         -                dict set result [dict get $opt key] {}
          990  +                set result([dict get $opt key]) {}
   995    991               }
   996    992           }
   997    993           if {[dict exists $opt pass]
   998         -         && ![dict exists $result [dict get $opt pass]]} {
   999         -            dict set result [dict get $opt pass] {}
          994  +         && ![info exists result([dict get $opt pass])]} {
          995  +            set result([dict get $opt pass]) {}
  1000    996           }
  1001    997       }
  1002    998   
  1003    999       if {[info exists inline]} {
  1004         -        # Return result dict.
  1005         -        return $result
         1000  +        # When -inline is used, return result array, converted to be a dict.
         1001  +        array get result
  1006   1002       } else {
  1007   1003           # Unless -keep was used, unset caller variables for omitted elements.
  1008   1004           if {![info exists keep]} {
  1009         -            dict for {name val} $omitted {
  1010         -                set opt [dict get $def $name]
  1011         -                if {![dict exists $opt keep] && [dict exists $opt key]
  1012         -                 && ![dict exists $result [dict get $opt key]]} {
         1005  +            dict for {name opt} $def {
         1006  +                if {[dict exists $opt key] && ![dict exists $opt keep]
         1007  +                 && ![info exists result([dict get $opt key])]} {
  1013   1008                       uplevel 1 [list ::unset -nocomplain [dict get $opt key]]
  1014   1009                   }
  1015   1010               }
  1016   1011           }
  1017   1012   
  1018         -        # Process results.
  1019         -        dict for {key val} $result {
         1013  +        # Update caller variables to store results.
         1014  +        foreach {key val} [array get result] {
  1020   1015               if {[dict exists $upvars $key]} {
  1021   1016                   # If this element uses -upvar, link to the named variable.
  1022   1017                   uplevel 1 [list ::upvar\
  1023   1018                           [dict get $def [dict get $upvars $key] level] $val $key]
  1024   1019               } else {
  1025   1020                   # Store result into caller variables.
  1026   1021                   uplevel 1 [list ::set $key $val]
  1027   1022               }
  1028   1023           }
  1029   1024       }
  1030   1025   }
  1031   1026   
  1032   1027   # vim: set sts=4 sw=4 tw=80 et ft=tcl: