From fe871e9ecda6fd851e9fba2601f238f1b782017b Mon Sep 17 00:00:00 2001 From: Milo Davis Date: Tue, 15 Aug 2017 22:24:40 +0200 Subject: [PATCH] Michelson: Fixes reversed list bug --- src/proto/alpha/script_interpreter.ml | 4 ++-- src/proto/alpha/script_ir_translator.ml | 6 +++--- test/contracts/concat_list.tz | 2 +- test/contracts/first.tz | 4 ++++ test/contracts/list_id.tz | 4 ++++ test/contracts/map_id.tz | 4 ++++ test/contracts/reverse.tz | 9 +++++---- test/contracts/reverse_loop.tz | 6 ++++++ test/test_contracts.sh | 18 ++++++++++++++++++ test/test_utils.sh | 10 +++++----- 10 files changed, 52 insertions(+), 15 deletions(-) create mode 100644 test/contracts/first.tz create mode 100644 test/contracts/list_id.tz create mode 100644 test/contracts/map_id.tz create mode 100644 test/contracts/reverse_loop.tz diff --git a/src/proto/alpha/script_interpreter.ml b/src/proto/alpha/script_interpreter.ml index c9b4db4ff..e6278024f 100644 --- a/src/proto/alpha/script_interpreter.ml +++ b/src/proto/alpha/script_interpreter.ml @@ -149,11 +149,11 @@ let rec interp | If_cons (bt, _), Item (hd :: tl, rest) -> step origination qta ctxt bt (Item (hd, Item (tl, rest))) | List_map, Item (lam, Item (l, rest)) -> - fold_left_s (fun (tail, qta, ctxt, origination) arg -> + fold_right_s (fun arg (tail, qta, ctxt, origination) -> interp ?log origination qta orig source amount ctxt lam arg >>=? fun (ret, qta, ctxt, origination) -> return (ret :: tail, qta, ctxt, origination)) - ([], qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) -> + l ([], qta, ctxt, origination) >>=? fun (res, qta, ctxt, origination) -> logged_return ~origination (Item (res, rest), qta, ctxt) | List_reduce, Item (lam, Item (l, Item (init, rest))) -> fold_left_s diff --git a/src/proto/alpha/script_ir_translator.ml b/src/proto/alpha/script_ir_translator.ml index 3d9bb2602..e6100172f 100644 --- a/src/proto/alpha/script_ir_translator.ml +++ b/src/proto/alpha/script_ir_translator.ml @@ -704,11 +704,11 @@ let rec parse_data (* Lists *) | List_t t, Prim (_, "List", vs) -> traced @@ - fold_left_s - (fun rest v -> + fold_right_s + (fun v rest -> parse_data ?type_logger ctxt t v >>=? fun v -> return (v :: rest)) - [] vs + vs [] | List_t _, expr -> traced (fail (unexpected expr [] Constant_namespace [ "List" ])) (* Sets *) diff --git a/test/contracts/concat_list.tz b/test/contracts/concat_list.tz index f347f7d10..1c4b9339e 100644 --- a/test/contracts/concat_list.tz +++ b/test/contracts/concat_list.tz @@ -2,5 +2,5 @@ parameter (list string); return string; storage unit; code {CAR; PUSH string ""; SWAP; - LAMBDA (pair string string) string {DUP; CAR; SWAP; CDR; SWAP; CONCAT}; + LAMBDA (pair string string) string {DUP; CDR; DIP{CAR}; CONCAT}; REDUCE; UNIT; SWAP; PAIR}; diff --git a/test/contracts/first.tz b/test/contracts/first.tz new file mode 100644 index 000000000..b2c9622c1 --- /dev/null +++ b/test/contracts/first.tz @@ -0,0 +1,4 @@ +parameter (list nat); +return nat; +storage unit; +code{CAR; IF_CONS {DIP{DROP}} {FAIL}; UNIT; SWAP; PAIR}; diff --git a/test/contracts/list_id.tz b/test/contracts/list_id.tz new file mode 100644 index 000000000..75a99e7c5 --- /dev/null +++ b/test/contracts/list_id.tz @@ -0,0 +1,4 @@ +parameter (list string); +return (list string); +storage unit; +code {} diff --git a/test/contracts/map_id.tz b/test/contracts/map_id.tz new file mode 100644 index 000000000..3ae75b50f --- /dev/null +++ b/test/contracts/map_id.tz @@ -0,0 +1,4 @@ +parameter (list string); +return (list string); +storage unit; +code {CAR; LAMBDA string string {}; MAP; UNIT; SWAP; PAIR} diff --git a/test/contracts/reverse.tz b/test/contracts/reverse.tz index aa5a824ad..08a110e41 100644 --- a/test/contracts/reverse.tz +++ b/test/contracts/reverse.tz @@ -1,7 +1,8 @@ parameter (list string); storage unit; return (list string); -code {CAR; DIP {NIL string}; SWAP; PUSH bool True; - # INV: BOOL : ORIG_LIST : REV_LIST : [] - LOOP {IF_CONS {DIP {SWAP}; CONS; SWAP; PUSH bool True} {NIL string; PUSH bool False}}; - DROP; UNIT; SWAP; PAIR}; +code { CAR; NIL string; SWAP; + LAMBDA (pair string (list string)) + (list string) + {DUP; CAR; DIP{CDR}; CONS}; + REDUCE; UNIT; SWAP; PAIR}; diff --git a/test/contracts/reverse_loop.tz b/test/contracts/reverse_loop.tz new file mode 100644 index 000000000..ca626c4ec --- /dev/null +++ b/test/contracts/reverse_loop.tz @@ -0,0 +1,6 @@ +parameter (list string); +return (list string); +storage unit; +code { CAR; NIL string; SWAP; PUSH bool True; + LOOP { IF_CONS {SWAP; DIP{CONS}; PUSH bool True} {NIL string; PUSH bool False}}; + DROP; UNIT; SWAP; PAIR} diff --git a/test/test_contracts.sh b/test/test_contracts.sh index d94640e5e..1ce4a63e7 100755 --- a/test/test_contracts.sh +++ b/test/test_contracts.sh @@ -2,6 +2,8 @@ set -e +set -o pipefail + source test_utils.sh start_sandboxed_node @@ -67,6 +69,16 @@ assert_output $CONTRACT_PATH/max_in_list.tz Unit \ assert_output $CONTRACT_PATH/max_in_list.tz Unit \ '(List -10 -1 -20 -100)' '(Some -1)' +# Identity on lists +assert_output $CONTRACT_PATH/list_id.tz Unit '(List "1" "2" "3")' '(List "1" "2" "3")' +assert_output $CONTRACT_PATH/list_id.tz Unit '(List)' 'List' +assert_output $CONTRACT_PATH/list_id.tz Unit '(List "a" "b" "c")' '(List "a" "b" "c")' + +assert_output $CONTRACT_PATH/map_id.tz Unit '(List "1" "2" "3")' '(List "1" "2" "3")' +assert_output $CONTRACT_PATH/map_id.tz Unit '(List)' 'List' +assert_output $CONTRACT_PATH/map_id.tz Unit '(List "a" "b" "c")' '(List "a" "b" "c")' + + # Set member -- set is in storage assert_output $CONTRACT_PATH/set_member.tz '(Set)' '"Hi"' 'False' assert_output $CONTRACT_PATH/set_member.tz '(Set "Hi")' '"Hi"' 'True' @@ -119,6 +131,8 @@ assert_output $CONTRACT_PATH/swap_left_right.tz Unit '(Right "a")' '(Left "a")' # Reverse a list assert_output $CONTRACT_PATH/reverse.tz Unit '(List )' 'List' assert_output $CONTRACT_PATH/reverse.tz Unit '(List "c" "b" "a")' '(List "a" "b" "c")' +assert_output $CONTRACT_PATH/reverse_loop.tz Unit '(List )' 'List' +assert_output $CONTRACT_PATH/reverse_loop.tz Unit '(List "c" "b" "a")' '(List "a" "b" "c")' # Exec concat contract assert_output $CONTRACT_PATH/exec_concat.tz Unit '""' '"_abc"' @@ -139,6 +153,10 @@ assert_output $CONTRACT_PATH/compare.tz Unit '(Pair "2.37" "2.37")' '(List True assert_output $CONTRACT_PATH/tez_add_sub.tz Unit '(Pair "2.00" "1.00")' '(Pair "3.00" "1.00")' assert_output $CONTRACT_PATH/tez_add_sub.tz Unit '(Pair "2.31" "1.01")' '(Pair "3.32" "1.30")' +# Test get first element of list +assert_output $CONTRACT_PATH/first.tz Unit '(List 1 2 3 4)' '1' +assert_output $CONTRACT_PATH/first.tz Unit '(List 4)' '4' + # Hash input string # Test assumed to be correct -- hash is based on encoding of AST assert_output $CONTRACT_PATH/hash_string.tz Unit '"abcdefg"' '"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF"' diff --git a/test/test_utils.sh b/test/test_utils.sh index 7b9f8f9fc..d47961935 100755 --- a/test/test_utils.sh +++ b/test/test_utils.sh @@ -199,23 +199,23 @@ KEY2=bar add_bootstrap_identities() { client=${1:-${TZCLIENT}} - ${client} add identity bootstrap1 ${BOOTSTRAP1_IDENTITY} + # ${client} add identity bootstrap1 ${BOOTSTRAP1_IDENTITY} ${client} add public key bootstrap1 ${BOOTSTRAP1_PUBLIC} ${client} add secret key bootstrap1 ${BOOTSTRAP1_SECRET} - ${client} add identity bootstrap2 ${BOOTSTRAP2_IDENTITY} + # ${client} add identity bootstrap2 ${BOOTSTRAP2_IDENTITY} ${client} add public key bootstrap2 ${BOOTSTRAP2_PUBLIC} ${client} add secret key bootstrap2 ${BOOTSTRAP2_SECRET} - ${client} add identity bootstrap3 ${BOOTSTRAP3_IDENTITY} + # ${client} add identity bootstrap3 ${BOOTSTRAP3_IDENTITY} ${client} add public key bootstrap3 ${BOOTSTRAP3_PUBLIC} ${client} add secret key bootstrap3 ${BOOTSTRAP3_SECRET} - ${client} add identity bootstrap4 ${BOOTSTRAP4_IDENTITY} + # ${client} add identity bootstrap4 ${BOOTSTRAP4_IDENTITY} ${client} add public key bootstrap4 ${BOOTSTRAP4_PUBLIC} ${client} add secret key bootstrap4 ${BOOTSTRAP4_SECRET} - ${client} add identity bootstrap5 ${BOOTSTRAP5_IDENTITY} + # ${client} add identity bootstrap5 ${BOOTSTRAP5_IDENTITY} ${client} add public key bootstrap5 ${BOOTSTRAP5_PUBLIC} ${client} add secret key bootstrap5 ${BOOTSTRAP5_SECRET}