balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Michelson: Fixes reversed list bug

Browse Source
This commit is contained in:
Milo Davis 2017-08-15 22:24:40 +02:00
parent ebbb3a1ac0
commit fe871e9ecd
10 changed files with 52 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/proto/alpha/script_interpreter.ml
View File

@ -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

6
src/proto/alpha/script_ir_translator.ml
View File

@ -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 *)

2
test/contracts/concat_list.tz
View File

@ -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};

4
test/contracts/first.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (list nat);
return nat;
storage unit;
code{CAR; IF_CONS {DIP{DROP}} {FAIL}; UNIT; SWAP; PAIR};

4
test/contracts/list_id.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (list string);
return (list string);
storage unit;
code {}

4
test/contracts/map_id.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (list string);
return (list string);
storage unit;
code {CAR; LAMBDA string string {}; MAP; UNIT; SWAP; PAIR}

9
test/contracts/reverse.tz
View File

@ -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};

6
test/contracts/reverse_loop.tz Normal file
View File

@ -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}

18
test/test_contracts.sh
View File

@ -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"'

10
test/test_utils.sh
View File

@ -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}