tasty-sugar (empty) → 0.2.0.0
raw patch · 41 files changed
+3809/−0 lines, 41 filesdep +basedep +directorydep +filemanipsetup-changed
Dependencies added: base, directory, filemanip, filepath, hedgehog, logict, optparse-applicative, pretty-show, prettyprinter, raw-strings-qq, tagged, tasty, tasty-hedgehog, tasty-hunit, tasty-sugar
Files
- CHANGELOG.md +18/−0
- LICENSE +13/−0
- README.org +571/−0
- Setup.hs +2/−0
- examples/example1/NiftyText.hs +34/−0
- examples/example1/README.org +164/−0
- examples/example1/test-passthru-ascii.hs +23/−0
- examples/example1/testdata/counting +5/−0
- examples/example1/testdata/counting.exp +5/−0
- examples/example1/testdata/hello_inp +1/−0
- examples/example1/testdata/hello_inp.exp +1/−0
- examples/params/samples/foo.c +1/−0
- examples/params/samples/functional.O2.expct +1/−0
- examples/params/samples/functional.hs +1/−0
- examples/params/samples/recursive.fast.expct +1/−0
- examples/params/samples/recursive.rs +1/−0
- examples/params/samples/simple-opt.expct +1/−0
- examples/params/samples/simple-opt.gcc-exe +1/−0
- examples/params/samples/simple.c +1/−0
- examples/params/samples/simple.expct +1/−0
- examples/params/samples/simple.noopt-gcc.expct +1/−0
- examples/params/samples/simple.noopt.clang.exe +1/−0
- examples/params/samples/simple.noopt.gcc.exe +1/−0
- examples/params/samples/simple.opt-clang.exe +1/−0
- examples/params/test-params.hs +68/−0
- src/Test/Tasty/Sugar.hs +329/−0
- src/internal/Test/Tasty/Sugar/Analysis.hs +54/−0
- src/internal/Test/Tasty/Sugar/AssocCheck.hs +86/−0
- src/internal/Test/Tasty/Sugar/ExpectCheck.hs +160/−0
- src/internal/Test/Tasty/Sugar/ParamCheck.hs +100/−0
- src/internal/Test/Tasty/Sugar/RootCheck.hs +249/−0
- src/internal/Test/Tasty/Sugar/Types.hs +384/−0
- tasty-sugar.cabal +142/−0
- test/Sample1.hs +58/−0
- test/TestMain.hs +118/−0
- test/TestMultiAssoc.hs +232/−0
- test/TestNoAssoc.hs +189/−0
- test/TestParamsAssoc.hs +186/−0
- test/TestSingleAssoc.hs +209/−0
- test/TestUtils.hs +113/−0
- test/TestWildcard.hs +282/−0
+ CHANGELOG.md view
@@ -0,0 +1,18 @@+# Revision history for tasty-sugar++## 0.2.0.0 -- 2021-01-12++ * Renamed CUBE "source" to "rootName"++ * Updated Sweets structure to show root match base and match name++ * Rewritten implementation using Logic capabilities. Clarified many+ corner cases and fully implemented all logic.++* Significantly enhanced testing.++ * Updated documentation.++## 0.1.0.0 -- 2019-12-24++* Initial version.
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (c) 2019 Kevin Quick++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.
+ README.org view
@@ -0,0 +1,571 @@+#+TITLE: Tasty SUGAR - Search Using Golden Answer References+#+AUTHOR: Kevin Quick <kquick@galois.com>++* Tasty SUGAR - Search Using Golden Answer References++ The ~tasty-sugar~ package extends the tasty testing framework with+ the ability to generate tests based on golden answer files found for+ specific inputs. Multiple answers may be specified with different+ parameterization, and there can be associated files that are+ presented to the test as well.++ The primary use of tasty-sugar is to generate test cases based on+ the contents of a directory, where the presence of various files+ determine which tests are generated.++** Elements of tasty-sugar:++ * Tasty.Sugar.CUBE :: Configuration Using Base Expectations++ Describes the configuration for tasty-sugar tests, including+ where they are located and what syntax the files should have.++ * Tasty.Sugar.Sweets :: Specifications With Existing Expected Testing Samples++ The tasty-sugar library uses one or more CUBE's to generate a+ set of test configurations based on the existing files found,+ outputting a list of Sweets representing the existing test+ data.++# * KWQ: something to generate the tests+# * KWQ: name of the test runner to show the tests+# * KWQ: a test runner or option to write new outputs++* How to use tasty-sugar++ Full information on tasty-sugar features and capabilities will be+ provided in a later [[id:de026768-f805-4d30-8299-522cdd70926b][Detailed Information]] section, but this is a+ quick introduction describing various testing use cases and how+ tasty-sugar can be used in those use cases.++ For these motivational use cases, the example scenario basis is that+ the target to be tested is a tool to parse binary ELF files and+ generate various output information about those files (e.g. similar+ to objdump, but in a Haskell library form).++** Single Expected Output per Test++ * Scenario :: When running a test, it generates output that should+ be compared to the expected data maintained in a file.+ There is a simple, single expected output for each+ test, and no inputs other than the test name.++ For the example scenario, several actual ELF binary files were+ collected and placed in the ~test/samples~ directory:++ #+BEGIN_EXAMPLE+ $ ls test/samples+ empty.txt+ fibonacci.c+ fibonacci+ foo.tar+ hello.c+ hello+ ls.c+ ls+ tmux.c+ tmux+ $+ #+END_EXAMPLE++ Note that there are a couple of non-ELF files in there as well, to+ verify the errors generated by our library when given++ The actual outputs aren't known yet, but tasty-sugar can help with+ that. Setup the tasty-sugar CUBE configuration as follows:++ #+BEGIN_EXAMPLE+ cube = mkCUBE { inputDir = "test/samples"+ , rootName = "*.c"+ , expectedSuffix = "exp"+ , associatedNames = [ ("binary", "") ]+ }+ main = do testSweets <- findSugar cube+ defaultMain $ testGroup "elf" $+ withSugarGroups testSweets testGroup $+ \sweets expIdx expectation ->+ testCase (rootMatchName sweets <> " #" <> show expIdx) $ do+ let Just binaryName = lookup "binary" $ associated expectation+ r <- runTestOn binaryName+ e <- readFile $ expectedFile expectation+ r @?= e++ runTestOn :: FilePath -> IO String+ runTestOn f = ...+ #+END_EXAMPLE++ The tasty-sugar framework does not provide the actual testing: that+ is still provided by the developer. Instead, the tasty-sugar+ framework reads the contents of the ~test/samples~ directory and+ analyses the available files to create a list of tests that should+ be run. The tasty-sugar package also provides a function that can+ organize the tests and invoke the user's test function once for+ each test configuration.++ If the tests are run at this point, the tasty-sugar framework will+ do nothing.++ Why?++ The tasty-sugar framework will ignore any files in the target+ directory that do not have an associated expected file describing+ the expected output. This can be confirmed by running the tests+ with the ~--showsearch~ argument, which will use an alternate tasty+ ingredient that does not actually run the tests but write out the+ search process and search results.++ To get actual tests to run, simply create an expected file for each+ of the input candidates. The contents of the file can be empty, or+ any random data.++ Running the tests now will result in a test created for each input+ file that has a corresponding ~*.exp~ file. Note that tasty-sweet+ doesn't actually read in any of the files, just invokes the test+ creation function with the Sweets and Expectation data structures+ that let the test do whatever is appropriate.++ #+BEGIN_EXAMPLE+ $ ls test/samples+ empty.txt+ empty.txt.exp+ fibonacci+ finonacci.c+ fibonacci.exp+ foo.tar+ foo.tar.exp+ hello+ hello.c+ hello.exp+ ls+ ls.c+ ls.exp+ tmux+ tmux.c+ $+ #+END_EXAMPLE++ Note that ~empty.txt~ and ~foo.tar~ will be ignored, even though+ there is an ~.exp~ file for them because they don't match the+ source target of ~*.c~. Similarly, ~tmux~ will be ignored because+ there is no ~.exp~ file for it.++ At this point, any changes to the target library that cause output+ changes will be identified when running the tests.++** Single Input and Output per Test++ * Scenario :: Similar to the previous scenario, but there is a file+ containing the expected input needed by the test to+ generate the output.++ To extend the previous example, let us assume that in addition to+ the pre-existing binaries that we will be generating a number of+ "interesting" binaries to run the target library on. These will be+ kept in a different directory where a different part of the build+ will compile the sources to generate the binaries for testing:++ #+BEGIN_EXAMPLE+ $ ls test/src_samples+ foo.c+ foo+ foo.expct+ simple.c+ simple+ simple.expct+ recursive.rs+ recursive+ recursive.expct+ functional.hs+ functional+ functional.expct+ $+ #+END_EXAMPLE++ Note that there are several different source types (C, Rust,+ Haskell) involved, but each of them has an associated output binary+ that the target library should be tested on.++ In an initial approach, the source files can be ignored by the+ testing code: simply create a ~FILE.expct~ file for each of the+ binaries and use the same ~Tasty.Sugar.CUBE~ configuration for this+ directory as for the previous directory.++ However however an approach where the actual test written by the+ user needs access to the source file itself for some reason. This+ can be handled by specifying an "associated" file in the+ ~Tasty.Sugar.CUBE~ configuration:++ #+BEGIN_EXAMPLE+ cube = mkCUBE { inputDir = "test/samples"+ , rootName = "*.exe"+ , expectedSuffix = "expct"+ , associatedNames = [ ("c-source", ".c")+ , ("rust-source", ".rs")+ , ("haskell", ".hs)+ ]+ }++ ingredients = includingOptions sugarOptions :+ sugarIngredients cube <> defaultIngredients++ main = do testSweets <- findSugar cube+ defaultMainWithIngredients ingredients $+ testGroup "elf" $+ withSugarGroups testSweets testGroup $+ \sweets expIdx expectation ->+ testCase (rootMatchName sweets <> " #" <> show expIdx) $ do+ e <- readFile $ expectedFile expectation+ let assoc = associated expectation+ f = rootFile sweets+ r <- case lookup "c-source" assoc of+ Just c -> runCTestOn f+ Nothing ->+ case lookup "rust-source" assoc of+ Just r -> runRustTestOn f+ Nothing ->+ runHaskellTestOn f+ r @?= e++ runCTestOn :: FilePath -> IO String+ runCTestOn f = ...++ runRustTestOn :: FilePath -> IO String+ runRustTestOn f = ...++ runHaskellTestOn :: FilePath -> IO String+ runHaskellTestOn f = ...+ #+END_EXAMPLE++ Now when tasty-sugar generates the test configurations, each test+ will have a name, a source file, an expected file, and a single+ associated file. The test is free to use these files in any way it+ sees fit. For the configuration above, there would be 4 test+ configurations provided to the test:++ | Test Name | Input File | Expected File | Associated Files |+ |------------+------------+------------------+---------------------------------|+ | simple | simple | simple.expct | ("c-source", "simple.c") |+ | foo | foo | foo.expct | ("c-source", "foo.c") |+ | recursive | recursive | recursive.expct | ("rust-source", "recursive.rs") |+ | functional | functional | functional.expct | ("haskell", "functional.hs") |++ Note that if both "simple.c" and "simple.hs" files existed, then the+ simple test configuration would get both as associated files.++** Single Input with different parameters producing different outputs++ * Scenario :: For each input file, multiple tests should be run,+ each with different parameters, and the expected+ output may or may not depend on the parameter.++ Using the previous example scenario, let's now assume that for each+ of the source sample files, two different executables were built:+ one with and one without optimization. Additionally, if they were a+ C source file, then there was a version built with GCC and a version+ built with Clang. The output executables are now named accordingly:++ #+BEGIN_EXAMPLE+ $ ls test/src_samples+ foo.c+ foo.noopt.clang.exe+ foo.O0.gcc.exe+ foo.opt.clang.exe+ foo.O2.gcc.exe+ foo.O3.gcc.exe+ simple.c+ simple.noopt.clang.exe+ simple.noopt.gcc.exe+ simple.opt-clang.exe+ simple-opt.gcc-exe+ recursive.rs+ recursive.noopt.exe+ recursive.opt.exe+ functional.hs+ functional.noopt.exe+ functional.opt.exe+ $+ #+END_EXAMPLE++ While the filenames are fairly regular, there are different numbers+ of executables and different naming conventions for different files.++ The opt/noopt/O0/O2/O3 and gcc/clang information is known to+ tasty-sugar as a "parameter". Parameters can appear in the filename+ in a specific order, and each parameter may have one of a set of+ valid values (e.g. gcc or clang) or it may have any (free-form)+ value (as with the optimization specification).++ The ~Tasty.Sugar.CUBE~ confguration for is scenario is updated to:++ #+BEGIN_EXAMPLE+ cube = mkCUBE { inputDir = "test/samples"+ , rootName = "*"+ , separators = "-."+ , expectedSuffix = "expct"+ , associatedNames = [ ("c-source", ".c")+ , ("rust-source", ".rs")+ , ("haskell", ".hs")+ ]+ , validParams = [+ ("optimization", Nothing)+ ,("c-compiler", Just ["gcc", "clang"])+ ]+ }++ ingredients = includingOptions sugarOptions :+ sugarIngredients cube <> defaultIngredients++ main = do testSweets <- findSugar cube+ defaultMainWithIngredients ingredients $+ testGroup "elf" $+ withSugarGroups testSweets testGroup $+ \sweets expIdx expectation ->+ testCase (rootMatchName sweets <> " #" <> show expIdx) $ do+ e <- readFile $ expectedFile expectation+ let assoc = associated expectation+ f = rootFile sweets+ r <- case lookup "c-source" assoc of+ Just c -> runCTestOn f+ Nothing ->+ case lookup "rust-source" assoc of+ Just r -> runRustTestOn f+ Nothing ->+ runHaskellTestOn f+ r @?= e++ runCTestOn :: FilePath -> String+ runCTestOn f = ...++ runRustTestOn :: FilePath -> String+ runRustTestOn f = ...++ runHaskellTestOn :: FilePath -> String+ runHaskellTestOn f = ...+ #+END_EXAMPLE++ Parameters are separated by designated separator characters and must+ appear in the order declared. The default separators are "." and+ "-" (e.g. both of the two optimized executable files for the+ simple.c source above are accepted). ++ Filenames may omit later parameter values: the file is assumed to+ apply to all unspecified parameter values if there is no more+ specific override. This can be very useful to avoid repetition and+ copying when specifying test files. ++ In the above example, a ~simple.expected~ file would be used for all+ four executables, but if there was also a+ ~simple.noopt-gcc.expected~ and a ~simple-opt.expected~ then the+ former would be used only for the ~simple.noopt.gcc.exe~ and the+ latter would be used for both the ~gcc~ and the ~clang~ executables,+ leaving the ~sample.expected~ to be used only for the+ ~simple.opt-clang.exe~ file.++# ** Multiple Inputs with different parameters producing different outputs+# +# KWQ...++* Comparisons++** tasty-KAT++ * The tasty-KAT package reads both the inputs and the outputs from a+ single file, instaed of allowing the inputs to be a separate file+ that can be processed by the target under test.++ + The tasty-sugar package allows inputs and outputs to be in+ separate files, and additional "associated" files to be provided+ as inputs to the test.++ * The tasty-KAT package inputs and outputs must be specifiable in a+ file with other KAT markup; this does not easily handle text+ markup conflicts and binary inputs/outputs.++ + The tasty-sugar package does not attempt to interpret the+ contents of the files, but simply passes them to the test+ itself.++ * The tasty-KAT package does not allow auxiliary files, or different+ parameterized tests.++ + As mentioned above, tasty-sugar allows multiple auxiliary files+ per tests, and allows test inputs and expected outputs to be+ filename parameterized (with either constrained or free-form+ parameter values).++** tasty-golden++ * The tasty-golden package requires a 1:1 association between tests+ and corresponding golden expected output files; it does not+ support file-provided inputs, or associated files.++ + The tasty-sugar package allows multiple associated files in+ addition to the primary input file.++ + The tasty-sugar package supports parameterization of expected+ results (and associated files) as part of the filenames to allow+ multiple tests per input.++ * The tasty-golden package will write the expected results if the+ expected file is missing.++ + The tasty-sugar package will write the actual output to a+ *separate* file, but it will not overwrite or assume+ expectations. This allows the user to validate the output+ before declaring it to be the proper expected value (simply by+ copying the actual output file to the expected output file).+ +** tasty-silver++ Similar to tasty-golden in functionality.++** Features unique to tasty-sugar++ * Multiple potential outputs, parameterized by filename elements.++ * Multiple associated input files.++ * Search analysis mode showing how tests are generated based on the+ available files.++ * Automatic grouping of generated tests by parameter values.++* Limitations++ * Huge directories+ * Huge files+ * Will throw any exception that the listDirectory function can throw.++* Detailed Information+ :PROPERTIES:+ :ID: de026768-f805-4d30-8299-522cdd70926b+ :END:++** Requirements++ * There must be a root (input) file to feed to the test++ * There must be one or more "expected" results files for a root file++ * There may be associated files for the root file required for the test++ * All three groups of files may be parameterized by additional fields.++ * All fields are represented by a common basename with optional+ parameters and required associated suffixes, separated by+ allowable separators.++ All of the above may utilize globbing as provided by System.FilePath.Glob++* Examples++** Example:++ For example, a test which would verify that the size of a compiled+ file meets the expectations would specify:++ #+BEGIN_EXAMPLE+ CUBE =+ { inputDir = "tests/samples" -- relative to cabal file+ , separators = ".-"+ , rootName = "*.c"+ , associatedNames = [ ("exe", "exe")+ , ("object", "o")+ ]+ , expectedSuffix = "expected"+ , validParams = [ ("arch" : Just ["ppc", "x86_64"]) ]+ }+ #+END_EXAMPLE++ And given the following directory configuration:++ #+BEGIN_EXAMPLE+ tests/samples/+ foo.c+ bar.c+ bar.exe+ bar.ppc.exe+ bar.expected+ cow.c+ cow.ppc.exe+ cow.x86_64.exe+ cow.expected+ cow.ppc-expected+ cow.x86.expected+ moo.c+ moo.exe+ moo-expected+ dog.exe+ dog.expected+ #+END_EXAMPLE++ The result would be:++ #+BEGIN_EXAMPLE+ sweets =+ [ Sweets+ { rootMatchName = "bar"+ , rootBaseName = "bar"+ , rootFile = "tests/samples/bar.c"+ , expected =+ [ Expectation+ { expectedFile = "tests/samples/bar.expected"+ , associated = [ ("exe", "tests/samples/bar.exe") ]+ , expParamsMatch = []+ }+ , Expectation+ { expectedFile = "tests/samples/bar.expected"+ , associated = [ ("exe", "tests/samples/bar.ppc.exe") ]+ , expParamsMatch = [ ("arch", "ppc") ]+ }+ ]+ },+ , Sweets+ { rootMatchName = "cow"+ , rootBaseName = "cow"+ , rootFile = "tests/samples/cow.c"+ , expected =+ [ Expectation+ { expectedFile = "tests/samples/cow.ppc-expected"+ , associated = [ ("exe", "tests/samples/cow.ppc.exe") ]+ , expParamsMatch = [ { "arch", "ppc" } ]+ }+ , Expectedfile+ { expectedFile = "tests/samples/cow.expected"+ , associated = [ ("exe", "tests/samples/cow.x86_64.exe") ]+ , expParamsMatch = [ ("arch", "x86_64") ]+ }+ ]+ },+ , Sweets+ { rootMatchName = "moo"+ , rootBaseName = "moo"+ , rootFile = "tests/samples/moo.c"+ , expected =+ [ Expectation+ { expectedFile = "tests/samples/moo-expected"+ , associated = [ ("exe", "tests/samples/moo.exe") ]+ , expParamsMatch = []+ }+ ]+ },+ #+END_EXAMPLE++* FAQ++ Why do the configurations need to be described by a ~Tasty.Sugar.CUBE~+ data object? Why can't they be passed in on the command-line?++ * Answer :: They could be, but there are a couple of issues that+ would make that more awkward:++ 1. There would need to be a number of command-line+ arguments to describe all of the CUBE information.++ 2. The tasty framework provides command-line parsing and+ argument handling (and expects to do so). Handling+ some command-line arguments prior to tasty and some+ within tasty would be difficult and brittle (and also+ note that the set of all tests must be known *prior*+ to invoking the tasty main code; they cannot be added+ dynamically after that point).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/example1/NiftyText.hs view
@@ -0,0 +1,34 @@+-- | Fancy text processor, surely destined to replace pandoc some day!++module NiftyText ( processText ) where++import Data.List++processText :: String -> String -> String -> String+processText transform outfmt inp =+ let wls = words <$> lines inp+ xf = case transform of+ "passthru" -> id+ "upper" -> upper+ "lower" -> lower+ outf = case outfmt of+ "ascii" -> unwords+ "octets" -> octets+ "sizes" -> sizes+ in unlines $ map (outf . map xf) wls++upper w =+ let toUpper c = if c `elem` ['a'..'z']+ then toEnum $ fromEnum c - fromEnum 'a' + fromEnum 'A'+ else c+ in map toUpper w++lower w =+ let toLower c = if c `elem` ['A'..'Z']+ then toEnum $ fromEnum c - fromEnum 'A' + fromEnum 'a'+ else c+ in map toLower w++octets = intercalate " " . map (intercalate " " . map (show . fromEnum))++sizes l = show (length l) <> ": " <> intercalate " " (map (show . length) l)
+ examples/example1/README.org view
@@ -0,0 +1,164 @@+* Scenario++In this example, a fancy library for processing text files has been+developed. The library will read text files and perform various+modifications to those files, then output them in one of various+forms.++The library is implemented by the [[NiftyText.hs]] source file in this+directory. The functionality provided by the library is pretty basic+at this stage:++#+BEGIN_EXAMPLE+$ ghci -isrc NiftyText.hs+GHCi, version 8.8.3: https://www.haskell.org/ghc/ :? for help+[1 of 1] Compiling NiftyText ( NiftyText.hs, interpreted )+Ok, one module loaded.++*NiftyText> processText "passthru" "ascii" "This is the TEXT I will process."+"This is the TEXT I will process.\n"++*NiftyText> processText "upper" "ascii" "This is the TEXT I will process."+"THIS IS THE TEXT I WILL PROCESS.\n"++*NiftyText> processText "lower" "ascii" "This is the TEXT I will process."+"this is the text i will process.\n"++*NiftyText> processText "lower" "octets" "This is the TEXT I will process."+"116 104 105 115 105 115 116 104 101 116 101 120 116 105 119 105 108 108 112 114 111 99 101 115 115 46\n"++*NiftyText> putStrLn $ processText "passthru" "sizes" "This is the\n TEXT\n I will process."+3: 4 2 3+1: 4+3: 1 4 8++*NiftyText>+#+END_EXAMPLE++The first parameter to the `processText` specifies the transformation+and the second parameter specifies the output form. In order to test+this library, a set of tests should be defined that will verify+different combinations of the transformation and the output form for+multiple different inputs.++* Testing++As a simple beginning, a test can be developed for the "passthru" and+"ascii" parameters, with simple pairings of sample input files and+expected output files.++Sample input files:++#+BEGIN_EXAMPLE+$ ls testdata+hello_inp+hello_inp.exp+counting+counting.exp++$ cat testdata/hello_inp+Hello, world.++$ cat testdata/counting+1+Number 2+The number three+This is # 4+Fifth line: here's number five.+#+END_EXAMPLE++For each one of these, the ~passthru ascii~ configuration should+result in no change to the input, so the expected results files are+identical to the input files:++#+BEGIN_EXAMPLE+$ cat testdata/hello_inp.exp+Hello, world.++$ cat testdata/counting.exp+1+Number 2+The number three+This is # 4+Fifth line: here's number five.+#+END_EXAMPLE++The ~tasty-sugar~ module can be used to identify the proper pairings+of these files to use for running tests. A "cube" is setup that+defines the file configurations:++#+BEGIN_EXAMPLE+$ ghci NiftyText.hs ../../src/Test/Tasty/Sugar.hs+GHCi, version 8.8.3: https://www.haskell.org/ghc/ :? for help+[1 of 2] Compiling NiftyText ( NiftyText.hs, interpreted )+[2 of 2] Compiling Test.Tasty.Sugar ( ../../src/Test/Tasty/Sugar.hs, interpreted )+Ok, two modules loaded.+*NiftyText>+*NiftyText> :module Test.Tasty.Sugar+Prelude Test.Tasty.Sugar> cube = mkCUBE { inputDir = "testdata" }+Prelude Test.Tasty.Sugar>+Prelude Test.Tasty.Sugar> findSugar cube+[Sweets+ {inputName = "counting",+ sourceFile = "testdata/counting",+ cubeParams = [],+ expected =+ [Expectation+ {expectedFile = "testdata/counting.exp",+ expParamsMatch = [],+ associated = []}]},+ Sweets+ {inputName = "hello_inp",+ sourceFile = "testdata/hello_inp",+ cubeParams = [],+ expected =+ [Expectation+ {expectedFile = "testdata/hello_inp.exp",+ expParamsMatch = [],+ associated = []}]}+]+Prelude Test.Tasty.Sugar>+#+END_EXAMPLE++The output above was reformatted for readability, but it's clear that+~tasty-sugar~ found both input files and the corresponding expected+output file.++The [[test-passthru-ascii.hs]] file shows how the above information is+used for operating actual tests. The test is passed a single ~Sweets~+object like the one returned from ~findSugar~ above, and also a+specific ~Expectation~ array entry for that ~Sweets~. The ~Sweets~+has a list of *all* the ~Expectation~ entries, but the test expects to+explicitly be given a single ~Expectation~ to validate.++It is worth noting at this point that ~tasty-sweet~ doesn't provide or+impose any specific testing mechanisms on the testing process; the+main facility provided by ~tasty-sweet~ is to scan the ~inputDir~+specified by the ~CUBE~ and find all pairings of inputs and outputs.+Although an explicit comparison was done above, other types of testing+could be performed, including using ~tasty-golden~ to perform the+comparison to the expected output file.++* Results++Running the tests shows the two expected outputs being verified:++#+BEGIN_EXAMPLE+$ cabal v2-run test:test-passthru-ascii+passthru ascii tests+ counting+ checking examples/example1/testdata/counting.exp: OK+ hello_inp+ checking examples/example1/testdata/hello_inp.exp: OK++All 2 tests passed (0.00s)+#+END_EXAMPLE++_Excellent!_ This has now used ~tasty-sweet~ to help verify that the+~NiftyText~ library does the right thing when used in ~passthru~+~ascii~ mode for a couple of different inputs. At this point however,+the test scenario is simple and ~tasty-golden~ could just as easily+have been used instead of ~tasty-sweet~. The advantage of using+~tasty-sweet~ starts to become apparent when testing is expanded to+other modes besides ~passthru~ and ~ascii~, as demonstrated in+[[../example2/README.org]].
+ examples/example1/test-passthru-ascii.hs view
@@ -0,0 +1,23 @@+module Main where++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Sugar++import NiftyText+++cube = mkCUBE { inputDir = "examples/example1/testdata" }+++main = do sweets <- findSugar cube+ defaultMain $ testGroup "passthru ascii tests" $+ withSugarGroups sweets testGroup test_passthru_ascii+++test_passthru_ascii sweet cnt exp =+ testCase ("checking #" <> show cnt <> ": " <> expectedFile exp) $ do+ inp <- readFile $ rootFile sweet+ let testout = NiftyText.processText "passthru" "ascii" inp+ out <- readFile $ expectedFile exp+ out @=? testout
+ examples/example1/testdata/counting view
@@ -0,0 +1,5 @@+1+Number 2+The number three+This is # 4+Fifth line: here's number five.
+ examples/example1/testdata/counting.exp view
@@ -0,0 +1,5 @@+1+Number 2+The number three+This is # 4+Fifth line: here's number five.
+ examples/example1/testdata/hello_inp view
@@ -0,0 +1,1 @@+Hello, world.
+ examples/example1/testdata/hello_inp.exp view
@@ -0,0 +1,1 @@+Hello, world.
+ examples/params/samples/foo.c view
@@ -0,0 +1,1 @@+Input C file
+ examples/params/samples/functional.O2.expct view
@@ -0,0 +1,1 @@+Haskell expected
+ examples/params/samples/functional.hs view
@@ -0,0 +1,1 @@+Input Haskell file
+ examples/params/samples/recursive.fast.expct view
@@ -0,0 +1,1 @@+Rust expected
+ examples/params/samples/recursive.rs view
@@ -0,0 +1,1 @@+Input RUST file
+ examples/params/samples/simple-opt.expct view
@@ -0,0 +1,1 @@+Simple C file expected output
+ examples/params/samples/simple-opt.gcc-exe view
@@ -0,0 +1,1 @@+This is an EXE file produced from C by GCC with OPTIMIZATION
+ examples/params/samples/simple.c view
@@ -0,0 +1,1 @@+Input C file
+ examples/params/samples/simple.expct view
@@ -0,0 +1,1 @@+Simple C file expected output
+ examples/params/samples/simple.noopt-gcc.expct view
@@ -0,0 +1,1 @@+Simple C file expected output
+ examples/params/samples/simple.noopt.clang.exe view
@@ -0,0 +1,1 @@+This is an EXE file produced from C by CLANG with NO OPTIMIZATION
+ examples/params/samples/simple.noopt.gcc.exe view
@@ -0,0 +1,1 @@+This is an EXE file produced from C by GCC with NO OPTIMIZATION
+ examples/params/samples/simple.opt-clang.exe view
@@ -0,0 +1,1 @@+This is an EXE file produced from C by CLANG with OPTIMIZATION
+ examples/params/test-params.hs view
@@ -0,0 +1,68 @@+module Main where++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Sugar+import Text.Show.Pretty+++cube :: CUBE+cube = mkCUBE { inputDir = "examples/params/samples"+ , rootName = "*.exe"+ , separators = "-."+ , expectedSuffix = "expct"+ , associatedNames = [ ("c-source", "c")+ , ("rust-source", "rs")+ , ("haskell", "hs")+]+ , validParams = [+ ("optimization", Nothing)+ ,("c-compiler", Just ["gcc", "clang"])+ ]+ }++ingredients = includingOptions sugarOptions :+ sugarIngredients cube <> defaultIngredients++main :: IO ()+main =+ do testSweets <- findSugar cube+ defaultMainWithIngredients ingredients $+ testGroup "elf" $+ withSugarGroups testSweets testGroup $+ \sweets expIdx expectation ->+ testCase (rootMatchName sweets <> " #" <> show expIdx) $ do+ e <- readFile $ expectedFile expectation+ let assoc = associated expectation+ f = rootFile sweets+ r <- case lookup "c-source" assoc of+ Just c -> runCTestOn f+ Nothing ->+ case lookup "rust-source" assoc of+ Just r -> runRustTestOn f+ Nothing ->+ case lookup "haskell" assoc of+ Just r -> runHaskellTestOn f+ Nothing ->+ -- Since "optimization" doesn't have+ -- specific values, the root *could*+ -- be "simple.noopt", but if that's+ -- the root, there's no associated+ -- file.+ if f == "examples/params/samples/simple.noopt.gcc.exe"+ then runCTestOn f+ else runUnexpTestOn sweets expectation f+ putStrLn $ ppShow sweets+ r @?= e++runCTestOn :: FilePath -> IO String+runCTestOn _ = return $ "Simple C file expected output"++runRustTestOn :: FilePath -> IO String+runRustTestOn _ = return "Rust expected"++runHaskellTestOn :: FilePath -> IO String+runHaskellTestOn _ = return "Haskell expected"++runUnexpTestOn :: Sweets -> Expectation -> FilePath -> IO String+runUnexpTestOn s e _ = return $ "unassociated " <> (ppShow s) <> " to " <> (show e)
+ src/Test/Tasty/Sugar.hs view
@@ -0,0 +1,329 @@+-- | Provides test identification by Search Using Golden Answer+-- References. This is similar in principle to Tasty.KAT and+-- Tasty.Golden, but with different input selection processes. The+-- intent is that there are multiple different test scenarios, which+-- may all originate with the same input, and that all scenarios are+-- specified by the presence of an "expected" result file along with+-- optional support files.+--+-- A 'Tasty.Sugar.CUBE' object is provided to the 'findSugar' function+-- which returns an array of 'Tasty.Sugar.Sweets' that describe test+-- configurations.+--+-- The 'sugarOptions' should be added to the tasty Options+-- specification, and the 'sugarIngredients' provides additional+-- ingredients for the sugar testing (e.g. the ability to use+-- --showsearch and see the scan and identification of tests).+--+-- The 'withSugarGroups' function can be used to drive the test+-- invocations and group the 'Sweets' by parameter values.+--+-- Example:+--+-- > import Test.Tasty as T+-- > import Test.Tasty.Options+-- > import Test.Tasty.Sugar+-- >+-- > sugarCube = mkCUBE { inputDir = "test/samples"+-- > , rootName = "*.c"+-- > , associatedNames = [ ("inputs", "inp") ]+-- > , expectedSuffix = "exp"+-- > }+-- >+-- > ingredients = T.includingOptions sugarOptions :+-- > sugarIngredients sugarCube <>+-- > T.defaultIngredients+-- >+-- > main =+-- > do testSweets <- findSugar sugarCube+-- > T.defaultMainWithIngredients ingredients $+-- > T.testGroup "sweet tests" $+-- > withSugarGroups testSweets T.testGroup mkTest+-- >+-- > mkTest :: Sweets -> Natural -> Expectation -> T.TestTree+-- > mkTest s n e = testCase (rootMatchName s <> " #" <> show n) $ do+-- > Just inpF <- lookup "inputs" $ associated e+-- > inp <- readFile inpF+-- > exp <- reads <$> readFile $ expectedFile e+-- > result <- testSomething inp+-- > result @?= exp+--+-- See the README for more information.++{-# LANGUAGE OverloadedStrings #-}++module Test.Tasty.Sugar+ (+ -- * Tasty Options and Ingredients+ sugarOptions+ , sugarIngredients++ -- * Test Generation Functions+ , findSugar+ , findSugarIn+ , withSugarGroups++ -- * Types+ -- ** Input+ , CUBE(..)+ , Separators+ , ParameterPattern+ , mkCUBE+ -- ** Output+ , Sweets(..)+ , Expectation(..)+ , Association+ , NamedParamMatch+ , ParamMatch(..)+ )+where++import Control.Applicative+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Logic+import Data.Function+import qualified Data.List as L+import Data.Maybe ( isJust, isNothing, fromJust )+import Data.Proxy+import Data.Tagged+import Data.Typeable ( Typeable )+import Numeric.Natural ( Natural )+import Options.Applicative+import Prettyprinter+import System.Directory ( listDirectory )+import Test.Tasty.Ingredients+import Test.Tasty.Options++import Test.Tasty.Sugar.Analysis+import Test.Tasty.Sugar.Types++import Prelude hiding ( exp )+++----------------------------------------------------------------------++data ShowSugarSearch = ShowSugarSearch Bool deriving (Eq, Ord, Typeable)++instance IsOption ShowSugarSearch where+ defaultValue = ShowSugarSearch False+ parseValue = fmap ShowSugarSearch . safeRead+ optionName = pure $ "showsearch"+ optionHelp = pure $ "Show details of the search for the set of\n\+ \sample-file driven tests that would be\n\+ \performed based on the search."+ optionCLParser = ShowSugarSearch <$> switch+ ( long (untag (optionName :: Tagged ShowSugarSearch String))+ <> help (untag (optionHelp :: Tagged ShowSugarSearch String))+ )+++-- | Specify the Sugar-specific Tasty command-line options+sugarOptions :: [OptionDescription]+sugarOptions = [ Option (Proxy :: Proxy ShowSugarSearch)+ ]++-- | Provides the Tasty Ingredients that can be used to inform the+-- testing process.+sugarIngredients :: CUBE -> [Ingredient]+sugarIngredients pat = [ searchResultsSugarReport pat ]+++-- | This is a Tasty "Ingredient" (aka test runner) that can be used+-- to display the search process and results for generating the tests.+-- This output can be requested by the "--showsearch" argument to the+-- test executable.++searchResultsSugarReport :: CUBE -> Ingredient+searchResultsSugarReport pat = TestManager [] $ \opts _tests ->+ if lookupOption opts == ShowSugarSearch True+ then Just $ do searchinfo <- findSugar' pat+ let (inps, expl) = searchinfo+ putStrLn $ show $ pretty pat+ putStrLn ""+ putStrLn $ show expl+ putStrLn ""+ putStrLn $ "Final set of tests [" ++ show (length inps) ++ "]:"+ putStrLn $ show $ vsep $ map (("•" <+>) . align . pretty) inps+ return True+ else Nothing+++----------------------------------------------------------------------++-- | Returns a list of the discovered test configurations (Sweets)+-- that should be run. This function is used to get the list of+-- possible test configurations that is passed with the+-- withSugarGroups function to generate the actual tests.++findSugar :: MonadIO m => CUBE -> m [Sweets]+findSugar cube = fst <$> findSugar' cube++findSugar' :: MonadIO m => CUBE -> m ([Sweets], Doc ann)+findSugar' pat = findSugarIn pat <$> liftIO (listDirectory $ inputDir pat)+++-- | Given a list of files and a CUBE, returns the list of matching+-- test Sweets that should be run, and an explanation of the search+-- process (describing unmatched possibilities as well as valid test+-- configurations).+--+-- This is a low-level function; the findSugar and withSugarGroups are+-- the recommended interface functions to use for writing tests.++findSugarIn :: CUBE -> [FilePath] -> ([Sweets], Doc ann)+findSugarIn pat allFiles =+ let (nCandidates, sres) = checkRoots pat allFiles+ inps = concat $ fst <$> sres+ expl = vsep $+ [ "Checking for test inputs in:" <+> pretty (inputDir pat)+ , indent 2 $+ vsep $ [ "# files in directory =" <+>+ pretty (length allFiles)+ , "# root candidates matching" <+>+ dquotes (pretty (rootName pat)) <+> equals <+>+ pretty nCandidates+ , "# valid roots" <+> equals <+>+ pretty (length sres)+ , "parameters = " <+> pretty (validParams pat)+ ] <> ((("--?" <+>) . pretty) <$> (concatMap snd sres))+ ]+ in case cubeIsValid pat of+ Right _ -> (inps, expl)+ Left e -> error e -- this is just testing code, so error is fine++ where++ cubeIsValid :: CUBE -> Either String CUBE+ cubeIsValid cube = cube+ <$ separatorsAreValid (separators cube)+ <* paramsAreValid (separators cube) (validParams cube)++ separatorsAreValid :: Separators -> Either String [()]+ separatorsAreValid seps = sequence $ observeAll $+ do (s1,s2) <- choose2 seps+ let globChars = "[*](|)\\" :: String+ return $ do when (s1 == s2) $+ Left "Duplicate separator characters"+ when (s1 `elem` globChars) $+ Left "Separator contains glob wildcard"+ when (s2 `elem` globChars) $+ Left "Separator contains glob wildcard"+ pure ()++ paramsAreValid :: Separators+ -> [ParameterPattern]+ -> Either String [ParameterPattern]+ paramsAreValid seps p =+ let existential = filter (isNothing . snd) p+ blankVals = filter (or . (fmap null) . snd) p+ emptyVal = filter (or . maybe [] (fmap null) . snd) $ filter (isJust . snd) p+ dupVals = rmvOrderSwapped $ observeAll duplicatedValues+ duplicatedValues =+ do p1 <- choose p+ p2 <- choose p+ guard (isJust $ snd p1)+ guard (isJust $ snd p2)+ pv <- if (fst p1 == fst p2)+ then do (p1v, p2v) <- choose2 $ fromJust $ snd p1+ guard (p1v == p2v)+ return p1v+ else do p1v <- choose $ fromJust $ snd p1+ p2v <- choose $ fromJust $ snd p2+ guard (p1v == p2v)+ return p1v+ return ((fst p1, fst p2), pv)+ sepVals = observeAll $+ do (n,vl) <- choose p+ guard (isJust vl)+ v <- choose $ maybe [] id vl+ s <- choose seps+ guard (s `elem` v)+ return n+ rmvOrderSwapped [] = []+ rmvOrderSwapped (e@((a,b),_):es) =+ let notSwapped ((a',b'),_) = not $ or [ a == a' && b == b'+ , a == b' && b == a' ]+ in e : rmvOrderSwapped (filter notSwapped es)+ in do when (length existential > 1) $+ Left "Only one parameter can have unconstrained values (i.e. Nothing)"+ unless (null blankVals) $+ Left ("Blank validParams values are not allowed (" <>+ (L.intercalate ", " (fst <$> blankVals)) <> ")")+ unless (null emptyVal) $+ Left ("Parameter values cannot be blank (" <>+ (L.intercalate ", " (fst <$> emptyVal)) <> ")")+ unless (null dupVals) $+ Left ("Parameter values cannot be duplicated " <> show dupVals)+ unless (null sepVals) $+ Left ("Parameter values cannot contain separators " <>+ show sepVals)+ return p++ choose = foldr (mplus . return) mzero++ choose2 lst = let ll = length lst+ in do guard (ll > 1)+ i1 <- choose [0..ll-1]+ i2 <- choose [0..ll-1]+ guard (i1 /= i2)+ return (lst !! i1, lst !! i2)+++-- | The 'withSugarGroups' is the primary function used to run tests.+-- Given a list of 'Sweets' returned by 'findSugar', a function to+-- mark a group of tests (usually @Tasty.testGroup@), and a function+-- to generate a test from a 'Sweets' and a specific 'Expectation',+-- this will iterate over the supplied 'Sweets' and call the test+-- generator for each valid test configuration.+--+-- Note that 'Sweets' contains all expectations (@[Expectation]@), but+-- the passed 'Expectation' is the only one that should be tested for+-- this generated test.+--+-- > withSugarGroups sweets groupFun mkTestFun+--+-- where+--+-- * @groupFun@ is the function to group a set of tests with a+-- specific name. Typically this can just be 'tasty.testGroup'+--+-- * @mkTestFun@ is the function to create a specific test for the+-- specified expectation. The output type is usually a+-- 'tasty.TestTree'. This is passed the general 'Sweets', the+-- specific 'Expectation' for the test that should be created, and+-- a numeric iteration indicating the test number within this+-- group. The iteration number can be used for differentiation+-- against the other tests, but there is no determinate+-- relationship to elements of the 'Sweets' (such as parameters or+-- associated sets).+--+withSugarGroups :: [Sweets]+ -> (String -> [a] -> a)+ -- Given a name and list of tests (aka+ -- 'TestTree'), group them (usually 'testGroup')+ -> (Sweets -> Natural -> Expectation -> a)+ -- Generate a test for this 'Expectation' (usually+ -- @a ~ TestTree@)+ -> [a]+withSugarGroups sweets mkGroup mkLeaf =+ let mkSweetTests sweet =+ mkGroup (rootMatchName sweet) $+ mkParams sweet (expected sweet) $ cubeParams sweet++ -- mkParams iterates through the declared expected values to+ -- create a group for each actual value per expectation, calling+ -- the user-supplied mkLeaf at the leaf of each path.+ mkParams sweet exp [] = map (uncurry $ mkLeaf sweet) $ zip [1..] exp+ mkParams sweet exp ((name,vspec):ps) =+ case vspec of+ Nothing -> [mkGroup name $ mkParams sweet exp ps]+ Just vs -> let f v = mkGroup v $ mkParams sweet (subExp v) ps+ subExp v = expMatching name v exp+ in f <$> L.sort vs++ expMatching :: String -> String -> [Expectation] -> [Expectation]+ expMatching p v exp =+ filter (\e -> maybe False (paramMatchVal v) (lookup p (expParamsMatch e))) exp++ in map mkSweetTests $ L.sortBy (compare `on` rootMatchName) sweets
+ src/internal/Test/Tasty/Sugar/Analysis.hs view
@@ -0,0 +1,54 @@+-- | Main internal entry point for determining the various test+-- configurations specified by a CUBE input.++module Test.Tasty.Sugar.Analysis+ (+ checkRoots+ )+where++import Control.Monad.Logic+import Data.Bifunctor ( bimap )+import Data.Maybe ( catMaybes )+import qualified System.FilePath as FP+import qualified System.FilePath.GlobPattern as FPGP++import Test.Tasty.Sugar.ExpectCheck+import Test.Tasty.Sugar.RootCheck+import Test.Tasty.Sugar.Types+++-- | Given a 'CUBE' and a list of files in the target directory,+-- return all 'Sweets' matches along with an explanation of the search+-- process. This is the core implementation for the+-- 'Test.Tasty.Sugar.findSugar' API interface.+checkRoots :: CUBE -> [FilePath]+ -> (Int, [([Sweets], [SweetExplanation])])+checkRoots pat allFiles =+ let isRootMatch n = n FPGP.~~ (rootName pat)+ rootNames = FP.takeFileName <$> (filter isRootMatch allFiles)+ in (length rootNames, fmap (checkRoot pat allFiles) rootNames)+++-- checkRoot will attempt to split the identified root file into three+-- parts:+--+-- basename + [param-values] + [suffix/extension]+--+-- Once it has performed this split, the calls findExpectation to+-- check if there are any expected file that matches the basename,+-- expSuffix, and any param-values provided. A 'Sweets' will be+-- returned for each expected file matching this root configuration+checkRoot :: CUBE+ -> [FilePath] -- all possible expect candidates+ -> FilePath -- root name+ -> ([Sweets], [SweetExplanation])+checkRoot pat allNames rootNm =+ let seps = separators pat+ params = validParams pat+ combineExpRes (swts, expl) = bimap (swts :) (expl :)+ in foldr combineExpRes ([], []) $+ catMaybes $+ fmap (findExpectation pat rootNm allNames) $+ observeAll $+ rootMatch rootNm seps params (rootName pat)
+ src/internal/Test/Tasty/Sugar/AssocCheck.hs view
@@ -0,0 +1,86 @@+-- | Function and implementation to find association files for an+-- identified test root file.++{-# LANGUAGE LambdaCase #-}++module Test.Tasty.Sugar.AssocCheck+ (+ getAssoc+ )+ where++import Control.Monad.Logic+import qualified Data.List as L+import Data.Maybe ( catMaybes )++import Test.Tasty.Sugar.ParamCheck+import Test.Tasty.Sugar.Types+++-- | For a specific NamedParamMatch, find all associated files having+-- the rootMatch plus the named parameter values (in the same order+-- but with any combination of separators) and the specified suffix+-- match.+getAssoc :: FilePath+ -> Separators+ -> [NamedParamMatch]+ -> [ (String, FileSuffix) ]+ -> [FilePath]+ -> Logic [(String, FilePath)]+getAssoc rootPrefix seps pmatch assocNames allNames = assocSet+ where+ assocSet = catMaybes <$> mapM fndAnAssoc assocNames++ fndAnAssoc assoc = ifte (fndAssoc assoc)+ (return . Just)+ (return Nothing)++ fndAssoc assoc =+ do pseq <- npseq pmatch+ (assocPfx, assocSfx) <- sepParams seps (fmap snd pseq)+ if null assocSfx+ then do let assocNm = if null (snd assoc) &&+ length assocPfx == 1 -- just a separator+ then rootPrefix+ else rootPrefix <> assocPfx <> (snd assoc)+ guard (assocNm `elem` allNames)+ return (fst assoc, assocNm)+ else let assocStart = rootPrefix <> assocPfx+ assocEnd = assocSfx <> snd assoc+ aSL = length assocStart+ aEL = length assocEnd+ possible f =+ and [ assocStart `L.isPrefixOf` f+ , assocEnd `L.isSuffixOf` f+ , length f > (aSL + aEL)+ , let mid = drop aSL (take (length f - aEL) f)+ in and $ fmap (not . flip elem mid) seps+ ]+ fnd = filter possible allNames+ in do f <- eachFrom fnd+ return (fst assoc, f)++ sepParams :: Separators -> [ParamMatch] -> Logic (String, String)+ sepParams sl = \case+ [] -> if null sl+ then return ([], [])+ else do s <- eachFrom sl+ return ([s], [])+ (NotSpecified:ps) -> do r <- sepParams sl ps+ return ([], fst r)+ ((Explicit v):ps) -> do (l,r) <- sepParams sl ps+ if null sl+ then return (v <> l, r)+ else do s <- eachFrom sl+ return ([s] <> v <> l, r)+ ((Assumed v):ps) -> do (l,r) <- sepParams sl ps+ if null sl+ then return (v <> l, r)+ else do s <- eachFrom sl+ return ([s] <> v <> l, r)++ npseq = eachFrom+ . ([]:) -- consider no parameters just once+ . filter (not . null) -- excluding multiple blanks in+ . concatMap L.inits -- any number of the+ . L.permutations -- parameters in each possible order
+ src/internal/Test/Tasty/Sugar/ExpectCheck.hs view
@@ -0,0 +1,160 @@+-- | Function to find expected results files for a specific root file,+-- along with any parameter values identified by the root file.++module Test.Tasty.Sugar.ExpectCheck+ (+ findExpectation+ )+ where++import Control.Monad.Logic+import System.FilePath ( (</>) )+import qualified Data.List as L++import Test.Tasty.Sugar.AssocCheck+import Test.Tasty.Sugar.ParamCheck+import Test.Tasty.Sugar.Types++++-- | Finds the possible expected files matching the selected+-- source. There will be either one or none.+findExpectation :: CUBE+ -> FilePath -- original name of source+ -> [FilePath] -- all of the names to choose from+ -> ([NamedParamMatch], FilePath, FilePath) -- param constraints from the root name+ -> Maybe ( Sweets, SweetExplanation )+findExpectation pat rootN allNames (rootPMatches, matchPrefix, _) =+ let r = mkSweet <$>+ trimExpectations $+ observeAll $+ expectedSearch d matchPrefix rootPMatches seps params expSuffix o+ candidates+ d = inputDir pat+ o = associatedNames pat+ seps = separators pat+ params = validParams pat+ expSuffix = expectedSuffix pat+ candidates = filter possible allNames+ possible f = and [ matchPrefix `L.isPrefixOf` f+ , rootN /= f+ ]+ mkSweet e = Just $ Sweets { rootMatchName = rootN+ , rootBaseName = matchPrefix+ , rootFile = inputDir pat </> rootN+ , cubeParams = validParams pat+ , expected = e+ }++ -- The expectedSearch tries various combinations and ordering of+ -- parameter values, separators, and such to find all valid+ -- expected file matches. However, the result is an+ -- over-sampling, so this function trims the excess and unwanted+ -- expectations.+ trimExpectations :: [Expectation] -> [Expectation]+ trimExpectations =++ -- If a parameter is Explicitly matched, discard any+ -- Expectation with Assumed matches.+ (\l -> let removeNonExplicits lst entry =+ let explParams = filter (isExplicit . snd)+ (expParamsMatch entry)+ removeNonExpl es explParam =+ filter (noNonExplicit explParam) es+ noNonExplicit (pn, Explicit pv) expl=+ let chkPV (pn', pv') =+ pn /= pn' || case pv' of+ Explicit _ -> True+ Assumed v -> v /= pv+ NotSpecified -> False+ in all chkPV $ expParamsMatch expl+ noNonExplicit _ _ = True+ in foldl removeNonExpl lst explParams+ in foldl removeNonExplicits l l)++ -- remove duplicates (uses the Eq instance for Expectation+ -- that ignores the order of the expParamsMatch and associated+ -- to ensure that different ordering with the same values+ -- doesn't cause multiple Expectation.+ . L.nub++ in case r of+ Nothing -> Nothing+ Just r' | [] <- expected r' -> Nothing+ Just r' -> Just ( r'+ , SweetExpl { rootPath = rootN+ , base = matchPrefix+ , expectedNames =+ filter+ (if null expSuffix then const True+ else (expSuffix `L.isSuffixOf`))+ candidates+ , results = [ r' ]+ })++-- Find all Expectations matching this rootMatch+expectedSearch :: FilePath+ -> FilePath+ -> [NamedParamMatch]+ -> Separators+ -> [ParameterPattern]+ -> FileSuffix+ -> [ (String, FileSuffix) ]+ -> [FilePath]+ -> Logic Expectation+expectedSearch inpDir rootPrefix rootPVMatches seps params expSuffix assocNames allNames =+ do (expFile, pmatch) <-+ let bestRanked :: [(FilePath, Int, [NamedParamMatch])]+ -> Logic (FilePath, [NamedParamMatch])+ bestRanked l =+ if null l then mzero+ else let m = maximum $ fmap rankValue l+ rankValue (_,r,_) = r+ rankMatching v (_,r,_) = v == r+ dropRank (a,_,b) = (a,b)+ in eachFrom $ fmap dropRank $ filter (rankMatching m) l++ in bestRanked $+ observeAll $+ do pseq <- eachFrom $+ ([] :) $+ filter (not . null) $+ concatMap L.inits $+ L.permutations params+ pvals <- getPVals pseq+ getExp rootPrefix rootPVMatches seps pvals expSuffix allNames+ assocFiles <- getAssoc rootPrefix seps pmatch assocNames allNames+ return $ Expectation { expectedFile = inpDir </> expFile+ , associated = fmap (inpDir </>) <$> assocFiles+ , expParamsMatch = pmatch+ }++-- Get all expected files for a particular sequence of param+value.+-- Returns the expected file, the sequence of parameter values that+-- match that expect file, and a ranking (the number of those paramter+-- values that actually appear in the expect file.+getExp :: FilePath+ -> [NamedParamMatch]+ -> Separators+ -> [(String, Maybe String)]+ -> FileSuffix+ -> [FilePath]+ -> Logic (FilePath, Int, [NamedParamMatch])+getExp rootPrefix rootPMatches seps pvals expSuffix allNames =+ do (pm, pmcnt, pmstr) <- pvalMatch seps rootPMatches pvals+ -- If the expSuffix starts with a separator then *only that*+ -- separator is allowed for the suffix (other seps are still+ -- allowed for parameter value separation).+ let suffixSpecifiesSep = and [ not (null expSuffix)+ , head expSuffix `elem` seps+ ]+ let suffixSepMatch = not suffixSpecifiesSep+ || and [ not (null pmstr)+ , last pmstr == head expSuffix+ ]+ guard suffixSepMatch+ let expFile = if suffixSpecifiesSep+ then rootPrefix <> pmstr <> tail expSuffix+ else rootPrefix <> pmstr <> expSuffix+ guard (expFile `elem` allNames)+ return (expFile, pmcnt, pm)
+ src/internal/Test/Tasty/Sugar/ParamCheck.hs view
@@ -0,0 +1,100 @@+-- | Functions for checking different parameter/value combinations.++module Test.Tasty.Sugar.ParamCheck+ (+ eachFrom+ , getPVals+ , pvalMatch+ )+ where++import Control.Monad.Logic+import qualified Data.List as L+import Data.Maybe ( fromMaybe )++import Test.Tasty.Sugar.Types+++-- | Core Logic function to iteratively return elements of a list via+-- backtracking.+eachFrom :: [a] -> Logic a+eachFrom = foldr (mplus . return) mzero+++-- | Returns various combinations of parameter value selections+getPVals :: [ParameterPattern] -> Logic [(String, Maybe String)]+getPVals = mapM getPVal+ where+ getPVal (pn, Nothing) = return (pn, Nothing)+ getPVal (pn, Just pv) = do pv' <- eachFrom pv+ return (pn, Just pv')++-- | Generate each possible combination of Explicit or non-Explicit+-- (Assumed or NotSpecified) parameter value and the corresponding+-- string with each combination of separators. The string will be+-- used to match against input files.+--+-- Note that valid combinations require that if a parameter is+-- non-Explicit, all following parameters must also be non-Explicit.+--+-- The preset set of parameters are any parameters *already* matched+-- against (usually in the rootName); these parameters may or may not+-- be present in the filename matched from the output of this+-- function, but if they are present, they must have the values+-- specified in the preset (instead of having any of the possible+-- values allowed for that parameter).+--+-- It's also possible that since this returns varying combinations of+-- parameters, that there may be multiple files that will match+-- against these combinations. Therefore, the results also indicate+-- how many of the parameters are used in the associated matching+-- string since the caller will usually select the match with the+-- highest ranking (number of matched parameters) in the filename.+-- [Note that it is not possibly to simply use the length of the+-- @[NamedParamMatch]@ return component since that may contain values+-- from the preset that don't actually occur in the match string.+pvalMatch :: Separators+ -> [NamedParamMatch]+ -> [(String, Maybe String)]+ -> Logic ([NamedParamMatch], Int, String)+pvalMatch seps preset pvals =+ let (ppv, rpv) = L.partition isPreset pvals+ isPreset p = fst p `elem` (fmap fst preset)++ matchesPreset = all matchPreset ppv+ matchPreset (pn,mpv) = maybe False (matchPresetVal mpv) $+ lookup pn preset+ matchPresetVal mpv pv = case mpv of+ Just v -> paramMatchVal v pv+ Nothing -> True++ pvVal :: [(String, Maybe String)] -> Logic [NamedParamMatch]+ pvVal [] = return []+ pvVal ((pn, mpv):ps) =+ let explicit v = do nxt <- pvVal ps+ return $ (pn, Explicit v) : nxt+ notExplicit = let pMatchImpl = maybe NotSpecified Assumed+ remPVMS = fmap (fmap pMatchImpl) ps+ in return $ (pn, pMatchImpl mpv) : remPVMS+ in (maybe mzero explicit mpv) `mplus` notExplicit++ genPVStr :: [NamedParamMatch] -> Logic String+ genPVStr pvs =+ let vstr = fromMaybe "" . getExplicit . snd+ sepJoin :: String -> NamedParamMatch -> Logic String+ sepJoin r v = if isExplicit (snd v)+ then do s <- eachFrom seps+ return $ [s] <> vstr v <> r+ else return r+ in if null seps+ then return $ foldr (\v r -> vstr v <> r) "" pvs+ else do s <- eachFrom seps+ foldM sepJoin [s] pvs++ in do guard matchesPreset+ candidateVals <- pvVal rpv+ let rset = preset <> candidateVals+ orderedRset = fmap from_rset $ fmap fst pvals+ from_rset n = let Just v = L.lookup n rset in (n,v)+ pvstr <- genPVStr orderedRset+ return (rset, length orderedRset, pvstr)
+ src/internal/Test/Tasty/Sugar/RootCheck.hs view
@@ -0,0 +1,249 @@+-- | Function and associated helpers to determine the matching root+-- name. The root name may contain zero or more parameter values.++{-# LANGUAGE LambdaCase #-}++module Test.Tasty.Sugar.RootCheck+ (+ rootMatch+ )+ where++import Control.Monad.Logic+import qualified Data.List as L+import Data.Maybe ( catMaybes, isNothing )++import Test.Tasty.Sugar.ParamCheck+import Test.Tasty.Sugar.Types+++-- | Determine which parts of the input name form the basePrefix and any+-- parameter values for searching for related files (expected and+-- associated)+rootMatch :: FilePath -> Separators -> [ParameterPattern] -> String+ -> Logic ([NamedParamMatch], FilePath, FilePath)+rootMatch origRootName seps params rootCmp =+ ifte+ (rootParamMatch origRootName seps params rootCmp)+ return+ (noRootParamMatch origRootName seps)+++data RootPart = RootSep String+ | RootParNm String String+ | RootText String+ | RootSuffix String+ deriving Show++isRootParNm :: RootPart -> Bool+isRootParNm (RootParNm _ _) = True+isRootParNm _ = False++isRootSep :: RootPart -> Bool+isRootSep (RootSep _) = True+isRootSep _ = False++isRootSuffix :: RootPart -> Bool+isRootSuffix (RootSuffix _) = True+isRootSuffix _ = False++rpStr :: [RootPart] -> String+rpStr = let s = \case+ RootSep x -> x+ RootParNm _ x -> x+ RootText x -> x+ RootSuffix x -> x+ bld a b = a <> s b+ in foldl bld ""++rpNPM :: [RootPart] -> [NamedParamMatch]+rpNPM = let bld (RootParNm n v) = Just [(n, Explicit v)]+ bld (RootSep _) = Nothing+ bld p = error ("Invalid RootPart for NamedParamMatch: "+ <> show p)+ in concat . catMaybes . fmap bld+++-- Return the prefix and suffix of the root name along with the+-- explicit parameter matches that comprise the central portion.+rootParamMatch :: FilePath -> Separators -> [ParameterPattern] -> String+ -> Logic ([NamedParamMatch], FilePath, FilePath)+rootParamMatch origRootName seps params rootCmp =+ if null seps+ then rootParamMatchNoSeps origRootName seps params+ else rootParamMatches origRootName seps params rootCmp++rootParamMatches :: FilePath -> Separators -> [ParameterPattern] -> String+ -> Logic ([NamedParamMatch], FilePath, FilePath)+rootParamMatches rootNm seps parms rMatch = do+ let rnSplit = sepSplit rootNm+ sepSplit = L.groupBy sepPoint+ sepPoint a b = not $ or [a `elem` seps, b `elem` seps ]+ rnPartIndices = [ n | n <- [0 .. length rnParts - 1] , even n ]+ freeValueParm = L.find (isNothing . snd) parms++ txtRootSfx = sepSplit $ reverse $+ -- Find the concrete extension in the+ -- rootName. Somewhat crude, but basically stops at+ -- any charcter that could be part of a filemanip+ -- GlobPattern.+ takeWhile (not . flip elem "[*]\\(|)") $ reverse rMatch++ -- if a part of the rootNm matches a known parameter value,+ -- that is the only way that part can be interpreted, and+ -- that anchors it.++ rnParts :: [RootPart]+ rnParts =+ let assignPart (ptxt,pidx) =+ let matchesParmValue (_, Nothing) = False+ matchesParmValue (_, Just vl) = ptxt `elem` vl+ in if pidx `elem` rnPartIndices+ then+ if length rnSplit - pidx < length txtRootSfx+ then RootSuffix ptxt+ else case L.find matchesParmValue parms of+ Just (pn,_) -> RootParNm pn ptxt+ Nothing -> RootText ptxt+ else RootSep ptxt++ in fmap assignPart $ zip rnSplit [0..]++ -- want [prefix, sep, MATCHES, [suffix]]+ guard (length rnSplit > 2 + length txtRootSfx)++ guard (not $ isRootParNm $ head rnParts) -- must have a prefix++ let rnChunks =+ -- pfx parms1 mid parms2 sfx+ -- r1-------------------+ -- r2------------+ -- r3--------+ let (pfx,r1) = L.span (not . isRootParNm) rnParts+ (parms1,r2) = L.span paramPart r1+ (mid,r3) = L.span (not . isRootParNm) r2+ (parms2,sfx) = L.span paramPart r3+ (_,extraprm) = L.span (not . isRootParNm) sfx+ paramPart x = isRootParNm x || isRootSep x+ in if null r3+ then Just $ Left (pfx, parms1, mid)+ else if null extraprm+ then Just $ Right (pfx, parms1, mid, parms2, sfx)+ else Nothing++ freeFirst Nothing = mzero+ freeFirst (Just (Right _)) = mzero+ freeFirst (Just (Left (allRP, [], []))) =+ -- There were no parameter value matches. If there is+ -- a wildcard parameter, try it in all the possible+ -- positions.+ if length allRP < 3+ then mzero+ else case freeValueParm of+ Nothing -> mzero+ Just p ->+ do idx <- eachFrom [i | i <- [2..length allRP], even i]+ let free = RootParNm (fst p) idxv+ RootText idxv = head $ drop idx allRP+ start = take (idx - 1) allRP+ guard (not $ isRootSuffix $ head $ drop idx allRP)+ return ( rpNPM [free]+ , rpStr $ start+ , rpStr $ drop (idx + 2) allRP )+ freeFirst (Just (Left (pfx, pl1, sfx))) =+ if length pfx < 3+ then mzero+ else case freeValueParm of+ Nothing ->+ -- No wildcard param, so just try the observed+ -- pattern+ return ( rpNPM pl1, rpStr pfx, rpStr sfx )+ Just p ->+ -- There is a wildcard parameter, try it at the end+ -- of pfx and before pl1+ let free = RootParNm (fst p) lpv+ RootText lpv = last start+ start = init pfx+ in do guard (not . isRootSuffix $ last start)+ return ( rpNPM $ free : pl1+ , rpStr $ reverse $ drop 3 $ reverse pfx+ , rpStr sfx )++ freeLast Nothing = mzero+ freeLast (Just (Right _)) = mzero+ freeLast (Just (Left (_, [], []))) = mzero -- handled by freeFirst+ freeLast (Just (Left (pfx, parms1, sfx))) =+ if null sfx+ then mzero+ else case freeValueParm of+ Nothing -> mzero -- handled by freeFirst+ Just p ->+ -- There is a wildcard parameter, try it at the end+ -- of pfx and before pl1+ let free = [RootParNm (fst p) fsv]+ RootText fsv = head sfx+ in do guard (not $ isRootSuffix $ head sfx)+ return ( rpNPM $ parms1 <> free+ , rpStr pfx+ , rpStr $ tail sfx )++ freeMid Nothing = mzero+ freeMid (Just (Left _)) = mzero+ freeMid (Just (Right (pfx, parms1, mid, parms2, sfx))) =+ -- If there is a wildcard param and mid is a single+ -- element, then try converting the mid to the+ -- wildcard, otherwise this is an invalid name.+ if length mid /= 3+ then mzero+ else case freeValueParm of+ Nothing -> mzero+ Just p ->+ let free = [RootParNm (fst p) mv]+ (ms1:RootText mv:ms2:[]) = mid+ in return ( rpNPM $ parms1 <> free <> parms2+ , rpStr $ pfx <> [ms1]+ , rpStr $ ms2 : sfx )++ (freeFirst rnChunks)+ `mplus` (freeLast rnChunks)+ `mplus` (freeMid rnChunks)+++-- If no separators, there are no "rnParts" identifiable, so fall+-- back on a cruder algorithm that simply attempts to find a+-- sequence of paramvals in the middle of the string and extract+-- the prefix and suffix (if any) around those paramvals.+rootParamMatchNoSeps :: FilePath -> Separators -> [ParameterPattern]+ -> Logic ([NamedParamMatch], FilePath, FilePath)+rootParamMatchNoSeps rootNm seps' parms = do+ pseq <- eachFrom $ filter (not . null) $ L.permutations parms+ pvals <- getPVals pseq+ (pvset, _pvcnt, pvstr) <- pvalMatch seps' [] pvals+ -- _pvcnt can be ignored because each is a different root+ let explicit = filter (isExplicit . snd) pvset+ guard (and [ not $ null explicit+ , pvstr `L.isInfixOf` rootNm+ , not $ pvstr `L.isPrefixOf` rootNm+ ])+ let (basename, suffix) =+ let l1 = length rootNm+ l2 = length pvstr+ bslen = l1 - l2+ matches n = pvstr `L.isPrefixOf` (drop n rootNm)+ Just pfxlen = L.find matches $ reverse [1..bslen]+ in (take pfxlen rootNm, drop (pfxlen + l2) rootNm)+ return (explicit, basename, suffix)++-- Return origRootName up to each sep-indicated point.+noRootParamMatch :: FilePath -> Separators+ -> Logic ([NamedParamMatch], FilePath, FilePath)+noRootParamMatch origRootName seps =+ return ([], origRootName, "") `mplus`+ do s <- eachFrom seps+ i <- eachFrom [1..length origRootName - 1]+ let a = take i origRootName+ let b = drop i origRootName+ if null b+ then do return ([], a, "")+ else do guard (and [ not $ null b, head b == s ])+ return ([], a, tail b)
+ src/internal/Test/Tasty/Sugar/Types.hs view
@@ -0,0 +1,384 @@+-- | Specifies the base tasty-sweet types and common class instance+-- definitions for those types.++{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Test.Tasty.Sugar.Types where++import Data.Function ( on )+import qualified Data.List as L+import Data.Maybe ( catMaybes )+import qualified System.FilePath.GlobPattern as FPGP+#if MIN_VERSION_prettyprinter(1,7,0)+import Prettyprinter+#else+import Data.Text.Prettyprint.Doc+#endif++import Prelude hiding ( exp )+++-- | This is the type used to specify file suffixes. The synonym name+-- is primarily used to indicate where this suffix specification is+-- used.+type FileSuffix = String+++-- | Specifies the parameters and patterns to use when searching for+-- samples to build tests from. The 'mkCUBE' function should be used+-- to obtain a 'CUBE' structure initialized with overrideable+-- defaults.+--+-- The primary elements to specify are the 'rootName' and the+-- 'expectedSuffix'. With these two specifications (and possibly the+-- 'inputDir') the 'Test.Tasty.Sugar' functionality will be similar to+-- a "golden" testing package.+--+-- The 'validParams' is an optional feature that is useful when+-- multiple expected results files are generated from a single+-- 'rootName', differing by the specified parameters.+--+-- The 'associatedNames' is an optional feature that is useful for+-- when there are other files to be associated with a test in addition+-- to the 'rootFile' and the 'expectedFile'.+--+data CUBE = CUBE+ {+ -- | The directory in which the sample files that drive the+ -- testing exist. When specified as a relative filepath+ -- (suggested) then this directory is relative to the cabal file.+ inputDir :: FilePath++ -- | The name of the "root" file for each test scenario. The+ -- contents of this file are opaque to 'tasty-sweet' and are+ -- interpreted by the tests themselves. Each "root" file is+ -- the kernel for a set of test cases.+ --+ -- The root file should not be specified with any path element,+ -- it should exist in the 'inputDir' location and it can be+ -- specified as a glob pattern.+ --+ -- The corresponding expected results files will be identified by+ -- finding files which match a portion of this name with a+ -- "{separator}{expectedSuffix}" appended to it.+ , rootName :: FPGP.GlobPattern++ -- | The expected suffix for a target pattern for running a test.+ -- There may be multiple files specifying expected results for a+ -- test (see the 'validParams' below), but a particular test case+ -- is comprised of a source file along with a corresponding+ -- "expected result" file that is the name of the source file+ -- with the 'expectedSuffix' suffix. The suffix should not contain+ -- any glob match characters. Note that the suffix is the text+ -- that comes after one of the 'separators' below.+ --+ -- The 'expectedSuffix' *may* start with one of the characters in+ -- 'separators'. If this occurs, then the suffix will only be+ -- considered if preceeded by that specific separator; otherwise+ -- any of the 'separators' may be used prior to the+ -- 'expectedSuffix'.+ , expectedSuffix :: FileSuffix++ -- | The 'separators' specify the characters which separate the+ -- expected suffix from the rootName, and which also separate+ -- the various parameters (if any, see 'validParams' below). Any+ -- one of the separators in this list can be used, and a file can+ -- used a mixture of the separators in the filename.+ --+ -- It is also valid to specify no separators, in which case the+ -- 'rootName' and 'expectedSuffix' are directly concatenated. This+ -- is not a typical usage, however.+ --+ -- The default separators (returned by 'mkCUBE') are ".-" meaning+ -- that extensions (and parameters) can be separated from the+ -- base name by either a period or a dash.+ , separators :: Separators++ -- | The 'associatedNames' specifies other files that are+ -- associated with a particular test configuration. These files+ -- are optional and not all of them appear, but different+ -- suffixes may be associated here with a general name. When a+ -- test is being generated, any associatedNames that were found+ -- will be passed to the test generator for use as supplemental+ -- data.+ --+ -- Specified as a list of tuples, where each tuple is the+ -- (arbitrary) name of the associated file type, and the file+ -- type suffix (with no period or other separator).+ , associatedNames :: [ (String, FileSuffix) ]++ -- | The 'validParams' can be used to specify various parameters+ -- that may be present in the filename.+ --+ -- For example, tests might be parameterized by which C compiler+ -- (@"gcc"@ or @"clang"@) was used, which target architecture+ -- (@"x86_64"@ or @"ppc"@ or @"arm"@), and which optimization+ -- level. The values for these parameters appear in any order in+ -- the filenames of any file (other than the 'rootName')+ -- delineated by any of the separators. Not all parameter values+ -- are required to appear.+ --+ -- The following are valid examples:+ --+ -- > foo-gcc-ppc-O3.o+ -- > foo-clang.x86_64.o+ -- > foo.O0-clang.o+ --+ -- The sugar matching code will attempt to identify the various+ -- parameter values appearing in the _expected_ filename and+ -- provide that information to the test generation process to+ -- allow the generated test to be customized to the available set+ -- of parameters.+ --+ -- The 'associatedNames' provided to the test generator will be+ -- constrained to those associated names that match the parameter+ -- values explicit in the expected name, and called for each+ -- combination of unspecified parameter values present in+ -- associated names.+ --+ -- There may actually be multiple sets of parameterized files for+ -- each 'rootName' file: the test generator will be called for+ -- each set of parameters.+ --+ -- Each entry in the 'validParams' specifies the name of the+ -- parameter and the set of values; one (and only one) parameter+ -- may have existential values rather than pre-determined values,+ -- as indicated by a Nothing for the parameter value set. Valid+ -- parameter values are *not* matched with file globbing (they+ -- must be explicit and precise matches) and they cannot be blank+ -- (the lack of a parameter is handled automatically rather than+ -- an explicit blank value).+ , validParams :: [ParameterPattern]+ }+ deriving (Show, Read)+++-- | Parameters are specified by their name and a possible list of+-- valid values. If there is no list of valid values, any value is+-- accepted for that parameter position. Parameters are listed in the+-- order that they should appear in the filenames to be matched.++type ParameterPattern = (String, Maybe [String])++-- | Separators for the path and suffix specifications. Any separator+-- is accepted in any position between parameters and prior to the+-- expected suffix. The synonym name is primarily used to indicate+-- where this separators specification is intended to be used.++type Separators = String++-- | Generates the default 'CUBE' configuration; callers should override+-- individual fields as appropriate.++mkCUBE :: CUBE+mkCUBE = CUBE { inputDir = "test/samples"+ , separators = ".-"+ , rootName = "*"+ , associatedNames = []+ , expectedSuffix = "exp"+ , validParams = []+ }+++instance Pretty CUBE where+ pretty cube =+ let assoc = prettyAssocNames $ associatedNames cube+ parms = prettyParamPatterns $ validParams cube+ hdrs = [ "input dir: " <+> pretty (inputDir cube)+ , "rootName: " <+> pretty (rootName cube)+ , "expected: " <+>+ brackets (pretty $ separators cube) <>+ pretty (expectedSuffix cube)+ ]+ in "Sugar.CUBE" <> (indent 1 $ vsep $ hdrs <> [assoc, parms])+++-- | Pretty printing for a set of associated names+prettyAssocNames :: [(String, String)] -> Doc ann+prettyAssocNames = \case+ [] -> mempty+ nms -> "associated:" <> (indent 1 $ vsep $ map (pretty . fmap show) nms)++-- | Pretty printing for a list of parameter patterns+prettyParamPatterns :: [ParameterPattern] -> Doc ann+prettyParamPatterns = \case+ [] -> mempty+ prms -> "params:" <>+ (let pp (pn,mpv) =+ pretty pn <+> equals <+>+ case mpv of+ Nothing -> "*"+ Just vl -> hsep $+ L.intersperse pipe $+ map pretty vl+ in indent 1 $ vsep $ map pp prms)++-- | Each identified test input set is represented as a 'Sweets'+-- object.. a Specifications With Existing Expected Testing Samples.++data Sweets = Sweets+ { rootBaseName :: String -- ^ base of root for matching to expected+ , rootMatchName :: String -- ^ full name of matched root+ , rootFile :: FilePath -- ^ full filepath of matched root+ , cubeParams :: [ParameterPattern] -- ^ parameters for match+ , expected :: [Expectation] -- ^ all expected files and associated+ }+ deriving (Show, Eq)++instance Pretty Sweets where+ pretty inp = "Sweet" <+>+ (align $ vsep+ [ pretty (rootMatchName inp)+ , "root:" <+>+ align (vsep [ pretty (rootBaseName inp)+ , pretty (rootFile inp)+ ])+ , prettyParamPatterns $ cubeParams inp+ , vsep $ map pretty $ expected inp+ ])++-- | The 'Association' specifies the name of the associated file entry+-- and the actual filepath of that associated file.++type Association = (String, FilePath)++-- | The 'NamedParamMatch' specifies the parameter name and the+-- corresponding value for the expected file found. These can be+-- extracted from the name of the expected file and the set of+-- 'ParameterPattern' entries, but they are presented in an associated+-- list format for easy utilization by the invoked test target.++type NamedParamMatch = (String, ParamMatch)++-- | The 'Expectation' represents a valid test configuration based on+-- the set of provided files. The 'Expectation' consists of an+-- expected file which matches the 'rootFile' in the containing+-- 'Sweets' data object. The 'expectedFile' field is the name of the+-- file containing expected output, the 'expParamsMatch' field+-- specifies the 'ParameterPattern' matching values for this expected+-- file, and the 'associated' field provides a list of files+-- associated with this expected file.++data Expectation = Expectation+ { expectedFile :: FilePath -- ^ file containing Expected results+ , expParamsMatch :: [ NamedParamMatch ] -- ^ set of CUBE parameters+ -- matched and the matched+ -- values.+ , associated :: [ Association ] -- ^ Associated files found+ }+ deriving Show++instance Eq Expectation where+ e1 == e2 = let bagCmp a b = any (a ==) $ L.permutations b+ in and [ expectedFile e1 == expectedFile e2+ , (bagCmp `on` expParamsMatch) e1 e2+ , (bagCmp `on` associated) e1 e2+ ]++instance Pretty Expectation where+ pretty exp =+ let p = expParamsMatch exp+ pp = if null p+ then Nothing+ else Just $ "Matched Params:" <+> (align $ vsep $ map ppp p)+ ppp (n,v) = pretty n <+> equals <+> pretty v+ a = associated exp+ pa = if null a+ then Nothing+ else Just $ "Associated:" <+> (align $ vsep $ map pretty a)+ in align $ vsep $ catMaybes+ [ Just $ "Expected: " <+> (align $ pretty (expectedFile exp))+ , pp+ , pa+ ]++-- | Indicates the matching parameter value for this identified+-- expected test. If the parameter value is explicitly specified in+-- the expected filename, it is an 'Explicit' entry, otherwise it is+-- 'Assumed' (for each of the valid 'ParameterPattern' values) or+-- NotSpecified if there are no known 'ParameterPattern' values.++data ParamMatch =+ -- | This parameter value was explicitly specified in the filename+ -- of the expected file.+ Explicit String++ -- | This parameter value was not specified in the filename of the+ -- expected file, so the value is being synthetically supplied.+ -- This is used for parameters that have known values but none is+ -- present: an 'Expectation' is created for each possible parameter+ -- value, identifying each as 'Assumed'.+ | Assumed String++ -- | This parameter value was not specified in the filename for the+ -- expected file. In addition, the associated 'ParameterPattern'+ -- specified no defined values (i.e. 'Nothing'), so it is not+ -- possible to identify any actual values. Instead, the+ -- 'Expectation' generated for this expected file will supply this+ -- 'NotSpecified' for this type of parameter.+ | NotSpecified++ deriving (Show, Eq)++instance Pretty ParamMatch where+ pretty (Explicit s) = pretty s+ pretty (Assumed s) = brackets $ pretty s+ pretty NotSpecified = "*"+++-- | The 'paramMatchVal' function is used to determine if a specific+-- value matches the corresponding 'ParamMatch'+paramMatchVal :: String -> ParamMatch -> Bool+paramMatchVal v (Explicit s) = s == v+paramMatchVal v (Assumed s) = s == v+paramMatchVal _ NotSpecified = True+++-- | Predicate test returning true for Explicit param values.+isExplicit :: ParamMatch -> Bool+isExplicit = \case+ Explicit _ -> True+ _ -> False+++-- | Extracts explicit value or Nothing+getExplicit :: ParamMatch -> Maybe String+getExplicit (Explicit v) = Just v+getExplicit _ = Nothing+++----------------------------------------------------------------------++-- | The 'SweetExplanation' is the data type that contains the+-- description of the 'Test.Tasty.Sugar.findSugar' process and+-- results.+data SweetExplanation =+ SweetExpl { rootPath :: FilePath+ , base :: String+ , expectedNames :: [String] -- ^ candidates+ , results :: [Sweets] -- ^ actual results+ }++instance Pretty SweetExplanation where+ pretty expl =+ let nms = expectedNames expl+ in align $ vsep $ catMaybes [+ Just $ fillSep $ punctuate ","+ [ "rootPath" <+> dquotes (pretty $ rootPath expl)+ , "base" <+> dquotes (pretty $ base expl)+ , if null nms+ then "no matches"+ else (pretty $ length nms) <+> "possible matches"+ ]+ , if null nms+ then Nothing+ else Just $ indent 8 $ vsep $ map pretty nms+ , if null (results expl)+ then Nothing+ else Just $ indent 2 $ hang 2 $ vsep $+ "Results:" : map pretty (results expl)+ ]++------------------------------------------------------------------------
+ tasty-sugar.cabal view
@@ -0,0 +1,142 @@+cabal-version: 2.0++name: tasty-sugar+version: 0.2.0.0+synopsis: Tests defined by Search Using Golden Answer References+description:+ .+ A tasty testing framework that builds individual test configurations+ from a set of input files and expected results (golden) files along+ with associated files, where multiple expected results and+ associated files for each input file can be parameterized by+ filename.+ .+ Additionally a tasty ingredient is supplied that can be used to show+ the search process and resulting test configurations without+ actually running the tests.++homepage: https://github.com/kquick/tasty-sugar+-- bug-reports:+license: ISC+license-file: LICENSE+author: Kevin Quick+maintainer: kquick@galois.com+copyright: Kevin Quick, 2019-2021+category: Testing+build-type: Simple++extra-source-files: CHANGELOG.md+ README.org+ examples/example1/NiftyText.hs+ examples/example1/README.org+ examples/example1/test-passthru-ascii.hs+ examples/example1/testdata/counting+ examples/example1/testdata/counting.exp+ examples/example1/testdata/hello_inp+ examples/example1/testdata/hello_inp.exp+ examples/params/test-params.hs+ examples/params/samples/foo.c+ examples/params/samples/functional.O2.expct+ examples/params/samples/functional.hs+ examples/params/samples/recursive.fast.expct+ examples/params/samples/recursive.rs+ examples/params/samples/simple-opt.expct+ examples/params/samples/simple-opt.gcc-exe+ examples/params/samples/simple.c+ examples/params/samples/simple.expct+ examples/params/samples/simple.noopt-gcc.expct+ examples/params/samples/simple.noopt.clang.exe+ examples/params/samples/simple.noopt.gcc.exe+ examples/params/samples/simple.opt-clang.exe++source-repository head+ type: git+ location: git://github.com/kquick/tasty-sugar.git++library+ exposed-modules: Test.Tasty.Sugar+ build-depends: base >=4.10 && < 5+ , directory+ , filepath+ , filemanip+ , logict+ , optparse-applicative+ , prettyprinter >= 1.7.0+ , tagged+ , tasty+ , tasty-sugar-internal+ hs-source-dirs: src+ default-language: Haskell2010+ GHC-options: -Wall -Wcompat -fhide-source-paths+ -- other-modules:+ -- other-extensions:+++library tasty-sugar-internal+ exposed-modules: Test.Tasty.Sugar.Analysis+ , Test.Tasty.Sugar.AssocCheck+ , Test.Tasty.Sugar.ExpectCheck+ , Test.Tasty.Sugar.ParamCheck+ , Test.Tasty.Sugar.RootCheck+ , Test.Tasty.Sugar.Types+ build-depends: base >= 4.10+ , filepath+ , filemanip+ , logict+ , prettyprinter+ hs-source-dirs: src/internal+ default-language: Haskell2010+ GHC-options: -Wall -Wcompat -fhide-source-paths+++test-suite test-sugar+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-language: Haskell2010+ GHC-options: -fhide-source-paths+ main-is: TestMain.hs+ other-modules: TestMultiAssoc+ TestNoAssoc+ TestSingleAssoc+ TestParamsAssoc+ TestUtils+ TestWildcard+ Sample1+ -- TestExpected+ -- TestSamples+ build-depends: base >= 4+ , filepath+ , hedgehog+ , logict+ , pretty-show+ , prettyprinter+ , raw-strings-qq+ , tasty+ , tasty-hedgehog+ , tasty-hunit+ , tasty-sugar+++test-suite test-passthru-ascii+ type: exitcode-stdio-1.0+ hs-source-dirs: examples/example1+ default-language: Haskell2010+ GHC-options: -fhide-source-paths+ main-is: test-passthru-ascii.hs+ other-modules: NiftyText+ build-depends: base+ , tasty+ , tasty-hunit+ , tasty-sugar++test-suite test-params+ type: exitcode-stdio-1.0+ hs-source-dirs: examples/params+ default-language: Haskell2010+ GHC-options: -fhide-source-paths+ main-is: test-params.hs+ build-depends: base+ , pretty-show+ , tasty+ , tasty-hunit+ , tasty-sugar
+ test/Sample1.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE QuasiQuotes #-}++module Sample1 where++import Text.RawString.QQ++sample1 :: [String]+sample1 = lines [r|+global-max-good.c+global-max-good.ppc.o+global-max-good.ppc.exe+global-max-good.ppc.expected+global-max-good.x86.exe+global-max-good.x86.expected+jumpfar.c+jumpfar.h+jumpfar.ppc.exe+jumpfar.ppc.expected+jumpfar.x86.exe+jumpfar.x86.expected+looping.c+looping.ppc.exe+looping.ppc.expected+looping.x86.exe+looping.x86.expected+Makefile+README.org+switching+switching_stuff+switching.c+switching.h+switching.hh+switching_llvm.c+switching_llvm.h+switching_llvm.x86.exe+switching_many.c+switching_many_llvm.c+switching_many_llvm.x86.exe+switching_many.ppc.exe+switching.ppc.base-expected+switching.ppc.o+switching.ppc.other+switching.ppc.exe+switching.x86.base-expected+switching.x86.exe+switching-refined.x86.o+switching.x86.orig+switching.x86.refined-expected+switching.x86.refined-expected-orig+switching.x86.refined-last-actual+tailrecurse.c+tailrecurse.expected+tailrecurse.expected.expected+tailrecurse.food.expected+tailrecurse.ppc.exe+tailrecurse.x86.exe+tailrecurse.x86.expected+|]
+ test/TestMain.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Exception ( SomeException, try )+import Data.Bifunctor ( bimap )+import qualified Hedgehog as HH+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Hedgehog+import Test.Tasty.Sugar++#if MIN_VERSION_prettyprinter(1,7,0)+import Prettyprinter+#else+import Data.Text.Prettyprint.Doc+#endif++import TestMultiAssoc+import TestNoAssoc+import TestSingleAssoc+import TestUtils+import TestParamsAssoc+import TestWildcard+++main :: IO ()+main = defaultMain $+ testGroup "tasty-sweet tests"+ [ testProperty "empty file list" $+ HH.withTests 10000 $ HH.property $ do+ cube <- HH.forAll $ genCube+ HH.assert $ null $ fst $ findSugarIn cube []++ , testGroup "invalid separators" $+ [+ testCase "duplicate separators" $+ (Left "Duplicate separator characters" @=?) =<<+ runTestOrErr (CUBE "." "*.foo" "e" ".-." [] [])++ , testCase "many duplicate separators" $+ (Left "Duplicate separator characters" @=?) =<<+ runTestOrErr (CUBE "." "*.foo" "e" ".---....---" [] [])++ ]++ , testGroup "invalid parameters" $+ let c1 = CUBE "." "*.foo" "e" "." [] [("a", Nothing)+ ,("b", Nothing)+ ]+ msg1 = "Only one parameter can have unconstrained values (i.e. Nothing)"+ c2 = CUBE "." "*.foo" "e" "." [] [("a", Just [])]+ msg2 = "Blank validParams values are not allowed (a)"+ c3 = CUBE "." "*.foo" "e" "." [] [("a", Just ["hi", ""])+ ,("b", Just ["one", "two"])+ ,("c", Just [""])]+ msg3 = "Parameter values cannot be blank (a, c)"++ c4 = CUBE "." "*.foo" "e" "." [] [("a", Just ["hi", "two"])+ ,("b", Just ["one", "two"])+ ,("c", Just ["end"])]+ msg4 = "Parameter values cannot be duplicated " <>+ show [(("a","b"), "two")]++ c5 = CUBE "." "*.foo" "e" "." [] [("a", Just ["two", "two"])+ ,("b", Just ["one", "hi"])+ ,("c", Just ["one"])]+ msg5 = "Parameter values cannot be duplicated " <>+ show [ (("a","a"), "two")+ , (("b", "c"), "one")+ ]++ c6 = CUBE "." "*.foo" "e" ".-o" [] [("a", Just ["two", "t"])+ ,("b", Just [".1", "one"+ , "hi.u"])+ ,("c", Just ["o"])]+ msg6 = "Parameter values cannot contain separators " <>+ show ["a", "b", "b", "b", "c"]+ in [++ testCase "too many ambiguous parameters" $+ (Left msg1 @=?) =<< runTestOrErr c1++ , testCase "empty parameter value list" $+ (Left msg2 @=?) =<< runTestOrErr c2++ , testCase "blank parameter values" $+ (Left msg3 @=?) =<< runTestOrErr c3++ , testCase "inter-duplicated parameter values" $+ (Left msg4 @=?) =<< runTestOrErr c4++ , testCase "intra-duplicated parameter values" $+ (Left msg5 @=?) =<< runTestOrErr c5++ , testCase "parameter values containing separators" $+ (Left msg6 @=?) =<< runTestOrErr c6++ ]++ , testGroup "no associated file" $ noAssocTests+ , testGroup "single associated file" $ singleAssocTests+ , testGroup "multiple associated files" $ multiAssocTests+ , testGroup "params association" $ paramsAssocTests+ , testGroup "wildcard tests" $ wildcardAssocTests+ ]+++runTestOrErr :: CUBE -> IO (Either String String)+runTestOrErr c = bimap (head . lines . show) show <$>+ (try (return $! findSugarIn c []) ::+ IO (Either SomeException ([Sweets], Doc ann)))++ -- , testGroup "samples tests" $ samplesTests+ -- , testGroup "expected matching" $ expectedTests++-- need tests for assicatedNames = [ ("binary", "") ]
+ test/TestMultiAssoc.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE ScopedTypeVariables #-}++module TestMultiAssoc ( multiAssocTests ) where++import System.FilePath ( (</>) )+import qualified Test.Tasty as TT+import Test.Tasty.HUnit+import Test.Tasty.Sugar+import TestUtils++import Sample1 ( sample1 )+++testInpPath :: FilePath+testInpPath = "tests/samples"++sugarCube :: CUBE+sugarCube = mkCUBE+ { rootName = "*.c"+ , expectedSuffix = "expected"+ , inputDir = testInpPath+ , associatedNames = [ ("exe", "exe")+ , ("obj", "o")+ , ("include", "h")+ , ("c++-include", "hh")+ , ("plain", "")+ ]+ , validParams = [ ("arch", Just ["x86", "ppc"])+ , ("form", Just ["base", "refined"])+ ]+ }++multiAssocTests :: [TT.TestTree]+multiAssocTests =+ let (sugar1,_s1desc) = findSugarIn sugarCube sample1+ in [ testCase "valid sample" $ 50 @=? length sample1+ , sugarTestEq "correct found count" sugarCube sample1 5 length+ , testCase "results" $ compareBags "results" sugar1 $+ let p = (testInpPath </>) in+ [+ Sweets { rootMatchName = "global-max-good.c"+ , rootBaseName = "global-max-good"+ , rootFile = p "global-max-good.c"+ , cubeParams = validParams sugarCube+ , expected =+ [+ Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "base")]+ , associated = [ ("exe", p "global-max-good.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "refined")]+ , associated = [ ("exe", p "global-max-good.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"),+ ("form", Assumed "base")]+ , associated = [ ("exe", p "global-max-good.ppc.exe")+ , ("obj", p "global-max-good.ppc.o")+ ]+ }+ , Expectation+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"),+ ("form", Assumed "refined")]+ , associated = [ ("exe", p "global-max-good.ppc.exe")+ , ("obj", p "global-max-good.ppc.o")+ ]+ }+ ]+ }++ , Sweets { rootMatchName = "jumpfar.c"+ , rootBaseName = "jumpfar"+ , rootFile = p "jumpfar.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "jumpfar.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "base") ]+ , associated = [ ("exe", p "jumpfar.x86.exe")+ , ("include", p "jumpfar.h")+ ]+ }+ , Expectation+ { expectedFile = p "jumpfar.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined")]+ , associated = [ ("exe", p "jumpfar.x86.exe")+ , ("include", p "jumpfar.h")+ ]+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = [ ("exe", p "jumpfar.ppc.exe")+ , ("include", p "jumpfar.h")+ ]+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = [ ("exe", p "jumpfar.ppc.exe")+ , ("include", p "jumpfar.h")+ ]+ }+ ]+ }+ , Sweets { rootMatchName = "looping.c"+ , rootBaseName = "looping"+ , rootFile = p "looping.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "base") ]+ , associated = [ ("exe", p "looping.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined")]+ , associated = [ ("exe", p "looping.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = [ ("exe", p "looping.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = [ ("exe", p "looping.ppc.exe")+ ]+ }+ ]+ }+ , Sweets { rootMatchName = "switching.c"+ , rootBaseName = "switching"+ , rootFile = p "switching.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "switching.x86.base-expected"+ , expParamsMatch = [ ("form", Explicit "base")+ , ("arch", Explicit "x86")+ ]+ , associated = [ ("exe", p "switching.x86.exe")+ , ("include", p "switching.h")+ , ("c++-include", p "switching.hh")+ , ("plain", p "switching")+ ]+ }+ , Expectation+ { expectedFile = p "switching.ppc.base-expected"+ , expParamsMatch = [ ("form", Explicit "base")+ , ("arch", Explicit "ppc")+ ]+ , associated = [ ("exe", p "switching.ppc.exe")+ , ("obj", p "switching.ppc.o")+ , ("include", p "switching.h")+ , ("c++-include", p "switching.hh")+ , ("plain", p "switching")+ ]+ }+ , Expectation+ { expectedFile = p "switching.x86.refined-expected"+ , expParamsMatch = [ ("form", Explicit "refined")+ , ("arch", Explicit "x86")+ ]+ , associated = [ ("exe", p "switching.x86.exe")+ , ("obj", p "switching-refined.x86.o")+ , ("include", p "switching.h")+ , ("c++-include", p "switching.hh")+ , ("plain", p "switching")+ ]+ }+ ]+ }+ , Sweets { rootMatchName = "tailrecurse.c"+ , rootBaseName = "tailrecurse"+ , rootFile = p "tailrecurse.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86"),+ ("form", Assumed "base") ]+ , associated = [ ("exe", p "tailrecurse.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined") ]+ , associated = [ ("exe", p "tailrecurse.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc"),+ ("form", Assumed "base") ]+ , associated = [ ("exe", p "tailrecurse.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc")+ , ("form", Assumed "refined") ]+ , associated = [ ("exe", p "tailrecurse.ppc.exe")+ ]+ }+ ]+ }+ ]+ ]
+ test/TestNoAssoc.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE ScopedTypeVariables #-}++module TestNoAssoc ( noAssocTests ) where++import Data.List+import System.FilePath ( (</>) )+import qualified Test.Tasty as TT+import Test.Tasty.HUnit+import Test.Tasty.Sugar+import TestUtils++import Sample1 ( sample1 )++testInpPath = "tests/samples"++sugarCube = mkCUBE+ { rootName = "*.c"+ , expectedSuffix = "expected"+ , inputDir = testInpPath+ , associatedNames = []+ , validParams = [ ("arch", Just ["x86", "ppc"])+ , ("form", Just ["base", "refined"])+ ]+ }++noAssocTests :: [TT.TestTree]+noAssocTests =+ let (sugar1,s1desc) = findSugarIn sugarCube sample1+ in [ testCase "valid sample" $ 50 @=? length sample1+ , sugarTestEq "correct found count" sugarCube sample1 5 length+ , testCase "results" $ compareBags "results" sugar1+ $ let p = (testInpPath </>) in+ [+ Sweets { rootMatchName = "global-max-good.c"+ , rootBaseName = "global-max-good"+ , rootFile = p "global-max-good.c"+ , cubeParams = validParams sugarCube+ , expected =+ [+ Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "base")]+ , associated = []+ }+ , Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "refined")]+ , associated = []+ }+ , Expectation+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"),+ ("form", Assumed "base")]+ , associated = []+ }+ , Expectation+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"),+ ("form", Assumed "refined")]+ , associated = []+ }+ ]+ }++ , Sweets { rootMatchName = "jumpfar.c"+ , rootBaseName = "jumpfar"+ , rootFile = p "jumpfar.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "jumpfar.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "base") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "jumpfar.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined")]+ , associated = []+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = []+ }+ ]+ }+ , Sweets { rootMatchName = "looping.c"+ , rootBaseName = "looping"+ , rootFile = p "looping.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "base") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined")]+ , associated = []+ }+ , Expectation+ { expectedFile = p "looping.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "looping.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = []+ }+ ]+ }+ , Sweets { rootMatchName = "switching.c"+ , rootBaseName = "switching"+ , rootFile = p "switching.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "switching.x86.base-expected"+ , expParamsMatch = [ ("form", Explicit "base")+ , ("arch", Explicit "x86")+ ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "switching.ppc.base-expected"+ , expParamsMatch = [ ("form", Explicit "base")+ , ("arch", Explicit "ppc")+ ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "switching.x86.refined-expected"+ , expParamsMatch = [ ("form", Explicit "refined")+ , ("arch", Explicit "x86")+ ]+ , associated = []+ }+ ]+ }+ , Sweets { rootMatchName = "tailrecurse.c"+ , rootBaseName = "tailrecurse"+ , rootFile = p "tailrecurse.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86"),+ ("form", Assumed "base") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc"),+ ("form", Assumed "base") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc")+ , ("form", Assumed "refined") ]+ , associated = []+ }+ ]+ }+ ]+ ]
+ test/TestParamsAssoc.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module TestParamsAssoc ( paramsAssocTests ) where++import Data.List+import System.FilePath ( (</>) )+import qualified Test.Tasty as TT+import Test.Tasty.HUnit+import Test.Tasty.Sugar+import TestUtils+import Text.RawString.QQ+++sample :: [String]+sample = lines [r|+recursive.rs+recursive.fast.exe+recursive.fast.expct+simple.c+simple.expct+simple.noopt.clang.exe+simple.noopt.gcc.exe+simple.noopt-gcc.expct+simple.opt-clang.exe+simple.clang-noopt-clang.exe+simple.clang-gcc.exe+simple-opt.expct+simple-opt.gcc-exe+|]++testInpPath = "test/params/samples"++-- Note: in addition to other differences when compared to the tests+-- here (TestNoAssoc, TestSingleAssoc, TestMultiAssoc), this test is+-- somewhat different in that the *output* is used as the rootname+-- instead of the source (e.g. a .c file), so parameter values must be+-- identified and removed from the root to match corresponding expects+-- and associated files.++sugarCube = mkCUBE { inputDir = testInpPath+ , rootName = "*.exe"+ , separators = "-."+ , expectedSuffix = "expct"+ , associatedNames = [ ("c-source", "c")+ , ("rust-source", "rs")+ , ("haskell", "hs")+ ]+ , validParams = [+ ("optimization", Nothing)+ ,("c-compiler", Just ["gcc", "clang"])+ ]+ }++paramsAssocTests :: [TT.TestTree]+paramsAssocTests =+ let (sugar1,_s1desc) = findSugarIn sugarCube sample+ in [ testCase "valid sample" $ 14 @=? length sample+ , sugarTestEq "correct found count" sugarCube sample 6 length+ , testCase "results" $ compareBags "results" sugar1 $+ let p = (testInpPath </>) in+ [+ Sweets { rootMatchName = "recursive.fast.exe"+ , rootBaseName = "recursive"+ , rootFile = p "recursive.fast.exe"+ , cubeParams = validParams sugarCube+ , expected =+ [+ Expectation+ { expectedFile = p "recursive.fast.expct"+ , expParamsMatch = [ ("optimization", Explicit "fast")+ , ("c-compiler", Assumed "gcc")+ ]+ , associated = [ ("rust-source", p "recursive.rs") ]+ }+ , Expectation+ { expectedFile = p "recursive.fast.expct"+ , expParamsMatch = [ ("optimization", Explicit "fast")+ , ("c-compiler", Assumed "clang")+ ]+ , associated = [ ("rust-source", p "recursive.rs") ]+ }++ ]+ }++ , Sweets { rootMatchName = "simple.noopt.clang.exe"+ , rootBaseName = "simple"+ , rootFile = p "simple.noopt.clang.exe"+ , cubeParams = validParams sugarCube+ , expected =+ [+ Expectation+ { expectedFile = p "simple.expct"+ , expParamsMatch = [ ("optimization", Explicit "noopt")+ , ("c-compiler", Explicit "clang")+ ]+ , associated = [ ("c-source", p "simple.c")]+ }+ ]+ }++ , Sweets { rootMatchName = "simple.noopt.gcc.exe"+ , rootBaseName = "simple"+ , rootFile = p "simple.noopt.gcc.exe"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "simple.noopt-gcc.expct"+ , expParamsMatch = [ ("optimization", Explicit "noopt")+ , ("c-compiler", Explicit "gcc")+ ]+ , associated = [ ("c-source", p "simple.c")]+ }+ ]+ }++ , Sweets { rootMatchName = "simple.opt-clang.exe"+ , rootBaseName = "simple"+ , rootFile = p "simple.opt-clang.exe"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "simple-opt.expct"+ , expParamsMatch = [ ("optimization", Explicit "opt")+ , ("c-compiler", Explicit "clang")+ ]+ , associated = [ ("c-source", p "simple.c")]+ }+ ]+ }++ -- This repeats a parameter value, which nullifies any+ -- parameter matching and so those elements that look like+ -- parameters are just part of the base.+ , Sweets { rootMatchName = "simple.clang-noopt-clang.exe"+ , rootBaseName = "simple"+ , rootFile = p "simple.clang-noopt-clang.exe"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "simple.expct"+ , expParamsMatch = [ ("optimization", NotSpecified)+ , ("c-compiler", Assumed "gcc")+ ]+ , associated = [ ("c-source", p "simple.c")]+ }+ , Expectation+ { expectedFile = p "simple.expct"+ , expParamsMatch = [ ("optimization", NotSpecified)+ , ("c-compiler", Assumed "clang")+ ]+ , associated = [ ("c-source", p "simple.c")]+ }+ ]+ }++ -- This repeats a parameter with a different value, which+ -- nullifies any parameter matching and so those elements+ -- that look like parameters are just part of the base.+ , Sweets { rootMatchName = "simple.clang-gcc.exe"+ , rootBaseName = "simple"+ , rootFile = p "simple.clang-gcc.exe"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "simple.expct"+ , expParamsMatch = [ ("optimization", NotSpecified)+ , ("c-compiler", Assumed "gcc")+ ]+ , associated = [ ("c-source", p "simple.c")]+ }+ , Expectation+ { expectedFile = p "simple.expct"+ , expParamsMatch = [ ("optimization", NotSpecified)+ , ("c-compiler", Assumed "clang")+ ]+ , associated = [ ("c-source", p "simple.c")]+ }+ ]+ }++ -- n.b. simple-opt.gcc-exe is *not* matched: the rootname is+ -- "*.exe" so the '.' separator is required.+ ]+ ]
+ test/TestSingleAssoc.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE ScopedTypeVariables #-}++module TestSingleAssoc ( singleAssocTests ) where++import Data.List+import System.FilePath ( (</>) )+import qualified Test.Tasty as TT+import Test.Tasty.HUnit+import Test.Tasty.Sugar+import TestUtils++import Sample1 ( sample1 )+++testInpPath = "test/samples"++sugarCube = mkCUBE+ { rootName = "*.c"+ , expectedSuffix = "expected"+ , inputDir = testInpPath+ , associatedNames = [ ("exe", "exe") ]+ , validParams = [ ("arch", Just ["x86", "ppc"])+ , ("form", Just ["base", "refined"])+ ]+ }++singleAssocTests :: [TT.TestTree]+singleAssocTests =+ let (sugar1,_s1desc) = findSugarIn sugarCube sample1+ in [ testCase "valid sample" $ 50 @=? length sample1+ , sugarTestEq "correct found count" sugarCube sample1 5 length+ , testCase "results" $ compareBags "results" sugar1 $+ let p = (testInpPath </>) in+ [+ Sweets { rootMatchName = "global-max-good.c"+ , rootBaseName = "global-max-good"+ , rootFile = p "global-max-good.c"+ , cubeParams = validParams sugarCube+ , expected =+ [+ Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "base")]+ , associated = [ ("exe", p "global-max-good.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "refined")]+ , associated = [ ("exe", p "global-max-good.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"),+ ("form", Assumed "base")]+ , associated = [ ("exe", p "global-max-good.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"),+ ("form", Assumed "refined")]+ , associated = [ ("exe", p "global-max-good.ppc.exe")+ ]+ }+ ]+ }++ , Sweets { rootMatchName = "jumpfar.c"+ , rootBaseName = "jumpfar"+ , rootFile = p "jumpfar.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "jumpfar.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "base") ]+ , associated = [ ("exe", p "jumpfar.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "jumpfar.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined")]+ , associated = [ ("exe", p "jumpfar.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = [ ("exe", p "jumpfar.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = [ ("exe", p "jumpfar.ppc.exe")+ ]+ }+ ]+ }+ , Sweets { rootMatchName = "looping.c"+ , rootBaseName = "looping"+ , rootFile = p "looping.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "base") ]+ , associated = [ ("exe", p "looping.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined")]+ , associated = [ ("exe", p "looping.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = [ ("exe", p "looping.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = [ ("exe", p "looping.ppc.exe")+ ]+ }+ ]+ }+ , Sweets { rootMatchName = "switching.c"+ , rootBaseName = "switching"+ , rootFile = p "switching.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "switching.x86.base-expected"+ , expParamsMatch = [ ("form", Explicit "base")+ , ("arch", Explicit "x86")+ ]+ , associated = [ ("exe", p "switching.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "switching.ppc.base-expected"+ , expParamsMatch = [ ("form", Explicit "base")+ , ("arch", Explicit "ppc")+ ]+ , associated = [ ("exe", p "switching.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "switching.x86.refined-expected"+ , expParamsMatch = [ ("form", Explicit "refined")+ , ("arch", Explicit "x86")+ ]+ , associated = [ ("exe", p "switching.x86.exe")+ ]+ }+ ]+ }+ , Sweets { rootMatchName = "tailrecurse.c"+ , rootBaseName = "tailrecurse"+ , rootFile = p "tailrecurse.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86"),+ ("form", Assumed "base") ]+ , associated = [ ("exe", p "tailrecurse.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined") ]+ , associated = [ ("exe", p "tailrecurse.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc"),+ ("form", Assumed "base") ]+ , associated = [ ("exe", p "tailrecurse.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc")+ , ("form", Assumed "refined") ]+ , associated = [ ("exe", p "tailrecurse.ppc.exe")+ ]+ }+ ]+ }+ ]+ ]
+ test/TestUtils.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module TestUtils where++import qualified Control.Exception as E+import qualified Data.List as L+import Data.Maybe ( catMaybes )+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import qualified Test.Tasty as TT+import Test.Tasty.HUnit+import Text.Show.Pretty++import Test.Tasty.Sugar+++genCube :: MonadGen m => m CUBE+genCube = do inpDir <- someStr+ srcName <- someStr+ expSfx <- someStr+ seps <- Gen.filterT (\s -> length s == length (L.nub s)) $+ Gen.string (Range.linear 0 3) Gen.alpha+ assocs <- Gen.list (Range.linear 0 10) assoc+ params <- Gen.list (Range.linear 0 5) param+ return $ CUBE inpDir srcName expSfx seps [] []+ where+ assoc = (,) <$> someStr <*> someStr+ param = (,) <$> someStr <*> Gen.maybe (Gen.list (Range.linear 1 6) someStr)+ someStr = Gen.string (Range.linear 0 10) Gen.alpha++testWithFailInfo desc test testInp = E.catch (test testInp) (\(_e::E.SomeException) -> assertFailure (show desc))+++eqTestWithFailInfo desc val = assertEqual (show desc) val+++testArray name elemTests lst =+ let testElem (n,e,t) = TT.testGroup (name <> " elem#" <> show n) $ t e+ testEach = map testElem $ zip3 [0..] lst elemTests+ in testCase (name <> " count") (assertEqual "length" (length elemTests) (length lst)) : testEach+++compareBags name gotBag expBag =+ if gotBag `elem` L.permutations expBag+ then return ()+ else let expCnt = length expBag+ gotCnt = length gotBag+ uGot = L.nub gotBag+ expUCnt = length $ L.nub expBag+ gotUCnt = length $ uGot+ expUnique = L.filter (not . flip elem gotBag) expBag+ gotUnique = L.filter (not . flip elem expBag) gotBag+ nMatches = length $ L.filter (flip elem expBag) gotBag+ plural n sing plu = show n <> " " <> if n == 1 then sing else plu+ showEnt nm ent = Just $ unwords [ "Unmatched", nm, "entry:"+ , ppShow ent+ ]+ in assertFailure $+ unlines $ catMaybes $+ [ if expCnt == gotCnt+ then Just $+ unwords [ "One or more mismatched entries in"+ , plural expCnt "total entry" "total entries"+ ]+ else Just $+ unwords [ "Expected", plural expCnt "entry" "entries"+ , "but got", plural gotCnt "entry" "entries"+ ]+ , if expCnt == expUCnt+ then Nothing+ else Just $+ unwords [ "Expected results list has"+ , plural (expCnt - expUCnt)+ "duplicate entry"+ "duplicate entries"+ ]+ , if gotCnt == gotUCnt+ then Nothing+ else Just $+ unwords ([ "Actual results list has"+ , plural (gotCnt - gotUCnt)+ "duplicate entry:"+ "duplicate entries:"+ ]+ <>+ let showDup e = unwords ([ "\n"+ , show $ nCopies e+ , "copies of"+ , ppShow e+ ])+ nCopies e = length $ filter (== e) gotBag+ in fmap showDup uGot)+ , if 0 == nMatches+ then Just "no common matches AT ALL"+ else Just $ show nMatches <> " matching common elements"+ ]+ <> (if null expUnique+ then [Nothing]+ else map (showEnt "expected") expUnique)+ <> (if null gotUnique+ then [Nothing]+ else map (showEnt "actual") gotUnique)++sugarTest name cube sample test =+ let (r,d) = findSugarIn cube sample+ in testCase name $ testWithFailInfo d test r+++sugarTestEq name cube sample expVal test =+ let (r,d) = findSugarIn cube sample+ in testCase name $ eqTestWithFailInfo d expVal $ test r
+ test/TestWildcard.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-| This test verifies behavior when the mkCUBE rootName is a generic+ wildcard ("*") which will match everything in the target directory.+ Proper tasty-sugar behavior will check for the expected and+ associated files and identify those as associated test files *not*+ include those as input rootFiles.+-}++module TestWildcard ( wildcardAssocTests ) where++import Data.List+import System.FilePath ( (</>) )+import qualified Test.Tasty as TT+import Test.Tasty.HUnit+import Test.Tasty.Sugar+import TestUtils+import Text.RawString.QQ+++testInpPath = "test/samples"+++sample1 = lines [r|+foo+foo.exp+foo.ex+bar.exp+bar.+bar-ex+cow.moo+cow.mooexp+cow.mooex+cow.mooexe+readme.txt+dog.bark+dog.bark-exp+|]+++wildcardAssocTests :: [TT.TestTree]+wildcardAssocTests =+ [ testCase "valid sample" $ 14 @=? length sample1++ -- The first CUBE uses the default set of separators, and the expected+ -- suffix does not limit which separators can preceed the suffix.+ , TT.testGroup "with default seps" $+ let sugarCube = mkCUBE+ { rootName = "*"+ , expectedSuffix = "exp"+ , inputDir = testInpPath+ , associatedNames = [ ("extern", "ex") ]+ }+ p = (testInpPath </>)+ in [ sugarTestEq "correct found count" sugarCube sample1 5 length++ -- foo.ex is an associated name for foo, but removing its+ -- extension makes it a sibling for the expected file and+ -- therefore a valid root as well.+ , sugarTestEq "foo is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "foo" ]+ , sugarTestEq "foo.ex is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "foo.ex" ]++ -- Similarly, bar.ex is an associated name, but also+ -- matches the expected Suffix when its .ex suffix is+ -- removed.+ , sugarTestEq "bar. is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "bar." ]+ , sugarTestEq "bar-ex is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "bar-ex" ]++ , sugarTestEq "dog.bark is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootFile x == p "dog.bark" ]+ -- n.b. cow.moo is not matched because there is no separator in cow.mooexp+ , testCase "full results" $+ compareBags "default result"+ (fst $ findSugarIn sugarCube sample1) $+ let p = (testInpPath </>) in+ [+ Sweets { rootMatchName = "foo"+ , rootBaseName = "foo"+ , rootFile = p "foo"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "foo.exp"+ , expParamsMatch = []+ , associated = [ ("extern", p "foo.ex") ]+ }+ ]+ }+ , Sweets { rootMatchName = "foo.ex"+ , rootBaseName = "foo"+ , rootFile = p "foo.ex"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "foo.exp"+ , expParamsMatch = []+ , associated = []+ }+ ]+ }+ , Sweets { rootMatchName = "bar."+ , rootBaseName = "bar"+ , rootFile = p "bar."+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "bar.exp"+ , expParamsMatch = []+ , associated = [ ("extern", p "bar-ex") ]+ }+ ]+ }+ , Sweets { rootMatchName = "bar-ex"+ , rootBaseName = "bar"+ , rootFile = p "bar-ex"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "bar.exp"+ , expParamsMatch = []+ , associated = []+ }+ ]+ }+ , Sweets { rootMatchName = "dog.bark"+ , rootBaseName = "dog.bark"+ , rootFile = p "dog.bark"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "dog.bark-exp"+ , expParamsMatch = []+ , associated = []+ }+ ]+ }+ ]+ ]++ -- The second CUBE specifies no separators: the expected suffix+ -- immediately follows the source name with no separator.+ , TT.testGroup "no seps" $+ let sugarCube = mkCUBE+ { rootName = "*"+ , expectedSuffix = "exp"+ , separators = ""+ , inputDir = testInpPath+ , associatedNames = [ ("extern", "ex") ]+ }+ p = (testInpPath </>)+ in [ sugarTestEq "correct found count" sugarCube sample1 2 length+ , sugarTestEq "bar is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootFile x == p "bar." ]+ , sugarTestEq "cow.moo is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootFile x == p "cow.moo" ]+ -- n.b. neither foo nor dog.bark is matched because they+ -- both have a character between the name and the+ -- expectedSuffix that is not a known separator+ , testCase "full results" $+ compareBags "default result"+ (fst $ findSugarIn sugarCube sample1) $+ let p = (testInpPath </>) in+ [+ Sweets { rootMatchName = "bar."+ , rootBaseName = "bar."+ , rootFile = p "bar."+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "bar.exp"+ , expParamsMatch = []+ , associated = []+ }+ ]+ }+ , Sweets { rootMatchName = "cow.moo"+ , rootBaseName = "cow.moo"+ , rootFile = p "cow.moo"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "cow.mooexp"+ , expParamsMatch = []+ , associated = [ ("extern", p "cow.mooex") ]+ }+ ]+ }+ ]+ ]+++ -- The third CUBE specifies one of the separators as part of the+ -- suffix, so only that separator is matched.+ , TT.testGroup "seps with suffix sep" $+ let sugarCube = mkCUBE+ { rootName = "*"+ , expectedSuffix = ".exp"+ , inputDir = testInpPath+ , associatedNames = [ ("extern", "ex") ]+ }+ p = (testInpPath </>)+ in [ sugarTestEq "correct found count" sugarCube sample1 4 length++ -- see notes for default seps tests above++ , sugarTestEq "foo is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "foo" ]+ , sugarTestEq "foo.ex is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "foo.ex" ]++ -- n.b. dog.bark is not matched because the separator in+ -- dog.bark-exp is not the separator specified for the+ -- expected suffix.++ , sugarTestEq "bar. is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "bar." ]+ , sugarTestEq "bar-ex is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "bar-ex" ]++ -- n.b. cow.moo is not matched because there is no separator in cow.mooexp+ , testCase "full results" $+ compareBags "default result"+ (fst $ findSugarIn sugarCube sample1) $+ let p = (testInpPath </>) in+ [+ Sweets { rootMatchName = "foo"+ , rootBaseName = "foo"+ , rootFile = p "foo"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "foo.exp"+ , expParamsMatch = []+ , associated = [ ("extern", p "foo.ex") ]+ }+ ]+ }+ , Sweets { rootMatchName = "foo.ex"+ , rootBaseName = "foo"+ , rootFile = p "foo.ex"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "foo.exp"+ , expParamsMatch = []+ , associated = []+ }+ ]+ }+ , Sweets { rootMatchName = "bar."+ , rootBaseName = "bar"+ , rootFile = p "bar."+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "bar.exp"+ , expParamsMatch = []+ , associated = [ ("extern", p "bar-ex") ]+ }+ ]+ }+ , Sweets { rootMatchName = "bar-ex"+ , rootBaseName = "bar"+ , rootFile = p "bar-ex"+ , cubeParams = []+ , expected =+ [ Expectation+ { expectedFile = p "bar.exp"+ , expParamsMatch = []+ , associated = []+ }+ ]+ }+ ]+ ]++ ]