Skip to content

Commit

Permalink
removed all logging from the library, everything is done at top-level
Browse files Browse the repository at this point in the history
  • Loading branch information
@AdrienChampion
AdrienChampion committed Mar 1, 2019
1 parent 375c0cb commit 8609e4b
Show file tree
Hide file tree
Showing 18 changed files with 199 additions and 130 deletions.
8 changes: 8 additions & 0 deletions docs/user_doc/print.html
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1319,6 +1319,10 @@ <h1 class="menu-title">Techelson User Documentation</h1>
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root

failure confirmed on test operation
MUST_FAIL[uid:4] _ (TRANSFER[uid:3] address[0]@MustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin)))
while running operation TRANSFER[uid:3] address[0]@MustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin))
failed with value &quot;illegal access to admin account&quot; : string
=&gt; live contracts: &lt;anonymous&gt; (0utz) address[2]@new_admin
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root
Expand Down Expand Up @@ -1405,6 +1409,10 @@ <h1 class="menu-title">Techelson User Documentation</h1>
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root

failure confirmed on test operation
MUST_FAIL[uid:4] &quot;illegal access to admin account&quot; : string (TRANSFER[uid:3] address[0]@PreciseMustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin)))
while running operation TRANSFER[uid:3] address[0]@PreciseMustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin))
failed with value &quot;illegal access to admin account&quot; : string
=&gt; live contracts: &lt;anonymous&gt; (0utz) address[2]@new_admin
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root
Expand Down
2 changes: 1 addition & 1 deletion docs/user_doc/searchindex.js
View file

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion docs/user_doc/searchindex.json
View file

Large diffs are not rendered by default.

8 changes: 8 additions & 0 deletions docs/user_doc/testing/failures.html
View file
Original file line number Diff line number Diff line change
Expand Up @@ -507,6 +507,10 @@ <h1 class="menu-title">Techelson User Documentation</h1>
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root

failure confirmed on test operation
MUST_FAIL[uid:4] _ (TRANSFER[uid:3] address[0]@MustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin)))
while running operation TRANSFER[uid:3] address[0]@MustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin))
failed with value &quot;illegal access to admin account&quot; : string
=&gt; live contracts: &lt;anonymous&gt; (0utz) address[2]@new_admin
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root
Expand Down Expand Up @@ -593,6 +597,10 @@ <h1 class="menu-title">Techelson User Documentation</h1>
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root

failure confirmed on test operation
MUST_FAIL[uid:4] &quot;illegal access to admin account&quot; : string (TRANSFER[uid:3] address[0]@PreciseMustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin)))
while running operation TRANSFER[uid:3] address[0]@PreciseMustFail -&gt; address[3]@admins 0utz (&quot;root&quot;, (&quot;new_admin&quot;, address[2]@new_admin))
failed with value &quot;illegal access to admin account&quot; : string
=&gt; live contracts: &lt;anonymous&gt; (0utz) address[2]@new_admin
Admins (0utz) address[3]@admins
&lt;anonymous&gt; (0utz) address[1]@root
Expand Down
4 changes: 0 additions & 4 deletions src/1_base/dtypCheck.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,8 +44,6 @@ let rec check (t_1 : Dtyp.t) (t_2 : Dtyp.t) =
|> Exc.throw
in

(* log_0 "type-checking@. %a@. %a@." Dtyp.fmt t_1 Dtyp.fmt t_2; *)

annot_check t_1.alias t_2.alias bail;

match t_1.typ, t_2.typ with
Expand Down Expand Up @@ -116,8 +114,6 @@ let unify (cxt : t) (t_1 : Dtyp.t) (t_2 : Dtyp.t) : unit =
|> Exc.throw
in

(* log_0 "type-checking@. %a@. %a@." Dtyp.fmt t_1 Dtyp.fmt t_2; *)

let rec loop (to_do : (Dtyp.t * Dtyp.t) list) =
match to_do with
| [] -> ()
Expand Down
7 changes: 0 additions & 7 deletions src/1_base/expand.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,22 +143,18 @@ module PairHelp = struct
(to_do : Mic.Macro.pair_op list)
: tree
=
(* log_1 "down (%i)@." (List.length to_do); *)
match to_do with

(* Going up from the left branch. *)
| A :: to_do ->
(* log_1 " A@."; *)
go_up stack to_do LeafA

(* Going up from the right branch. *)
| I :: to_do ->
(* log_1 " I@."; *)
go_up stack to_do LeafI

(* Go down the left part of a pair constructor. *)
| P :: to_do ->
(* log_1 " P@."; *)
go_down (PairLeft :: stack) to_do

| [] -> bail_pair 1
Expand All @@ -170,17 +166,14 @@ module PairHelp = struct
(tree : tree)
: tree
=
(* log_1 "up %a@." fmt_tree tree; *)
match stack with

(* Going up a left branch, need to go down the left branch now. *)
| PairLeft :: stack ->
(* log_1 " P left@."; *)
go_down ((PairRight tree) :: stack) to_do

(* Going up a right branch from a pair constructor. *)
| (PairRight left_branch) :: stack ->
(* log_1 " P right@."; *)
go_up stack to_do (Pair (left_branch, tree))

(* Reached the top of the stack, there should be no operator left. *)
Expand Down
1 change: 0 additions & 1 deletion src/2_parse/mic.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -191,7 +191,6 @@ let rec parse
let args = args_to_mic args in
match Mic.leaf_of_string token with
| Some leaf -> (
(* log_1 "token: `%s` (%i)@." token (List.length args); *)
let typ_arity, var_arity, field_arity = Mic.annot_arity_of_leaf leaf in
param_arity_check 0 0;
annot_arity_check typ_arity var_arity field_arity;
Expand Down
1 change: 0 additions & 1 deletion src/3_testgen/test.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -87,7 +87,6 @@ and generate_contract (param : Dtyp.t) : Mic.t list =
let generate (contract : Contract.t) (name : string) : Testcase.t =
(* Creates a storage value. *)
let make_storage () : Mic.t =
(* log_0 "making storage for %a@." Dtyp.fmt contract.storage; *)
Values.from generate_contract generate_address contract.storage
|> Mic.mk_seq
|> Mic.comments [ sprintf "creating storage for contract `%s`" contract.name ]
Expand Down
9 changes: 0 additions & 9 deletions src/3_testgen/values.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,6 @@ let hash () : Mic.t =
| 1 -> Mic.Blake2B
| 2 -> Mic.Sha256
| 3 -> Mic.Sha512
(* | n -> log_0 "n: %i@." n ; Exc.unreachable () *)
| _ -> Exc.unreachable ()
)
|> Mic.mk_leaf
Expand Down Expand Up @@ -140,7 +139,6 @@ let from
: Mic.t list
=
let rec go_down (stack : stack) (current : (Dtyp.t, Mic.t list) Either.t) : Mic.t list =
(* log_4 "go down %a@." Dtyp.fmt dtyp; *)
match current with
| Either.Rgt mic -> go_up stack mic
| Either.Lft dtyp -> (
Expand Down Expand Up @@ -177,10 +175,8 @@ let from
let mic_pref, to_do, (mic_suff, next) =
[], [], (
if Rng.bool () then (
(* log_4 "> left@."; *)
(Mic.Left rgt.inner |> Mic.mk) :: mic_suff, lft.inner
) else (
(* log_4 "> right@."; *)
(Mic.Right lft.inner |> Mic.mk) :: mic_suff, rgt.inner
)
)
Expand Down Expand Up @@ -289,21 +285,16 @@ let from
)

and go_up (stack : stack) (current : Mic.t list) : Mic.t list =
(* log_4 "current : %a@." Mic.fmt (Mic.mk_seq current); *)

match stack with
| [] -> current

| { to_do = next :: to_do ; mic_pref ; mic_suff } :: stack_tail ->
(* log_4 " pref 1: %a@." Mic.fmt (Mic.mk_seq mic_pref); *)
(* log_4 " suff 1: %a@." Mic.fmt (Mic.mk_seq mic_suff); *)
let mic_pref = List.rev_append current mic_pref in
let stack = { to_do ; mic_pref ; mic_suff } :: stack_tail in
go_down stack next

| { to_do = [] ; mic_pref ; mic_suff } :: stack ->
(* log_4 " pref 2: %a@." Mic.fmt (Mic.mk_seq mic_pref); *)
(* log_4 " suff 2: %a@." Mic.fmt (Mic.mk_seq mic_suff); *)
current @ mic_suff |> List.rev_append mic_pref |> go_up stack

in
Expand Down
5 changes: 0 additions & 5 deletions src/4_theory/bigArith.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -158,11 +158,6 @@ module PTStampConv = struct

let int_to_tstamp (i : int) : t_stamp =
let span = Z.to_float i |> Ptime.Span.of_float_s in
(* (
match span with
| None -> log_0 "none@."
| Some f -> log_0 "some %a@." Ptime.Span.pp f
); *)
match span |> Opt.and_then (PTStamp.now () |> Ptime.add_span) with
| Some res -> res
| None -> asprintf "failed to convert integer %a to timestamp" BInt.fmt i |> Exc.throw
Expand Down
103 changes: 53 additions & 50 deletions src/7_test/load.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,16 +3,42 @@
open Base
open Common

type error_count = int
type error_list = Exc.exc list
let fmt_error_list (fmt : formatter) (errs : error_list) : unit =
errs |> List.iter (
fun e -> fprintf fmt "@[<v>%a@]" Exc.fmt (Exc.Exc e)
)

type errors = {
contracts : error_list ;
testcases : error_list ;
}
let has_errors (self : errors) : bool =
self.contracts <> [] || self.testcases <> []
let fmt_errors (fmt : formatter) (self : errors) : unit =
let sep =
if self.contracts <> [] then (
fprintf fmt "on contracts: %a" fmt_error_list self.contracts;
fun () -> fprintf fmt "@ "
) else (
ignore
)
in
if self.testcases <> [] then (
sep ();
fprintf fmt "on testcases: %a" fmt_error_list self.testcases
)
let error_count (self : errors) : int = List.length self.contracts + List.length self.testcases

let of_source (src : Source.t list) : in_channel list * error_count =
let of_source (src : Source.t list) : in_channel list * error_list =
Lst.fold (
fun (res, err_count) src ->
let () = log_3 "extracting input channel from %a.@." Source.fmt src in
match Exc.catch_print (fun () -> Source.to_channel src) with
| None -> log_0 "@." ; res, err_count + 1
| Some chan -> res @ [chan], err_count
) ([], 0) src
fun (res, err_list) src ->
try (
let chan = Source.to_channel src in
res @ [chan], err_list
) with
| (Exc.Exc e) -> res, err_list @ [e]
) ([], []) src

let contract (name : string) (source : Source.t) (chan : in_channel) : Contract.t =
let lexbuf = Lexing.from_channel chan in
Expand Down Expand Up @@ -77,29 +103,25 @@ let load_map
(files : 'a list)
(file : 'a -> string)
(f : 'a -> in_channel -> 'b)
: 'b list * error_count
: 'b list * error_list
=
files |> List.fold_left (
fun (acc, err_count) data ->
let file = file data in
let () = log_3 "loading file %s...@." file in
let load () = open_file file |> f data in
match
(
fun () -> load |> Exc.chain_err (
fun () -> sprintf "while loading %s file `%s`" desc file
fun (acc, err_list) data ->
try (
let stuff =
(fun () -> file data |> open_file |> f data) |> Exc.chain_err (
fun () -> sprintf "while loading %s file `%s`" desc (file data)
)
)
|> Exc.catch_print
with
| None -> log_3 "failed@." ; acc, err_count + 1
| Some stuff -> log_3 "success@." ; stuff :: acc, err_count
) ([], 0)
|> fun (result, count) ->
assert (count + List.length result = List.length files);
(List.rev result), count
in
acc @ [stuff], err_list
) with
| Exc.Exc e -> acc, err_list @ [e]
) ([], [])
|> fun (result, errors) ->
assert (List.length errors + List.length result = List.length files);
result, errors

let contracts (files : Conf.contract list) : Contract.t list * error_count =
let contracts (files : Conf.contract list) : Contract.t list * error_list =
load_map "contract" files (fun contract -> contract.Conf.file) (
fun c chan ->
let file = c.Conf.file in
Expand All @@ -108,7 +130,7 @@ let contracts (files : Conf.contract list) : Contract.t list * error_count =
contract name src chan
)

let tests (files : string list) : Testcase.t list * error_count =
let tests (files : string list) : Testcase.t list * error_list =
load_map "test" files id (
fun file chan ->
let name = Contract.name_of_file file in
Expand All @@ -127,29 +149,10 @@ let scenario
let context
~(contract_files : Conf.contract list)
~(test_files : string list)
: Testcases.t * error_count
: Testcases.t * errors
=
let contract_count = List.length contract_files in
if contract_count > 0 then (
log_2 "loading %i contract file%s@." contract_count (Fmt.plurify contract_count)
);
let contracts, c_errors = contracts contract_files in

let test_count = List.length test_files in
if test_count > 0 then (
log_2 "loading %i test file%s@." test_count (Fmt.plurify test_count)
);
let tests, t_errors = tests test_files in
if c_errors + t_errors > 0 then (
if c_errors > 0 then (
log_0 "%i error%s occured during contract loading@." c_errors (Fmt.plurify c_errors)
);
if t_errors > 0 then (
log_0 "%i error%s occured during testcase loading@." t_errors (Fmt.plurify t_errors)
);
log_0 "@."
);

let errors = { contracts = c_errors ; testcases = t_errors } in
let cxt = Testcases.of_raw contracts tests in

cxt, c_errors + t_errors
cxt, errors
37 changes: 29 additions & 8 deletions src/7_test/load.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,13 +3,34 @@
open Base
open Common

(** Number of errors found during loading.
(** A list of errors in the form of exceptions. *)
type error_list = Exc.exc list

Functions returning this metric print the error. *)
type error_count = int
(** Formats a list of errors as a vertical block. *)
val fmt_error_list : formatter -> error_list -> unit

(** Errors during contract/testcase loading. *)
type errors = {
contracts : error_list ;
(** Errors during contract loading. *)
testcases : error_list ;
(** Errors during testcase loading. *)
}

(** True if there is one error or more. *)
val has_errors : errors -> bool

(** Formats load errors.
The output may have line breaks `@ `, but the surrounding block is left to the caller.
*)
val fmt_errors : formatter -> errors -> unit

(** Number of errors. *)
val error_count : errors -> int

(** Loads some files. *)
val of_source : Source.t list -> in_channel list * error_count
val of_source : Source.t list -> in_channel list * error_list

(** Loads a contract.
Expand All @@ -27,16 +48,16 @@ val test : string -> Source.t -> in_channel -> Testcase.t
`contracts files constructor`
*)
val contracts : Conf.contract list -> Contract.t list * error_count
val contracts : Conf.contract list -> Contract.t list * error_list

(** Loads some tests.
`tests files constructor`
*)
val tests : string list -> Testcase.t list * error_count
val tests : string list -> Testcase.t list * error_list

(** Loads a ful context. *)
(** Loads a full context: contracts and testcases. *)
val context :
contract_files : Conf.contract list ->
test_files : string list ->
Testcases.t * error_count
Testcases.t * errors
Loading

0 comments on commit 8609e4b

Please sign in to comment.