From 4de36c5f0edc0e4d1ba7373fcf50b1fa8d8be652 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 19 Jun 2019 17:54:53 -0400 Subject: [PATCH] Rewrite the Stat tests so they're not racy. --- semantic.cabal | 1 + test/Semantic/Stat/Spec.hs | 133 +++++++++++++++++++++---------------- test/Spec.hs | 4 +- 3 files changed, 78 insertions(+), 60 deletions(-) diff --git a/semantic.cabal b/semantic.cabal index dd07aae43..7e0ffd623 100644 --- a/semantic.cabal +++ b/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 diff --git a/test/Semantic/Stat/Spec.hs b/test/Semantic/Stat/Spec.hs index 47d9bfd0d..74b607a96 100644 --- a/test/Semantic/Stat/Spec.hs +++ b/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" +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 - 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" +case_sets_appropriate_defaults :: Assertion +case_sets_appropriate_defaults = do + StatsClient{..} <- defaultStatsClient + statsClientNamespace @?= "semantic" + statsClientUDPHost @?= "127.0.0.1" + statsClientUDPPort @?= "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" +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" - describe "renderDatagram" $ do - let key = "app.metric" +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" - 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" +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" - it "renders statsClientNamespace" $ - renderDatagram "pre" (increment key []) `shouldBe` "pre.app.metric:1|c" +key :: String +key = "app.metric" - 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" +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" - 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" +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 diff --git a/test/Spec.hs b/test/Spec.hs index ba4ae21cb..c7f868d4e 100644 --- a/test/Spec.hs +++ b/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