#3 Performance fixes

cls/TestCoverage/Data/CodeUnit.cls

@@ -32,7 +32,7 @@ Property MethodMap As array Of %Integer;
 
 /// For classes, map of line numbers in code to associated method names
 /// For routines, map of labels to associated line numbers
-Property LineToMethodMap As array Of %String [ Private ];
+Property LineToMethodMap As array Of %Dictionary.CacheIdentifier [ Private ];
 
 /// Set to true if this class/routine is generated
 Property Generated As %Boolean [ InitialExpression = 0 ];
@@ -160,8 +160,13 @@ ClassMethod GetCurrentByName(pInternalName As %String, pSourceNamespace As %Stri
 			}
 		}
 
-		$$$ThrowOnError(pCodeUnit.%Save())
-
+		Set tSC = pCodeUnit.%Save()
+		If $$$ISERR(tSC) && $System.Status.Equals(tSC,$$$ERRORCODE($$$IDKeyNotUnique)) {
+			// Some other process beat us to it.
+			Set tSC = $$$OK
+			Set pCodeUnit = ..%OpenId(pCodeUnit.Hash,,.tSC)
+			Quit
+		}
 		// For non-class (e.g., .MAC/.INT) code, it's possible that something else generated it,
 		// so update the mappings between generated and the thing that generated it.
 		If (tType '= "CLS") {

cls/TestCoverage/Data/CodeUnitMap.cls

@@ -1,3 +1,5 @@
+/// This class maintains the mapping between .INT/.MAC/.CLS and therefore is critical for
+/// interpreting the .INT-level coverage data that the line-by-line monitor collects.
 Class TestCoverage.Data.CodeUnitMap Extends %Persistent
 {
 
@@ -23,33 +25,99 @@ ForeignKey ToCodeUnitFK(ToHash) References TestCoverage.Data.CodeUnit(Hash) [ On
 
 ClassMethod Create(pFromHash As %String, pFromLine As %Integer, pToHash As %String, pToLineStart As %Integer, pToLineEnd As %Integer) As %Status
 {
+	#def1arg DefaultStorageNode(%node) ##expression($$$comMemberKeyGet("TestCoverage.Data.CodeUnitMap", $$$cCLASSstorage, "Default", %node))
+	#def1arg CodeUnitMasterMap(%arg) $$$DefaultStorageNode($$$cSDEFdatalocation)(%arg)
+	#def1arg CodeUnitReverseMap(%arg) $$$DefaultStorageNode($$$cSDEFindexlocation)("Reverse",%arg)
+
 	Set tSC = $$$OK
 	Try {
-		&sql(insert or update %NOLOCK %NOCHECK into TestCoverage_Data.CodeUnitMap
-			(FromHash, FromLine, ToHash, ToLine)
-			select :pFromHash, :pFromLine, :pToHash, Counter
-			from TestCoverage.Sequence(:pToLineStart,:pToLineEnd))
-		If (SQLCODE < 0) {
-			Throw ##class(%Exception.SQL).CreateFromSQLCODE(SQLCODE,%msg)
+		For counter=pToLineStart:1:pToLineEnd {
+			// Uses direct global references for performance boost; this is one of the most performance-critical sections.
+			If '$Data($$$CodeUnitMasterMap(pFromHash,pFromLine,pToHash,counter)) {
+				&sql(insert %NOLOCK %NOCHECK into TestCoverage_Data.CodeUnitMap
+					(FromHash, FromLine, ToHash, ToLine)
+					select :pFromHash, :pFromLine, :pToHash, :counter)
+				If (SQLCODE < 0) {
+					Throw ##class(%Exception.SQL).CreateFromSQLCODE(SQLCODE,%msg)
+				}
+			}
 		}
 
 		// Insert/update transitive data (e.g., .INT -> .MAC (generator) -> .CLS)
+		// Original implementation:
+		/*
+		// Leg 1: Lines that map to the "from" line also map to the "to" line
+		// Leg 2: The "from" line also maps to lines that the "to" line maps to
 		&sql(
-			/* Lines that map to the "from" line also map to the "to" line */
 			insert or update %NOLOCK %NOCHECK into TestCoverage_Data.CodeUnitMap
 			(FromHash, FromLine, ToHash, ToLine)
 			select FromHash, FromLine, :pToHash, Counter
 			from TestCoverage.Sequence(:pToLineStart,:pToLineEnd),TestCoverage_Data.CodeUnitMap
 				where ToHash = :pFromHash and ToLine = :pFromLine
 			union
-			/* The "from" line also maps to lines that the "to" line maps to */
 			select :pFromHash, :pFromLine, ToHash, ToLine
 			from TestCoverage.Sequence(:pToLineStart,:pToLineEnd)
 				join TestCoverage_Data.CodeUnitMap
 				on FromHash = :pToHash and FromLine = Counter)
 		If (SQLCODE < 0) {
 			Throw ##class(%Exception.SQL).CreateFromSQLCODE(SQLCODE,%msg)
 		}
+		*/
+
+		// This introduced some unacceptable performance overhead, and has been rewritten with direct global references.
+		// This reduces overall overhead of code capture for test coverage measurement by roughly 40%.
+
+		// Leg 1: Lines that map to the "from" line also map to the "to" line
+		Set fromHash = ""
+		For {
+			Set fromHash = $Order($$$CodeUnitReverseMap(pFromHash,pFromLine,fromHash))
+			If (fromHash = "") {
+				Quit
+			}
+			Set fromLine = ""
+			For {
+				Set fromLine = $Order($$$CodeUnitReverseMap(pFromHash,pFromLine,fromHash,fromLine))
+				If (fromLine = "") {
+					Quit
+				}
+				For counter=pToLineStart:1:pToLineEnd {	
+					If '$Data($$$CodeUnitMasterMap(fromHash,fromLine,pToHash,counter)) {
+						&sql(insert %NOLOCK %NOCHECK into TestCoverage_Data.CodeUnitMap
+							(FromHash, FromLine, ToHash, ToLine)
+							select :fromHash, :fromLine, :pToHash, :counter)
+						If (SQLCODE < 0) {
+							Throw ##class(%Exception.SQL).CreateFromSQLCODE(SQLCODE,%msg)
+						}
+					}
+				}
+			}
+		}
+
+		For counter=pToLineStart:1:pToLineEnd {
+			// Leg 2: The "from" line also maps to lines that the "to" line maps to
+			Set toHash = ""
+			For {
+				Set toHash = $Order($$$CodeUnitMasterMap(pToHash,counter,toHash))
+				If (toHash = "") {
+					Quit
+				}
+				Set toLine = ""
+				For {
+					Set toLine = $Order($$$CodeUnitMasterMap(pToHash,counter,toHash,toLine))
+					If (toLine = "") {
+						Quit
+					}
+					If '$Data($$$CodeUnitMasterMap(pFromHash,pFromLine,toHash,toLine)) {
+						&sql(insert %NOLOCK %NOCHECK into TestCoverage_Data.CodeUnitMap
+							(FromHash, FromLine, ToHash, ToLine)
+							select :pFromHash, :pFromLine, :toHash, :toLine)
+						If (SQLCODE < 0) {
+							Throw ##class(%Exception.SQL).CreateFromSQLCODE(SQLCODE,%msg)
+						}
+					}
+				}
+			}
+		}
 	} Catch e {
 		Set tSC = e.AsStatus()
 	}

cls/TestCoverage/Data/Run.cls

@@ -85,7 +85,7 @@ ClassMethod MapRunCoverage(pRunIndex As %Integer) As %Status
 			Set tMetric = tRun.Metrics.GetAt(i)
 			Set tSQLStatement = "INSERT OR UPDATE %NOLOCK %NOCHECK INTO TestCoverage_Data.""Coverage_"_tMetric_""" "_
 				"(Coverage,element_key,"""_tMetric_""") "_
-				"SELECT target.ID,map.ToLine,NVL(oldMetric."""_tMetric_""",0) + metric."""_tMetric_""" "_
+				"SELECT target.ID,map.ToLine,NVL(oldMetric."""_tMetric_""",0) + SUM(metric."""_tMetric_""") "_
 				"FROM TestCoverage_Data.Coverage source "_
 				"JOIN TestCoverage_Data.CodeUnitMap map "_
 				"	ON source.Hash = map.FromHash "_
@@ -101,7 +101,8 @@ ClassMethod MapRunCoverage(pRunIndex As %Integer) As %Status
 				"	AND oldMetric.element_key = map.ToLine "_
 				"WHERE source.Run = ? "_
 				"	AND source.Ignore = 0"_
-				"	AND source.Calculated = 0"
+				"	AND source.Calculated = 0"_
+				"GROUP BY target.ID,map.ToLine"
 
 			#dim tResult As %SQL.StatementResult
 			Set tResult = ##class(%SQL.Statement).%ExecDirect(,tSQLStatement,pRunIndex)

cls/TestCoverage/Manager.cls

@@ -52,7 +52,8 @@ Property ProcessIDs As %List [ Internal, Private ];
 
 Property Run As TestCoverage.Data.Run;
 
-/// Known coverage targets (already snapshotted)
+/// Known coverage targets (already snapshotted). <br />
+/// Value at subscript is set to 1 if there are executable lines of code in the target, 0 if not.
 Property KnownCoverageTargets [ MultiDimensional, Private ];
 
 /// Cache of (name, type) -> hash
@@ -172,23 +173,33 @@ Method StartCoverageTracking() As %Status [ Private ]
 	Try {
 		If (..CoverageTargets '= "") {
 			Set $Namespace = ..SourceNamespace
-
+
+			Set tRelevantTargets = ""
 			Set tNewTargets = ""
 			Set tPointer = 0
 			While $ListNext(..CoverageTargets,tPointer,tCoverageTarget) {
-				If '$Data(..KnownCoverageTargets(tCoverageTarget)) {
+				If '$Data(..KnownCoverageTargets(tCoverageTarget),tIsRelevant)#2 {
 					Set tNewTargets = tNewTargets_$ListBuild(tCoverageTarget)
+				} ElseIf tIsRelevant {
+					Set tRelevantTargets = tRelevantTargets_$ListBuild(tCoverageTarget)
 				}
 			}
 
 			If (tNewTargets '= "") {
 				$$$StartTimer("Taking snapshot of code and CLS/MAC/INT mappings")
-				Do ##class(TestCoverage.Utils).Snapshot(tNewTargets)
+				Set tSC = ##class(TestCoverage.Utils).Snapshot(tNewTargets, .tNewRelevantTargets)
 				$$$StopTimer
+				$$$ThrowOnError(tSC)
 
 				Set tPointer = 0
 				While $ListNext(tNewTargets,tPointer,tNewTarget) {
-					Set ..KnownCoverageTargets(tNewTarget) = ""
+					Set ..KnownCoverageTargets(tNewTarget) = 0
+				}
+
+				Set tPointer = 0
+				While $ListNext(tNewRelevantTargets,tPointer,tRelevantTarget) {
+					Set ..KnownCoverageTargets(tRelevantTarget) = 1
+					Set tRelevantTargets = tRelevantTargets_$ListBuild(tRelevantTarget)
 				}
 			}
 
@@ -218,7 +229,7 @@ Method StartCoverageTracking() As %Status [ Private ]
 				}
 			}
 			Set tMetrics = $ListBuild("RtnLine") _ $Select(..Timing:$ListBuild("Time","TotalTime"),1:"")
-			$$$ThrowOnError(..Monitor.StartWithScope(..CoverageTargets,tMetrics,tProcessIDs))
+			$$$ThrowOnError(..Monitor.StartWithScope(tRelevantTargets,tMetrics,tProcessIDs))
 		}
 	} Catch e { 
 		Set tSC = e.AsStatus()
@@ -282,8 +293,6 @@ Method UpdateCoverageTargetsForTestDirectory(pDirectory As %String) As %Status [
 		}
 
 		Set tObjectCodeList = ..GetObjectCodeForSourceNames(tCoverageTargetList)
-		// Check the available memory before trying to capture coverage, so the user can remediate without waiting a really long time
-		$$$ThrowOnError(##class(TestCoverage.Utils.LineByLineMonitor).CheckAvailableMemory($ListLength(..ProcessIDs),$ListLength(tObjectCodeList)))
 		Set ..CoverageTargets = tObjectCodeList // Also restarts the monitor if it is running and updates data on covered routines/classes
 	} Catch e {
 		Set tSC = e.AsStatus()
@@ -697,19 +706,35 @@ Method PrintURL()
 {
 	Do ##super()
 
-	Do ..PrintLine("Use the following URL to view test coverage data:")
-	Do ..PrintLine(..GetURL(..Run.%Id()))
+	Set tURL = ..GetURL(..Run.%Id())
+	If (tURL '= "") {
+		Do ..PrintLine("Use the following URL to view test coverage data:")
+		Do ..PrintLine(tURL)
+	} Else {
+		Do ..PrintLine("WARNING: No default web application found for namespace '"_$Namespace_"' - test coverage results cannot be viewed.")
+	}
 	Quit
 }
 
+/// Returns the URL to the aggregate result viewer. <br />
+/// <var>pRunID</var> is the test coverage run index.
+/// <var>pHost</var> contains the host/protocol to use.
+/// <var>pPath</var> contains the rest of the URL after that.
 ClassMethod GetURL(pRunID As %String, Output pHost As %String, Output pPath As %String) As %String
 {
-	Set tSC = ##class(%RoutineMgr).GetWebServerPort(.tPort,.tServer,.tURLPrefix)
+	Set tSC = ##class(%Library.RoutineMgr).GetWebServerPort(.tPort,.tServer,.tURLPrefix)
 	$$$ThrowOnError(tSC)
-	Set pHost = $Case(tPort,443:"https",:"http")_"://"_$Get(^%SYS("HealthShare","NetworkHostName"),tServer)
-	Set pHost = pHost _ $Case(tPort,80:"",:":"_tPort)
+	Set pHost = $ZConvert($Get(^%SYS("WebServer","Protocol"),$Select(tPort=443:"https",1:"http")),"l")
+	Set pHost = pHost_"://"_$Get(^%SYS("HealthShare","NetworkHostName"),tServer)
+	// Ports 80 and 443 are defaults for their respective protocols; in other cases, port needs to be explicit.
+	Set pHost = pHost _ $Case(tPort,80:"",443:"",:":"_tPort)
+	Set tDefaultApp = $System.CSP.GetDefaultApp($Namespace)
+	If (tDefaultApp = "") || (((tDefaultApp = "/csp/sys") || (tDefaultApp [ "/csp/sys/")) && ($Namespace '= "%SYS")) {
+		// The URL won't be valid, so just return an empty string.
+		Quit ""
+	}
 	Set pPath = $Case(tURLPrefix,"":"",:"/"_tURLPrefix)
-	Set pPath = pPath _ $$getDefaultApp^%SYS.cspServer2($Namespace)
+	Set pPath = pPath _ tDefaultApp
 	Set pPath = pPath _ "/TestCoverage.UI.AggregateResultViewer.cls?Index="_$ZConvert(pRunID,"O","URL")
 	Quit pHost_pPath
 }

cls/TestCoverage/Procedures.cls

@@ -1,3 +1,4 @@
+/// Contains several helpful stored procedures for use in SQL.
 Class TestCoverage.Procedures
 {
 
@@ -86,32 +87,5 @@ ClassMethod ListToBit(pSource As %List) As %Binary [ SqlName = LIST_TO_BIT, SqlP
 	Quit tResult
 }
 
-/// Table-valued function returning a sequence of integers (column name "Counter") going from <var>pStart</var> to <var>pEnd</var> by <var>pIncrement</var>.
-Query Sequence(pStart As %Integer, pEnd As %Integer, pIncrement As %Integer = 1) As %Query(ROWSPEC = "Counter:%Integer") [ SqlName = SEQUENCE, SqlProc ]
-{
-}
-
-ClassMethod SequenceExecute(ByRef qHandle As %Binary, pStart As %Integer, pEnd As %Integer, pIncrement As %Integer = 1) As %Status
-{
-	Set qHandle = pStart
-	Set qHandle("inc") = pIncrement
-	Set qHandle("end") = pEnd
-	Quit $$$OK
-}
-
-ClassMethod SequenceClose(ByRef qHandle As %Binary) As %Status [ PlaceAfter = SequenceExecute ]
-{
-	Quit $$$OK
-}
-
-ClassMethod SequenceFetch(ByRef qHandle As %Binary, ByRef Row As %List, ByRef AtEnd As %Integer = 0) As %Status [ PlaceAfter = SequenceExecute ]
-{
-	Set Row = $ListBuild(qHandle)
-	If ($Increment(qHandle,qHandle("inc")) > qHandle("end")) {
-		Set AtEnd = 1
-	}
-	Quit $$$OK
-}
-
 }
 

cls/TestCoverage/UI/Application.cls

@@ -70,14 +70,14 @@ pre.coverage {
 	max-height: 75vh;
 	overflow-x: auto;
 }
-pre.coverage span {
+pre.coverage > span {
 	white-space: pre;
 	tab-size: 4;
 	display: block;
 	line-height: 1.5em;
 	width: 100%;
 }
-pre.coverage span:before {
+pre.coverage > span:before {
 	counter-increment: line;
 	content: counter(line);
 	display: inline-block;
@@ -89,15 +89,15 @@ pre.coverage span:before {
 }
 
 /* Classes for display of code coverage */
-pre.coverage span.executable:before {
+pre.coverage > span.executable:before {
 	background-color: #f66;
 }
 
-pre.coverage span.covered:before {
+pre.coverage > span.covered:before {
 	background-color: #6f6;
 }
 
-pre.coverage span.hide:before {
+pre.coverage > span.hide:before {
 	background-color: #fff;
 }