From 18cd8eba4e4648197b21e3c00eb0edaa3642f588 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 9 Dec 2024 10:40:34 -0500 Subject: [PATCH] Draft: Cryptol API unit tests --- .github/ci.sh | 5 +- .github/workflows/ci.yml | 15 ++++- api-tests/Main.hs | 64 +++++++++++++++++++ .../REPL/Haskeline.hs | 0 .../REPL/Logo.hs | 0 cryptol.cabal | 59 +++++++++++++---- 6 files changed, 129 insertions(+), 14 deletions(-) create mode 100644 api-tests/Main.hs rename {cryptol => cryptol-repl-internal}/REPL/Haskeline.hs (100%) rename {cryptol => cryptol-repl-internal}/REPL/Logo.hs (100%) diff --git a/.github/ci.sh b/.github/ci.sh index dd5bec3eb..5d7ebecb4 100755 --- a/.github/ci.sh +++ b/.github/ci.sh @@ -25,7 +25,7 @@ deps() { # Finds the cabal-built '$1' executable and copies it to the '$2' # directory. extract_exe() { - exe="$(cabal v2-exec which "$1$EXT")" + exe="$(cabal list-bin -v0 "$1")" name="$(basename "$exe")" echo "Copying $name to $2" mkdir -p "$2" @@ -64,11 +64,12 @@ build() { ghc_ver="$(ghc --numeric-version)" cp cabal.GHC-"$ghc_ver".config cabal.project.freeze cabal v2-update - cabal v2-configure -j2 --minimize-conflict-set + cabal v2-configure -j2 --minimize-conflict-set --enable-tests git status --porcelain retry ./cry build exe:cryptol-html "$@" # retry due to flakiness with windows builds retry ./cry build exe:cryptol-remote-api "$@" retry ./cry build exe:cryptol-eval-server "$@" + retry ./cry build test:cryptol-api-tests "$@" } install_system_deps() { diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index a5157c6ac..0db36ece2 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -151,8 +151,13 @@ jobs: run: .github/ci.sh build - shell: bash + name: Extract Cryptol executables to dist/bin/ run: .github/ci.sh setup_dist_bins + - shell: bash + name: Extract Cryptol API test suite executable to bin/ + run: .github/ci.sh extract_exe "cryptol-api-tests" "bin" + - shell: bash run: .github/ci.sh check_docs if: runner.os != 'Windows' @@ -266,7 +271,7 @@ jobs: strategy: fail-fast: false matrix: - suite: [test-lib] + suite: [api-tests, test-lib] target: ${{ fromJson(needs.build.outputs.test-lib-json) }} os: [ubuntu-22.04, macos-14, windows-2019] continue-on-error: [false] @@ -358,6 +363,7 @@ jobs: chmod +x dist/bin/cryptol chmod +x dist/bin/cryptol-remote-api chmod +x dist/bin/cryptol-eval-server + chmod +x bin/cryptol-api-tests chmod +x bin/test-runner .github/ci.sh install_system_deps .github/ci.sh deps bin/abc* @@ -393,6 +399,13 @@ jobs: export PATH=$PWD/bin:$PWD/dist/bin:$PATH cryptol-remote-api/run_rpc_tests.sh + - if: matrix.suite == 'api-tests' + shell: bash + continue-on-error: ${{ matrix.continue-on-error }} + run: | + export PATH=$PWD/bin:$PWD/dist/bin:$PATH + ./bin/cryptol-api-tests + build-push-image: runs-on: ubuntu-22.04 needs: [config] diff --git a/api-tests/Main.hs b/api-tests/Main.hs new file mode 100644 index 000000000..32ea3b394 --- /dev/null +++ b/api-tests/Main.hs @@ -0,0 +1,64 @@ +module Main (main) where + +import System.Console.Haskeline.Completion (Completion(..)) +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Cryptol.REPL.Command as REPL +import qualified Cryptol.REPL.Monad as REPL +import Cryptol.REPL.Monad (REPL) +import Cryptol.Utils.Logger (quietLogger) +import Cryptol.Utils.PP (pp) + +import REPL.Haskeline (cryptolCommand) + +main :: IO () +main = defaultMain $ + testGroup "Cryptol API tests" + [ testGroup "Tab completion tests" $ + map (uncurry replTabCompletionTestCase) + [ (":check rev", ":check reverse") + , (":t rev", ":t reverse") + , (":type rev", ":type reverse") + ] + ] + +-- | Assert a property in the 'REPL' monad and turn it into a test case. +replTestCase :: TestName -> REPL () -> TestTree +replTestCase name replAssertion = + testCase name $ + REPL.runREPL + False -- Don't use batch mode + False -- Disable call stacks + quietLogger -- Ignore all log messages + replAssertion + +-- | Assert that the REPL will tab-complete the given input in a particular way. +replTabCompletionTestCase :: + -- | The input before the cursor just prior to hitting the tab key. + String -> + -- | The expected terminal input after hitting the tab key. + String -> + TestTree +replTabCompletionTestCase beforeTab afterTabExpected = + replTestCase (show beforeTab ++ " --> " ++ show afterTabExpected) $ + do -- Load the prelude so that the REPL knows how to tab-complete prelude + -- definitions. + REPL.loadPrelude + -- Perform the actual tab completion. (Oddly, Haskeline requires that the + -- input to the left of the cursor should be reversed.) + (_input, completions) <- cryptolCommand (reverse beforeTab, "") + -- Check that the results match what is expected. + REPL.io $ + case completions of + [completion] -> + do assertBool "Tab completion finished" (isFinished completion) + let afterTabActual = beforeTab ++ replacement completion + afterTabExpected @=? afterTabActual + [] -> assertFailure "Expected one tab completion, but received none" + _ -> assertFailure $ "Expected one tab completion, but received " ++ + show (length completions) + `REPL.catch` + -- If something goes wrong run running the REPL, report it as a test + -- failure. + \x -> REPL.io $ assertFailure $ show $ pp x diff --git a/cryptol/REPL/Haskeline.hs b/cryptol-repl-internal/REPL/Haskeline.hs similarity index 100% rename from cryptol/REPL/Haskeline.hs rename to cryptol-repl-internal/REPL/Haskeline.hs diff --git a/cryptol/REPL/Logo.hs b/cryptol-repl-internal/REPL/Logo.hs similarity index 100% rename from cryptol/REPL/Logo.hs rename to cryptol-repl-internal/REPL/Logo.hs diff --git a/cryptol.cabal b/cryptol.cabal index 872e8664e..f7a6b69e1 100644 --- a/cryptol.cabal +++ b/cryptol.cabal @@ -254,18 +254,22 @@ library if flag(relocatable) cpp-options: -DRELOCATABLE -executable cryptol - Default-language: - Haskell2010 - Main-is: Main.hs - hs-source-dirs: cryptol +-- The portions of the Cryptol REPL that are specific to the Cryptol executable. +-- We factor this out into a separate internal library because (1) it has some +-- dependencies (e.g., ansi-terminal and haskeline) that the Cryptol library +-- does not need to depend on, and (2) we want to be able to test this code in +-- the cryptol-api-tests test suite. +library cryptol-repl-internal + exposed-modules: REPL.Haskeline + REPL.Logo Autogen-modules: Paths_cryptol - - Other-modules: OptParser, - REPL.Haskeline, - REPL.Logo, - Paths_cryptol - + Other-modules: Paths_cryptol + hs-source-dirs: cryptol-repl-internal + default-language: Haskell2010 + GHC-options: -Wall -O2 + if os(linux) && flag(static) + ld-options: -static -pthread + ghc-options: -optl-fuse-ld=bfd build-depends: ansi-terminal , base , base-compat @@ -278,6 +282,19 @@ executable cryptol , monad-control , text , transformers + +executable cryptol + Default-language: + Haskell2010 + Main-is: Main.hs + hs-source-dirs: cryptol + Other-modules: OptParser + build-depends: base + , base-compat + , cryptol + , cryptol-repl-internal + , directory + , filepath GHC-options: -Wall -threaded -rtsopts "-with-rtsopts=-N1 -A64m" -O2 if impl(ghc >= 8.0.1) ghc-options: -Wno-redundant-constraints @@ -315,6 +332,26 @@ executable check-exercises , temporary , text GHC-options: -Wall + +-- Test cases that require the use of the Cryptol API to test effectively. Most +-- other test cases should be added to the integration tests (which only require +-- the Cryptol executable and/or the REPL) under tests/. +test-suite cryptol-api-tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: api-tests + default-language: Haskell2010 + GHC-options: -Wall -threaded -rtsopts "-with-rtsopts=-N1 -A64m" -O2 + if os(linux) && flag(static) + ld-options: -static -pthread + ghc-options: -optl-fuse-ld=bfd + build-depends: base + , cryptol + , cryptol-repl-internal + , haskeline + , tasty + , tasty-hunit + benchmark cryptol-bench type: exitcode-stdio-1.0 main-is: Main.hs