diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-02-02 14:53:34 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-02-03 14:44:53 -0500 |
commit | 84ab0153a3527e7bd8b627ca559d782064af3c80 (patch) | |
tree | eb9f6b78e76175ce8d6e5d8c28387b5aa1f00810 /testsuite/tests | |
parent | aa5ef3402579da5523ee3d1fef7f26737b8d71fc (diff) | |
download | haskell-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')
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)) |