<pre style='margin:0'>
Joshua Root (jmroot) pushed a commit to branch master
in repository macports-base.

</pre>
<p><a href="https://github.com/macports/macports-base/commit/a28e81ce2b21c1800248188bf6ff0620bbe9b162">https://github.com/macports/macports-base/commit/a28e81ce2b21c1800248188bf6ff0620bbe9b162</a></p>
<pre style="white-space: pre; background: #F8F8F8">The following commit(s) were added to refs/heads/master by this push:
<span style='display:block; white-space:pre;color:#404040;'>     new a28e81ce2 More portlist improvements
</span>a28e81ce2 is described below

<span style='display:block; white-space:pre;color:#808000;'>commit a28e81ce2b21c1800248188bf6ff0620bbe9b162
</span>Author: Joshua Root <jmr@macports.org>
AuthorDate: Wed Jan 31 14:13:59 2024 +1100

<span style='display:block; white-space:pre;color:#404040;'>    More portlist improvements
</span><span style='display:block; white-space:pre;color:#404040;'>    
</span><span style='display:block; white-space:pre;color:#404040;'>    More use of dict, including rewrites of opIntersection and opComplement
</span><span style='display:block; white-space:pre;color:#404040;'>    which should perform considerably better.
</span><span style='display:block; white-space:pre;color:#404040;'>    
</span><span style='display:block; white-space:pre;color:#404040;'>    No more use of regex_pat_sanitize in portlist1.0, so it moves back to
</span><span style='display:block; white-space:pre;color:#404040;'>    port.tcl.
</span><span style='display:block; white-space:pre;color:#404040;'>    
</span><span style='display:block; white-space:pre;color:#404040;'>    Bug fix for version comparison in portlist_compare. It should be
</span><span style='display:block; white-space:pre;color:#404040;'>    correct more often now, but it can't always be correct if there are
</span><span style='display:block; white-space:pre;color:#404040;'>    underscores in the version because of inherent ambiguity with the
</span><span style='display:block; white-space:pre;color:#404040;'>    combined version and revision.
</span>---
 src/port/port.tcl            |   5 ++
 src/portlist1.0/portlist.tcl | 140 +++++++++++++++++++------------------------
 2 files changed, 67 insertions(+), 78 deletions(-)

<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port/port.tcl b/src/port/port.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index d279d23c0..269841b35 100755
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port/port.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port/port.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -282,6 +282,11 @@ proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retli
</span>     }
 }
 
<span style='display:block; white-space:pre;background:#e0ffe0;'>+proc regex_pat_sanitize {s} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    return $sanitized
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span> ##
 # Makes sure we get the current terminal size
 proc term_init_size {} {
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/portlist1.0/portlist.tcl b/src/portlist1.0/portlist.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 80940e0bd..d9963a551 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/portlist1.0/portlist.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/portlist1.0/portlist.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -6,11 +6,6 @@ namespace eval portlist {
</span>     variable split_variants_re {([-+])([[:alpha:]_]+[\w\.]*)}
 }
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc regex_pat_sanitize {s} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    return $sanitized
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> # Form a composite version as is sometimes used for registry functions
 # This function sorts the variants and presents them in a canonical representation
 proc composite_version {version variations {emptyVersionOkay 0}} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -140,23 +135,25 @@ proc foreachport {portlist block} {
</span> 
 
 proc portlist_compare { a b } {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    array set a_ $a
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    array set b_ $b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set namecmp [string equal -nocase $a_(name) $b_(name)]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set namecmp [string equal -nocase [dict get $a name] [dict get $b name]]
</span>     if {$namecmp != 1} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        if {[dict get $a name] eq [lindex [lsort -dictionary [list [dict get $a name] [dict get $b name]]] 0]} {
</span>             return -1
         }
         return 1
     }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    set avr_ [split $a_(version) "_"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set bvr_ [split $b_(version) "_"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # the version proper is everything up to the last underscore
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set avr_ [split [dict get $a version] _]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set bvr_ [split [dict get $b version] _]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set av_ [join [lrange $avr_ 0 end-1] _]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set bv_ [join [lrange $bvr_ 0 end-1] _]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set versioncmp [vercmp $av_ $bv_]
</span>     if {$versioncmp != 0} {
         return $versioncmp
     }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    set ar_ [lindex $avr_ 1]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set br_ [lindex $bvr_ 1]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # revision comes after the last underscore
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set ar_ [lindex $avr_ end]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set br_ [lindex $bvr_ end]
</span>     if {$ar_ < $br_} {
         return -1
     } elseif {$ar_ > $br_} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -167,44 +164,42 @@ proc portlist_compare { a b } {
</span> }
 
 # Sort two ports in NVR (name@version_revision) order
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc portlist_sort { list } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    return [lsort -command portlist_compare $list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc portlist_sort {portlist} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    return [lsort -command portlist_compare $portlist]
</span> }
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc portlist_compareint { a b } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    return [portlist_compare [array get a_] [array get b_]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc portlist_compareint {a b} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set a_ [dict create name [lindex $a 0] version [lindex $a 1]_[lindex $a 2]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set b_ [dict create name [lindex $b 0] version [lindex $b 1]_[lindex $b 2]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    return [portlist_compare $a_ $b_]
</span> }
 
 # Same as portlist_sort, but with numeric indexes {name version revision}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc portlist_sortint { list } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    return [lsort -command portlist_compareint $list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc portlist_sortint {portlist} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    return [lsort -command portlist_compareint $portlist]
</span> }
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc unique_entries { entries } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc unique_entries {entries} {
</span>     # Form the list of all the unique elements in the list a,
     # considering only the port fullname, and taking the first
     # found element first
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    set result [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    array unset unique
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set unique [dict create]
</span>     foreach item $entries {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        array set port $item
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        if {[info exists unique($port(fullname))]} continue
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set unique($port(fullname)) 1
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        lappend result $item
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        set fullname [dict get $item fullname]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        if {[dict exists $unique $fullname]} continue
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        dict set unique $fullname $item
</span>     }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    return $result
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    return [dict values $unique]
</span> }
 
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc opUnion { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc opUnion {a b} {
</span>     # Return the unique elements in the combined two lists
     return [unique_entries [concat $a $b]]
 }
 
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc opIntersection { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc opIntersection {a b} {
</span>     set result [list]
 
     # Rules we follow in performing the intersection of two port lists:
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -218,36 +213,30 @@ proc opIntersection { a b } {
</span>     #   If there's an exact match, we take it.
     #   If there's a match between simple and discriminated, we take the later.
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    # First create a list of the fully discriminated names in b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    array unset bfull
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set i 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # First create a 2-level dict of the items in b.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # Top level keys are normalised port names.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # Second level is a dict mapping fully discriminated names to the
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # corresponding full entry.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set bdict [dict create]
</span>     foreach bitem [unique_entries $b] {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        array set port $bitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set bfull($port(fullname)) $i
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        incr i
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        dict set bdict [string tolower [dict get $bitem name]] [dict get $bitem fullname] $bitem
</span>     }
 
     # Walk through each item in a, matching against b
     foreach aitem [unique_entries $a] {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        array set port $aitem
</span> 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        # Quote the fullname and portname to avoid special characters messing up the regexp
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set safefullname [regex_pat_sanitize $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set simpleform [string equal -nocase "$port(name)/" $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            set pat "^${safefullname}"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        } else {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            set safename [regex_pat_sanitize [string tolower $port(name)]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            set pat "^${safefullname}$|^${safename}/$"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        set normname [string tolower [dict get $aitem name]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        if {![dict exists $bdict $normname]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            # this port name is not in b at all
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            continue
</span>         }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set matches [array names bfull -regexp $pat]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        foreach match $matches {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-                set i $bfull($match)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-                lappend result [lindex $b $i]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        if {[dict get $aitem version] eq "" && [dict get $aitem variants] eq ""} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            # just a port name, append all entries with this name in b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            lappend result {*}[dict values [dict get $bdict $normname]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            # append if either the fullname or a simple entry with a matching name is in b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            set fullname [dict get $aitem fullname]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            if {[dict exists $bdict $normname $fullname] || [dict exists $bdict $normname ${normname}/]} {
</span>                 lappend result $aitem
             }
         }
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -257,40 +246,35 @@ proc opIntersection { a b } {
</span> }
 
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc opComplement { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc opComplement {a b} {
</span>     set result [list]
 
     # Return all elements of a not matching elements in b
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    # First create a list of the fully discriminated names in b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    array unset bfull
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set i 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # First create a 2-level dict of the items in b.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # Top level keys are normalised port names.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # Second level is a dict mapping fully discriminated names (to empty
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    # strings since we don't need the full entries from b.)
</span>     foreach bitem $b {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        array set port $bitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set bfull($port(fullname)) $i
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        incr i
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        dict set bdict [string tolower [dict get $bitem name]] [dict get $bitem fullname] ""
</span>     }
 
     # Walk through each item in a, taking all those items that don't match b
     foreach aitem $a {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        array set port $aitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        # Quote the fullname and portname to avoid special characters messing up the regexp
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set safefullname [regex_pat_sanitize $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        set simpleform [string equal -nocase "$port(name)/" $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            set pat "^${safefullname}"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        } else {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            set safename [regex_pat_sanitize [string tolower $port(name)]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            set pat "^${safefullname}$|^${safename}/$"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        set normname [string tolower [dict get $aitem name]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        if {![dict exists $bdict $normname]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            # this port name is not in b at all
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            lappend result $aitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            continue
</span>         }
 
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        set matches [array names bfull -regexp $pat]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        # We copy this element to result only if it didn't match against b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        if {![llength $matches]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            lappend result $aitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        # We now know the port name is in b, so only fully discriminated entries might not match
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        if {[dict get $aitem version] ne "" || [dict get $aitem variants] ne ""} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            set fullname [dict get $aitem fullname]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            # append if neither the fullname nor a simple entry with a matching name is in b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            if {![dict exists $bdict $normname $fullname] && ![dict exists $bdict $normname ${normname}/]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                lappend result $aitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            }
</span>         }
     }
 
</pre><pre style='margin:0'>

</pre>