Changeset 24678

Timestamp:

04/29/07 15:50:55 (19 months 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

Location:

trunk/base

Files:

• ChangeLog (modified) (1 diff)
• src/port1.0/portdepends.tcl (modified) (1 diff)
• src/port1.0/portutil.tcl (modified) (5 diffs)

trunk/base/ChangeLog

@@ -6 +6 @@
 
 (unreleased):
+
+    - variable tracing now works in a much better way and handles unsets properly.
+      Similarly, ${option}-delete now works better. Depends validation no longer
+      attempts to validate when the variable is unset. Additionally, the validation
+      now actually validates each depspec instead of simply finding a single spec
+      within the list that works (ticket #11868, eridius r24678).
 
     - macports infrastructure now easier to use from scripts.

trunk/base/src/port1.0/portdepends.tcl

@@ -43 +43 @@
 option_proc depends_lib validate_depends_options
 
-proc validate_depends_options {option action args} {
+proc validate_depends_options {option action {value ""}} {
     global targets
-    switch -regex $action {
-                set|append|delete {
-                        foreach depspec $args {
+    switch $action {
+                set {
+                        foreach depspec $value {
                                 switch -regex $depspec {
-                                        (lib|bin|path):([-A-Za-z0-9_/.${}^?+()|\\\\]+):([-A-Za-z./0-9_]+) {}
-                                        (port):([-A-Za-z./0-9_]+) {}
+                                        ^(lib|bin|path):([-A-Za-z0-9_/.${}^?+()|\\\\]+):([-A-Za-z./0-9_]+)$ {}
+                                        ^(port):([-A-Za-z./0-9_]+)$ {}
                                         default { return -code error [format [msgcat::mc "invalid depspec: %s"] $depspec] }
                                 }

trunk/base/src/port1.0/portutil.tcl

@@ -91 +91 @@
 proc options {args} {
     foreach option $args {
-        proc $option {args} "
-            global ${option} user_options option_procs
-            if {!\[info exists user_options(${option})\]} {
-                set ${option} \$args
+        proc $option {args} [subst -nocommands {
+            global $option user_options option_procs
+            if {![info exists user_options($option)]} {
+                set $option \$args
             }
-        "
-        proc ${option}-delete {args} "
-            global ${option} user_options option_procs
-            if {!\[info exists user_options(${option})\] && \[info exists ${option}\]} {
+        }]
+        proc ${option}-delete {args} [subst -nocommands {
+            global $option user_options option_procs
+            if {![info exists user_options($option)] && [info exists $option]} {
+                set temp $option
                 foreach val \$args {
-                   set ${option} \[ldelete \${$option} \$val\]
+                   set temp [ldelete \${$option} \$val]
                 }
-                if {\[string length \${${option}}\] == 0} {
-                    unset ${option}
+                if {\$temp eq ""} {
+                    unset $option
+                } else {
+                    set $option \$temp
                 }
             }
-        "
-        proc ${option}-append {args} "
-            global ${option} user_options option_procs
-            if {!\[info exists user_options(${option})\]} {
-                if {\[info exists ${option}\]} {
-                    set ${option} \[concat \${$option} \$args\]
+        }]
+        proc ${option}-append {args} [subst -nocommands {
+            global $option user_options option_procs
+            if {![info exists user_options($option)]} {
+                if {[info exists $option]} {
+                    set $option [concat \${$option} \$args]
                 } else {
-                    set ${option} \$args
+                    set $option \$args
                 }
             }
-        "
+        }]
     }
 }
@@ -123 +126 @@
 proc options_export {args} {
     foreach option $args {
-        proc options::export-${option} {args} "
-            global ${option} PortInfo
-            if {\[info exists ${option}\]} {
-                set PortInfo(${option}) \${${option}}
-            } else {
-                unset PortInfo(${option})
+        proc options::export-${option} {option action {value ""}} [subst -nocommands {
+            global $option PortInfo
+            switch \$action {
+                set {
+                    set PortInfo($option) \$value
+                }
+                delete {
+                    unset PortInfo($option)
+                }
             }
-        "
-        option_proc ${option} options::export-${option}
+        }]
+        option_proc $option options::export-$option
     }
 }
@@ -141 +147 @@
     # Display a warning
     if {$newoption != ""} {
-        proc warn_deprecated_${option} {option action args} "
+        proc warn_deprecated_${option} {option action args} [subst -nocommands {
             global portname $option $newoption
-            if {\$action != \"read\"} {
+            if {\$action != "read"} {
                 $newoption \$$option
             } else {
-                ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\"
+                ui_warn "Port \$portname using deprecated option \\\"$option\\\"."
                 $option \[set $newoption\]
             }
-        "
+        }]
     } else {
-        proc warn_deprecated_$option {option action args} "
+        proc warn_deprecated_$option {option action args} [subst -nocommands {
             global portname $option $newoption
-            ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\"
-        "
+            ui_warn "Port \$portname using deprecated option \\\"$option\\\"."
+        }]
     }
     option_proc $option warn_deprecated_$option
@@ -161 +167 @@
 proc option_proc {option args} {
     global option_procs $option
-    eval lappend option_procs($option) $args
-    # Add a read trace to the variable, as the option procedures have no access to reads
-    trace variable $option rwu option_proc_trace
+    if {[info exists option_procs($option)]} {
+        set option_procs($option) [concat $option_procs($option) $args]
+        # we're already tracing
+    } else {
+        set option_procs($option) $args
+        trace add variable $option {read write unset} option_proc_trace
+    }
 }
 
@@ -170 +180 @@
 proc option_proc_trace {optionName index op} {
     global option_procs
-    upvar $optionName optionValue
+    upvar $optionName $optionName
     switch $op {
-        w {
+        write {
             foreach p $option_procs($optionName) {
-                $p $optionName set $optionValue
+                $p $optionName set [set $optionName]
             }
-            return
-        }
-        r {
+        }
+        read {
             foreach p $option_procs($optionName) {
                 $p $optionName read
             }
-            return
-        }
-        u {
+        }
+        unset {
             foreach p $option_procs($optionName) {
-                $p $optionName delete
-                trace vdelete $optionName rwu $p
+                if {[catch {$p $optionName delete} result]} {
+                    ui_debug "error during unset trace ($p): $result\n$::errorInfo"
+                }
             }
-            return
+            trace add variable $optionName {read write unset} option_proc_trace
         }
     }