Test plutus-tx-tests on all supported GHC versions (#5497)

plutus-core/testlib/Test/Tasty/Extras.hs

@@ -3,6 +3,7 @@ module Test.Tasty.Extras
  , runTestNestedIn
  , runTestNested
  , testNested
+ , testNestedGhc
  , goldenVsText
  , goldenVsTextM
  , goldenVsDoc
@@ -19,7 +20,9 @@ import Control.Monad.Reader
 import Data.ByteString.Lazy qualified as BSL
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
+import Data.Version
 import System.FilePath ((</>))
+import System.Info
 import Test.Tasty
 import Test.Tasty.Golden
 
@@ -39,6 +42,12 @@ testNested :: String -> [TestNested] -> TestNested
 testNested folderName =
  local (++ [folderName]) . fmap (testGroup folderName) . sequence
 
+-- | Like `testNested` but adds a subdirectory corresponding to the GHC version being used.
+testNestedGhc :: String -> [TestNested] -> TestNested
+testNestedGhc folderName = testNested (folderName </> ghcVer)
+ where
+ ghcVer = showVersion compilerVersion
+
 -- | Check the contents of a file against a 'Text'.
 goldenVsText :: TestName -> FilePath -> Text -> TestTree
 goldenVsText name ref = goldenVsTextM name ref . pure

plutus-tx-plugin/plutus-tx-plugin.cabal

@@ -118,10 +118,6 @@ executable gen-plugin-opts-doc
 test-suite plutus-tx-tests
  import: lang, ghc-version-support
 
- -- test output changes after 9.2, bad for golden tests
- if impl(ghc >=9.3)
- buildable: False
-
  if flag(use-ghc-stub)
  buildable: False
 

plutus-tx-plugin/src/PlutusTx/Compiler/Names.hs

@@ -1,12 +1,10 @@
--- editorconfig-checker-disable-file
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 
 -- | Functions for compiling GHC names into Plutus Core names.
 module PlutusTx.Compiler.Names where
 
-
 import PlutusTx.Compiler.Kind
 import {-# SOURCE #-} PlutusTx.Compiler.Type
 import PlutusTx.Compiler.Types
@@ -49,34 +47,34 @@ on how it is printed.
 getUntidiedOccString :: GHC.Name -> String
 getUntidiedOccString n = dropWhileEnd isDigit (GHC.getOccString n)
 
-compileNameFresh :: MonadQuote m => GHC.Name -> m PLC.Name
+compileNameFresh :: (MonadQuote m) => GHC.Name -> m PLC.Name
 compileNameFresh n = safeFreshName $ T.pack $ getUntidiedOccString n
 
-compileVarFresh :: CompilingDefault uni fun m ann => Ann -> GHC.Var -> m (PLCVar uni)
+compileVarFresh :: (CompilingDefault uni fun m ann) => Ann -> GHC.Var -> m (PLCVar uni)
 compileVarFresh ann v = do
-  t' <- compileTypeNorm $ GHC.varType v
-  n' <- compileNameFresh $ GHC.getName v
-  pure $ PLC.VarDecl ann n' t'
+ t' <- compileTypeNorm $ GHC.varType v
+ n' <- compileNameFresh $ GHC.getName v
+ pure $ PLC.VarDecl ann n' t'
 
 lookupTyName :: Scope uni -> GHC.Name -> Maybe PLCTyVar
 lookupTyName (Scope _ tyns) n = Map.lookup n tyns
 
-compileTyNameFresh :: MonadQuote m => GHC.Name -> m PLC.TyName
+compileTyNameFresh :: (MonadQuote m) => GHC.Name -> m PLC.TyName
 compileTyNameFresh n = safeFreshTyName $ T.pack $ getUntidiedOccString n
 
-compileTyVarFresh :: Compiling uni fun m ann => GHC.TyVar -> m PLCTyVar
+compileTyVarFresh :: (Compiling uni fun m ann) => GHC.TyVar -> m PLCTyVar
 compileTyVarFresh v = do
-  k' <- compileKind $ GHC.tyVarKind v
-  t' <- compileTyNameFresh $ GHC.getName v
-  pure $ PLC.TyVarDecl annMayInline t' (k' $> annMayInline)
+ k' <- compileKind $ GHC.tyVarKind v
+ t' <- compileTyNameFresh $ GHC.getName v
+ pure $ PLC.TyVarDecl annMayInline t' (k' $> annMayInline)
 
-compileTcTyVarFresh :: Compiling uni fun m ann => GHC.TyCon -> m PLCTyVar
+compileTcTyVarFresh :: (Compiling uni fun m ann) => GHC.TyCon -> m PLCTyVar
 compileTcTyVarFresh tc = do
-  k' <- compileKind $ GHC.tyConKind tc
-  t' <- compileTyNameFresh $ GHC.getName tc
-  pure $ PLC.TyVarDecl annMayInline t' (k' $> annMayInline)
+ k' <- compileKind $ GHC.tyConKind tc
+ t' <- compileTyNameFresh $ GHC.getName tc
+ pure $ PLC.TyVarDecl annMayInline t' (k' $> annMayInline)
 
-pushName :: GHC.Name -> PLCVar uni-> Scope uni -> Scope uni
+pushName :: GHC.Name -> PLCVar uni -> Scope uni -> Scope uni
 pushName ghcName n (Scope ns tyns) = Scope (Map.insert ghcName n ns) tyns
 
 pushNames :: [(GHC.Name, PLCVar uni)] -> Scope uni -> Scope uni

plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden

@@ -0,0 +1,2 @@
+({cpu: 1551053
+| mem: 5602})

plutus-tx-plugin/test/Budget/9.6/allCheap.pir-readable.golden

@@ -0,0 +1,39 @@
+letrec
+ data (List :: * -> *) a | List_match where
+ Nil : List a
+ Cons : a -> List a -> List a
+in
+let
+ data Bool | Bool_match where
+ True : Bool
+ False : Bool
+in
+letrec
+ !go : List integer -> Bool
+ = \(ds : List integer) ->
+ List_match
+ {integer}
+ ds
+ {all dead. Bool}
+ (/\dead -> True)
+ (\(x : integer) (xs : List integer) ->
+ /\dead ->
+ Bool_match
+ (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True)
+ {all dead. Bool}
+ (/\dead -> go xs)
+ (/\dead -> False)
+ {all dead. dead})
+ {all dead. dead}
+in
+let
+ !eta : List integer
+ = (let
+ a = List integer
+ in
+ \(c : integer -> a -> a) (n : a) ->
+ c 1 (c 2 (c 3 (c 4 (c 5 (c 6 (c 7 (c 8 (c 9 (c 10 n))))))))))
+ (\(ds : integer) (ds : List integer) -> Cons {integer} ds ds)
+ (Nil {integer})
+in
+go eta

plutus-tx-plugin/test/Budget/9.6/allCheap.uplc-readable.golden

@@ -0,0 +1,40 @@
+program
+ 1.1.0
+ ((\s ->
+ s s)
+ (\s x ->
+ (\go ->
+ force
+ (case
+ x
+ [ (delay (constr 0 []))
+ , (\x xs ->
+ delay
+ (force
+ (force ifThenElse
+ (lessThanEqualsInteger 1 x)
+ (delay (constr 1 []))
+ (delay (go xs))))) ]))
+ (s s))
+ (constr 1
+ [ 1
+ , (constr 1
+ [ 2
+ , (constr 1
+ [ 3
+ , (constr 1
+ [ 4
+ , (constr 1
+ [ 5
+ , (constr 1
+ [ 6
+ , (constr 1
+ [ 7
+ , (constr 1
+ [ 8
+ , (constr 1
+ [ 9
+ , (constr 1
+ [ 10
+ , (constr 0
+ [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))

plutus-tx-plugin/test/Budget/9.6/allEmptyList.budget.golden

@@ -0,0 +1,2 @@
+({cpu: 460100
+| mem: 2100})

plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir-readable.golden

@@ -0,0 +1,32 @@
+letrec
+ data (List :: * -> *) a | List_match where
+ Nil : List a
+ Cons : a -> List a -> List a
+in
+let
+ data Bool | Bool_match where
+ True : Bool
+ False : Bool
+in
+letrec
+ !go : List integer -> Bool
+ = \(ds : List integer) ->
+ List_match
+ {integer}
+ ds
+ {all dead. Bool}
+ (/\dead -> True)
+ (\(x : integer) (xs : List integer) ->
+ /\dead ->
+ Bool_match
+ (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True)
+ {all dead. Bool}
+ (/\dead -> go xs)
+ (/\dead -> False)
+ {all dead. dead})
+ {all dead. dead}
+in
+let
+ !eta : List integer = Nil {integer}
+in
+go eta

plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc-readable.golden

@@ -0,0 +1,18 @@
+program
+ 1.1.0
+ ((\s -> s s)
+ (\s x ->
+ (\go ->
+ force
+ (case
+ x
+ [ (delay (constr 0 []))
+ , (\x xs ->
+ delay
+ (force
+ (force ifThenElse
+ (lessThanEqualsInteger 1 x)
+ (delay (constr 1 []))
+ (delay (go xs))))) ]))
+ (s s))
+ (constr 0 []))

plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden

@@ -0,0 +1,2 @@
+({cpu: 10219630
+| mem: 32120})

plutus-tx-plugin/test/Budget/9.6/allExpensive.pir-readable.golden

@@ -0,0 +1,39 @@
+letrec
+ data (List :: * -> *) a | List_match where
+ Nil : List a
+ Cons : a -> List a -> List a
+in
+let
+ data Bool | Bool_match where
+ True : Bool
+ False : Bool
+in
+letrec
+ !go : List integer -> Bool
+ = \(ds : List integer) ->
+ List_match
+ {integer}
+ ds
+ {all dead. Bool}
+ (/\dead -> True)
+ (\(x : integer) (xs : List integer) ->
+ /\dead ->
+ Bool_match
+ (ifThenElse {Bool} (lessThanEqualsInteger 11 x) False True)
+ {all dead. Bool}
+ (/\dead -> go xs)
+ (/\dead -> False)
+ {all dead. dead})
+ {all dead. dead}
+in
+let
+ !eta : List integer
+ = (let
+ a = List integer
+ in
+ \(c : integer -> a -> a) (n : a) ->
+ c 1 (c 2 (c 3 (c 4 (c 5 (c 6 (c 7 (c 8 (c 9 (c 10 n))))))))))
+ (\(ds : integer) (ds : List integer) -> Cons {integer} ds ds)
+ (Nil {integer})
+in
+go eta

plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc-readable.golden

@@ -0,0 +1,40 @@
+program
+ 1.1.0
+ ((\s ->
+ s s)
+ (\s x ->
+ (\go ->
+ force
+ (case
+ x
+ [ (delay (constr 0 []))
+ , (\x xs ->
+ delay
+ (force
+ (force ifThenElse
+ (lessThanEqualsInteger 11 x)
+ (delay (constr 1 []))
+ (delay (go xs))))) ]))
+ (s s))
+ (constr 1
+ [ 1
+ , (constr 1
+ [ 2
+ , (constr 1
+ [ 3
+ , (constr 1
+ [ 4
+ , (constr 1
+ [ 5
+ , (constr 1
+ [ 6
+ , (constr 1
+ [ 7
+ , (constr 1
+ [ 8
+ , (constr 1
+ [ 9
+ , (constr 1
+ [ 10
+ , (constr 0
+ [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))

plutus-tx-plugin/test/Budget/9.6/andCheap.budget.golden

@@ -0,0 +1,2 @@
+({cpu: 1058100
+| mem: 4700})

plutus-tx-plugin/test/Budget/9.6/andCheap.pir-readable.golden

@@ -0,0 +1,44 @@
+let
+ data Bool | Bool_match where
+ True : Bool
+ False : Bool
+in
+letrec
+ data (List :: * -> *) a | List_match where
+ Nil : List a
+ Cons : a -> List a -> List a
+in
+letrec
+ !and : List Bool -> Bool
+ = \(ds : List Bool) ->
+ List_match
+ {Bool}
+ ds
+ {all dead. Bool}
+ (/\dead -> True)
+ (\(x : Bool) (xs : List Bool) ->
+ /\dead ->
+ Bool_match
+ x
+ {all dead. Bool}
+ (/\dead -> and xs)
+ (/\dead -> False)
+ {all dead. dead})
+ {all dead. dead}
+in
+and
+ ((let
+ a = List Bool
+ in
+ \(c : Bool -> a -> a) (n : a) ->
+ c
+ False
+ (c
+ True
+ (c
+ True
+ (c
+ True
+ (c True (c True (c True (c True (c True (c True n))))))))))
+ (\(ds : Bool) (ds : List Bool) -> Cons {Bool} ds ds)
+ (Nil {Bool}))