Ignore:
Timestamp:
Apr 29, 2007, 10:50:55 PM (11 years ago)
Author:
eridius@…
Message:

Fix tracing to work *much* better. Also fix depends validation to actually validate each depspec instead of just finding a single one within the list, and to stop validating on unset. Include ChangeLog entry. Fixes #11868

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/base/src/port1.0/portutil.tcl

    r24608 r24678  
    9191proc options {args} {
    9292    foreach option $args {
    93         proc $option {args} "
    94             global ${option} user_options option_procs
    95             if {!\[info exists user_options(${option})\]} {
    96                 set ${option} \$args
     93        proc $option {args} [subst -nocommands {
     94            global $option user_options option_procs
     95            if {![info exists user_options($option)]} {
     96                set $option \$args
    9797            }
    98         "
    99         proc ${option}-delete {args} "
    100             global ${option} user_options option_procs
    101             if {!\[info exists user_options(${option})\] && \[info exists ${option}\]} {
     98        }]
     99        proc ${option}-delete {args} [subst -nocommands {
     100            global $option user_options option_procs
     101            if {![info exists user_options($option)] && [info exists $option]} {
     102                set temp $option
    102103                foreach val \$args {
    103                    set ${option} \[ldelete \${$option} \$val\]
     104                   set temp [ldelete \${$option} \$val]
    104105                }
    105                 if {\[string length \${${option}}\] == 0} {
    106                     unset ${option}
     106                if {\$temp eq ""} {
     107                    unset $option
     108                } else {
     109                    set $option \$temp
    107110                }
    108111            }
    109         "
    110         proc ${option}-append {args} "
    111             global ${option} user_options option_procs
    112             if {!\[info exists user_options(${option})\]} {
    113                 if {\[info exists ${option}\]} {
    114                     set ${option} \[concat \${$option} \$args\]
     112        }]
     113        proc ${option}-append {args} [subst -nocommands {
     114            global $option user_options option_procs
     115            if {![info exists user_options($option)]} {
     116                if {[info exists $option]} {
     117                    set $option [concat \${$option} \$args]
    115118                } else {
    116                     set ${option} \$args
     119                    set $option \$args
    117120                }
    118121            }
    119         "
     122        }]
    120123    }
    121124}
     
    123126proc options_export {args} {
    124127    foreach option $args {
    125         proc options::export-${option} {args} "
    126             global ${option} PortInfo
    127             if {\[info exists ${option}\]} {
    128                 set PortInfo(${option}) \${${option}}
    129             } else {
    130                 unset PortInfo(${option})
     128        proc options::export-${option} {option action {value ""}} [subst -nocommands {
     129            global $option PortInfo
     130            switch \$action {
     131                set {
     132                    set PortInfo($option) \$value
     133                }
     134                delete {
     135                    unset PortInfo($option)
     136                }
    131137            }
    132         "
    133         option_proc ${option} options::export-${option}
     138        }]
     139        option_proc $option options::export-$option
    134140    }
    135141}
     
    141147    # Display a warning
    142148    if {$newoption != ""} {
    143         proc warn_deprecated_${option} {option action args} "
     149        proc warn_deprecated_${option} {option action args} [subst -nocommands {
    144150            global portname $option $newoption
    145             if {\$action != \"read\"} {
     151            if {\$action != "read"} {
    146152                $newoption \$$option
    147153            } else {
    148                 ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\"
     154                ui_warn "Port \$portname using deprecated option \\\"$option\\\"."
    149155                $option \[set $newoption\]
    150156            }
    151         "
     157        }]
    152158    } else {
    153         proc warn_deprecated_$option {option action args} "
     159        proc warn_deprecated_$option {option action args} [subst -nocommands {
    154160            global portname $option $newoption
    155             ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\"
    156         "
     161            ui_warn "Port \$portname using deprecated option \\\"$option\\\"."
     162        }]
    157163    }
    158164    option_proc $option warn_deprecated_$option
     
    161167proc option_proc {option args} {
    162168    global option_procs $option
    163     eval lappend option_procs($option) $args
    164     # Add a read trace to the variable, as the option procedures have no access to reads
    165     trace variable $option rwu option_proc_trace
     169    if {[info exists option_procs($option)]} {
     170        set option_procs($option) [concat $option_procs($option) $args]
     171        # we're already tracing
     172    } else {
     173        set option_procs($option) $args
     174        trace add variable $option {read write unset} option_proc_trace
     175    }
    166176}
    167177
     
    170180proc option_proc_trace {optionName index op} {
    171181    global option_procs
    172     upvar $optionName optionValue
     182    upvar $optionName $optionName
    173183    switch $op {
    174         w {
     184        write {
    175185            foreach p $option_procs($optionName) {
    176                 $p $optionName set $optionValue
     186                $p $optionName set [set $optionName]
    177187            }
    178             return
    179         }
    180         r {
     188        }
     189        read {
    181190            foreach p $option_procs($optionName) {
    182191                $p $optionName read
    183192            }
    184             return
    185         }
    186         u {
     193        }
     194        unset {
    187195            foreach p $option_procs($optionName) {
    188                 $p $optionName delete
    189                 trace vdelete $optionName rwu $p
     196                if {[catch {$p $optionName delete} result]} {
     197                    ui_debug "error during unset trace ($p): $result\n$::errorInfo"
     198                }
    190199            }
    191             return
     200            trace add variable $optionName {read write unset} option_proc_trace
    192201        }
    193202    }
Note: See TracChangeset for help on using the changeset viewer.