Skip to content

Commit c4a7bd9

Browse files
bladyjokerbladyjoker
committed
Extracts the PlutusTx testsuite
1 parent e4baf10 commit c4a7bd9

File tree

9 files changed

+272
-0
lines changed

9 files changed

+272
-0
lines changed

‎flake.nix

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,13 +49,15 @@
4949
./docs/plutarch/build.nix
5050
./extras/build.nix
5151
./extras/lbf-nix/build.nix
52+
./extras/dev-shells/build.nix
5253
./libs/build.nix
5354
./api/build.nix
5455
./lambda-buffers-compiler/build.nix
5556
./lambda-buffers-codegen/build.nix
5657
./lambda-buffers-frontend/build.nix
5758
./runtimes/haskell/lbr-prelude/build.nix
5859
./runtimes/haskell/lbr-plutus/build.nix
60+
./runtimes/haskell/lbr-plutustx/build.nix
5961
./runtimes/haskell/lbr-plutarch/build.nix
6062
./runtimes/purescript/lbr-prelude/build.nix
6163
./runtimes/purescript/lbr-plutus/build.nix
@@ -75,6 +77,7 @@
7577
./testsuites/lbt-plutus/lbt-plutus-purescript/build.nix
7678
./testsuites/lbt-plutus/lbt-plutus-typescript/build.nix
7779
./testsuites/lbt-plutus/lbt-plutus-plutarch/build.nix
80+
./testsuites/lbt-plutus/lbt-plutus-plutustx/build.nix
7881
./testsuites/lbt-plutus/lbt-plutus-rust/build.nix
7982
./experimental/build.nix
8083
./docs/typescript-prelude/build.nix

‎testsuites/lbt-plutus/api/build.nix

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,12 @@ _: {
2020
files = [ "Foo.lbf" "Foo/Bar.lbf" "Days.lbf" ];
2121
};
2222

23+
lbf-plutus-golden-api-plutustx = config.lbf-nix.lbfPlutusTx {
24+
name = "lbf-plutus-plutustx-golden-api";
25+
src = ./.;
26+
files = [ "Foo.lbf" "Foo/Bar.lbf" "Days.lbf" ];
27+
};
28+
2329
lbf-plutus-golden-api-rust = config.lbf-nix.lbfPlutusRust {
2430
name = "lbf-plutus-rust-golden-api";
2531
src = ./.;

‎testsuites/lbt-plutus/lbt-plutus-plutustx/.envrc

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
use flake ../../..#dev-lbt-plutus-plutustx

‎testsuites/lbt-plutus/lbt-plutus-plutustx/build.nix

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
{ inputs, ... }:
2+
{
3+
perSystem = { config, system, ... }:
4+
let
5+
hsFlake = inputs.flake-lang.lib.${system}.haskellPlutusFlake {
6+
src = ./.;
7+
8+
name = "lbt-plutus-plutustx";
9+
10+
inherit (config.settings.haskell) index-state compiler-nix-name;
11+
12+
dependencies = [
13+
# LB PlutusTx backend imports
14+
"${config.packages.lbf-prelude-plutustx}"
15+
"${config.packages.lbf-plutus-plutustx}"
16+
"${config.packages.lbf-plutus-golden-api-plutustx}"
17+
"${config.packages.lbr-plutustx-src}"
18+
19+
# LB Haskell backend imports (Prelude and Plutus)
20+
"${config.packages.lbr-prelude-haskell-src}"
21+
"${config.packages.lbf-prelude-haskell}"
22+
"${config.packages.lbr-plutus-haskell-src}"
23+
"${config.packages.lbf-plutus-haskell}"
24+
"${config.packages.lbf-plutus-golden-api-haskell}"
25+
"${config.packages.lbt-plutus-golden-haskell}"
26+
];
27+
28+
devShellTools = config.settings.shell.tools;
29+
devShellHook = config.settings.shell.hook;
30+
};
31+
32+
in
33+
34+
{
35+
devShells.dev-lbt-plutus-plutustx = hsFlake.devShell;
36+
37+
packages = {
38+
lbt-plutus-plutustx-tests = hsFlake.packages."lbt-plutus-plutustx:test:tests";
39+
};
40+
41+
checks.check-lbt-plutus-plutustx = hsFlake.checks."lbt-plutus-plutustx:test:tests";
42+
};
43+
}

‎testsuites/lbt-plutus/lbt-plutus-plutustx/cabal.project

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
packages: ./.
2+
3+
tests: true

‎testsuites/lbt-plutus/lbt-plutus-plutustx/hie.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
cradle:
2+
cabal:

‎testsuites/lbt-plutus/lbt-plutus-plutustx/lbt-plutus-plutustx.cabal

Lines changed: 109 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
cabal-version: 3.0
2+
name: lbt-plutus-plutustx
3+
version: 0.1.0.0
4+
synopsis:
5+
Integration Test Suite for `lbf-plutus` and Haskell `lbr-plutustx`
6+
7+
author: Drazen Popovic
8+
maintainer: bladyjoker@gmail.com
9+
10+
flag dev
11+
description: Enable non-strict compilation for development
12+
manual: True
13+
14+
common common-language
15+
ghc-options:
16+
-Wall -Wcompat -fprint-explicit-foralls -fprint-explicit-kinds
17+
-fwarn-missing-import-lists -Weverything -Wno-unsafe
18+
-Wno-missing-safe-haskell-mode -Wno-implicit-prelude
19+
-Wno-missing-kind-signatures -Wno-all-missed-specializations
20+
21+
if !flag(dev)
22+
ghc-options: -Werror
23+
24+
default-extensions:
25+
BangPatterns
26+
BinaryLiterals
27+
ConstrainedClassMethods
28+
ConstraintKinds
29+
DataKinds
30+
DeriveAnyClass
31+
DeriveDataTypeable
32+
DeriveFoldable
33+
DeriveFunctor
34+
DeriveGeneric
35+
DeriveLift
36+
DeriveTraversable
37+
DerivingStrategies
38+
DerivingVia
39+
DoAndIfThenElse
40+
DuplicateRecordFields
41+
EmptyCase
42+
EmptyDataDecls
43+
EmptyDataDeriving
44+
ExistentialQuantification
45+
ExplicitForAll
46+
ExplicitNamespaces
47+
FlexibleContexts
48+
FlexibleInstances
49+
ForeignFunctionInterface
50+
GADTSyntax
51+
GeneralizedNewtypeDeriving
52+
HexFloatLiterals
53+
ImportQualifiedPost
54+
InstanceSigs
55+
KindSignatures
56+
LambdaCase
57+
MonomorphismRestriction
58+
MultiParamTypeClasses
59+
NamedFieldPuns
60+
NamedWildCards
61+
NoStarIsType
62+
NumericUnderscores
63+
OverloadedLabels
64+
OverloadedStrings
65+
PartialTypeSignatures
66+
PatternGuards
67+
PolyKinds
68+
PostfixOperators
69+
RankNTypes
70+
RecordWildCards
71+
RelaxedPolyRec
72+
ScopedTypeVariables
73+
StandaloneDeriving
74+
StandaloneKindSignatures
75+
TemplateHaskell
76+
TraditionalRecordSyntax
77+
TupleSections
78+
TypeApplications
79+
TypeFamilies
80+
TypeOperators
81+
TypeSynonymInstances
82+
ViewPatterns
83+
84+
default-language: Haskell2010
85+
86+
test-suite tests
87+
import: common-language
88+
type: exitcode-stdio-1.0
89+
hs-source-dirs: test
90+
main-is: Test.hs
91+
build-depends:
92+
, base >=4.16
93+
, hedgehog >=1.2
94+
, lbf-plutus-golden-api
95+
, lbf-plutus-plutustx
96+
, lbf-plutus-plutustx-golden-api
97+
, lbf-prelude
98+
, lbf-prelude-plutustx
99+
, lbr-plutus
100+
, lbr-plutustx
101+
, plutus-tx
102+
, plutus-tx-plugin
103+
, prettyprinter
104+
, tasty >=1.4
105+
, tasty-expected-failure
106+
, tasty-hedgehog >=1.4
107+
, tasty-hunit
108+
109+
other-modules: Test.LambdaBuffers.Runtime.PlutusTx.PlutusTx

‎testsuites/lbt-plutus/lbt-plutus-plutustx/test/Test.hs

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
module Main (main) where
2+
3+
import Test.LambdaBuffers.Runtime.PlutusTx.PlutusTx qualified as PlutusTx
4+
import Test.Tasty (defaultMain, testGroup)
5+
6+
main :: IO ()
7+
main = do
8+
defaultMain $
9+
testGroup
10+
"LambdaBuffers Plutus package tests"
11+
[ PlutusTx.tests
12+
]

‎testsuites/lbt-plutus/lbt-plutus-plutustx/test/Test/LambdaBuffers/Runtime/PlutusTx/PlutusTx.hs

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
{-# LANGUAGE TemplateHaskellQuotes #-}
4+
{-# LANGUAGE NoImplicitPrelude #-}
5+
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
6+
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
7+
{-# OPTIONS_GHC -fno-specialise #-}
8+
{-# OPTIONS_GHC -fno-strictness #-}
9+
{-# OPTIONS_GHC -fobject-code #-}
10+
11+
-- TODO(bladyjoker): This module just tries to make sure things compile and it pprints the CompiledCode which is lame. Let's rather evaluate these scripts like proper people.
12+
module Test.LambdaBuffers.Runtime.PlutusTx.PlutusTx (tests) where
13+
14+
import LambdaBuffers.Days.PlutusTx (Day, FreeDay, WorkDay)
15+
import LambdaBuffers.Foo.PlutusTx (A, B, C, D, E, FInt, GInt)
16+
import PlutusTx (BuiltinData, CompiledCode, FromData (fromBuiltinData), ToData (toBuiltinData), compile, getPlc)
17+
import PlutusTx.Maybe (fromMaybe)
18+
import PlutusTx.Plugin ()
19+
import PlutusTx.Prelude (Bool, Eq ((==)), Integer, traceError, (&&))
20+
import Prettyprinter (Pretty (pretty))
21+
import Test.Tasty (TestTree, testGroup)
22+
import Test.Tasty.ExpectedFailure (ignoreTestBecause)
23+
import Test.Tasty.HUnit (testCase)
24+
import Prelude (IO, String, print, ($), (.))
25+
26+
{-# INLINEABLE fromToDataAndEq #-}
27+
fromToDataAndEq :: forall a. (PlutusTx.Prelude.Eq a, FromData a, ToData a) => BuiltinData -> Bool
28+
fromToDataAndEq x =
29+
let
30+
x' = fromMaybe (traceError "Failed parsing x from PlutusData") (fromBuiltinData @a x)
31+
x'' = toBuiltinData @a x'
32+
in
33+
x' == x' && x'' == x
34+
35+
integerCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
36+
integerCompiled = $$(PlutusTx.compile [||fromToDataAndEq @Integer||])
37+
38+
boolCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
39+
boolCompiled = $$(PlutusTx.compile [||fromToDataAndEq @Bool||])
40+
41+
dayCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
42+
dayCompiled = $$(PlutusTx.compile [||fromToDataAndEq @Day||])
43+
44+
freeDayCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
45+
freeDayCompiled = $$(PlutusTx.compile [||fromToDataAndEq @FreeDay||])
46+
47+
workDayCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
48+
workDayCompiled = $$(PlutusTx.compile [||fromToDataAndEq @WorkDay||])
49+
50+
fooACompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
51+
fooACompiled = $$(PlutusTx.compile [||fromToDataAndEq @A||])
52+
53+
fooBCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
54+
fooBCompiled = $$(PlutusTx.compile [||fromToDataAndEq @B||])
55+
56+
fooCCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
57+
fooCCompiled = $$(PlutusTx.compile [||fromToDataAndEq @C||])
58+
59+
fooDCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
60+
fooDCompiled = $$(PlutusTx.compile [||fromToDataAndEq @D||])
61+
62+
fooECompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
63+
fooECompiled = $$(PlutusTx.compile [||fromToDataAndEq @(E Integer Bool)||])
64+
65+
fooFIntCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
66+
fooFIntCompiled = $$(PlutusTx.compile [||fromToDataAndEq @FInt||])
67+
68+
fooGIntCompiled :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool)
69+
fooGIntCompiled = $$(PlutusTx.compile [||fromToDataAndEq @GInt||])
70+
71+
tests :: TestTree
72+
tests =
73+
testGroup
74+
"Just trying to compile with PlutusTx"
75+
[ testGroup
76+
"Compiling Prelude types"
77+
[ testCase "Prelude.Integer" (pprint integerCompiled)
78+
, testCase "Prelude.Bool" (pprint boolCompiled)
79+
, testCase "Days.Day" (pprint dayCompiled)
80+
, testCase "Days.FreeDay" (pprint freeDayCompiled)
81+
, testCase "Days.WorkDay" (pprint workDayCompiled)
82+
, testCase "Foo.A" (pprint fooACompiled)
83+
, testCase "Foo.B" (pprint fooBCompiled)
84+
, testCase "Foo.C" (pprint fooCCompiled)
85+
, testCase "Foo.D" (pprint fooDCompiled)
86+
, testCase "Foo.E" (pprint fooECompiled)
87+
, ignoreTestBecause "GHC Core to PLC plugin: E003:Error: Error from the PIR compiler: E003: Unsupported construct: Mutually recursive datatypes ((recursive) let binding; from [ AnnOther ])" $ testCase "Foo.FInt" (print ("Not printing" :: String))
88+
, ignoreTestBecause "GHC Core to PLC plugin: E003:Error: Error from the PIR compiler: E003: Unsupported construct: Mutually recursive datatypes ((recursive) let binding; from [ AnnOther ])" $ testCase "Foo.GInt" (print ("Not printing" :: String))
89+
]
90+
]
91+
where
92+
pprint :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> Bool) -> IO ()
93+
pprint = print . pretty . getPlc

0 commit comments

Comments
 (0)