Merge pull request #12 from intersystems/fix-missing-obj-code

Fail gracefully if nothing to monitor

Author: isc-tleavitt

cls/TestCoverage/Manager.cls

@@ -203,6 +203,10 @@ Method StartCoverageTracking() As %Status [ Private ]
 				}
 			}
 
+			If (tRelevantTargets = "") {
+				Write !,"WARNING: Nothing found to monitor for routine(s): "_$ListToString(tNewTargets)
+			}
+			
 			// If we are to monitor all process IDs, actually use all except for the SuperServer (Routine = '%SYS.SERVER')
 			// Workaround for versions without RFD1682
 			Set tProcessIDs = ..ProcessIDs
@@ -474,6 +478,8 @@ Method EndCoverageTracking(pTestSuite As %String = "", pTestClass As %String = "
 Method OnAfterSaveResult(ByRef userparam)
 {
 	Try {
+		Quit:'$IsObject(..Run)
+		
 		// Associate to unit test results.
 		Do ..Run.TestResultsSetObjectId(..LogIndex)
 		$$$ThrowOnError(..Run.%Save())
@@ -710,12 +716,14 @@ Method PrintURL()
 {
 	Do ##super()
 
-	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.")
+	If $IsObject(..Run) {
+		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
 }

cls/TestCoverage/ManagerBase.cls

@@ -216,6 +216,7 @@ ClassMethod RunTestSuites(testspec As %String, qspec, ByRef userparam) As %Statu
 		Do manager.LogStateBegin(tDummySuite)
 		Do manager.LogStateStatus(sc,tDummySuite)
 		Do manager.LogStateEnd(0)
+		Set status(" "_tDummySuite)=""
 	} Else {
 		For {
 			Set suite=$order(testspec(suite)) Quit:suite=""
@@ -265,6 +266,7 @@ ClassMethod RunTestSuites(testspec As %String, qspec, ByRef userparam) As %Statu
 		Do manager.LogStateBegin(tDummySuite)
 		Do manager.LogStateStatus(sc,tDummySuite)
 		Do manager.LogStateEnd(0)
+		Set status(" "_tDummySuite)=""
 	}
 	;
 	#; Need to make a list of suites that failed and report these at the end. Is this logged under suite or testsuite from the loop above?

cls/TestCoverage/Utils/LineByLineMonitor.cls

@@ -1,3 +1,5 @@
+Include %occErrors
+
 /// Wrapper around %Monitor.System.LineByLine to ensure that the monitor is stopped when it should be, and also
 /// to wrap the decision about whether to stop/start the monitor or to just clear counters.
 Class TestCoverage.Utils.LineByLineMonitor Extends %Monitor.System.LineByLine
@@ -120,5 +122,40 @@ ClassMethod IsRunning() As %Boolean [ CodeMode = expression ]
 $zu(84,8) && $zu(84,1)
 }
 
+/// Overridden and minimally modified from parent implementation
+ClassMethod Start(Routine As %List, Metric As %List, Process As %List) As %Status
+{
+	// Before attempting to start monitor, ensure we actually have object code for at least some element of Routine
+	Set pointer = 0
+	Set found = 0
+	While $ListNext(Routine,pointer,routine) {
+		Set rtnname = routine_".obj"
+		For {
+			Set data = ""
+			Set more = $$LIST^%R(rtnname,32767,0,.data,.ctx)
+			If (data '= "") {
+				Set found = 1
+				Quit
+			}
+		}
+		If (found = 1) {
+			Quit
+		}
+	}
+	If 'found {
+		Quit ..GetError("NoObjFound")
+	}
+	
+	Quit ##super(.Routine,.Metric,.Process)
+}
+
+ClassMethod GetError(key As %String, args...)
+{
+	Quit $Case(key,
+		"NoObjFound":$System.Status.Error($$$GeneralError,"Unable to start monitor: no object code exists for selected classes/routines. "_
+			"Possible remediations: ensure that at least some class/routine is selected; ""view other"" for the routine and make sure that the "_
+			".INT code actually has some content that could be covered."))
+}
+
 }
 

internal/testing/unit_tests/UnitTest/TestCoverage/Unit/CodeUnit.cls

@@ -10,6 +10,8 @@ Method TestCodeUnitCreation()
 		If (tResult.%SQLCODE < 0) {
 			Throw ##class(%Exception.SQL).CreateFromSQLCODE(tResult.%SQLCODE,tResult.%Message)
 		}
+
+		Do $$$AssertStatusOK($System.OBJ.Compile($classname(),"ck-d"))
 
 		#dim tCodeUnit As TestCoverage.Data.CodeUnit
 		Set tClsName = $classname()_".CLS"

internal/testing/unit_tests/UnitTest/TestCoverage/Unit/TestComplexity.cls

@@ -7,6 +7,7 @@ Method TestMethodsInThisClass()
 	Set tClass = $classname()
 	&sql(delete from TestCoverage_Data.CodeUnit where Name %STARTSWITH :tClass)
 	Do $$$AssertTrue(SQLCODE>=0)
+	Do $$$AssertStatusOK($System.OBJ.Compile($classname(),"ck-d"))
 	Do $$$AssertStatusOK(##class(TestCoverage.Data.CodeUnit).GetCurrentByName(tClass_".1.INT"))
 	If $$$AssertStatusOK(##class(TestCoverage.Data.CodeUnit).GetCurrentByName(tClass_".CLS",,.tCodeUnit)) {
 		Set tKey = ""
@@ -224,7 +225,8 @@ Method FunctionWithAppropriateScope(pArgument As %String)
 	Quit tSC
 }
 
-/// Complexity: 2 (1 + If)
+/// Complexity: 7 (1 + UCQ)
+/// Was 2 on earlier IRIS versions; UCQ adds a bit.
 Method MethodWithEmbeddedSQL()
 {
 	&sql(select top 1 1 into :foo)

module.xml

@@ -2,16 +2,14 @@
 <Export generator="Cache" version="25">
 <Document name="TestCoverage.ZPM"><Module>
   <Name>TestCoverage</Name>
-  <Version>2.1.2</Version>
+  <Version>2.1.3</Version>
   <Description>Run your typical ObjectScript %UnitTest tests and see which lines of your code are executed. Includes Cobertura-style reporting for use in continuous integration tools.</Description>
   <Packaging>module</Packaging>
   <Resources>
     <Resource Name="TestCoverage.PKG">
     </Resource>
     <Resource Name="TestCoverage.DataType.PKG">
     </Resource>
-    <Resource Name="TestCoverage.Utils.LineByLineMonitor.CLS">
-    </Resource>
     <Resource Name="TestCoverage.INC">
     </Resource>
     <Resource Name="/internal/testing/unit_tests/" ProcessorClass="UnitTest">