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

[cal at macports.org]

Revision: 151777
          https://trac.macports.org/changeset/151777
Author:   cal at macports.org
Date:     2016-08-21 15:50:30 -0700 (Sun, 21 Aug 2016)
Log Message:
-----------
base: porttrace: Do not store duplicate violations

The violations list became slow for large builds, which could be noticed
especially when software uses Qt (which creates a large number of false
positive violations in trace mode at the moment due to the use of directory
symlinks).

Replace the current list that kept duplicates with a list that will deduplicate
and automatically sort in O(log n).

Add a unit test to ensure that the implementation works as expected.

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

Added Paths:
-----------
    trunk/base/src/port1.0/tests/porttrace.test

Modified: trunk/base/src/port1.0/porttrace.tcl
===================================================================
--- trunk/base/src/port1.0/porttrace.tcl	2016-08-21 22:47:55 UTC (rev 151776)
+++ trunk/base/src/port1.0/porttrace.tcl	2016-08-21 22:50:30 UTC (rev 151777)
@@ -48,12 +48,13 @@
 	variable thread
 
 	##
-	# A list of files to which access was denied by trace mode.
+	# An ordered duplicate-free list of files to which access was denied by
+	# trace mode.
 	variable sandbox_violation_list [list]
 
 	##
-	# A list of files inside the MacPorts prefix but unknown to MacPorts that
-	# were used by the current trace session.
+	# An ordered duplicate-free list of files inside the MacPorts prefix but
+	# unknown to MacPorts that were used by the current trace session.
 	variable sandbox_unknown_list [list]
 
     proc appendEntry {sandbox path action} {
@@ -466,7 +467,7 @@
 	proc slave_add_sandbox_violation {path} {
 		variable sandbox_violation_list
 
-		lappend sandbox_violation_list $path
+		sorted_list_insert sandbox_violation_list $path
 	}
 
 	##
@@ -492,6 +493,36 @@
 	proc slave_add_sandbox_unknown {path} {
 		variable sandbox_unknown_list
 
-		lappend sandbox_unknown_list $path
+		sorted_list_insert sandbox_unknown_list $path
 	}
+
+	##
+	# Insert an element into a sorted list, keeping the list sorted. If the
+	# element is already present in the list, do nothing. This should run in
+	# O(log n) to be useful.
+	proc sorted_list_insert {listname element} {
+		upvar $listname l
+
+		set rboundary [llength $l]
+		set lboundary 0
+
+		while {[set distance [expr {$rboundary - $lboundary}]] > 0} {
+			set index [expr {$lboundary + ($distance / 2)}]
+
+			set cmp [string compare $element [lindex $l $index]]
+			if {$cmp == 0} {
+				# element already present, do nothing
+				return
+			} elseif {$cmp < 0} {
+				# continue left
+				set rboundary $index
+			} else {
+				# continue right
+				set lboundary [expr {$index + 1}]
+			}
+		}
+
+		# we're at the end, lets insert here
+		set l [linsert $l $lboundary $element]
+	}
 }

Added: trunk/base/src/port1.0/tests/porttrace.test
===================================================================
--- trunk/base/src/port1.0/tests/porttrace.test	                        (rev 0)
+++ trunk/base/src/port1.0/tests/porttrace.test	2016-08-21 22:50:30 UTC (rev 151777)
@@ -0,0 +1,42 @@
+# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
+
+package require tcltest 2
+namespace import tcltest::*
+
+set pwd [file dirname [file normalize $argv0]]
+
+package require Tclx
+package require porttrace 1.0
+
+test sorted_list_insert {
+    Test porttrace::sorted_list_insert
+} -setup {
+    set numbers [list]
+    for {set i 0} {$i < 1000} {incr i} {
+        lappend numbers [random 2000]
+    }
+    set sorted_numbers [lsort -unique $numbers]
+} -body {
+    # random is provided by TclX
+    set l [list]
+
+    foreach num $numbers {
+        porttrace::sorted_list_insert l $num
+    }
+
+    set differences [list]
+    set l_len [llength $l]
+    set s_len [llength $sorted_numbers]
+    if {$l_len != $s_len} {
+        lappend differences [list "length" $l_len $s_len]
+    }
+    for {set i 0} {$i < [expr {min($l_len, $s_len)}]} {incr i} {
+        if {[lindex $l $i] ne [lindex $sorted_numbers $i]} {
+            lappend differences [list $i [lindex $l $i] [lindex $sorted_numbers $i]]
+        }
+    }
+
+    return $differences
+} -result [list]
+
+cleanupTests
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.macosforge.org/pipermail/macports-changes/attachments/20160821/dd8e77a2/attachment.html>