CI: add big-endian job (#436)

* Run less UTF-8 tests so that tests in emulated environment take reasonable time

* Wrap certain tests into Sqrt to reduce memory pressure

* CI: add s390x and ppc64le emulated jobs

Co-authored-by: Simon Jakobi <[email protected]>

Author: Bodigrim

.github/workflows/ci.yml

@@ -4,7 +4,7 @@ on:
     branches:
       - master
       - bytestring-0.11
-  pull_request: {}
+  pull_request: {} # Validate all PRs
 
 defaults:
   run:
@@ -60,3 +60,31 @@ jobs:
       run: |
         cd bytestring-*/
         cabal haddock
+
+  # Emulation is incredibly slow and memory demanding. It seems that any
+  # executable with GHC RTS takes at least 7-8 Gb of RAM, so we can run
+  # `cabal` or `ghc` on their own, but cannot run them both at the same time,
+  # striking out `cabal test`. Instead we rely on system packages and invoke
+  # `ghc --make` manually, and even so `ghc -O` is prohibitively expensive.
+  emulated:
+    needs: build
+    runs-on: ubuntu-latest
+    strategy:
+      fail-fast: true
+      matrix:
+        arch: ['s390x', 'ppc64le']
+    steps:
+    - uses: actions/checkout@v2
+    - uses: uraimo/[email protected]
+      timeout-minutes: 60
+      with:
+        arch: ${{ matrix.arch }}
+        distro: ubuntu20.04
+        githubToken: ${{ github.token }}
+        install: |
+          apt-get update -y
+          apt-get install -y ghc libghc-tasty-quickcheck-dev
+        run: |
+          ghc --version
+          ghc --make -Iinclude -itests:tests/builder -o Main cbits/*.c tests/Main.hs +RTS -s
+          ./Main +RTS -s

tests/IsValidUtf8.hs

@@ -29,7 +29,7 @@ testSuite = testGroup "UTF-8 validation" $ [
     goInvalid = forAll arbitrary $ 
       \inv -> (B.isValidUtf8 . toByteString $ inv) === False
     testCount :: QuickCheckTests
-    testCount = 100000
+    testCount = 1000
 
 checkRegressions :: [TestTree]
 checkRegressions = [

tests/Properties/ByteString.hs

@@ -141,13 +141,13 @@ tests =
     B.unpack mempty === []
 
   , testProperty "concat" $
-    \xs -> B.unpack (B.concat xs) === concat (map B.unpack xs)
+    \(Sqrt xs) -> B.unpack (B.concat xs) === concat (map B.unpack xs)
   , testProperty "concat [x,x]" $
     \x -> B.unpack (B.concat [x, x]) === concat [B.unpack x, B.unpack x]
   , testProperty "concat [x,[]]" $
     \x -> B.unpack (B.concat [x, B.empty]) === concat [B.unpack x, []]
   , testProperty "mconcat" $
-    \xs -> B.unpack (mconcat xs) === mconcat (map B.unpack xs)
+    \(Sqrt xs) -> B.unpack (mconcat xs) === mconcat (map B.unpack xs)
   , testProperty "mconcat [x,x]" $
     \x -> B.unpack (mconcat [x, x]) === mconcat [B.unpack x, B.unpack x]
   , testProperty "mconcat [x,[]]" $
@@ -186,7 +186,7 @@ tests =
   , testProperty "<>" $
     \x y -> B.unpack (x <> y) === B.unpack x <> B.unpack y
   , testProperty "stimes" $
-    \(NonNegative n) x -> stimes (n :: Int) (x :: B.ByteString) === mtimesDefault n x
+    \(Sqrt (NonNegative n)) (Sqrt x) -> stimes (n :: Int) (x :: B.ByteString) === mtimesDefault n x
 
   , testProperty "break" $
     \f x -> (B.unpack *** B.unpack) (B.break f x) === break f (B.unpack x)
@@ -434,10 +434,10 @@ tests =
   , testProperty "foldr cons" $
     \x -> B.foldr B.cons B.empty x === x
   , testProperty "foldl special" $
-    \x (toElem -> c) -> B.unpack (B.foldl (\acc t -> if t == c then acc else B.cons t acc) B.empty x) ===
+    \(Sqrt x) (toElem -> c) -> B.unpack (B.foldl (\acc t -> if t == c then acc else B.cons t acc) B.empty x) ===
       foldl (\acc t -> if t == c then acc else t : acc) [] (B.unpack x)
   , testProperty "foldr special" $
-    \x (toElem -> c) -> B.unpack (B.foldr (\t acc -> if t == c then acc else B.cons t acc) B.empty x) ===
+    \(Sqrt x) (toElem -> c) -> B.unpack (B.foldr (\t acc -> if t == c then acc else B.cons t acc) B.empty x) ===
       foldr (\t acc -> if t == c then acc else t : acc) [] (B.unpack x)
 
   , testProperty "foldl1" $
@@ -486,7 +486,7 @@ tests =
   , testProperty "intersperse" $
     \(toElem -> c) x -> B.unpack (B.intersperse c x) === List.intersperse c (B.unpack x)
   , testProperty "intercalate" $
-    \x ys -> B.unpack (B.intercalate x ys) === List.intercalate (B.unpack x) (map B.unpack ys)
+    \(Sqrt x) (Sqrt ys) -> B.unpack (B.intercalate x ys) === List.intercalate (B.unpack x) (map B.unpack ys)
   , testProperty "intercalate 'c' [x,y]" $
     \(toElem -> c) x y -> B.unpack (B.intercalate (B.singleton c) [x, y]) === List.intercalate [c] [B.unpack x, B.unpack y]
   , testProperty "intercalate split" $

tests/QuickCheckUtils.hs

@@ -1,6 +1,13 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeApplications #-}
 
-module QuickCheckUtils (Char8(..), String8(..), CByteString(..)) where
+module QuickCheckUtils
+  ( Char8(..)
+  , String8(..)
+  , CByteString(..)
+  , Sqrt(..)
+  ) where
 
 import Test.Tasty.QuickCheck
 import Text.Show.Functions
@@ -84,3 +91,13 @@ instance Arbitrary String8 where
       toChar :: Word8 -> Char
       toChar = toEnum . fromIntegral
   shrink (String8 xs) = fmap String8 (shrink xs)
+
+-- | If a test takes O(n^2) time or memory, it's useful to wrap its inputs
+-- into 'Sqrt' so that increasing number of tests affects run time linearly.
+newtype Sqrt a = Sqrt { unSqrt :: a }
+  deriving (Eq, Show)
+
+instance Arbitrary a => Arbitrary (Sqrt a) where
+  arbitrary = Sqrt <$> sized
+    (\n -> resize (round @Double $ sqrt $ fromIntegral @Int n) arbitrary)
+  shrink = map Sqrt . shrink . unSqrt