diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b683dfc4..92b8d413 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -138,7 +138,7 @@ jobs: apt-get install -y ghc libghc-tasty-quickcheck-dev libghc-syb-dev run: | ghc --version - ghc --make -fPIC -XHaskell2010 -XBangPatterns -XDeriveDataTypeable -XDeriveGeneric -XDeriveLift -XFlexibleContexts -XFlexibleInstances -XLambdaCase -XMagicHash -XMultiWayIf -XNamedFieldPuns -XPatternSynonyms -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XUnboxedTuples -optP-Wall -optP-Werror=undef -DPURE_HASKELL=0 -Iinclude -itests:tests/builder -o Main cbits/*.c tests/Main.hs +RTS -s + ghc --make -fPIC -XHaskell2010 -XBangPatterns -XDeriveDataTypeable -XDeriveGeneric -XDeriveLift -XFlexibleContexts -XFlexibleInstances -XLambdaCase -XMagicHash -XMultiWayIf -XNamedFieldPuns -XPatternSynonyms -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XUnboxedTuples -optP-Wall -optP-Werror=undef -DPURE_HASKELL=0 -DBYTESTRING_PLUGIN_TESTS=0 -Iinclude -itests:tests/builder -o Main cbits/*.c tests/Main.hs +RTS -s ./Main +RTS -s bounds-checking: @@ -158,7 +158,7 @@ jobs: path: | ${{ steps.setup-haskell-cabal.outputs.cabal-store }} dist-newstyle - key: ${{ runner.os }}-latest + key: ${{ runner.os }}-latest-bounds-checking - name: Test run: cabal test --ghc-options='-fcheck-prim-bounds -fno-ignore-asserts -DHS_BYTESTRING_ASSERTIONS' @@ -183,6 +183,27 @@ jobs: - name: Test run: cabal test -fpure-haskell --ghc-options=-fno-ignore-asserts --enable-tests --test-show-details=direct all + inspection-testing: + needs: build + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: haskell-actions/setup@v2 + id: setup-haskell-cabal + with: + ghc-version: 'latest' + - name: Update cabal package database + run: cabal update + - uses: actions/cache@v3 + name: Cache cabal stuff + with: + path: | + ${{ steps.setup-haskell-cabal.outputs.cabal-store }} + dist-newstyle + key: ${{ runner.os }}-latest-inspection-testing + - name: Test + run: sh run-plugin-tests.sh + i386: needs: build runs-on: ubuntu-latest diff --git a/bytestring.cabal b/bytestring.cabal index dcdd35a0..09879788 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -216,8 +216,10 @@ test-suite bytestring-tests QuickCheckUtils hs-source-dirs: tests, tests/builder + build-depends: bytestring + -- Keep 'bytestring' on the same line as 'build-depends:' + -- this is used by our hack to allow plugin-based tests build-depends: base, - bytestring, deepseq, QuickCheck, tasty, @@ -226,6 +228,17 @@ test-suite bytestring-tests transformers >= 0.3, syb + -- The following intentionally-funnily-spelled condition + -- is changed to 'true' by our hack to allow plugin-based tests + if false && impl(pluginTestsHack) + cpp-options: -DBYTESTRING_PLUGIN_TESTS=1 + build-depends: tasty-inspection-testing ^>= 0.2.1, + tasty-expected-failure ^>= 0.12.3 + other-modules: PluginTests + PluginTests.Splices + else + cpp-options: -DBYTESTRING_PLUGIN_TESTS=0 + ghc-options: -fwarn-unused-binds -rtsopts if !arch(wasm32) @@ -249,8 +262,10 @@ benchmark bytestring-bench ghc-options: -O2 "-with-rtsopts=-A32m" -fproc-alignment=64 + build-depends: bytestring + -- Keep 'bytestring' on the same line as 'build-depends:' + -- this is used by our hack to allow plugin-based tests build-depends: base, - bytestring, deepseq, tasty-bench, random diff --git a/run-plugin-tests.sh b/run-plugin-tests.sh new file mode 100644 index 00000000..4f1bc306 --- /dev/null +++ b/run-plugin-tests.sh @@ -0,0 +1,14 @@ +# small script to hackily work around the dependency cycle +# 'bytestring -> [plugin] -> ghc -> bytestring' that prevents +# the testsuite from using plugins, by renaming the library +# to 'bytestring-plugins-hack' + +sed -E ' + /Name:|build-depends:/s/bytestring/bytestring-plugins-hack/ ; + s/if false && impl\(pluginTestsHack\)/if true/' \ + bytestring.cabal > bytestring-plugins-hack.cabal + +mv bytestring.cabal bytestring.cabal.__MOVED_DURING_PLUGIN_TESTS__ +cabal test --test-show-details=direct "$@" +mv bytestring.cabal.__MOVED_DURING_PLUGIN_TESTS__ bytestring.cabal +rm bytestring-plugins-hack.cabal diff --git a/tests/Main.hs b/tests/Main.hs index 043b5c41..b519e086 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Main (main) where import Test.Tasty @@ -7,6 +9,9 @@ import qualified IsValidUtf8 import qualified LazyHClose import qualified Lift import qualified Properties +#if BYTESTRING_PLUGIN_TESTS +import qualified PluginTests +#endif main :: IO () main = defaultMain $ testGroup "All" @@ -15,4 +20,7 @@ main = defaultMain $ testGroup "All" , LazyHClose.testSuite , Lift.testSuite , Properties.testSuite +#if BYTESTRING_PLUGIN_TESTS + , PluginTests.testSuite +#endif ] diff --git a/tests/PluginTests.hs b/tests/PluginTests.hs new file mode 100644 index 00000000..70ceec90 --- /dev/null +++ b/tests/PluginTests.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE TemplateHaskell #-} + +{-# OPTIONS_GHC -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-} + +module PluginTests (testSuite) where + +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BL8 +import Data.ByteString.Builder +import Data.Word + +import Test.Tasty +import Test.Tasty.ExpectedFailure +import Test.Tasty.Inspection + +import PluginTests.Splices + +testSuite :: TestTree +testSuite = testGroup "Inspection plugin tests" + [ testGroup "Literals" $ + [ testGroup "StrictByteString" + [ $(hasNoStringyStuff 'pack_strict_foo) + , $(inspectTest $ 'len_pack_strict_foo === 'literal_three) + , $(hasNoStringyStuff 'pack_strict_literal) + , $(inspectTest $ 'len_pack_strict_literal === 'literal_thirtyOne) + , expectFail $ $(hasNoStringyStuff 'pack_strict_nonAscii) + , expectFail $ $(hasNoStringyStuff 'pack_strict_literal_nonAscii) + ] + + , testGroup "Builder" + [ $(hasNoStringyStuff 'builder_string8_foo) + , $(hasNoStringyStuff 'builder_string8_literal) + , $(hasNoStringyStuff 'builder_stringUtf8_foo) + , $(hasNoStringyStuff 'builder_stringUtf8_literal) + , $(hasNoStringyStuff 'builder_stringUtf8_nonAscii) + , $(hasNoStringyStuff 'builder_stringUtf8_literal_nonAscii) + ] + ] + + , $(inspectTest $ 'append_pack_replicate_unboxing `hasNoType` ''S.ByteString) + ] + +foo_string_literal :: [Char] +foo_string_literal = "foo" + +unicode_string_literal :: [Char] +unicode_string_literal = "\0example\0 ... \xff \x1f530" + +pack_strict_foo :: S.ByteString +pack_strict_foo = S8.pack foo_string_literal + +len_pack_strict_foo :: Int +len_pack_strict_foo = S.length pack_strict_foo + +pack_strict_literal :: S.ByteString +pack_strict_literal = S8.pack "some ascii literal of length 31" + +len_pack_strict_literal :: Int +len_pack_strict_literal = S.length pack_strict_literal + +pack_strict_nonAscii :: S.ByteString +pack_strict_nonAscii = S8.pack unicode_string_literal + +pack_strict_literal_nonAscii :: S.ByteString +pack_strict_literal_nonAscii + = S8.pack "this\0literal contains\x80\xf0\xff non-ascii characters" + +literal_three :: Int +literal_three = 3 + +literal_thirtyOne :: Int +literal_thirtyOne = 31 + +builder_string8_foo :: Builder +builder_string8_foo = string8 foo_string_literal + +builder_string8_literal :: Builder +builder_string8_literal = string8 "some ascii string literal" + +builder_stringUtf8_foo :: Builder +builder_stringUtf8_foo = stringUtf8 foo_string_literal + +builder_stringUtf8_literal :: Builder +builder_stringUtf8_literal = stringUtf8 "some other ascii string literal" + +builder_stringUtf8_nonAscii :: Builder +builder_stringUtf8_nonAscii = stringUtf8 unicode_string_literal + +builder_stringUtf8_literal_nonAscii :: Builder +builder_stringUtf8_literal_nonAscii + = stringUtf8 "inline literal string containing \0special\0 and non-ASCII characters like \x2139" + +append_pack_replicate_unboxing :: Int -> Word8 -> Int +append_pack_replicate_unboxing n c + = S.count c $ S.append (S.pack [0..c]) (S.replicate n c) + diff --git a/tests/PluginTests/Splices.hs b/tests/PluginTests/Splices.hs new file mode 100644 index 00000000..7cd30f5a --- /dev/null +++ b/tests/PluginTests/Splices.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} + +module PluginTests.Splices where + +import Test.Tasty +import Test.Tasty.Inspection +import Language.Haskell.TH + +import GHC.Base + ( unpackCString# + , unpackAppendCString# + , unpackCStringUtf8# + , unpackAppendCStringUtf8# + , unpackNBytes# + , unpackFoldrCString# + , unpackFoldrCStringUtf8# + ) +import Language.Haskell.TH (Name) + +unpackCString_functions_without_foldr :: [Name] +unpackCString_functions_without_foldr = + [ 'unpackCString# + , 'unpackAppendCString# + , 'unpackCStringUtf8# + , 'unpackAppendCStringUtf8# + , 'unpackNBytes# + ] + +unpackCString_functions_all :: [Name] +unpackCString_functions_all = + [ 'unpackFoldrCString# + , 'unpackFoldrCStringUtf8# + ] ++ unpackCString_functions_without_foldr + +hasNoStringyStuff :: Name -> Q Exp +hasNoStringyStuff n = flip inspectObligations n + [ (`hasNoTypes` [''Char, ''[]]) + , (`doesNotUseAnyOf` unpackCString_functions_all) + ] + +hasNoStringyStuffExceptFolds :: Name -> Q Exp +hasNoStringyStuffExceptFolds n = flip inspectObligations n + [ (`hasNoTypes` [''Char, ''[]]) + , (`doesNotUseAnyOf` unpackCString_functions_without_foldr) + ]