Add a few basic tests for unboxing and RULES working

.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

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

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

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
   ]

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)
+

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)
+  ]