[24678] trunk/base

source_changes at macosforge.org source_changes at macosforge.org
Sun Apr 29 15:50:56 PDT 2007


Revision: 24678
          http://trac.macosforge.org/projects/macports/changeset/24678
Author:   eridius at macports.org
Date:     2007-04-29 15:50:55 -0700 (Sun, 29 Apr 2007)

Log 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

Modified Paths:
--------------
    trunk/base/ChangeLog
    trunk/base/src/port1.0/portdepends.tcl
    trunk/base/src/port1.0/portutil.tcl

Modified: trunk/base/ChangeLog
===================================================================
--- trunk/base/ChangeLog	2007-04-29 22:41:56 UTC (rev 24677)
+++ trunk/base/ChangeLog	2007-04-29 22:50:55 UTC (rev 24678)
@@ -6,6 +6,12 @@
 
 (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.
       ui_prefix and ui_channels have default implementations, and
       all arguments to dportinit are now optional (ticket #11837, eridius r24460).

Modified: trunk/base/src/port1.0/portdepends.tcl
===================================================================
--- trunk/base/src/port1.0/portdepends.tcl	2007-04-29 22:41:56 UTC (rev 24677)
+++ trunk/base/src/port1.0/portdepends.tcl	2007-04-29 22:50:55 UTC (rev 24678)
@@ -42,14 +42,14 @@
 option_proc depends_run validate_depends_options
 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] }
 				}
 			}

Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl	2007-04-29 22:41:56 UTC (rev 24677)
+++ trunk/base/src/port1.0/portutil.tcl	2007-04-29 22:50:55 UTC (rev 24678)
@@ -90,47 +90,53 @@
 # Arguments: <list of options>
 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
                 }
             }
-        "
+        }]
     }
 }
 
 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
     }
 }
 
@@ -140,55 +146,58 @@
     # If a new option is specified, default the option to {${newoption}}
     # 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
 }
 
 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
+    }
 }
 
 # option_proc_trace
 # trace handler for option reads. Calls option procedures with correct arguments.
 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
         }
     }
 }

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20070429/33bda3c3/attachment.html


More information about the macports-changes mailing list