Merge pull request #5890 from unisonweb/runarorama/debugtests

Author: aryairani

lib/unison-prelude/src/Unison/Debug.hs

@@ -46,6 +46,7 @@ data DebugFlag
   | PatternCoverageConstraintSolver
   | KindInference
   | Update
+  | Tests
   deriving (Eq, Ord, Show, Bounded, Enum)
 
 debugFlags :: Set DebugFlag
@@ -74,6 +75,7 @@ debugFlags = case (unsafePerformIO (lookupEnv "UNISON_DEBUG")) of
       "PATTERN_COVERAGE_CONSTRAINT_SOLVER" -> pure PatternCoverageConstraintSolver
       "KIND_INFERENCE" -> pure KindInference
       "UPDATE" -> pure Update
+      "TESTS" -> pure Tests
       _ -> empty
 {-# NOINLINE debugFlags #-}
 
@@ -145,6 +147,10 @@ debugPatternCoverageConstraintSolver :: Bool
 debugPatternCoverageConstraintSolver = PatternCoverageConstraintSolver `Set.member` debugFlags
 {-# NOINLINE debugPatternCoverageConstraintSolver #-}
 
+debugTests :: Bool
+debugTests = Tests `Set.member` debugFlags
+{-# NOINLINE debugTests #-}
+
 -- | Use for trace-style selective debugging.
 -- E.g. 1 + (debug Sync "The second number" 2)
 --
@@ -201,3 +207,4 @@ shouldDebug = \case
   PatternCoverageConstraintSolver -> debugPatternCoverageConstraintSolver
   KindInference -> debugKindInference
   Update -> debugUpdate
+  Tests -> debugTests

unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs

@@ -32,6 +32,7 @@ import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Runtime qualified as Runtime
 import Unison.Codebase.Runtime.Profile (ProfileSpec (NoProf))
 import Unison.ConstructorReference (GConstructorReference (..))
+import Unison.Debug qualified as Debug
 import Unison.HashQualified qualified as HQ
 import Unison.Name (Name)
 import Unison.Names (Names)
@@ -114,13 +115,15 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} =
           Cli.respond (TermNotFound' . SH.shortenTo hqLength . Reference.toShortHash $ Reference.DerivedId r)
           pure []
         Just tm -> do
+          let testName = Cli.prettyTermName fqnPPE (Referent.fromTermReferenceId r)
+          Debug.whenDebug Debug.Tests $
+            liftIO (putStrLn $ "\nAbout to run test:" <> ("\n" <> P.toPlain 80 testName))
           Cli.respond $ TestIncrementalOutputStart fqnPPE (n, total) r
           --                        v don't cache; test cache populated below
-          tm' <- RuntimeUtils.evalPureUnison fqnPPE False tm
+          tm' <- Cli.time ("\n" <> P.toPlain 80 testName) $ RuntimeUtils.evalPureUnison fqnPPE False tm
           case tm' of
             Left e -> do
               Cli.respond $ TestIncrementalOutputEnd fqnPPE (n, total) r False
-              let testName = (Cli.prettyTermName fqnPPE (Referent.fromTermReferenceId r))
               Cli.returnEarly $ EvaluationFailure (P.callout ("Error while evaluating test " <> P.backticked testName <> ":") . P.indentN 2) e
             Right tm' -> do
               -- After evaluation, cache the result of the test