daml/daml-lf/tests/BasicTests.daml
Neil Mitchell 4b89903a73 Delete the id function (#851)
* Delete the `id` function

* Fix documentation that referred to id

* Fix some DAML-LF tests that relied on id
2019-05-02 22:57:52 +00:00

504 lines
13 KiB
Haskell

-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
daml 1.2
module BasicTests where
import DA.Time
import DA.Date
data MyRec = MyRec { foo: Text }
data MyNestedRec = MyNestedRec { bar: Text; nested: MyRec }
r : MyRec
r = MyRec { foo = "bar" }
r2 : MyNestedRec
r2 = MyNestedRec{ bar = "foo"; nested = r }
data XYZ = XYZ { x: Int; y: Int; z: Int }
xyz : Int -> Int -> Int -> XYZ
xyz x y z =
XYZ with x = x; y = y+x; z = z+x
data XYZ2 = XYZ2 { a: XYZ; b: XYZ; c: XYZ }
testXyz : XYZ2
testXyz = XYZ2 with a = xyz 1 2 3; b = xyz 2 4 5; c = xyz 3 4 5
test_testXyzTest = scenario do
pure testXyz
pure testXyz
idToText : Int -> Text
idToText x = identity show x
double : Int -> Int
double x = 2 * x
myrecFoo : MyRec -> Text
myrecFoo x = x.foo
four : () -> Int
four tok = 2 + (identity 2)
shadowTest : Int -> Int
shadowTest x = (\x -> x) $ 2 * x
test_letTest = scenario do
let x = four ()
y = double x
assertS (x * y == 32)
pure (x * y)
test_doubleLetTest = scenario do
x <- test_letTest
assertS (x == 32)
pure x
hello : Text
hello = "hello world"
listTest : [Int]
listTest = [1, 2, 3]
listTest2 : [Int]
listTest2 = 1 :: 2 :: 3 :: []
foldrTest : () -> Text
foldrTest _tok =
foldr (\x accum -> accum <> x) "" ["a", "b", "c"]
foldlTest : () -> Text
foldlTest _tok =
foldl (\accum x -> accum <> x) "" ["a", "b", "c"]
upureTest: Update Text
upureTest =
pure "hello"
tupeq : (Int, Int) -> (Int, Int) -> Bool
tupeq a b =
a == b
tupeqtest : () -> Bool
tupeqtest _tok = tupeq (1, 1) (1, 2)
partition : (a -> Bool) -> [a] -> ([a], [a])
partition f xs =
let work x acc =
if f x
then ((x :: (fst acc)), (snd acc))
else ((fst acc), (x :: (snd acc)))
in
foldr work (([], [])) xs
pt : [a] -> ([a], [a])
pt xs =
let true x = True
in
partition true xs
-- def passWork (xs: List a) (x: a) : List a = xs -- cons x xs
passWork : [Int] -> [Int]
passWork xs =
let work acc x = x :: acc
in
foldl work [] xs
consTest : [a] -> a -> [a]
consTest xs x = x :: xs
listEqTest : () -> Bool
listEqTest _tok =
[1, 2, 3] == [3]
data Tree a = Leaf a | Node { left: Tree a, right: Tree a }
variantEqTest : () -> Bool
variantEqTest _tok =
Some ((1, [1,2,3])) == Some ((1, [1,2,3]))
-- Decomposes a list into head and tail.
uncons : [a] -> Optional (a, [a])
uncons l =
case l of
[] -> None
h :: t -> Some $ (h, t)
jtup : () -> Bool
jtup _tok =
uncons [3,2,1] ==
(Some (3, [2,1]))
template Simple
with p: Party
where
agreement show p
signatory p
controller p can
Hello : Text
do pure "hello"
template Composite
with p1: Party
where
agreement show p1
signatory p1
controller p1 can
First : Text
do
cid <- create Simple with p = p1
cid2 <- exercise cid Hello
pure "hello"
ucreate : Party -> Update (ContractId Simple)
ucreate p =
create Simple with p=p
ucreateAndExercise : Party -> Update Text
ucreateAndExercise p = do
cid <- create Simple with p=p
exercise cid Hello
test_screateAndExercise = scenario do
alice <- getParty "Alice"
cid <- submit alice $ ucreate alice
submit alice $ exercise cid Hello
test_screateAndExerciseComposit = scenario do
alice <- getParty "Alice"
cid <- submit alice $ create Composite with p1 = alice
submit alice $ exercise cid First
variantMatch : Optional Int -> Int
variantMatch mbX =
case mbX of
Some x -> x
None -> 0
listMatch : [Text] -> Text
listMatch l =
case l of
h ::_t -> h
[] -> "<none>"
assertMsgS : Bool -> Text -> Scenario ()
assertMsgS b msg =
if not b then abort msg else return ()
assertS : Bool -> Scenario ()
assertS b = assertMsgS b ""
assertMsg : Bool -> Text -> Update ()
assertMsg b msg =
if not b then abort msg else return ()
test_listMatchTest = scenario do
assertMsgS (listMatch ["x"] == "x") "listMatch [x] == x"
assertMsgS (listMatch [] == "<none>") "listMatch [] == <none>"
test_sgetTimeTest = scenario do
getTime
-- Moves the scenario time forward to the specified time.
passTo (t: Time) = scenario do
now: Time <- pass (days 0)
assert {- TODO "passTo can only go forward in time"-} (now < t)
pass (subTime t now)
ugetTime : Update Time
ugetTime = do
t <- getTime
pure t
test_ugetTimeTest = scenario do
alice <- getParty "Alice"
passToDate $ date 2017 Jun 16
submit alice $ ugetTime
template TypeWithParameters
with
p: Party
v: Optional Int
where
signatory p
controller p can
Hello2 : Text
do pure "hello"
test_typeWithParameters = scenario do
alice <- getParty "Alice"
submit alice $ create TypeWithParameters with p = alice; v = Some 42
test_createAndFetch = scenario do
alice <- getParty "alice"
cid <- submit alice $ do
cid <- create Simple with p=alice
fetch cid -- relative fetch
pure cid
-- absolute fetch
submit alice $ do
x <- fetch cid -- absolute fetch
create Simple with p=x.p
test_exponentiation = scenario do
assertS (3 ^ 5 == 243)
template PayOut
with
receiver: Party
giver: Party
where
signatory receiver
signatory giver
agreement
(show giver) <> " must pay to " <>
(show receiver) <> " the sum of five pounds."
template CallablePayout
with
giver: Party
receiver: Party
where
signatory giver
controller receiver can
Call : ContractId PayOut
do create PayOut with receiver; giver
Transfer : ContractId CallablePayout
with newReceiver: Party
do create this with receiver = newReceiver
test_payoutTest = scenario do
alice <- getParty "Alice"
bob <- getParty "Bob"
clara <- getParty "Clara"
pa <- submit alice $ create CallablePayout with giver=alice;receiver=bob
-- 'Bob' should see all consequences
submit bob $ exercise pa Transfer with newReceiver = clara
test_mustFails = scenario do
alice <- getParty "Alice"
bob <- getParty "Bob"
passToDate $ date 2017 Jun 16
cid <- submit alice $ ucreate alice
submitMustFail bob $ exercise cid Hello
template TwoParties
with p: Party
p2: Party
where
agreement show p
signatory p
signatory p2
controller p can
Hello3 : Text
do pure "hello"
controller p2 can
World : Text
do pure "world"
test_failedAuths = scenario do
alice <- getParty "alice"
bob <- getParty "bob"
submitMustFail alice $ (create TwoParties with p=alice; p2=bob)
-- this monster exists solely to test the nesting limit, in the absence of recursive types.
-- generated with
--
-- unlines ["data Nesting" ++ show (n - 1) ++ " = {x: Nesting" ++ show n ++ "}" | n <- [1..150]]
-- Tests for the dynamic computation of fetch actors
template Fetched
with
sig1 : Party
sig2 : Party
obs : Party
where
signatory sig1, sig2
observer obs
template Fetcher
with
sig : Party
obs : Party
fetcher : Party
where
signatory sig
controller fetcher can
DoFetch : Fetched
with cid : ContractId Fetched
do fetch cid
data Nesting0 = Nesting0 {x: Nesting1}
data Nesting1 = Nesting1 {x: Nesting2}
data Nesting2 = Nesting2 {x: Nesting3}
data Nesting3 = Nesting3 {x: Nesting4}
data Nesting4 = Nesting4 {x: Nesting5}
data Nesting5 = Nesting5 {x: Nesting6}
data Nesting6 = Nesting6 {x: Nesting7}
data Nesting7 = Nesting7 {x: Nesting8}
data Nesting8 = Nesting8 {x: Nesting9}
data Nesting9 = Nesting9 {x: Nesting10}
data Nesting10 = Nesting10 {x: Nesting11}
data Nesting11 = Nesting11 {x: Nesting12}
data Nesting12 = Nesting12 {x: Nesting13}
data Nesting13 = Nesting13 {x: Nesting14}
data Nesting14 = Nesting14 {x: Nesting15}
data Nesting15 = Nesting15 {x: Nesting16}
data Nesting16 = Nesting16 {x: Nesting17}
data Nesting17 = Nesting17 {x: Nesting18}
data Nesting18 = Nesting18 {x: Nesting19}
data Nesting19 = Nesting19 {x: Nesting20}
data Nesting20 = Nesting20 {x: Nesting21}
data Nesting21 = Nesting21 {x: Nesting22}
data Nesting22 = Nesting22 {x: Nesting23}
data Nesting23 = Nesting23 {x: Nesting24}
data Nesting24 = Nesting24 {x: Nesting25}
data Nesting25 = Nesting25 {x: Nesting26}
data Nesting26 = Nesting26 {x: Nesting27}
data Nesting27 = Nesting27 {x: Nesting28}
data Nesting28 = Nesting28 {x: Nesting29}
data Nesting29 = Nesting29 {x: Nesting30}
data Nesting30 = Nesting30 {x: Nesting31}
data Nesting31 = Nesting31 {x: Nesting32}
data Nesting32 = Nesting32 {x: Nesting33}
data Nesting33 = Nesting33 {x: Nesting34}
data Nesting34 = Nesting34 {x: Nesting35}
data Nesting35 = Nesting35 {x: Nesting36}
data Nesting36 = Nesting36 {x: Nesting37}
data Nesting37 = Nesting37 {x: Nesting38}
data Nesting38 = Nesting38 {x: Nesting39}
data Nesting39 = Nesting39 {x: Nesting40}
data Nesting40 = Nesting40 {x: Nesting41}
data Nesting41 = Nesting41 {x: Nesting42}
data Nesting42 = Nesting42 {x: Nesting43}
data Nesting43 = Nesting43 {x: Nesting44}
data Nesting44 = Nesting44 {x: Nesting45}
data Nesting45 = Nesting45 {x: Nesting46}
data Nesting46 = Nesting46 {x: Nesting47}
data Nesting47 = Nesting47 {x: Nesting48}
data Nesting48 = Nesting48 {x: Nesting49}
data Nesting49 = Nesting49 {x: Nesting50}
data Nesting50 = Nesting50 {x: Nesting51}
data Nesting51 = Nesting51 {x: Nesting52}
data Nesting52 = Nesting52 {x: Nesting53}
data Nesting53 = Nesting53 {x: Nesting54}
data Nesting54 = Nesting54 {x: Nesting55}
data Nesting55 = Nesting55 {x: Nesting56}
data Nesting56 = Nesting56 {x: Nesting57}
data Nesting57 = Nesting57 {x: Nesting58}
data Nesting58 = Nesting58 {x: Nesting59}
data Nesting59 = Nesting59 {x: Nesting60}
data Nesting60 = Nesting60 {x: Nesting61}
data Nesting61 = Nesting61 {x: Nesting62}
data Nesting62 = Nesting62 {x: Nesting63}
data Nesting63 = Nesting63 {x: Nesting64}
data Nesting64 = Nesting64 {x: Nesting65}
data Nesting65 = Nesting65 {x: Nesting66}
data Nesting66 = Nesting66 {x: Nesting67}
data Nesting67 = Nesting67 {x: Nesting68}
data Nesting68 = Nesting68 {x: Nesting69}
data Nesting69 = Nesting69 {x: Nesting70}
data Nesting70 = Nesting70 {x: Nesting71}
data Nesting71 = Nesting71 {x: Nesting72}
data Nesting72 = Nesting72 {x: Nesting73}
data Nesting73 = Nesting73 {x: Nesting74}
data Nesting74 = Nesting74 {x: Nesting75}
data Nesting75 = Nesting75 {x: Nesting76}
data Nesting76 = Nesting76 {x: Nesting77}
data Nesting77 = Nesting77 {x: Nesting78}
data Nesting78 = Nesting78 {x: Nesting79}
data Nesting79 = Nesting79 {x: Nesting80}
data Nesting80 = Nesting80 {x: Nesting81}
data Nesting81 = Nesting81 {x: Nesting82}
data Nesting82 = Nesting82 {x: Nesting83}
data Nesting83 = Nesting83 {x: Nesting84}
data Nesting84 = Nesting84 {x: Nesting85}
data Nesting85 = Nesting85 {x: Nesting86}
data Nesting86 = Nesting86 {x: Nesting87}
data Nesting87 = Nesting87 {x: Nesting88}
data Nesting88 = Nesting88 {x: Nesting89}
data Nesting89 = Nesting89 {x: Nesting90}
data Nesting90 = Nesting90 {x: Nesting91}
data Nesting91 = Nesting91 {x: Nesting92}
data Nesting92 = Nesting92 {x: Nesting93}
data Nesting93 = Nesting93 {x: Nesting94}
data Nesting94 = Nesting94 {x: Nesting95}
data Nesting95 = Nesting95 {x: Nesting96}
data Nesting96 = Nesting96 {x: Nesting97}
data Nesting97 = Nesting97 {x: Nesting98}
data Nesting98 = Nesting98 {x: Nesting99}
data Nesting99 = Nesting99 {x: Nesting100}
data Nesting100 = Nesting100 {x: Nesting101}
data Nesting101 = Nesting101 {x: Nesting102}
data Nesting102 = Nesting102 {x: Nesting103}
data Nesting103 = Nesting103 {x: Nesting104}
data Nesting104 = Nesting104 {x: Nesting105}
data Nesting105 = Nesting105 {x: Nesting106}
data Nesting106 = Nesting106 {x: Nesting107}
data Nesting107 = Nesting107 {x: Nesting108}
data Nesting108 = Nesting108 {x: Nesting109}
data Nesting109 = Nesting109 {x: Nesting110}
data Nesting110 = Nesting110 {x: Nesting111}
data Nesting111 = Nesting111 {x: Nesting112}
data Nesting112 = Nesting112 {x: Nesting113}
data Nesting113 = Nesting113 {x: Nesting114}
data Nesting114 = Nesting114 {x: Nesting115}
data Nesting115 = Nesting115 {x: Nesting116}
data Nesting116 = Nesting116 {x: Nesting117}
data Nesting117 = Nesting117 {x: Nesting118}
data Nesting118 = Nesting118 {x: Nesting119}
data Nesting119 = Nesting119 {x: Nesting120}
data Nesting120 = Nesting120 {x: Nesting121}
data Nesting121 = Nesting121 {x: Nesting122}
data Nesting122 = Nesting122 {x: Nesting123}
data Nesting123 = Nesting123 {x: Nesting124}
data Nesting124 = Nesting124 {x: Nesting125}
data Nesting125 = Nesting125 {x: Nesting126}
data Nesting126 = Nesting126 {x: Nesting127}
data Nesting127 = Nesting127 {x: Nesting128}
data Nesting128 = Nesting128 {x: Nesting129}
data Nesting129 = Nesting129 {x: Nesting130}
data Nesting130 = Nesting130 {x: Nesting131}
data Nesting131 = Nesting131 {x: Nesting132}
data Nesting132 = Nesting132 {x: Nesting133}
data Nesting133 = Nesting133 {x: Nesting134}
data Nesting134 = Nesting134 {x: Nesting135}
data Nesting135 = Nesting135 {x: Nesting136}
data Nesting136 = Nesting136 {x: Nesting137}
data Nesting137 = Nesting137 {x: Nesting138}
data Nesting138 = Nesting138 {x: Nesting139}
data Nesting139 = Nesting139 {x: Nesting140}
data Nesting140 = Nesting140 {x: Nesting141}
data Nesting141 = Nesting141 {x: Nesting142}
data Nesting142 = Nesting142 {x: Nesting143}
data Nesting143 = Nesting143 {x: Nesting144}
data Nesting144 = Nesting144 {x: Nesting145}
data Nesting145 = Nesting145 {x: Nesting146}
data Nesting146 = Nesting146 {x: Nesting147}
data Nesting147 = Nesting147 {x: Nesting148}
data Nesting148 = Nesting148 {x: Nesting149}
data Nesting149 = Nesting149 {x: Int}