sized 1.0.0.0 → 1.0.0.1
raw patch · 3 files changed
+146/−134 lines, 3 filesdep +tastydep +tasty-expected-failuredep +tasty-inspection-testingdep −hspecdep ~inspection-testing
Dependencies added: tasty, tasty-expected-failure, tasty-inspection-testing
Dependencies removed: hspec
Dependency ranges changed: inspection-testing
Files
- sized.cabal +49/−49
- test/Shared.hs +23/−16
- test/opt-test.hs +74/−69
sized.cabal view
@@ -1,66 +1,66 @@-cabal-version: >=2.0+cabal-version: 2.0 name: sized-version: 1.0.0.0+version: 1.0.0.1 license: BSD3 license-file: LICENSE maintainer: konn.jinro_at_gmail.com author: Hiromi ISHII-tested-with:- ghc ==8.6.5, ghc ==8.8.4, ghc ==8.10.3-+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 synopsis: Sized sequence data-types description:- A wrapper to make length-parametrized data-type from functorial data-types.+ A wrapper to make length-parametrized data-type from functorial data-types. category: Data build-type: Simple source-repository head- type: git- location: git://github.com/konn/sized.git+ type: git+ location: git://github.com/konn/sized.git library- exposed-modules:- Data.Sized- Data.Sized.Builtin- Data.Sized.Flipped+ exposed-modules:+ Data.Sized+ Data.Sized.Builtin+ Data.Sized.Flipped - hs-source-dirs: src- other-modules: Data.Sized.Internal- default-language: Haskell2010- ghc-options: -O2 -Wall -Wno-redundant-constraints- build-depends:- base ==4.*,- constraints,- these,- type-natural >=0.8.1.0,- ghc-typelits-presburger >=0.4,- ghc-typelits-knownnat,- mono-traversable >=0.10,- subcategories,- deepseq >=1.4,- hashable >=1.2,- vector >=0.12,- containers >=0.5,- equational-reasoning >=0.5,- lens >=0.14+ hs-source-dirs: src+ other-modules: Data.Sized.Internal+ default-language: Haskell2010+ ghc-options: -O2 -Wall -Wno-redundant-constraints+ build-depends:+ base >=4 && <5+ , constraints+ , containers >=0.5+ , deepseq >=1.4+ , equational-reasoning >=0.5+ , ghc-typelits-knownnat+ , ghc-typelits-presburger >=0.5+ , hashable >=1.2+ , lens >=0.14+ , mono-traversable >=0.10+ , subcategories+ , these+ , type-natural >=1.0+ , vector >=0.12 test-suite optimisaion-test- type: exitcode-stdio-1.0- main-is: opt-test.hs- hs-source-dirs: test- other-modules: Shared- default-language: Haskell2010- ghc-options: -O2 -Wall -Wno-redundant-constraints -fno-hpc- build-depends:- base -any,- containers -any,- hspec -any,- inspection-testing ^>=0.4,- mono-traversable -any,- sized -any,- template-haskell -any,- type-natural,- th-lift -any,- subcategories -any,- vector -any+ type: exitcode-stdio-1.0+ main-is: opt-test.hs+ hs-source-dirs: test+ other-modules: Shared+ default-language: Haskell2010+ ghc-options: -O2 -Wall -Wno-redundant-constraints -fno-hpc+ build-depends:+ base+ , containers+ , inspection-testing >=0.4 && <0.6+ , mono-traversable+ , sized+ , subcategories+ , tasty+ , tasty-expected-failure+ , tasty-inspection-testing+ , template-haskell+ , th-lift+ , type-natural+ , vector
@@ -1,21 +1,28 @@-{-# LANGUAGE DataKinds, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -O2 -fno-hpc #-}-{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions- -dsuppress-type-applications- -dsuppress-module-prefixes -dsuppress-type-signatures- -dsuppress-uniques #-}+ module Shared where-import Language.Haskell.TH-import Test.Hspec-import Test.Inspection +import Language.Haskell.TH (ExpQ)+import Test.Tasty.Inspection -checkInspection- :: Result -> Expectation-checkInspection Success{} = pure ()-checkInspection (Failure msg) =- fail msg+inspecting :: String -> Obligation -> ExpQ+inspecting title obl = inspectTest $ obl {testName = Just title} -inspecting :: String -> Obligation -> Q Exp-inspecting desc reg =- [|it desc $ checkInspection $(inspectTest reg)|]+data GHCVer = GHC8_8 | GHC8_10 | GHC9_0 | GHC9_2+ deriving (Show, Eq, Ord)++ghcVer :: GHCVer++#if __GLASGOW_HASKELL__ == 902+ghcVer = GHC9_2+#elif __GLASGOW_HASKELL__ == 900+ghcVer = GHC9_0+#elif __GLASGOW_HASKELL__ == 810+ghcVer = GHC8_10+#elif __GLASGOW_HASKELL__ == 808+ghcVer = GHC8_8+#else+ghcVer = error "Coudld not determine GHC Version: __GLASGOW_HASKELL__"+#endif
test/opt-test.hs view
@@ -10,9 +10,10 @@ module Main where import Control.Subcategory+import Data.Function ((&)) import qualified Data.Sequence as Seq-import Data.Sized.Builtin (Sized, zipWithSame)-import qualified Data.Sized.Builtin as SV+import Data.Sized (Sized, zipWithSame)+import qualified Data.Sized as SV import Data.Type.Natural import qualified Data.Vector as V import qualified Data.Vector.Generic as G@@ -22,8 +23,9 @@ import qualified Data.Vector.Unboxed as U import Numeric.Natural (Natural) import Shared-import Test.Hspec-import Test.Inspection+import Test.Tasty+import Test.Tasty.ExpectedFailure (expectFailBecause)+import Test.Tasty.Inspection type LSized = Sized [] @@ -35,6 +37,8 @@ type SeqSized = Sized Seq.Seq +{-# ANN module "HLINT: ignore Use camelCase" #-}+ zipWith_subcat_List :: (Int -> Int -> Int) -> [Int] -> [Int] -> [Int] zipWith_subcat_List = czipWith@@ -106,68 +110,69 @@ const_two_dom = const 2 main :: IO ()-main = hspec $ do- describe "czipWith" $ do- $( inspecting "doesn't contain type classes" $- hasNoTypeClasses 'zipWith_subcat_List- )- describe "zipWith" $ do- $( inspecting "doesn't contain type classes" $- hasNoTypeClasses 'zipWith_List- )- describe "zipWithSame" $ do- describe "list" $ do- it "doesn't contain type classes" $- checkInspection- $( inspectTest $- hasNoTypeClasses 'zipWithSame_List- )- it "is almost the same as the original zipWith (list)" $- checkInspection- $( inspectTest $- 'zipWithSame_List ==- 'zipWith_List_Prel- )- describe "Boxed Vector" $ do- it "doesn't contain type classes, except for G.Vector" $- checkInspection- $( inspectTest $- 'zipWithSame_Boxed- `hasNoTypeClassesExcept` [''G.Vector]- )- it "is almost the same as the original zipWith (Boxed)" $- checkInspection- $( inspectTest $- 'zipWithSame_Boxed ==- 'zipWith_Boxed- )- describe "Unboxed Vector" $ do- it "doesn't contain type classes except for Unbox" $- checkInspection- $( inspectTest $- 'zipWithSame_Unboxed- `hasNoTypeClassesExcept` [''Unbox]- )- it "doesn't contain type classes if fully instnatiated" $- checkInspection- $( inspectTest $- hasNoTypeClasses 'zipWithSame_Unboxed_monomorphic- )- it "is almost the same as the original zipWith, if fully instantiated" $- checkInspection- $( inspectTest $- 'zipWithSame_Unboxed_monomorphic- ==- 'zipWith_Unboxed_monomorphic- )- describe "length" $ do- it "is a constant function when length is concrete (with Dom dictionary)" $- checkInspection- $( inspectTest $- 'length_two ==- 'const_two_dom- )- it "doesn't contain Integer when the length is concrete" $- checkInspection- $( inspectTest $ hasNoType 'length_two ''Integer- )- it "doesn't contain Natural when the length is concrete" $- checkInspection- $( inspectTest $ hasNoType 'length_two ''Natural- )+main =+ defaultMain $+ testGroup+ "Optimisation test"+ [ testGroup+ "czipWith"+ [ $( inspecting "doesn't contain type classes" $+ hasNoTypeClasses 'zipWith_subcat_List+ )+ ]+ , testGroup+ "zipWith"+ [ $( inspecting "doesn't contain type classes" $+ hasNoTypeClasses 'zipWith_List+ )+ ]+ , testGroup+ "zipWithSame"+ [ testGroup+ "list"+ [ $( inspecting "doesn't contain type classes" $+ hasNoTypeClasses 'zipWithSame_List+ )+ , $( inspecting "is almost the same as the original zipWith (list)" $+ 'zipWithSame_List ==- 'zipWith_List_Prel+ )+ ]+ , testGroup+ "Boxed Vector"+ [ $( inspecting "doesn't contain type classes, except for G.Vector" $+ 'zipWithSame_Boxed+ `hasNoTypeClassesExcept` [''G.Vector]+ )+ , $( inspecting "is almost the same as the original zipWith (Boxed)" $+ 'zipWithSame_Boxed ==- 'zipWith_Boxed+ )+ ]+ , testGroup+ "Unboxed Vector"+ [ $( inspecting "doesn't contain type classes except for Unbox" $+ 'zipWithSame_Unboxed+ `hasNoTypeClassesExcept` [''Unbox]+ )+ & if ghcVer >= GHC9_0+ then expectFailBecause "This suffers from Simplified Subsumption"+ else id+ , $( inspecting "doesn't contain type classes if fully instnatiated" $+ hasNoTypeClasses 'zipWithSame_Unboxed_monomorphic+ )+ , $( inspecting "is almost the same as the original zipWith, if fully instantiated" $+ 'zipWithSame_Unboxed_monomorphic+ ==- 'zipWith_Unboxed_monomorphic+ )+ ]+ ]+ , testGroup+ "length"+ [ $( inspecting "is a constant function when length is concrete (with Dom dictionary)" $+ 'length_two ==- 'const_two_dom+ )+ , $( inspecting "doesn't contain Integer when the length is concrete" $ hasNoType 'length_two ''Integer+ )+ , $( inspecting "doesn't contain Natural when the length is concrete" $ hasNoType 'length_two ''Natural+ )+ ]+ ]