Merge branch 'dev' of gitlab.com:ligolang/ligo into rinderknecht-dev

.gitlab-ci.yml

@@ -11,6 +11,14 @@ stages:
   - build_and_deploy_docker
   - build_and_deploy_website
 
+# TODO provide sensible CI for master
+dont-merge-to-master:
+  stage: test
+  script:
+    - "false"
+  only:
+    - master
+
 .build_binary: &build_binary
   # To run in sequence and save CPU usage, use stage: build_and_package_binaries
   stage: test
@@ -95,6 +103,9 @@ local-dune-job:
   artifacts:
     paths:
       - _coverage_all
+  only:
+    - merge_requests
+    - dev
 
 # Run a docker build without publishing to the registry
 build-current-docker-image:
@@ -105,9 +116,8 @@ build-current-docker-image:
   script:
     - sh scripts/build_docker_image.sh
     - sh scripts/test_cli.sh
-  except:
+  only:
-    - master
+    - merge_requests
-    - dev
 
 # When a MR/PR is merged to dev
 # take the previous build and publish it to Docker Hub
@@ -135,6 +145,8 @@ build-and-package-debian-9:
     target_os: "debian"
     target_os_version: "9"
   <<: *build_binary
+  only:
+    - dev
 
 build-and-package-debian-10:
   <<: *docker
@@ -145,6 +157,12 @@ build-and-package-debian-10:
     target_os: "debian"
     target_os_version: "10"
   <<: *build_binary
+  # this one is merge_requests and dev, because the debian 10 binary
+  # is used for build-current-docker-image and for
+  # build-and-publish-latest-docker-image
+  only:
+    - merge_requests
+    - dev
 
 build-and-package-ubuntu-18-04:
   <<: *docker
@@ -155,6 +173,8 @@ build-and-package-ubuntu-18-04:
     target_os: "ubuntu"
     target_os_version: "18.04"
   <<: *build_binary
+  only:
+    - dev
 
 build-and-package-ubuntu-19-04:
   <<: *docker
@@ -165,11 +185,12 @@ build-and-package-ubuntu-19-04:
     target_os: "ubuntu"
     target_os_version: "19.04"
   <<: *build_binary
+  only:
+    - dev
 
-# Pages are deployed from both master & dev, be careful not to override 'next'
+# Pages are deployed from dev, be careful not to override 'next'
 # in case something gets merged into 'dev' while releasing.
 pages:
   <<: *website_build
   only:
-    - master
     - dev

src/bin/cli.ml

@@ -410,6 +410,19 @@ let dump_changelog =
   let doc = "Dump the LIGO changelog to stdout." in
   (Term.ret term , Term.info ~doc cmdname)
 
+let list_declarations =
+  let f source_file syntax =
+    toplevel ~display_format:(`Human_readable) @@
+    let%bind simplified_prg  = Compile.Of_source.compile source_file (Syntax_name syntax) in
+    let json_decl = List.map (fun decl -> `String decl) @@ Compile.Of_simplified.list_declarations simplified_prg in
+    ok @@ J.to_string @@ `Assoc [ ("source_file", `String source_file) ; ("declarations", `List json_decl) ]
+  in
+  let term =
+    Term.(const f $ source_file 0 $ syntax ) in
+  let cmdname = "list-declarations" in
+  let doc = "Subcommand: list all the top-level decalarations." in
+  (Term.ret term , Term.info ~doc cmdname)
+
 let run ?argv () =
   Term.eval_choice ?argv main [
     compile_file ;
@@ -425,5 +438,6 @@ let run ?argv () =
     print_cst ;
     print_ast ;
     print_typed_ast ;
-    print_mini_c
+    print_mini_c ;
+    list_declarations ;
   ]

src/bin/expect_tests/eval_value_tests.ml

@@ -1,10 +0,0 @@
-open Cli_expect
-
-let%expect_test _ =
-  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "a" ] ;
-  [%expect {|
-    {foo = +0 , bar = "bar"} |} ];
-
-  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "b" ] ;
-  [%expect {|
-    2 |} ]

src/bin/expect_tests/help_tests.ml

@@ -44,6 +44,9 @@ let%expect_test _ =
                Subcommand: interpret the expression in the context initialized by
                the provided source file.
 
+           list-declarations
+               Subcommand: list all the top-level decalarations.
+
            measure-contract
                Subcommand: measure a contract's compiled size in bytes.
 
@@ -117,6 +120,9 @@ let%expect_test _ =
                Subcommand: interpret the expression in the context initialized by
                the provided source file.
 
+           list-declarations
+               Subcommand: list all the top-level decalarations.
+
            measure-contract
                Subcommand: measure a contract's compiled size in bytes.
 

src/bin/expect_tests/misc_cli_commands.ml

@@ -0,0 +1,22 @@
+open Cli_expect
+
+(* evaluate-value *)
+let%expect_test _ =
+  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "a" ] ;
+  [%expect {|
+    {foo = +0 , bar = "bar"} |} ];
+
+  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "b" ] ;
+  [%expect {|
+    2 |} ]
+
+(* list-declarations *)
+let%expect_test _ =
+  run_ligo_good [ "list-declarations" ; "../../test/contracts/loop.ligo" ] ;
+  [%expect {| {"source_file":"../../test/contracts/loop.ligo","declarations":["inner_capture_in_conditional_block","dummy","nested_for_collection_local_var","nested_for_collection","for_collection_map_k","for_collection_map_kv","for_collection_empty","for_collection_with_patches","for_collection_comp_with_acc","for_collection_proc_call","for_collection_rhs_capture","for_collection_if_and_local_var","for_collection_set","for_collection_list","for_sum","while_sum","counter"]} |} ];
+
+  run_ligo_good [ "list-declarations" ; "../../test/contracts/loop.mligo" ] ;
+  [%expect {| {"source_file":"../../test/contracts/loop.mligo","declarations":["counter_nest","aux_nest","counter","counter_simple","aux_simple"]} |} ];
+
+  run_ligo_good [ "list-declarations" ; "../../test/contracts/loop.religo" ] ;
+  [%expect {| {"source_file":"../../test/contracts/loop.religo","declarations":["counter_nest","aux_nest","counter","counter_simple","aux_simple"]} |} ];

src/main/compile/of_simplified.ml

@@ -20,4 +20,14 @@ let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simpl
   ok applied
 
 let pretty_print formatter (program : Ast_simplified.program) = 
-  Ast_simplified.PP.program formatter program
+  Ast_simplified.PP.program formatter program
+
+let list_declarations (program : Ast_simplified.program) : string list =
+  List.fold_left
+    (fun prev el -> 
+      let open Location in
+      let open Ast_simplified in
+      match el.wrap_content with
+      | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
+      | _ -> prev) 
+    [] program

src/test/contracts/timelock_repeat.mligo

@@ -0,0 +1,22 @@
+type storage = {
+  next_use: timestamp;
+  interval: int;
+  execute: unit -> operation list;
+}
+
+let main (p,s: unit * storage) : operation list * storage =
+  (* Multiple calls to Current.time give different values *)
+  let now: timestamp = Current.time in
+  if now > s.next_use
+  then
+    let s: storage = {
+                      next_use = now + s.interval;
+                      interval = s.interval;
+                      execute = s.execute;
+                      }
+    in
+    (s.execute (), s)
+  else
+    (* TODO: Add the time until next use to this message *)
+    (failwith "You have to wait before you can execute this contract again.":
+       operation list * storage)

src/test/test.ml

@@ -14,5 +14,6 @@ let () =
     Multisig_v2_tests.main ;
     Replaceable_id_tests.main ;
     Time_lock_tests.main ;
+    Time_lock_repeat_tests.main ;
   ] ;
   ()

src/test/time_lock_repeat_tests.ml

@@ -0,0 +1,78 @@
+open Trace
+open Test_helpers
+open Ast_simplified
+
+let type_file f =
+  let%bind simplified  = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in
+  let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
+  ok @@ (typed,state)
+
+let get_program =
+  let s = ref None in
+  fun () -> match !s with
+    | Some s -> ok s
+    | None -> (
+        let%bind program = type_file "./contracts/timelock_repeat.mligo" in
+        s := Some program ;
+        ok program
+      )
+
+let compile_main () = 
+  let%bind simplified      = Ligo.Compile.Of_source.compile "./contracts/timelock_repeat.mligo" (Syntax_name "cameligo") in
+  let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
+  let%bind mini_c_prg      = Ligo.Compile.Of_typed.compile typed_prg in
+  let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
+  let%bind (_contract: Tezos_utils.Michelson.michelson) =
+    (* fails if the given entry point is not a valid contract *)
+    Ligo.Compile.Of_michelson.build_contract michelson_prg in
+  ok ()
+
+let empty_op_list =
+  (e_typed_list [] t_operation)
+let empty_message = e_lambda (Var.of_name "arguments")
+  (Some t_unit) (Some (t_list t_operation))
+  empty_op_list
+
+let call msg = e_constructor "Call" msg
+let mk_time st =
+  match Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation st with
+  | Some s -> ok s
+  | None -> simple_fail "bad timestamp notation"
+let to_sec t = Tezos_utils.Time.Protocol.to_seconds t
+let storage st interval execute =
+  e_ez_record [("next_use", e_timestamp (Int64.to_int @@ to_sec st)) ;
+               ("interval", e_int interval) ;
+               ("execute", execute)]
+
+let early_call () =
+  let%bind program,_ = get_program () in
+  let%bind predecessor_timestamp = mk_time "2000-01-01T00:10:10Z" in
+  let%bind lock_time = mk_time "2000-01-01T10:10:10Z" in
+  let init_storage = storage lock_time 86400 empty_message in
+  let options =
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
+  let exp_failwith = "You have to wait before you can execute this contract again." in
+  expect_string_failwith ~options program "main"
+    (e_pair (e_unit ())  init_storage) exp_failwith
+
+let fake_uncompiled_empty_message = e_string "[lambda of type: (lambda unit (list operation)) ]"
+
+(* Test that when we use the contract the next use time advances by correct interval *)
+let interval_advance () =
+  let%bind program,_ = get_program () in
+  let%bind predecessor_timestamp = mk_time "2000-01-01T10:10:10Z" in
+  let%bind lock_time = mk_time "2000-01-01T00:10:10Z" in
+  let init_storage = storage lock_time 86400 empty_message in
+  (* It takes a second for Current.now to be called, awful hack *)
+  let%bind new_timestamp = mk_time "2000-01-02T10:10:11Z" in
+  let new_storage_fake = storage new_timestamp 86400 fake_uncompiled_empty_message in
+  let options =
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
+  expect_eq ~options program "main"
+  (e_pair (e_unit ()) init_storage) (e_pair empty_op_list new_storage_fake)
+
+let main = test_suite "Time Lock Repeating" [
+    test "compile" compile_main ;
+    test "early call" early_call ;
+    test "interval advance" interval_advance ;
+  ]

src/test/time_lock_tests.ml

@@ -27,14 +27,14 @@ let compile_main () =
   ok ()
 
 open Ast_simplified
-let empty_op_list = 
+let empty_op_list =
   (e_typed_list [] t_operation)
 let empty_message = e_lambda (Var.of_name "arguments")
   (Some t_unit) (Some (t_list t_operation))
   empty_op_list
 
 let call msg = e_constructor "Call" msg
-let mk_time st = 
+let mk_time st =
   match Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation st with
   | Some s -> ok s
   | None -> simple_fail "bad timestamp notation"
@@ -66,4 +66,4 @@ let main = test_suite "Time lock" [
     test "compile" compile_main ;
     test "early call" early_call ;
     test "call on time" call_on_time ;
-  ]
+  ]