summaryrefslogtreecommitdiff
path: root/testsuite/tests/profiling
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-02-02 14:53:34 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-03 14:44:53 -0500
commit84ab0153a3527e7bd8b627ca559d782064af3c80 (patch)
treeeb9f6b78e76175ce8d6e5d8c28387b5aa1f00810 /testsuite/tests/profiling
parentaa5ef3402579da5523ee3d1fef7f26737b8d71fc (diff)
downloadhaskell-84ab0153a3527e7bd8b627ca559d782064af3c80.tar.gz
Rewrite CallerCC parser using ReadP
This allows us to remove the dependency on parsec and hence transitively on text. Also added some simple unit tests for the parser and fixed two small issues in the documentation. Fixes #21033
Diffstat (limited to 'testsuite/tests/profiling')
-rw-r--r--testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.hs38
-rw-r--r--testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.stdout5
-rw-r--r--testsuite/tests/profiling/should_run/caller-cc/all.T4
3 files changed, 47 insertions, 0 deletions
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.hs b/testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.hs
new file mode 100644
index 0000000000..a6f160a5e3
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.hs
@@ -0,0 +1,38 @@
+-- Unit tests for the CallerCcParser
+{-# LANGUAGE StandaloneDeriving #-}
+module Main where
+
+import GHC.Core.Opt.CallerCC
+import GHC.Unit.Module.Name
+
+deriving instance Eq CallerCcFilter
+deriving instance Show CallerCcFilter
+deriving instance Eq NamePattern
+deriving instance Show NamePattern
+
+runTest :: String -> Maybe CallerCcFilter -> IO ()
+runTest filter exp = putStrLn $
+ case parseCallerCcFilter filter of
+ Left err -> case exp of
+ Nothing -> "Expected failure: " ++ filter ++ " " ++ err
+ Just exp -> "Unexpected failure: " ++ filter ++ " " ++ err
+ Right res ->
+ case exp of
+ Nothing -> "Unexpected parse: " ++ filter ++ " " ++ show res
+ Just exp | exp == res -> "Expected parse: " ++ filter ++ " " ++ show res
+ | otherwise -> "Unexpected parse: " ++ filter ++ show res ++ show exp
+
+mkPattern :: String -> NamePattern
+mkPattern s = foldr PChar PEnd s
+
+mkPattern_ :: String -> NamePattern -> NamePattern
+mkPattern_ s e = foldr PChar e s
+
+main = do
+ runTest "*.map" (Just (CallerCcFilter Nothing (mkPattern "map")))
+ runTest "*.parse*" (Just (CallerCcFilter Nothing (mkPattern_ "parse" (PWildcard PEnd))))
+ runTest "Data.List.map" (Just (CallerCcFilter (Just (mkModuleName "Data.List")) (mkPattern "map")))
+ runTest "*.<\\*>" (Just (CallerCcFilter Nothing (mkPattern "<*>")))
+ runTest "as.b" Nothing
+
+
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.stdout b/testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.stdout
new file mode 100644
index 0000000000..4c60714103
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.stdout
@@ -0,0 +1,5 @@
+Expected parse: *.map CallerCcFilter {ccfModuleName = Nothing, ccfFuncName = PChar 'm' (PChar 'a' (PChar 'p' PEnd))}
+Expected parse: *.parse* CallerCcFilter {ccfModuleName = Nothing, ccfFuncName = PChar 'p' (PChar 'a' (PChar 'r' (PChar 's' (PChar 'e' (PWildcard PEnd)))))}
+Expected parse: Data.List.map CallerCcFilter {ccfModuleName = Just (ModuleName "Data.List"), ccfFuncName = PChar 'm' (PChar 'a' (PChar 'p' PEnd))}
+Expected parse: *.<\*> CallerCcFilter {ccfModuleName = Nothing, ccfFuncName = PChar '<' (PChar '*' (PChar '>' PEnd))}
+Expected failure: as.b parse error on as.b
diff --git a/testsuite/tests/profiling/should_run/caller-cc/all.T b/testsuite/tests/profiling/should_run/caller-cc/all.T
index 2b8837aa07..db9979b67d 100644
--- a/testsuite/tests/profiling/should_run/caller-cc/all.T
+++ b/testsuite/tests/profiling/should_run/caller-cc/all.T
@@ -1,3 +1,7 @@
+test('CallerCcParser', normal,
+ compile_and_run,
+ ['-package ghc'])
+
setTestOpts(req_profiling)
setTestOpts(extra_ways(['prof', 'ghci-ext-prof']))
setTestOpts(only_ways(prof_ways))