Skip to content

Commit 07b20e0

Browse files
committed
Tests to reveal the compilation error
1 parent f02a8d7 commit 07b20e0

File tree

3 files changed

+109
-0
lines changed

3 files changed

+109
-0
lines changed

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -134,6 +134,7 @@ test-suite plutus-tx-plugin-tests
134134
Budget.WithGHCOptimisations
135135
Budget.WithoutGHCOptimisations
136136
BuiltinList.Budget.Spec
137+
BuiltinUnit.Spec
137138
ByteStringLiterals.Lib
138139
ByteStringLiterals.Spec
139140
DataList.Budget.Spec
Lines changed: 106 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
1+
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE NoImplicitPrelude #-}
4+
{-# LANGUAGE Strict #-}
5+
{-# LANGUAGE TemplateHaskell #-}
6+
{-# LANGUAGE TypeApplications #-}
7+
{-# OPTIONS_GHC -ddump-simpl-iterations -dsuppress-all #-}
8+
{-# OPTIONS_GHC -fno-float-in #-}
9+
{-# OPTIONS_GHC -fno-full-laziness #-}
10+
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
11+
{-# OPTIONS_GHC -fno-local-float-out #-}
12+
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
13+
{-# OPTIONS_GHC -fno-spec-constr #-}
14+
{-# OPTIONS_GHC -fno-specialise #-}
15+
{-# OPTIONS_GHC -fno-strictness #-}
16+
{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-}
17+
{-# OPTIONS_GHC -fno-unbox-strict-fields #-}
18+
{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-}
19+
20+
module BuiltinUnit.Spec where
21+
22+
import PlutusTx.Prelude
23+
import Prelude (IO, seq)
24+
25+
import Control.Lens (view)
26+
import PlutusTx (CompiledCode, compile, getPlcNoAnn)
27+
import PlutusTx.Builtins.Internal (unitval)
28+
import Test.Tasty (TestTree, testGroup)
29+
import Test.Tasty.HUnit (Assertion, testCase)
30+
import UntypedPlutusCore (progTerm)
31+
32+
tests :: TestTree
33+
tests =
34+
testGroup
35+
"BuiltinUnit"
36+
[ testCase "error ()" do assertCompiledTerm code1
37+
, testCase "unitval" do assertCompiledTerm code2
38+
, testCase "locally defined constructor" do assertCompiledTerm code3
39+
, testCase "toOpaque ()" do assertCompiledTerm code4
40+
]
41+
42+
{- GHC Core after simplification:
43+
44+
code1 = case error () of
45+
validator1_X0 { BuiltinUnit ipv_smFH -> plc Proxy validator1_X0 }
46+
47+
code2 = case unitval of
48+
validator2_X0 { BuiltinUnit ipv_smFJ -> plc Proxy validator2_X0 }
49+
50+
code3 = case unitval of
51+
builtinUnit_X0 { BuiltinUnit ipv_smFL -> plc Proxy builtinUnit_X0 }
52+
53+
code4 = case toOpaque $fHasToOpaque()BuiltinUnit () of
54+
validator4_X0 { BuiltinUnit ipv_smGp -> plc Proxy validator4_X0 }
55+
56+
Compilation error:
57+
58+
<no location info>: error:
59+
GHC Core to PLC plugin:
60+
Error: Unsupported feature:
61+
Cannot construct a value of type: BuiltinUnit
62+
Note: GHC can generate these unexpectedly, you may need
63+
'-fno-strictness', '-fno-specialise', '-fno-spec-constr',
64+
'-fno-unbox-strict-fields', or '-fno-unbox-small-strict-fields'.
65+
Context: Compiling expr: BuiltinUnit
66+
Context: Compiling expr: BuiltinUnit ipv
67+
Context: Compiling definition of: validator1
68+
Context: Compiling expr: validator1
69+
Context: Compiling expr at: test/BuiltinUnit/Spec.hs:75:11-36
70+
Context: Compiling expr: validator1
71+
-}
72+
73+
code1 :: CompiledCode BuiltinUnit
74+
code1 = $$(compile [||validator1||])
75+
where
76+
validator1 :: BuiltinUnit
77+
validator1 = PlutusTx.Prelude.error ()
78+
{-# INLINEABLE validator1 #-}
79+
80+
code2 :: CompiledCode BuiltinUnit
81+
code2 = $$(compile [||validator2||])
82+
where
83+
validator2 :: BuiltinUnit
84+
validator2 = unitval
85+
{-# INLINEABLE validator2 #-}
86+
87+
code3 :: CompiledCode BuiltinUnit
88+
code3 = $$(compile [||validator3||])
89+
where
90+
validator3 :: BuiltinUnit
91+
validator3 = builtinUnit
92+
{-# INLINEABLE validator3 #-}
93+
94+
builtinUnit :: BuiltinUnit
95+
builtinUnit = unitval
96+
{-# INLINEABLE builtinUnit #-}
97+
98+
code4 :: CompiledCode BuiltinUnit
99+
code4 = $$(compile [||validator4||])
100+
where
101+
validator4 :: BuiltinUnit
102+
validator4 = toOpaque ()
103+
{-# INLINEABLE validator4 #-}
104+
105+
assertCompiledTerm :: CompiledCode a -> Assertion
106+
assertCompiledTerm code = view progTerm (getPlcNoAnn code) `seq` return @IO ()

plutus-tx-plugin/test/Spec.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ import AssocMap.Spec qualified as AssocMap
66
import Blueprint.Tests qualified
77
import Budget.Spec qualified as Budget
88
import BuiltinList.Budget.Spec qualified as BuiltinList.Budget
9+
import BuiltinUnit.Spec qualified as BuiltinUnit
910
import ByteStringLiterals.Spec qualified as ByteStringLiterals
1011
import DataList.Budget.Spec qualified as DataList.Budget
1112
import Inline.Spec qualified as Inline
@@ -60,4 +61,5 @@ tests =
6061
, embed AssocMap.propertyTests
6162
, embed List.propertyTests
6263
, Array.smokeTests
64+
, embed BuiltinUnit.tests
6365
]

0 commit comments

Comments
 (0)