[64533] trunk/base/src

jmr at macports.org jmr at macports.org
Mon Mar 8 03:50:03 PST 2010


Revision: 64533
          http://trac.macports.org/changeset/64533
Author:   jmr at macports.org
Date:     2010-03-08 03:50:01 -0800 (Mon, 08 Mar 2010)
Log Message:
-----------
record negated variants in registry and use in upgrade (#2377), record active rather than requested variants in statefile

Modified Paths:
--------------
    trunk/base/src/cregistry/sql.c
    trunk/base/src/macports1.0/macports.tcl
    trunk/base/src/package1.0/portarchive.tcl
    trunk/base/src/package1.0/portunarchive.tcl
    trunk/base/src/port1.0/portinstall.tcl
    trunk/base/src/port1.0/portutil.tcl
    trunk/base/src/registry2.0/entryobj.c
    trunk/base/src/registry2.0/receipt_sqlite.tcl

Modified: trunk/base/src/cregistry/sql.c
===================================================================
--- trunk/base/src/cregistry/sql.c	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/cregistry/sql.c	2010-03-08 11:50:01 UTC (rev 64533)
@@ -284,7 +284,7 @@
             "id INTEGER PRIMARY KEY AUTOINCREMENT, "
             "name TEXT COLLATE NOCASE, portfile CLOB, url TEXT, "
             "location TEXT, epoch INTEGER, version TEXT COLLATE VERSION, "
-            "revision INTEGER, variants TEXT, default_variants TEXT, "
+            "revision INTEGER, variants TEXT, negated_variants TEXT, "
             "state TEXT, date DATETIME, installtype TEXT, archs TEXT, "
             "requested INT, os_platform TEXT, os_major INTEGER, "
             "UNIQUE (name, epoch, version, revision, variants), "

Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/macports1.0/macports.tcl	2010-03-08 11:50:01 UTC (rev 64533)
@@ -1458,7 +1458,7 @@
     macports::push_log $mport
     # xxx: set the work path?
     set workername [ditem_key $mport workername]
-    if {![catch {$workername eval check_variants variations $target} result] && $result == 0 &&
+    if {![catch {$workername eval check_variants $target} result] && $result == 0 &&
         ![catch {$workername eval eval_targets $target} result] && $result == 0} {
         # If auto-clean mode, clean-up after dependency install
         if {[string equal ${macports::portautoclean} "yes"]} {
@@ -1492,7 +1492,7 @@
     set workername [ditem_key $mport workername]
 
     # check variants
-    if {[$workername eval check_variants variations $target] != 0} {
+    if {[$workername eval check_variants $target] != 0} {
         return 1
     }
     set portname [_mportkey $mport name]
@@ -1561,12 +1561,12 @@
         }
     }
 
+    set clean 0
     if {[string equal $target "install"]} {
         # mark port as explicitly requested
         $workername eval set user_options(ports_requested) 1
         
         # If we're doing an install, check if we should clean after
-        set clean 0
         if {[string equal ${macports::portautoclean} "yes"]} {
             set clean 1
         }
@@ -2640,6 +2640,7 @@
             set version_active $version
             set revision_active $revision
             set variant_active $variant
+            set epoch_active $epoch
         }
     }
 
@@ -2649,33 +2650,37 @@
     ui_debug "$portname ${version_installed}_${revision_installed} $variant_installed is the latest installed"
     if {$anyactive} {
         ui_debug "$portname ${version_active}_${revision_active} $variant_active is active"
+        # save existing variant for later use
+        set oldvariant $variant_active
+        set regref [registry::open_entry $portname $version_active $revision_active $variant_active $epoch_active]
     } else {
         ui_debug "no version of $portname is active"
-    }
-
-    # save existing variant for later use
-    if {$anyactive} {
-        set oldvariant $variant_active
-    } else {
         set oldvariant $variant_installed
+        set regref [registry::open_entry $portname $version_installed $revision_installed $variant_installed $epoch_installed]
     }
+    set oldnegatedvariant [registry::property_retrieve $regref negated_variants]
+    if {$oldnegatedvariant == 0} {
+        set oldnegatedvariant {}
+    }
 
     # Before we do
     # dependencies, we need to figure out the final variants,
     # open the port, and update the portinfo.
-
     set porturl $portinfo(porturl)
     if {![info exists porturl]} {
         set porturl file://./
     }
 
-    # will break if we start recording negative variants (#2377)
-    set variant [lrange [split $oldvariant +] 1 end]
-    ui_debug "Merging existing variants $variant into variants"
+    set minusvariant [lrange [split $oldnegatedvariant -] 1 end]
+    set plusvariant [lrange [split $oldvariant +] 1 end]
+    ui_debug "Merging existing variants '${oldvariant}${oldnegatedvariant}' into variants"
     set oldvariantlist [list]
-    foreach v $variant {
+    foreach v $plusvariant {
         lappend oldvariantlist $v "+"
     }
+    foreach v $minusvariant {
+        lappend oldvariantlist $v "-"
+    }
     # remove implicit variants, without printing warnings
     set oldvariantlist [mport_filtervariants $oldvariantlist no]
 

Modified: trunk/base/src/package1.0/portarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portarchive.tcl	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/package1.0/portarchive.tcl	2010-03-08 11:50:01 UTC (rev 64533)
@@ -65,7 +65,7 @@
 
 proc portarchive::archive_init {args} {
     global UI_PREFIX target_state_fd
-    global variations package.destpath workpath
+    global package.destpath workpath
     global ports_force ports_source_only ports_binary_only
     global name version revision portvariants
     global archive.destpath archive.type archive.meta
@@ -77,18 +77,6 @@
         return -code error "Archive mode is not enabled!"
     }
 
-    # Define port variants if not already defined
-    if { ![info exists portvariants] } {
-        set portvariants ""
-        set vlist [lsort -ascii [array names variations]]
-        # Put together variants in the form +foo+bar for the archive name
-        foreach v $vlist {
-            if {$variations($v) == "+"} {
-                append portvariants "+${v}"
-            }
-        }
-    }
-
     # Define archive destination directory and target filename
     if {![string equal ${archive.destpath} ${workpath}] && ![string equal ${archive.destpath} ""]} {
         if {$supported_archs == "noarch"} {
@@ -312,7 +300,7 @@
 }
 
 proc portarchive::archive_main {args} {
-    global UI_PREFIX variations
+    global UI_PREFIX PortInfo
     global workpath destpath portpath ports_force
     global name epoch version revision portvariants
     global archive.fulldestpath archive.type archive.file archive.path
@@ -380,9 +368,10 @@
     } else {
         puts $fd "@archs ${os.arch}"
     }
-    set vlist [lsort -ascii [array names variations]]
+    array set ourvariations $PortInfo(active_variants)
+    set vlist [lsort -ascii [array names ourvariations]]
     foreach v $vlist {
-        if {$variations($v) == "+"} {
+        if {$ourvariations($v) == "+"} {
             puts $fd "@portvariant +${v}"
         }
     }
@@ -435,7 +424,6 @@
         } else {
             putel $sd arch ${os.arch}
         }
-        set vlist [lsort -ascii [array names variations]]
         putlist $sd variants variant $vlist
 
         if {[exists categories]} {

Modified: trunk/base/src/package1.0/portunarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portunarchive.tcl	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/package1.0/portunarchive.tcl	2010-03-08 11:50:01 UTC (rev 64533)
@@ -61,7 +61,7 @@
 set_ui_prefix
 
 proc portunarchive::unarchive_init {args} {
-    global UI_PREFIX target_state_fd variations workpath
+    global UI_PREFIX target_state_fd workpath
     global ports_force ports_source_only ports_binary_only
     global name version revision portvariants portpath
     global unarchive.srcpath unarchive.type unarchive.file unarchive.path unarchive.fullsrcpath
@@ -72,18 +72,6 @@
         return -code error "Archive mode is not enabled!"
     }
 
-    # Define port variants if not already defined
-    if { ![info exists portvariants] } {
-        set portvariants ""
-        set vlist [lsort -ascii [array names variations]]
-        # Put together variants in the form +foo+bar for the archive name
-        foreach v $vlist {
-            if {$variations($v) == "+"} {
-                append portvariants "+${v}"
-            }
-        }
-    }
-
     # Define archive directory, file, and path
     if {![string equal ${unarchive.srcpath} ${workpath}] && ![string equal ${unarchive.srcpath} ""]} {
         if {$supported_archs == "noarch"} {
@@ -289,7 +277,6 @@
 
 proc portunarchive::unarchive_main {args} {
     global UI_PREFIX
-    global name version revision portvariants
     global unarchive.dir unarchive.file unarchive.pipe_cmd
 
     # Setup unarchive command

Modified: trunk/base/src/port1.0/portinstall.tcl
===================================================================
--- trunk/base/src/port1.0/portinstall.tcl	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/port1.0/portinstall.tcl	2010-03-08 11:50:01 UTC (rev 64533)
@@ -142,7 +142,7 @@
     global name version portpath categories description long_description \
     homepage depends_run installPlist package-install uninstall workdir \
     worksrcdir UI_PREFIX destroot revision maintainers user_options \
-    portvariants default_variants targets depends_lib PortInfo epoch license \
+    portvariants negated_variants targets depends_lib PortInfo epoch license \
     registry.installtype registry.path registry.format \
     os.arch configure.build_arch configure.universal_archs supported_archs \
     os.platform os.major
@@ -181,8 +181,8 @@
             }
             # Trick to have a portable GMT-POSIX epoch-based time.
             $regref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
-            if {[info exists default_variants]} {
-                $regref default_variants $default_variants
+            if {[info exists negated_variants]} {
+                $regref negated_variants $negated_variants
             }
 
             foreach dep_portname $dep_portnames {
@@ -216,6 +216,9 @@
     } else {
         # Begin the registry entry
         set regref [registry_new $name $version $revision $portvariants $epoch]
+        if {[info exists negated_variants]} {
+            registry_prop_store $regref negated_variants $negated_variants
+        }
 
         set imagedir ""
         if { [registry_prop_retr $regref installtype] == "image" } {

Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/port1.0/portutil.tcl	2010-03-08 11:50:01 UTC (rev 64533)
@@ -1665,6 +1665,7 @@
     upvar $variations upvariations
 
     set selected [list]
+    set negated [list]
 
     foreach ditem $dlist {
         # Enumerate through the provides, tallying the pros and cons.
@@ -1683,13 +1684,14 @@
             }
         }
 
-        if {$cons > 0} { continue }
-
+        if {$cons > 0} {
+            lappend negated $ditem
+        }
         if {$pros > 0 && $ignored == 0} {
             lappend selected $ditem
         }
     }
-    return $selected
+    return [list $selected $negated]
 }
 
 proc variant_run {ditem} {
@@ -1720,24 +1722,26 @@
     # was turned on or off, a particular instance of the port is uniquely
     # characterized by the set of variants that are *on*. Thus, record those
     # variants in a string in a standard order as +var1+var2 etc.
-    # XXX: this doesn't quite work because of default variants, see ticket #2377
-proc canonicalize_variants {variants} {
+    # Can also do the same for -variants, for recording the negated list.
+proc canonicalize_variants {variants {sign "+"}} {
     array set vara $variants
     set result ""
     set vlist [lsort -ascii [array names vara]]
     foreach v $vlist {
-        if {$vara($v) == "+"} {
-            append result +$v
+        if {$vara($v) == $sign} {
+            append result "${sign}${v}"
         }
     }
     return $result
 }
 
 proc eval_variants {variations} {
-    global all_variants ports_force PortInfo portvariants
+    global all_variants ports_force PortInfo portvariants negated_variants
     set dlist $all_variants
     upvar $variations upvariations
     set chosen [choose_variants $dlist upvariations]
+    set negated [lindex $chosen 1]
+    set chosen [lindex $chosen 0]
     set portname $PortInfo(name)
 
     # Check to make sure the requested variations are available with this
@@ -1775,7 +1779,7 @@
     # it's convenient to check for inconsistent requests for
     # variations, namely foo +requirer -required where the 'requirer'
     # variant requires the 'required' one.
-    array set activevariants [list]
+    set activevariants [list]
     foreach dvar $newlist {
         set thevar [ditem_key $dvar provides]
         if {[info exists upvariations($thevar)] && $upvariations($thevar) eq "-"} {
@@ -1786,33 +1790,31 @@
             ui_error "Inconsistent variant specification: $portname variant +$thevar is required by at least one of $chosenlist, but specified -$thevar"
             return 1
         }
-        set activevariants($thevar) "+"
+        lappend activevariants $thevar "+"
     }
 
     # Record a canonical variant string, used e.g. in accessing the registry
-    set portvariants [canonicalize_variants [array get activevariants]]
+    set portvariants [canonicalize_variants $activevariants]
 
     # Make this important information visible in PortInfo
-    set PortInfo(active_variants) [array get activevariants]
+    set PortInfo(active_variants) $activevariants
     set PortInfo(canonical_active_variants) $portvariants
 
-    # XXX: I suspect it would actually work better in the following
-    # block to record the activevariants in the statefile rather than
-    # the upvariations, since as far as I can see different sets of
-    # upvariations which amount to the same activevariants in the end
-    # can share all aspects of the build. But I'm leaving this alone
-    # for the time being, so that someone with more extensive
-    # experience can examine the idea before putting it into
-    # action. -- GlenWhitney
+    # now set the negated variants
+    set negated_list [list]
+    foreach dvar $negated {
+        set thevar [ditem_key $dvar provides]
+        lappend negated_list $thevar "-"
+    }
+    set negated_variants [canonicalize_variants $negated_list "-"]
 
     return 0
 }
 
-proc check_variants {variations target} {
+proc check_variants {target} {
     global targets ports_force ports_dryrun PortInfo
-    upvar $variations upvariations
     set result 0
-    set portname $PortInfo(name)
+    array set variations $PortInfo(active_variants)
 
     # Make sure the variations match those stored in the statefile.
     # If they don't match, print an error indicating a 'port clean'
@@ -1840,13 +1842,13 @@
         set state_fd [open_statefile]
 
         array set oldvariations {}
-        if {[check_statefile_variants upvariations oldvariations $state_fd]} {
-            ui_error "Requested variants \"[canonicalize_variants [array get upvariations]]\" do not match original selection \"[canonicalize_variants [array get oldvariations]]\".\nPlease use the same variants again, perform 'port clean $portname' or specify the force option (-f)."
+        if {[check_statefile_variants variations oldvariations $state_fd]} {
+            ui_error "Requested variants \"[canonicalize_variants [array get variations]]\" do not match original selection \"[canonicalize_variants [array get oldvariations]]\".\nPlease use the same variants again, perform 'port clean [option name]' or specify the force option (-f)."
             set result 1
         } elseif {!([info exists ports_dryrun] && $ports_dryrun == "yes")} {
             # Write variations out to the statefile
-            foreach key [array names upvariations *] {
-            write_statefile variant $upvariations($key)$key $state_fd
+            foreach key [array names variations *] {
+                write_statefile variant $variations($key)$key $state_fd
             }
         }
 

Modified: trunk/base/src/registry2.0/entryobj.c
===================================================================
--- trunk/base/src/registry2.0/entryobj.c	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/registry2.0/entryobj.c	2010-03-08 11:50:01 UTC (rev 64533)
@@ -48,7 +48,7 @@
     "version",
     "revision",
     "variants",
-    "default_variants",
+    "negated_variants",
     "date",
     "state",
     "installtype",
@@ -372,7 +372,7 @@
     { "version", entry_obj_prop },
     { "revision", entry_obj_prop },
     { "variants", entry_obj_prop },
-    { "default_variants", entry_obj_prop },
+    { "negated_variants", entry_obj_prop },
     { "date", entry_obj_prop },
     { "state", entry_obj_prop },
     { "installtype", entry_obj_prop },

Modified: trunk/base/src/registry2.0/receipt_sqlite.tcl
===================================================================
--- trunk/base/src/registry2.0/receipt_sqlite.tcl	2010-03-08 11:21:25 UTC (rev 64532)
+++ trunk/base/src/registry2.0/receipt_sqlite.tcl	2010-03-08 11:50:01 UTC (rev 64533)
@@ -128,7 +128,10 @@
             set ret [$ref location]
         }
         default {
-            set ret [$ref $property]
+            if {[catch {set ret [$ref $property]}]} {
+                # match behaviour of receipt_flat
+                set ret 0
+            }
         }
     }
     return $ret
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100308/88ff54d6/attachment.html>


More information about the macports-changes mailing list