Rewrite the Stat tests so they're not racy.

Author: Patrick Thomson

semantic.cabal

@@ -393,6 +393,7 @@ test-suite test
                      , tasty-golden ^>= 2.3.2
                      , tasty-hedgehog ^>= 1.0.0.1
                      , tasty-hspec ^>= 1.1.5.1
+                     , tasty-hunit ^>= 0.10.0.2
                      , HUnit ^>= 1.6.0.0
                      , leancheck >= 0.8 && <1
                      , temporary ^>= 1.3

test/Semantic/Stat/Spec.hs

@@ -1,4 +1,6 @@
-module Semantic.Stat.Spec (spec) where
+{-# LANGUAGE TemplateHaskell #-}
+
+module Semantic.Stat.Spec (testTree) where
 
 import Control.Exception
 import Network.Socket hiding (recv)
@@ -7,80 +9,95 @@ import Semantic.Telemetry.Stat
 import Semantic.Config
 import System.Environment
 
-import SpecHelpers
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.Runners
 
 withSocketPair :: ((Socket, Socket) -> IO c) -> IO c
 withSocketPair = bracket create release
   where create = socketPair AF_UNIX Datagram defaultProtocol
         release (client, server) = close client >> close server
 
-withEnvironment :: String -> String -> (() -> IO ()) -> IO ()
-withEnvironment key value = bracket (setEnv key value) (const (unsetEnv key))
+withEnvironment :: String -> String -> IO () -> IO ()
+withEnvironment key value = bracket (setEnv key value) (const (unsetEnv key)) . const
 
 -- NOTE: These cannot easily run in parallel because we test things like
 -- setting/unsetting the environment.
-spec :: Spec
-spec = do
-  describe "defaultStatsClient" $ do
-    it "sets appropriate defaults" $ do
-      StatsClient{..} <- defaultStatsClient
-      statsClientNamespace `shouldBe` "semantic"
-      statsClientUDPHost `shouldBe` "127.0.0.1"
-      statsClientUDPPort `shouldBe` "28125"
-
-    around (withEnvironment "STATS_ADDR" "localhost:8125") $
-      it "takes STATS_ADDR from environment" $ do
-        StatsClient{..} <- defaultStatsClient
-        statsClientUDPHost `shouldBe` "localhost"
-        statsClientUDPPort `shouldBe` "8125"
-
-    around (withEnvironment "STATS_ADDR" "localhost") $
-      it "handles STATS_ADDR with just hostname" $ do
-        StatsClient{..} <- defaultStatsClient
-        statsClientUDPHost `shouldBe` "localhost"
-        statsClientUDPPort `shouldBe` "28125"
-
-    around (withEnvironment "DOGSTATSD_HOST" "0.0.0.0") $
-      it "takes DOGSTATSD_HOST from environment" $ do
-        StatsClient{..} <- defaultStatsClient
-        statsClientUDPHost `shouldBe` "0.0.0.0"
-        statsClientUDPPort `shouldBe` "28125"
-
-  describe "renderDatagram" $ do
-    let key = "app.metric"
-
-    describe "counters" $ do
-      it "renders increment" $
-        renderDatagram "" (increment key []) `shouldBe` "app.metric:1|c"
-      it "renders decrement" $
-        renderDatagram "" (decrement key []) `shouldBe` "app.metric:-1|c"
-      it "renders count" $
-        renderDatagram "" (count key 8 []) `shouldBe` "app.metric:8|c"
-
-    it "renders statsClientNamespace" $
-      renderDatagram "pre" (increment key []) `shouldBe` "pre.app.metric:1|c"
-
-    describe "tags" $ do
-      it "renders a tag" $ do
-        let inc = increment key [("key", "value")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#key:value"
-      it "renders a tag without value" $ do
-        let inc = increment key [("a", "")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#a"
-      it "renders tags" $ do
-        let inc = increment key [("key", "value"), ("a", "true")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#key:value,a:true"
-      it "renders tags without value" $ do
-        let inc = increment key [("key", "value"), ("a", "")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#key:value,a"
-
-  describe "sendStat" $
-    it "delivers datagram" $ do
-      client@StatsClient{..} <- defaultStatsClient
-      withSocketPair $ \(clientSoc, serverSoc) -> do
-        sendStat client { statsClientUDPSocket = clientSoc } (increment "app.metric" [])
-        info <- recv serverSoc 1024
-        info `shouldBe` "semantic.app.metric:1|c"
+testTree :: TestTree
+testTree = testCaseSteps "Semantic.Stat.Spec" $ \step -> do
+  step "Sets appropriate defaults"
+  case_sets_appropriate_defaults
+  step "Takes stats addr from environment"
+  case_takes_stats_addr_from_environment
+  step "Handles stats addr with just hostname"
+  case_handles_stats_addr_with_just_hostname
+  step "takes dogstats host from environment"
+  case_takes_stats_addr_from_environment
+  step "rendering"
+  case_render_counters *> case_render_tags
+  step "stats deliver datagram"
+  case_sendstat_delivers_datagram
+
+
+case_sets_appropriate_defaults :: Assertion
+case_sets_appropriate_defaults = do
+  StatsClient{..} <- defaultStatsClient
+  statsClientNamespace @?= "semantic"
+  statsClientUDPHost   @?= "127.0.0.1"
+  statsClientUDPPort   @?= "28125"
+
+case_takes_stats_addr_from_environment :: Assertion
+case_takes_stats_addr_from_environment =
+  withEnvironment "STATS_ADDR" "localhost:8125" $ do
+    StatsClient{..} <- defaultStatsClient
+    statsClientUDPHost @?= "localhost"
+    statsClientUDPPort @?= "8125"
+
+case_handles_stats_addr_with_just_hostname :: Assertion
+case_handles_stats_addr_with_just_hostname =
+  withEnvironment "STATS_ADDR" "localhost" $ do
+    StatsClient{..} <- defaultStatsClient
+    statsClientUDPHost @?= "localhost"
+    statsClientUDPPort @?= "28125"
+
+case_takes_dogstats_host_from_environment :: Assertion
+case_takes_dogstats_host_from_environment =
+  withEnvironment "DOGSTATSD_HOST" "0.0.0.0" $ do
+    StatsClient{..} <- defaultStatsClient
+    statsClientUDPHost @?= "0.0.0.0"
+    statsClientUDPPort @?= "28125"
+
+key :: String
+key = "app.metric"
+
+case_render_counters :: Assertion
+case_render_counters = do
+  renderDatagram "" (increment key []) @?= "app.metric:1|c"
+  renderDatagram "" (decrement key []) @?= "app.metric:-1|c"
+  renderDatagram "" (count key 8 []) @?= "app.metric:8|c"
+  renderDatagram "pre" (increment key []) @?= "pre.app.metric:1|c"
+
+case_render_tags :: Assertion
+case_render_tags = do
+  let incTag = increment key [("key", "value")]
+  renderDatagram "" incTag @?= "app.metric:1|c|#key:value"
+
+  let tagWithoutValue = increment key [("a", "")]
+  renderDatagram "" tagWithoutValue @?= "app.metric:1|c|#a"
+
+  let tags = increment key [("key", "value"), ("a", "true")]
+  renderDatagram "" tags @?= "app.metric:1|c|#key:value,a:true"
+
+  let tagsWithoutValue = increment key [("key", "value"), ("a", "")]
+  renderDatagram "" tagsWithoutValue @?= "app.metric:1|c|#key:value,a"
+
+case_sendstat_delivers_datagram :: Assertion
+case_sendstat_delivers_datagram = do
+  client@StatsClient{..} <- defaultStatsClient
+  withSocketPair $ \(clientSoc, serverSoc) -> do
+    sendStat client { statsClientUDPSocket = clientSoc } (increment "app.metric" [])
+    info <- recv serverSoc 1024
+    info @?= "semantic.app.metric:1|c"
 
 -- Defaults are all driven by defaultConfig.
 defaultStatsClient :: IO StatsClient

test/Spec.hs

@@ -47,6 +47,7 @@ tests =
   [ Integration.Spec.spec
   , Semantic.CLI.Spec.spec
   , Data.Source.Spec.testTree
+  , Semantic.Stat.Spec.testTree
   ]
 
 -- We can't bring this out of the IO monad until we divest
@@ -64,8 +65,7 @@ allTests = do
 -- using one or the other.") Instead, create a new TestTree value
 -- in your spec module and add it to the above 'tests' list.
 legacySpecs :: (?session :: TaskSession) => Spec
-legacySpecs = do
-  describe "Semantic.Stat" Semantic.Stat.Spec.spec
+legacySpecs = parallel $ do
   describe "Analysis.Go" Analysis.Go.Spec.spec
   describe "Analysis.PHP" Analysis.PHP.Spec.spec
   describe "Analysis.Python" Analysis.Python.Spec.spec