[51569] trunk/base/src/port1.0

[raimue at macports.org]

Revision: 51569
          http://trac.macports.org/changeset/51569
Author:   raimue at macports.org
Date:     2009-05-27 16:55:37 -0700 (Wed, 27 May 2009)
Log Message:
-----------
port1.0:
Warn about deprecated variables only in portlint by incrementing a reference
counter when an deprecated option is accessed.

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

Modified: trunk/base/src/port1.0/portlint.tcl
===================================================================
--- trunk/base/src/port1.0/portlint.tcl	2009-05-27 23:52:02 UTC (rev 51568)
+++ trunk/base/src/port1.0/portlint.tcl	2009-05-27 23:55:37 UTC (rev 51569)
@@ -474,6 +474,22 @@
         }
     }
 
+    # Check for use of deprecated options
+    set deprecated_options_name [get_deprecated_options]
+    global $deprecated_options_name
+    foreach option [array names $deprecated_options_name] {
+        set newoption [lindex [set ${deprecated_options_name}($option)] 0]
+        set refcount  [lindex [set ${deprecated_options_name}($option)] 1]
+
+        if {$refcount > 0} {
+            if {$newoption != ""} {
+                ui_warn "Using deprecated option '$option', superseded by '$newoption'"
+            } else {
+                ui_warn "Using deprecated option '$option'"
+            }
+        }
+    }
+
     ### TODO: more checks to Tcl variables/sections
 
     ui_debug "Name: $name"

Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl	2009-05-27 23:52:02 UTC (rev 51568)
+++ trunk/base/src/port1.0/portutil.tcl	2009-05-27 23:55:37 UTC (rev 51569)
@@ -199,7 +199,8 @@
 # @param value ignored
 proc handle_deprecated_option {option action {value ""}} {
     global name $option deprecated_options
-    set newoption $deprecated_options($option)
+    set newoption [lindex $deprecated_options($option) 0]
+    set refcount  [lindex $deprecated_options($option) 1]
     global $newoption
 
     if {$newoption == ""} {
@@ -207,7 +208,9 @@
         return
     }
 
-    ui_warn "Port $name using deprecated option \"$option\", superseded by \"$newoption\"."
+    # Increment reference counter
+    lset deprecated_options($option) 1 [expr $refcount + 1]
+
     if {$action != "read"} {
         $newoption [set $option]
     } else {
@@ -216,15 +219,23 @@
 }
 
 ##
-# Causes a warning to be printed when an option is set or accessed
+# Get the name of the array containing the deprecated options
+# Thin layer avoiding to share global variables without notice
+proc get_deprecated_options {} {
+    return "deprecated_options"
+}
+
+##
+# Mark an option as deprecate
+# If it is set or accessed, it will be mapped it to the new option
 #
 # @param option name of the option
 # @param newoption name of a superseding option
 proc option_deprecate {option {newoption ""} } {
     global deprecated_options
     # If a new option is specified, default the option to $newoption
-    set deprecated_options($option) $newoption
-    # Register a proc for printing a warning
+    set deprecated_options($option) [list $newoption 0]
+    # Register a proc for handling the deprecation
     option_proc $option handle_deprecated_option
 }
 
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090527/287a5a5a/attachment.html>