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

Proto/test: do not depend on shell

Browse Source 
For the test suite we only use the in-memory context.
This commit is contained in:
Grégoire Henry 2018-02-05 19:23:18 +01:00
parent a6ab12e701
commit 7929027793
35 changed files with 225 additions and 356 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitlab-ci.yml
View File

@ -147,7 +147,7 @@ test:p2p:pool:
test:proto_alpha:
<<: *test_definition
script:
- jbuilder build @src/proto_alpha/runtest
- jbuilder build @src/proto_alpha/lib_protocol/runtest
test:client_alpha:transaction:
<<: *test_definition

2
src/lib_protocol_environment_sigs/jbuild
View File

@ -62,7 +62,7 @@
))
(action
(with-stdout-to ${@}
(chdir ${ROOT} (run ${exe:sigs_packer/sigs_packer.exe} ${!^}))))))
(chdir ${ROOT} (run ${exe:sigs_packer/sigs_packer.exe} ${^}))))))
(library
((name tezos_protocol_environment_sigs)

13
src/proto_alpha/lib_protocol/test/helpers/helpers_account.mli
View File

@ -7,7 +7,8 @@
(* *)
(**************************************************************************)
open Proto_alpha.Tezos_context
open Proto_alpha
open Tezos_context
(** Facilities to deal with accounts , bootstrap accounts and make new
accounts *)
@ -34,27 +35,27 @@ val init_amount : int
(** Credits a new account *)
val init_account :
tc:context -> account ->
(account * context) Proto_alpha.tzresult Lwt.t
(account * context) proto_tzresult Lwt.t
(** Generates a new account and credits it *)
val make_account :
tc:context ->
(account * context) Proto_alpha.tzresult Lwt.t
(account * context) proto_tzresult Lwt.t
(** Generates a list of new accounts and credits them *)
val make_accounts :
tc:context -> int ->
(account list * context) Proto_alpha.tzresult Lwt.t
(account list * context) proto_tzresult Lwt.t
(** Better typed "make_accounts tc 2" *)
val make_2_accounts :
tc:context ->
((account * account) * context) Proto_alpha.tzresult Lwt.t
((account * account) * context) proto_tzresult Lwt.t
(** Better typed "make_accounts tc 4" *)
val make_4_accounts :
tc:context ->
((t * t * t * t) * context) Proto_alpha.tzresult Lwt.t
((t * t * t * t) * context) proto_tzresult Lwt.t
(** Debug : Displays an account and its balance *)
val display_account : tc:context -> account -> unit Lwt.t

21
src/proto_alpha/lib_protocol/test/helpers/helpers_apply.mli
View File

@ -9,49 +9,50 @@
(** Functions to build and apply operations *)
open Proto_alpha.Tezos_context
open Proto_alpha
open Tezos_context
val operation :
tc:context -> ?baker:Helpers_account.t -> ?src:Helpers_account.t ->
Block_hash.t -> Tezos_base.Operation.shell_header -> proto_operation ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val transaction :
tc:context -> ?fee:int -> ?baker:Helpers_account.t -> Block_hash.t ->
Tezos_base.Operation.shell_header -> Helpers_account.t -> Helpers_account.t -> int ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val transaction_pred :
?tc:t -> pred:Helpers_block.result -> ?baker:Helpers_account.t ->
Helpers_account.t * Helpers_account.t * int * int option ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val script_origination :
tc:context -> Block_hash.t -> Tezos_base.Operation.shell_header ->
Script.t option -> Helpers_account.t -> int ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val origination :
tc:context -> ?baker:Helpers_account.t -> ?spendable:bool -> ?fee:int ->
?delegatable:bool -> Block_hash.t -> Tezos_base.Operation.shell_header ->
Helpers_account.t -> int ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val script_origination_pred :
?tc:t -> pred:Helpers_block.result -> Script.t * Helpers_account.t * int ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val origination_pred :
?tc:t -> ?baker:Helpers_account.t -> pred:Helpers_block.result ->
Helpers_account.t * int * bool * bool * int ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val delegation :
tc:context -> ?baker:Helpers_account.t -> ?fee:int -> Block_hash.t ->
Tezos_base.Operation.shell_header -> Helpers_account.t -> public_key_hash ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t
val delegation_pred :
?tc:t -> ?baker:Helpers_account.t -> pred:Helpers_block.result ->
Helpers_account.t * public_key_hash * int ->
((Contract.contract list * Proto_alpha.error list option) * context) Proto_alpha.tzresult Lwt.t
((Contract.contract list * proto_error list option) * context) proto_tzresult Lwt.t

35
src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli
View File

@ -7,7 +7,8 @@
(* *)
(**************************************************************************)
open Proto_alpha.Tezos_context
open Proto_alpha
open Tezos_context
include module type of Assert
@ -15,32 +16,32 @@ include module type of Assert
(** Converts a tzresult from the Environment's error monad to a tzresult of the
top level error monad *)
val wrap_result : 'a Proto_alpha.tzresult -> 'a tzresult
val wrap_result : 'a proto_tzresult -> 'a tzresult
(** Converts a tzresult Lwt.t from the Environment's error monad to a tzresult Lwt.t
of the top level error monad *)
val wrap : 'a Proto_alpha.tzresult -> 'a tzresult Lwt.t
val wrap : 'a proto_tzresult -> 'a tzresult Lwt.t
(** Binds a top level error monad function with an Environment's error monad
tzresult Lwt.t *)
val ( >>=?? ) :
'a Proto_alpha.tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t
'a proto_tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t
(** Binds a top level error monad function with an Environment's error monad
tzresult *)
val ( >>?? ) : 'a Proto_alpha.tzresult -> ('a -> 'b tzresult) -> 'b tzresult
val ( >>?? ) : 'a proto_tzresult -> ('a -> 'b tzresult) -> 'b tzresult
(** Partially binds a top level error monad function with an Environment's
error monad tzresult *)
val ( >>?= ) : 'a Proto_alpha.tzresult Lwt.t -> ('a tzresult -> 'b Lwt.t) -> 'b Lwt.t
val ( >>?= ) : 'a proto_tzresult Lwt.t -> ('a tzresult -> 'b Lwt.t) -> 'b Lwt.t
val tmp_map : ('a -> 'b Proto_alpha.tzresult) -> 'a list -> 'b list Proto_alpha.tzresult
val tmp_map : ('a -> 'b proto_tzresult) -> 'a list -> 'b list proto_tzresult
val ok : ?msg:string -> 'a Proto_alpha.tzresult -> 'a Proto_alpha.tzresult Lwt.t
val ok : ?msg:string -> 'a proto_tzresult -> 'a proto_tzresult Lwt.t
val ok_contract : ?msg:string ->
(('a * 'b option) * 'c) Proto_alpha.tzresult ->
(('a * 'b option) * 'c) Proto_alpha.tzresult Lwt.t
(('a * 'b option) * 'c) proto_tzresult ->
(('a * 'b option) * 'c) proto_tzresult Lwt.t
exception No_error
@ -54,25 +55,25 @@ val equal_tez : ?msg:string -> Tez.t -> Tez.t -> unit
val equal_balance :
tc:context -> ?msg:string ->
Contract.contract * Tez.t ->
unit Proto_alpha.tzresult Lwt.t
unit proto_tzresult Lwt.t
val equal_cents_balance :
tc:context -> ?msg:string ->
Contract.contract * int ->
unit Proto_alpha.tzresult Lwt.t
unit proto_tzresult Lwt.t
val ecoproto_error :
(Proto_alpha.error -> bool) -> Error_monad.error -> bool
(proto_error -> bool) -> error -> bool
val generic_economic_error : msg:string -> 'a tzresult -> unit
val economic_error :
msg:string -> (Proto_alpha.error -> bool) -> 'a tzresult -> unit
msg:string -> (proto_error -> bool) -> 'a tzresult -> unit
val ill_typed_data_error : msg:string -> 'a tzresult -> unit
val ill_typed_return_error : msg:string -> 'a tzresult -> unit
val double_endorsement : msg:string -> 'a tzresult -> unit
val contain_error_alpha :
?msg:string -> f:('a -> bool) -> ('b, 'a list) result -> unit
val unknown_contract : msg:string -> 'a Proto_alpha.tzresult -> unit
val non_existing_contract : msg:string -> 'a Proto_alpha.tzresult -> unit
val balance_too_low : msg:string -> 'a Proto_alpha.tzresult -> unit
val unknown_contract : msg:string -> 'a proto_tzresult -> unit
val non_existing_contract : msg:string -> 'a proto_tzresult -> unit
val balance_too_low : msg:string -> 'a proto_tzresult -> unit
val non_spendable : msg:string -> 'a tzresult -> unit
val inconsistent_pkh : msg:string -> 'a tzresult -> unit
val initial_amount_too_low : msg:string -> 'a tzresult -> unit

9
src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml
View File

@ -7,7 +7,8 @@
(* *)
(**************************************************************************)
open Proto_alpha.Error_monad
open Proto_alpha
open Error_monad
type shell_header = Block_header.shell_header
type tezos_header = Block_header.t
@ -24,14 +25,14 @@ type init_block = {
proto_header_bytes : MBytes.t ;
timestamp : Time.t ;
level : Int32.t ;
context : Tezos_storage.Context.t
context : Context.t
}
type result = {
tezos_header : tezos_header ;
hash : Block_hash.t ;
level : Int32.t ;
validation : Tezos_protocol_updater.Updater.validation_result ;
validation : Updater.validation_result ;
tezos_context : Proto_alpha.Tezos_context.t
}
@ -106,7 +107,7 @@ let get_level opt_msg =
let get_header_hash
(init_block : init_block)
(validation_result : Tezos_protocol_updater.Updater.validation_result)
(validation_result : Updater.validation_result)
: result tzresult Lwt.t
=
let op_hashs = init_block.operation_hashs in

32
src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
open Proto_alpha
(** Representation of blocks independent from the State module *)
type shell_header = Block_header.shell_header
@ -26,7 +28,7 @@ type init_block = {
proto_header_bytes : MBytes.t;
timestamp : Time.t;
level : Int32.t;
context : Tezos_storage.Context.t;
context : Context.t;
}
(** Result of the application of a block *)
@ -34,7 +36,7 @@ type result = {
tezos_header : tezos_header;
hash : Block_hash.t;
level : Int32.t;
validation : Tezos_protocol_updater.Updater.validation_result;
validation : Updater.validation_result;
tezos_context : Tezos_context.t;
}
val get_op_header_res : result -> operation_header
@ -44,38 +46,38 @@ val make_sourced_operation :
Operation.shell_header ->
Tezos_context.proto_operation *
Helpers_account.t ->
((Proto_alpha.Main.operation * Helpers_account.t) * Operation_hash.t) Proto_alpha.Error_monad.tzresult
((Proto_alpha.Main.operation * Helpers_account.t) * Operation_hash.t) proto_tzresult
val init :
shell_header -> Block_hash.t -> Int32.t -> int ->
(Tezos_context.proto_operation * Helpers_account.t) list ->
Tezos_storage.Context.t -> init_block Proto_alpha.Error_monad.tzresult
Context.t -> init_block proto_tzresult
val init_of_result :
?priority:int -> res:result ->
ops:(Tezos_context.proto_operation * Helpers_account.t) list ->
init_block Proto_alpha.Error_monad.tzresult
init_block proto_tzresult
val get_level : string option -> int32
val get_header_hash :
init_block -> Tezos_protocol_updater.Updater.validation_result ->
result Proto_alpha.Error_monad.tzresult Lwt.t
init_block -> Updater.validation_result ->
result proto_tzresult Lwt.t
val begin_construction_pre :
init_block -> Main.validation_state Proto_alpha.Error_monad.tzresult Lwt.t
val make : init_block -> result Proto_alpha.Error_monad.tzresult Lwt.t
init_block -> Main.validation_state proto_tzresult Lwt.t
val make : init_block -> result proto_tzresult Lwt.t
val make_init :
shell_header -> Block_hash.t -> Int32.t -> int ->
(Tezos_context.proto_operation * Helpers_account.t) list ->
Tezos_storage.Context.t -> result Proto_alpha.Error_monad.tzresult Lwt.t
Context.t -> result proto_tzresult Lwt.t
val of_res :
?priority:int ->
?ops:(Tezos_context.proto_operation * Helpers_account.t) list ->
res:result ->
unit -> result Proto_alpha.Error_monad.tzresult Lwt.t
unit -> result proto_tzresult Lwt.t
val endorsement :
shell_header -> Block_hash.t -> Int32.t -> int ->
Helpers_account.t -> Tezos_storage.Context.t -> int ->
result Proto_alpha.Error_monad.tzresult Lwt.t
Helpers_account.t -> Context.t -> int ->
result proto_tzresult Lwt.t
val endorsement_of_res :
result -> Helpers_account.t -> int -> ?priority:int -> res:result ->
unit -> result Proto_alpha.Error_monad.tzresult Lwt.t
unit -> result proto_tzresult Lwt.t
val empty :
shell_header -> Block_hash.t -> Int32.t -> int ->
Tezos_storage.Context.t -> result Proto_alpha.Error_monad.tzresult Lwt.t
Context.t -> result proto_tzresult Lwt.t

2
src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli
View File

@ -23,5 +23,5 @@ val tez_add_int : Tez.tez -> int -> Tez.tez
(** Tez.(-?) with a top - level error instead *)
val tez_sub : Tez.tez -> Tez.tez -> Tez.tez
val tez_sub_int : Tez.tez -> int -> Tez.tez
val ctxt_of_tc : context -> Tezos_storage.Context.t
val ctxt_of_tc : context -> Mem_context.t

32
src/proto_alpha/lib_protocol/test/helpers/helpers_constants.ml
View File

@ -1,32 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Tezos_shell
let genesis : State.Net.genesis = {
time =
Time.of_notation_exn "2017-09-22T00:00:00Z" ;
block =
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" ;
protocol =
Protocol_hash.of_b58check_exn
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ;
}
let alpha_hash : Tezos_base.TzPervasives.Protocol_hash.t =
Protocol_hash.of_b58check_exn
"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"
let test_folder =
let home = Sys.getenv "HOME" in
Filename.concat home ".tezos-test"
let store_root = Filename.concat test_folder "store"
let context_root = Filename.concat test_folder "context"

19
src/proto_alpha/lib_protocol/test/helpers/helpers_constants.mli
View File

@ -1,19 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(** Constants used for testing *)
val genesis : Tezos_shell.State.Net.genesis
val alpha_hash : Protocol_hash.t
(** Folder in which the temporary files for testing are put *)
val test_folder : string
val store_root : string
val context_root : string

148
src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml
View File

@ -7,99 +7,8 @@
(* *)
(**************************************************************************)
open Tezos_shell
open Helpers_logger
let previous_gs = ref None
let cleanup () =
ignore @@ Sys.command @@ "rm -rf " ^ Helpers_constants.test_folder
let get_global_state () =
match !previous_gs with
| Some gs ->
State.Net.all gs >>= fun ls ->
Lwt_list.iter_p (State.Net.destroy gs) ls >>= fun () ->
return gs
| None ->
Lwt.catch (
fun () ->
State.read
~store_root: Helpers_constants.store_root
~context_root: Helpers_constants.context_root
() >>= function
| Ok init_state -> (
previous_gs := Some init_state ;
Lwt.return @@ Ok init_state
)| Error errors -> (
lwt_warn "Errors !" >>= fun () ->
lwt_warn "Error when building global state ...%a" pp_print_error errors >>= fun () ->
Lwt.return @@ Error errors
)
) (function
| e -> Logger.lwt_warn "Error !" >>= fun () ->
Lwt.fail e
)
let get_activation_block baker context_hash head =
let open Tezos_embedded_raw_protocol_genesis in
State.Block.context head >>= fun context ->
Data.Pubkey.set_pubkey context baker.Helpers_account.pub >>= fun context ->
let shell_header =
Helpers_misc.get_block_header
head
Helpers_misc.no_ops_hash
(State.Block.fitness head)
context_hash
(Time.now ())
in
let fitness =
Tezos_embedded_raw_protocol_alpha.Fitness_repr.from_int64 100L in
let command: Data.Command.t =
Data.Command.Activate({protocol = Helpers_constants.alpha_hash ; fitness}) in
let content_bytes = Data.Command.forge shell_header command in
let signature = Ed25519.sign baker.ppk content_bytes in
let proto = (command , signature) in
let proto_bytes =
Data_encoding.Binary.to_bytes
Data.Command.signed_encoding
proto in
let raw_block: Block_header.t = {
shell = shell_header ;
proto = proto_bytes
} in
return (context , raw_block)
let get_alpha () =
get_global_state () >>=? fun global_state ->
State.Net.create global_state Helpers_constants.genesis >>= fun state ->
Tezos_shell.Chain.head state >>= fun head ->
let baker = Helpers_account.new_account () in
let rec attempt context_hash =
begin
get_activation_block baker context_hash head >>=? fun (context , raw_block) ->
Tezos_storage.Context.get_protocol context >>= fun protocol_hash ->
let (module Protocol) = Helpers_misc.get_protocol protocol_hash in
Protocol.begin_application
~predecessor_context: context
~predecessor_timestamp: (State.Block.timestamp head)
~predecessor_fitness: (State.Block.fitness head)
raw_block
>>=? fun app ->
Protocol.finalize_block app >>=? fun result ->
State.Block.store state raw_block [[]] result >>=? fun opt_block ->
return (opt_block , result)
end >>= function
| Ok v -> return v
| Error [ State.Block.Inconsistent_hash (got , _) ] ->
attempt got
| Error err ->
Error_monad.pp_print_error Format.err_formatter err ;
Lwt.return (Error err) in
attempt Context_hash.zero >>=? fun (opt_block , result) ->
Error_monad.protect (fun () -> return (Option.unopt_exn (Failure "get_alpha") opt_block)) >>=? fun block ->
Tezos_shell.Chain.set_head state block >>= fun _ ->
return (global_state , state , result)
open Proto_alpha
open Error_monad
let get_sandbox () =
Data_encoding_ezjsonm.read_file
@ -109,19 +18,44 @@ let get_sandbox () =
Data_encoding_ezjsonm.read_file "test/sandbox.json" >>= fun x ->
Lwt.return @@ Helpers_assert.no_error ~msg:__LOC__ x
open Helpers_assert
let main () =
cleanup () ;
ignore @@ Unix.mkdir Helpers_constants.test_folder 0o777 ;
ignore @@ Unix.mkdir Helpers_constants.store_root 0o777 ;
get_alpha () >>=? fun (_gs, s, r) ->
let context = r.context in
Tezos_shell.Chain.head s >>= fun head ->
let hash = State.Block.hash head in
let block_shell_header = State.Block.shell_header head in
let context = Tezos_protocol_environment_client.Mem_context.empty in
get_sandbox () >>= fun json ->
Main.configure_sandbox context @@ Some json >>=?? fun context ->
Helpers_block.empty block_shell_header hash Int32.zero 0 context >>= Helpers_assert.wrap
let () = at_exit cleanup
Main.configure_sandbox context @@ Some json >>=? fun context ->
let genesis_hash =
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in
let header = {
Block_header.level = 1l ;
proto_level = 0 ;
predecessor = genesis_hash ;
timestamp = Time.of_notation_exn "2017-09-22T00:00:00Z" ;
validation_passes = List.length Proto_alpha.Main.validation_passes ;
operations_hash = Helpers_misc.no_ops_hash ;
fitness = [] ; (* don't care *)
context = Context_hash.zero ; (* don't care *)
} in
let proto_header =
Data_encoding.Binary.to_bytes
Tezos_context.Block_header.proto_header_encoding
(Helpers_block.get_proto_header 0) in
let tezos_header = { Block_header.shell = header ; proto = proto_header } in
Proto_alpha.Main.begin_construction
~predecessor_context: context
~predecessor_fitness:[]
~predecessor_timestamp:(Time.epoch)
~predecessor_level: 0l
~predecessor: genesis_hash
~timestamp: header.timestamp
~proto_header
() >>=? fun vstate ->
let hash = Block_header.hash tezos_header in
Proto_alpha.Main.finalize_block vstate >>=? fun validation ->
Tezos_context.init
~level: (Int32.succ header.level)
~timestamp: header.timestamp
~fitness: header.fitness
validation.context >>=? fun tezos_context ->
return
{ Helpers_block.tezos_header ; hash ; level = tezos_header.shell.level ;
validation ; tezos_context }

4
src/proto_alpha/lib_protocol/test/helpers/helpers_init.mli
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
open Proto_alpha
(** Functions used to build the first tezos_context and first block *)
val main : unit -> Helpers_block.result tzresult Lwt.t
val main : unit -> Helpers_block.result proto_tzresult Lwt.t

47
src/proto_alpha/lib_protocol/test/helpers/helpers_misc.ml
View File

@ -7,61 +7,18 @@
(* *)
(**************************************************************************)
open Tezos_shell
exception Unknown_protocol
let no_ops_hash =
Operation_list_list_hash.compute
[Operation_list_hash.empty]
let get_protocol hash : (module Registred_protocol.T) =
let (module Protocol): (module Registred_protocol.T) =
Option.unopt_exn
Unknown_protocol
@@ Registred_protocol.get hash
in
(module Protocol)
let get_shell_header head =
let shell_header : Operation.shell_header = {
branch = State.Block.hash head
} in
shell_header
let get_block_header pred operations_hash fitness context timestamp =
let pred_header = State.Block.header pred in
let pred_hash = State.Block.hash pred in
let shell_header : Block_header.shell_header = {
level = Int32.succ pred_header.shell.level ;
proto_level = 0 ;
predecessor = pred_hash ;
timestamp ;
validation_passes = 1 ;
operations_hash ;
context ;
fitness
} in
shell_header
(List.map (fun _ -> Operation_list_hash.empty)
Proto_alpha.Main.validation_passes)
let find_account accounts hpub =
let hpub_pred (x : Helpers_account.t) =
Ed25519.Public_key_hash.equal x.hpub hpub in
List.find hpub_pred accounts
let get_dummy_tezos_context context =
Proto_alpha.Tezos_context.init
context
~level: Int32.one
~timestamp:(Time.now ())
~fitness:([])
let read_file path =
let (//) = Filename.concat in
let executable_path = Sys.getcwd () in

17
src/proto_alpha/lib_protocol/test/helpers/helpers_misc.mli
View File

@ -7,23 +7,14 @@
(* *)
(**************************************************************************)
open Tezos_shell
open Proto_alpha.Tezos_context
exception Unknown_protocol
(** Miscellaneous self-descriptive functions *)
val no_ops_hash : Operation_list_list_hash.t
val get_protocol : Protocol_hash.t -> (module Tezos_protocol_updater.Registred_protocol.T)
val get_shell_header :
State.Block.t -> Tezos_base.Operation.shell_header
val get_block_header :
State.Block.t -> Operation_list_list_hash.t ->
Tezos_stdlib.MBytes.t list -> Context_hash.t ->
Tezos_base.Time.t -> Block_header.shell_header
val find_account : Helpers_account.t list -> Ed25519.Public_key_hash.t -> Helpers_account.t
val get_dummy_tezos_context :
Proto_alpha.Environment.Context.t -> Proto_alpha.Tezos_context.context Proto_alpha.Environment.Error_monad.tzresult Lwt.t
val find_account :
Helpers_account.t list -> Ed25519.Public_key_hash.t -> Helpers_account.t
val read_file : string -> string

7
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml
View File

@ -7,13 +7,14 @@
(* *)
(**************************************************************************)
open Proto_alpha.Tezos_context
open Proto_alpha.Environment.Error_monad
open Proto_alpha
open Error_monad
open Tezos_context
let sourced ops = Sourced_operations ops
let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context =
Helpers_misc.get_dummy_tezos_context context >>=? fun context ->
Tezos_context.init ~level:0l ~timestamp:(Time.now ()) ~fitness:[] context >>=? fun context ->
Contract.get_counter context src.contract >>=? fun counter ->
let counter = Int32.succ counter in
return @@

17
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli
View File

@ -7,7 +7,8 @@
(* *)
(**************************************************************************)
open Proto_alpha.Tezos_context
open Proto_alpha
open Tezos_context
(** Functions building operations *)
@ -15,11 +16,11 @@ val sourced : sourced_operations -> proto_operation
val manager :
Helpers_account.t -> ?fee:Tez.tez -> manager_operation list ->
Proto_alpha.Environment.Context.t -> sourced_operations Proto_alpha.tzresult Lwt.t
Proto_alpha.Environment.Context.t -> sourced_operations proto_tzresult Lwt.t
val manager_full :
Helpers_account.t -> ?fee:Tez.tez -> manager_operation list ->
Proto_alpha.Environment.Context.t -> proto_operation Proto_alpha.tzresult Lwt.t
Proto_alpha.Environment.Context.t -> proto_operation proto_tzresult Lwt.t
val transaction :
?parameters:Script.expr option -> Tez.t -> Contract.contract ->
@ -33,20 +34,20 @@ val delegation : public_key_hash -> manager_operation
val delegation_full :
?fee:Tez.tez -> Helpers_account.t -> public_key_hash -> Proto_alpha.Environment.Context.t ->
proto_operation Proto_alpha.tzresult Lwt.t
proto_operation proto_tzresult Lwt.t
val script_origination_full :
Script.t option -> Helpers_account.t -> Tez.t -> Proto_alpha.Environment.Context.t ->
proto_operation Proto_alpha.tzresult Lwt.t
proto_operation proto_tzresult Lwt.t
val origination_full :
?spendable:bool -> ?delegatable:bool -> ?fee:Tez.tez ->
Helpers_account.t -> Tez.t -> Proto_alpha.Environment.Context.t ->
proto_operation Proto_alpha.tzresult Lwt.t
proto_operation proto_tzresult Lwt.t
val transaction_full :
?fee:Tez.tez -> Helpers_account.t -> Contract.contract -> Tez.t ->
Proto_alpha.Environment.Context.t -> proto_operation Proto_alpha.tzresult Lwt.t
Proto_alpha.Environment.Context.t -> proto_operation proto_tzresult Lwt.t
val delegate :
Helpers_account.t -> delegate_operation list -> sourced_operations
@ -63,7 +64,7 @@ val sign :
val main_of_proto :
Helpers_account.t -> Tezos_base.Operation.shell_header ->
proto_operation -> (Main.operation * Tezos_base.Operation_hash.t) Proto_alpha.tzresult
proto_operation -> (Main.operation * Tezos_base.Operation_hash.t) proto_tzresult
val apply_of_proto :
Helpers_account.t option -> Tezos_base.Operation.shell_header ->

5
src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml
View File

@ -7,8 +7,9 @@
(* *)
(**************************************************************************)
open Proto_alpha.Error_monad
open Proto_alpha.Tezos_context
open Proto_alpha
open Error_monad
open Tezos_context
let init_amount = 20000

5
src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli
View File

@ -7,11 +7,12 @@
(* *)
(**************************************************************************)
open Proto_alpha.Tezos_context
open Proto_alpha
open Tezos_context
val init_amount : int
val execute_code_pred :
?tc:Tezos_context.t -> Helpers_block.result -> Script.t -> Script.expr ->
(Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce)
Proto_alpha.tzresult Lwt.t
proto_tzresult Lwt.t

6
src/proto_alpha/lib_protocol/test/helpers/helpers_services.mli
View File

@ -7,12 +7,14 @@
(* *)
(**************************************************************************)
open Proto_alpha
(** Wrappers around Services_registration calls *)
val endorsement_rights :
tc:Proto_alpha.Tezos_context.context -> unit ->
tc:Tezos_context.context -> unit ->
(int * Tezos_context.public_key_hash) list tzresult Lwt.t
val baking_rights :
tc:Proto_alpha.Tezos_context.context -> unit ->
tc:Tezos_context.context -> unit ->
(int * Tezos_context.public_key_hash) list tzresult Lwt.t

12
src/proto_alpha/lib_protocol/test/helpers/isolate_helpers.ml
View File

@ -7,11 +7,12 @@
(* *)
(**************************************************************************)
open Proto_alpha
module Sodium = Helpers_sodium
module Cast = Helpers_cast
module Assert = Helpers_assert
module Services = Helpers_services
module Constants = Helpers_constants
module Account = Helpers_account
module Misc = Helpers_misc
module Operation = Helpers_operation
@ -22,8 +23,6 @@ module Script = Helpers_script
module Shorthands = struct
let to_tc ctxt = Misc.get_dummy_tezos_context ctxt
let to_tc_full ctxt level fitness =
Tezos_context.init
ctxt
@ -31,9 +30,6 @@ module Shorthands = struct
~fitness
~timestamp:(Time.now())
let get_tc (res:Block.result) =
to_tc res.validation.context
let get_tc_full (res:Block.result) =
Tezos_context.init
res.validation.context
@ -42,9 +38,9 @@ module Shorthands = struct
~fitness:res.validation.fitness
let get_balance_res (account:Account.t) (result:Block.result) =
let open Proto_alpha.Error_monad in
let open Proto_alpha.Environment.Error_monad in
get_tc_full result >>=? fun tc ->
Proto_alpha.Tezos_context.Contract.get_balance tc account.contract
Tezos_context.Contract.get_balance tc account.contract
let chain_empty_block (result:Block.result) =
Block.empty

9
src/proto_alpha/lib_protocol/test/helpers/jbuild
View File

@ -4,16 +4,13 @@
((name tezos_proto_alpha_isolate_helpers)
(libraries (tezos-test-helpers
tezos-base
tezos-embedded-protocol-genesis
tezos-embedded-protocol-alpha
tezos-protocol-updater
tezos-shell))
tezos-protocol-environment-client
tezos-protocol-alpha))
(wrapped false)
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_protocol_updater
-open Tezos_embedded_raw_protocol_alpha))))
-open Tezos_protocol_environment_client))))
(alias
((name runtest_indent)

25
src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml
View File

@ -1,5 +1,22 @@
include Tezos_embedded_raw_protocol_alpha
module Environment = Tezos_embedded_protocol_environment_alpha.Environment
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Name = struct let name = "alpha" end
module Context =
Tezos_protocol_environment_client.Mem_context
module Updater =
Tezos_protocol_environment_client.Fake_updater.Make(Context)
module Environment =
Tezos_base.Protocol_environment.MakeV1(Name)(Context)(Updater)()
include Tezos_protocol_alpha.Functor.Make(Environment)
module Error_monad = Environment.Error_monad
type error = Error_monad.error
type 'a tzresult = 'a Error_monad.tzresult
type proto_error = Error_monad.error
type 'a proto_tzresult = 'a Error_monad.tzresult

14
src/proto_alpha/lib_protocol/test/jbuild
View File

@ -3,28 +3,28 @@
(executables
((names (test_isolate_main))
(libraries (tezos-base
tezos-rpc-http
tezos-test-helpers
tezos_proto_alpha_isolate_helpers))
tezos_proto_alpha_isolate_helpers
tezos_proto_alpha_isolate_michelson_parser))
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_rpc_http))))
-open Tezos_proto_alpha_isolate_michelson_parser))))
(alias
((name buildtest)
(package tezos-embedded-protocol-alpha)
(package tezos-protocol-alpha)
(deps (test_isolate_main.exe))))
(alias
((name runtest_isolate_main)
(package tezos-embedded-protocol-alpha)
(package tezos-protocol-alpha)
(deps (sandbox.json (glob_files contracts/*.tz)))
(action (chdir ${ROOT} (run ${exe:test_isolate_main.exe})))))
(action (chdir ${ROOT} (run ${exe:test_isolate_main.exe} ${path-no-dep:contracts})))))
(alias
((name runtest)
(package tezos-embedded-protocol-alpha)
(package tezos-protocol-alpha)
(deps ((alias runtest_isolate_main)))))
(alias

1
src/proto_alpha/lib_protocol/test/michelson_macros.ml
View File

@ -1 +0,0 @@
../../lib_client/michelson_macros.ml

13
src/proto_alpha/lib_protocol/test/michelson_parser/jbuild Normal file
View File

@ -0,0 +1,13 @@
(jbuild_version 1)
(library
((name tezos_proto_alpha_isolate_michelson_parser)
(libraries (tezos-base
tezos_proto_alpha_isolate_helpers))
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives))))
(alias
((name runtest_indent)
(deps ((glob_files *.ml) (glob_files *.mli)))
(action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

1
src/proto_alpha/lib_protocol/test/michelson_parser/michelson_macros.ml Symbolic link
View File

@ -0,0 +1 @@
../../../lib_client/michelson_macros.ml

1
src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_parser.ml Symbolic link
View File

@ -0,0 +1 @@
../../../lib_client/michelson_v1_parser.ml

1
src/proto_alpha/lib_protocol/test/michelson_v1_parser.ml
View File

@ -1 +0,0 @@
../../lib_client/michelson_v1_parser.ml

11
src/proto_alpha/lib_protocol/test/test_isolate_dsl.ml
View File

@ -7,16 +7,16 @@
(* *)
(**************************************************************************)
open Proto_alpha
open Helpers_logger.Logger
exception No_error
open Isolate_helpers
let run (starting_block : Block.result): unit Proto_alpha.tzresult Lwt.t =
let run (starting_block : Block.result): unit proto_tzresult Lwt.t =
let open Proto_alpha.Error_monad in
let open Proto_alpha.Environment.Error_monad in
let init_tc = starting_block.tezos_context in
@ -151,8 +151,9 @@ let run (starting_block : Block.result): unit Proto_alpha.tzresult Lwt.t =
let main () =
let open Proto_alpha.Error_monad in
Init.main () >>=? fun starting_block ->
run starting_block >>= Assert.wrap
run starting_block
let tests = [
@ -160,5 +161,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
let module Test = Test.Make(Error_monad) in
Test.run "dsl." tests

32
src/proto_alpha/lib_protocol/test/test_isolate_endorsement.ml
View File

@ -7,6 +7,7 @@
(* *)
(**************************************************************************)
open Proto_alpha
let name = "Isolate Endorsement"
module Logger = Logging.Make(struct let name = name end)
@ -19,7 +20,8 @@ exception No_error
open Isolate_helpers
open Shorthands
open Proto_alpha.Environment.Error_monad
open Error_monad
let (>>?=) = Assert.(>>?=)
let test_wrong_slot endorse_a starting_block =
@ -27,9 +29,9 @@ let test_wrong_slot endorse_a starting_block =
| Proto_alpha.Baking.Invalid_endorsement_slot _ -> true
| _ -> false
in
starting_block >>=? endorse_a (-1) >>?= fun result ->
endorse_a (-1) starting_block >>?= fun result ->
Assert.economic_error ~msg: __LOC__ wrong_slot result ;
starting_block >>=? endorse_a 16 >>?= fun result ->
endorse_a 16 starting_block >>?= fun result ->
Assert.economic_error ~msg: __LOC__ wrong_slot result ;
return ()
@ -39,16 +41,14 @@ let test_wrong_delegate endorse_a starting_block =
| Proto_alpha.Baking.Wrong_delegate _ -> true
| _ -> false
in
starting_block >>=?
endorse_a 0 >>=? endorse_a 1 >>=? endorse_a 2 >>= Assert.wrap >>= fun result ->
endorse_a 0 starting_block >>=? endorse_a 1 >>=? endorse_a 2 >>= Assert.wrap >>= fun result ->
Assert.economic_error ~msg: __LOC__ wrong_delegate result ;
return ()
let test_endorsement_payment starting_block =
let test_endorsement_payment root =
let bootstrap_accounts = Account.bootstrap_accounts in
let open Proto_alpha.Tezos_context in
starting_block >>=? fun root ->
get_tc_full root >>=? fun tc ->
let level = Level.succ tc @@ Level.current tc in
Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) ->
@ -99,7 +99,7 @@ let test_endorsement_payment starting_block =
let test_multiple_endorsement (pred: Block.result) =
let open Proto_alpha.Tezos_context in
let tc = pred.tezos_context in
let level = Level.succ tc @@ Level.current tc in
let level = Level.current tc in
Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) ->
let endorser =
Misc.find_account Account.bootstrap_accounts
@ -133,16 +133,14 @@ let test_fitness (res: Block.result) =
let (>>=??) = Assert.(>>=??)
let main (): unit Error_monad.tzresult Lwt.t =
let main (): unit proto_tzresult Lwt.t =
let open Error_monad in
Init.main () >>=? fun sb ->
let starting_block = Proto_alpha.Error_monad.return sb in
test_endorsement_payment starting_block >>=?? fun () ->
test_wrong_endorsement starting_block >>=?? fun () ->
test_multiple_endorsement sb >>=?? fun () ->
test_fitness sb >>=?? fun () ->
Init.main () >>=? fun starting_block ->
test_endorsement_payment starting_block >>=? fun () ->
test_wrong_endorsement starting_block >>=? fun () ->
test_multiple_endorsement starting_block >>=? fun () ->
test_fitness starting_block >>=? fun () ->
return ()
let tests = [
@ -150,5 +148,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
let module Test = Test.Make(Error_monad) in
Test.run "endorsement." tests

20
src/proto_alpha/lib_protocol/test/test_isolate_michelson.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
open Proto_alpha
open Tezos_context
let name = "Isolate Michelson"
module Logger = Logging.Make(struct let name = name end)
@ -14,6 +16,10 @@ let section = Lwt_log.Section.make name
let () =
Lwt_log.Section.set_level section Lwt_log.Debug(*.Warning*)
let (//) = Filename.concat
let contract_path =
try Sys.argv.(1) with _ -> Filename.dirname Sys.executable_name // "contracts"
open Logger
open Isolate_helpers
@ -45,9 +51,8 @@ let program param ret st code =
let quote s = "\"" ^ s ^ "\""
let test parse_execute =
let dir_path = "test/contracts/" in
let test ?tc (file_name: string) (storage: string) (input: string) =
let full_path = dir_path ^ file_name ^ ".tz" in
let full_path = contract_path // file_name ^ ".tz" in
let file = Helpers_misc.read_file full_path in
let spaced_file = Str.global_replace (Str.regexp_string "\n") "\n " file in
let program = "{" ^ spaced_file ^ "}" in
@ -447,7 +452,6 @@ let test_example parse_execute sb =
let test_program parse_execute =
let open Error_monad in
let id_code = "code
{ DUP ;
PAIR ;
@ -476,14 +480,14 @@ let test_program parse_execute =
return ()
let main (): unit Error_monad.tzresult Lwt.t =
Init.main () >>=? fun sb ->
let main (): unit tzresult Lwt.t =
Init.main () >>=?? fun sb ->
let execute_code ?tc = Script.execute_code_pred ?tc sb in
let parse_execute ?tc code_str param_str storage_str =
let param = parse_param param_str in
let script = parse_script code_str storage_str in
execute_code ?tc script param >>=?? fun (ret, st, _, tc, nonce) ->
let contracts = Proto_alpha.Tezos_context.Contract.originated_contracts nonce in
let contracts = Contract.originated_contracts nonce in
return (ret, st, tc, contracts)
in
test_program parse_execute >>=? fun _x ->
@ -491,12 +495,10 @@ let main (): unit Error_monad.tzresult Lwt.t =
return ()
let tests = [
"main", (fun _ -> main ()) ;
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
let module Test = Test.Make(Tezos_error_monad.Error_monad) in
Test.run "michelson." tests

4
src/proto_alpha/lib_protocol/test/test_isolate_origination.ml
View File

@ -69,7 +69,7 @@ let test_delegation
let main (): unit Error_monad.tzresult Lwt.t =
Init.main () >>=? fun root ->
Init.main () >>=?? fun root ->
let originate ?(tc=root.tezos_context) ?baker ?spendable ?fee ?delegatable src amount =
let delegatable = Option.unopt ~default:true delegatable in
@ -103,5 +103,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
let module Test = Test.Make(Error_monad) in
Test.run "origination." tests

7
src/proto_alpha/lib_protocol/test/test_isolate_transaction.ml
View File

@ -151,15 +151,14 @@ let run (starting_block: Helpers.Block.result): unit tzresult Lwt.t =
let main () =
let open Error_monad in
Helpers.Init.main () >>=? fun starting_block ->
run starting_block >>= Assert.wrap
run starting_block
let tests = [
"main", (fun _ -> main ()) ;
"main", (fun _ -> main () >>= Assert.wrap) ;
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
let module Test = Test.Make(Error_monad) in
Test.run "transactions." tests

4
src/proto_alpha/lib_protocol/tezos-embedded-protocol-alpha.opam
View File

@ -9,11 +9,9 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta15" }
"tezos-test-helpers" { test }
"tezos-embedded-protocol-genesis" { test }
"tezos-base"
"tezos-protocol-compiler"
"tezos-protocol-updater"
"tezos-shell"
]
build: [
[ "rm" "jbuild" "src/jbuild" ]

3
src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam
View File

@ -9,7 +9,10 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta15" }
"tezos-base"
"tezos-protocol-compiler"
"tezos-test-helpers" { test }
"tezos-protocol-environment-client" { test }
]
build: [
[ "rm" "jbuild" "src/jbuild" ]