More failure tests, fix mligo assert
This commit is contained in:
parent
a521c01115
commit
8a96e38f04
@ -703,8 +703,7 @@ module Compiler = struct
|
|||||||
("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ;
|
("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ;
|
||||||
("SIZE" , simple_unary @@ prim I_SIZE) ;
|
("SIZE" , simple_unary @@ prim I_SIZE) ;
|
||||||
("FAILWITH" , simple_unary @@ prim I_FAILWITH) ;
|
("FAILWITH" , simple_unary @@ prim I_FAILWITH) ;
|
||||||
("ASSERT_INFERRED" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ;
|
("ASSERT" , simple_unary @@ i_if (seq [i_push_unit]) (seq [i_push_unit ; i_failwith])) ;
|
||||||
("ASSERT" , simple_unary @@ i_if (seq [i_push_unit ; i_failwith]) (seq [i_push_unit])) ;
|
|
||||||
("INT" , simple_unary @@ prim I_INT) ;
|
("INT" , simple_unary @@ prim I_INT) ;
|
||||||
("ABS" , simple_unary @@ prim I_ABS) ;
|
("ABS" , simple_unary @@ prim I_ABS) ;
|
||||||
("CONS" , simple_binary @@ prim I_CONS) ;
|
("CONS" , simple_binary @@ prim I_CONS) ;
|
||||||
|
3
src/test/contracts/assert.mligo
Normal file
3
src/test/contracts/assert.mligo
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
let%entry main (p : bool) (s : unit) =
|
||||||
|
let u : unit = assert(p) in
|
||||||
|
(([] : operation list), s)
|
@ -41,7 +41,7 @@ function transfer_single(const action : action_transfer_single ; const s : stora
|
|||||||
begin
|
begin
|
||||||
const cards : cards = s.cards ;
|
const cards : cards = s.cards ;
|
||||||
const card : card = get_force(action.card_to_transfer , cards) ;
|
const card : card = get_force(action.card_to_transfer , cards) ;
|
||||||
if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ;
|
if (card.card_owner =/= source) then failwith("This card doesn't belong to you") else skip ;
|
||||||
card.card_owner := action.destination ;
|
card.card_owner := action.destination ;
|
||||||
cards[action.card_to_transfer] := card ;
|
cards[action.card_to_transfer] := card ;
|
||||||
s.cards := cards ;
|
s.cards := cards ;
|
||||||
@ -51,7 +51,7 @@ function transfer_single(const action : action_transfer_single ; const s : stora
|
|||||||
function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is
|
function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is
|
||||||
begin
|
begin
|
||||||
const card : card = get_force(action.card_to_sell , s.cards) ;
|
const card : card = get_force(action.card_to_sell , s.cards) ;
|
||||||
if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ;
|
if (card.card_owner =/= source) then failwith("This card doesn't belong to you") else skip ;
|
||||||
const card_pattern : card_pattern = get_force(card.card_pattern , s.card_patterns) ;
|
const card_pattern : card_pattern = get_force(card.card_pattern , s.card_patterns) ;
|
||||||
card_pattern.quantity := abs(card_pattern.quantity - 1n);
|
card_pattern.quantity := abs(card_pattern.quantity - 1n);
|
||||||
const card_patterns : card_patterns = s.card_patterns ;
|
const card_patterns : card_patterns = s.card_patterns ;
|
||||||
@ -71,7 +71,7 @@ function buy_single(const action : action_buy_single ; const s : storage_type) :
|
|||||||
// Check funds
|
// Check funds
|
||||||
const card_pattern : card_pattern = get_force(action.card_to_buy , s.card_patterns) ;
|
const card_pattern : card_pattern = get_force(action.card_to_buy , s.card_patterns) ;
|
||||||
const price : tez = card_pattern.coefficient * (card_pattern.quantity + 1n) ;
|
const price : tez = card_pattern.coefficient * (card_pattern.quantity + 1n) ;
|
||||||
if (price > amount) then fail "Not enough money" else skip ;
|
if (price > amount) then failwith("Not enough money") else skip ;
|
||||||
// Administrative procedure
|
// Administrative procedure
|
||||||
const operations : list(operation) = nil ;
|
const operations : list(operation) = nil ;
|
||||||
// Increase quantity
|
// Increase quantity
|
||||||
|
12
src/test/contracts/failwith.ligo
Normal file
12
src/test/contracts/failwith.ligo
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
type param is
|
||||||
|
| Zero of nat
|
||||||
|
| Pos of nat
|
||||||
|
|
||||||
|
function main (const p : param; const s : unit) : list(operation) * unit is
|
||||||
|
block {
|
||||||
|
case p of
|
||||||
|
| Zero (n) -> if n > 0n then failwith("fail") else skip
|
||||||
|
| Pos (n) -> if n > 0n then skip else failwith("fail")
|
||||||
|
end
|
||||||
|
}
|
||||||
|
with ((nil : list(operation)), s)
|
@ -643,11 +643,28 @@ let dispatch_counter_contract () : unit result =
|
|||||||
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
|
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
|
||||||
expect_eq_n program "main" make_input make_expected
|
expect_eq_n program "main" make_input make_expected
|
||||||
|
|
||||||
|
let failwith_ligo () : unit result =
|
||||||
|
let%bind program = type_file "./contracts/failwith.ligo" in
|
||||||
|
let should_fail = expect_fail program "main" in
|
||||||
|
let should_work input = expect_eq program "main" input (e_pair (e_typed_list [] t_operation) (e_unit ())) in
|
||||||
|
let%bind _ = should_work (e_pair (e_constructor "Zero" (e_nat 0)) (e_unit ())) in
|
||||||
|
let%bind _ = should_fail (e_pair (e_constructor "Zero" (e_nat 1)) (e_unit ())) in
|
||||||
|
let%bind _ = should_work (e_pair (e_constructor "Pos" (e_nat 1)) (e_unit ())) in
|
||||||
|
let%bind _ = should_fail (e_pair (e_constructor "Pos" (e_nat 0)) (e_unit ())) in
|
||||||
|
ok ()
|
||||||
|
|
||||||
let failwith_mligo () : unit result =
|
let failwith_mligo () : unit result =
|
||||||
let%bind program = mtype_file "./contracts/failwith.mligo" in
|
let%bind program = mtype_file "./contracts/failwith.mligo" in
|
||||||
let make_input = e_pair (e_unit ()) (e_unit ()) in
|
let make_input = e_pair (e_unit ()) (e_unit ()) in
|
||||||
|
expect_fail program "main" make_input
|
||||||
|
|
||||||
|
let assert_mligo () : unit result =
|
||||||
|
let%bind program = mtype_file "./contracts/assert.mligo" in
|
||||||
|
let make_input b = e_pair (e_bool b) (e_unit ()) in
|
||||||
let make_expected = e_pair (e_typed_list [] t_operation) (e_unit ()) in
|
let make_expected = e_pair (e_typed_list [] t_operation) (e_unit ()) in
|
||||||
expect_eq program "main" make_input make_expected
|
let%bind _ = expect_fail program "main" (make_input false) in
|
||||||
|
let%bind _ = expect_eq program "main" (make_input true) make_expected in
|
||||||
|
ok ()
|
||||||
|
|
||||||
let guess_the_hash_mligo () : unit result =
|
let guess_the_hash_mligo () : unit result =
|
||||||
let%bind program = mtype_file "./contracts/new-syntax.mligo" in
|
let%bind program = mtype_file "./contracts/new-syntax.mligo" in
|
||||||
@ -800,7 +817,9 @@ let main = test_suite "Integration (End to End)" [
|
|||||||
test "match variant 2 (mligo)" match_matej ;
|
test "match variant 2 (mligo)" match_matej ;
|
||||||
test "list matching (mligo)" mligo_list ;
|
test "list matching (mligo)" mligo_list ;
|
||||||
(* test "guess the hash mligo" guess_the_hash_mligo ; WIP? *)
|
(* test "guess the hash mligo" guess_the_hash_mligo ; WIP? *)
|
||||||
(* test "failwith mligo" failwith_mligo ; *)
|
test "failwith ligo" failwith_ligo ;
|
||||||
|
test "failwith mligo" failwith_mligo ;
|
||||||
|
test "assert mligo" assert_mligo ;
|
||||||
(* test "guess string mligo" guess_string_mligo ; WIP? *)
|
(* test "guess string mligo" guess_string_mligo ; WIP? *)
|
||||||
test "lambda mligo" lambda_mligo ;
|
test "lambda mligo" lambda_mligo ;
|
||||||
test "lambda ligo" lambda_ligo ;
|
test "lambda ligo" lambda_ligo ;
|
||||||
|
Loading…
Reference in New Issue
Block a user