Last active
August 1, 2023 14:34
-
-
Save shubhamkumar13/29c70ac16315684b6188fdfa4775e897 to your computer and use it in GitHub Desktop.
testing lpm by comparing outputs with generated tz files
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Fpath = Fpath | |
| module OS = Bos.OS | |
| module Cmd = Bos.Cmd | |
| open Core | |
| let ( let* ) o f = Result.bind o ~f | |
| let get_tmp_dir () : string = OS.Dir.default_tmp () |> Fpath.to_string | |
| let rm_rf ~(path : string) : unit = | |
| OS.Dir.delete ~must_exist:true ~recurse:true (Fpath.v path) |> function | |
| | Ok () -> () | |
| | Error (`Msg s) -> raise @@ Failure s | |
| let create_tmp ~(path : string) : (string, [> Rresult.R.msg ]) result = | |
| let tmp_path = get_tmp_dir () ^ "/" ^ path in | |
| OS.Dir.create ~path:true (Fpath.v path) |> function | |
| | Ok _ -> Ok tmp_path | |
| | Error e -> Error e | |
| let output_file ~(path : string) : string = | |
| get_tmp_dir () ^ "/" ^ "output" ^ "/" ^ path ^ ".tz" | |
| let git_clone ~(repo : string) ~(dest : string) : Cmd.t = | |
| Cmd.(v "git" % "clone" % repo % dest) | |
| let cd ~(dir : string) : (unit, [> Rresult.R.msg ]) result = | |
| OS.Dir.set_current @@ Fpath.v dir | |
| (* let ligo_install_pkgs ~(package_dir : string) ~(cache_path : string) ~(baseurl : string) : (unit, [> Rresult.R.msg]) result = | |
| Lwt_main.run Install.run package_dir cache_path baseurl *) | |
| let ligo_install () : Cmd.t = Cmd.(v "ligo" % "install") | |
| let ligo_compile_contract ~(src : string) : Cmd.t = | |
| Cmd.(v "ligo" % "compile" % "contract" % src) | |
| let get_repo repo = "git@github.com:ligolang/" ^ repo ^ ".git" | |
| let find_main_contract : Fpath.t list -> (string, [> Rresult.R.msg ]) result = | |
| fun lst -> | |
| lst | |
| |> List.map ~f:Fpath.to_string | |
| |> List.filter ~f:(String.is_substring ~substring:"main") | |
| |> List.hd | |
| |> function | |
| | Some s -> Ok s | |
| | None -> Error (Rresult.R.msg "couldn't find main contract") | |
| let get_main_path ~(repo : string) : (string, [> Rresult.R.msg ]) result = | |
| let* lst = OS.Dir.contents Fpath.(v (repo ^ "/" ^ "src")) in | |
| find_main_contract lst | |
| let repos = [ | |
| "dao-jsligo"; | |
| "dao-cameligo"; | |
| "permit-jsligo"; | |
| "permit-cameligo"; | |
| ] | |
| let run_cmd_to_null : Cmd.t -> (unit, [> Rresult.R.msg ]) result = | |
| fun cmd -> OS.Cmd.(run_out cmd |> to_null) | |
| let run_cmd_to_string : Cmd.t -> (string, [> Rresult.R.msg ]) result = | |
| fun cmd -> OS.Cmd.(run_out cmd |> to_string ~trim:true) | |
| let package_dir = "." | |
| let cache_path = ".ligo" | |
| let ligo_registry = "https://packages.ligolang.org/-/api" | |
| let rec run_seq : string -> (string, [> Rresult.R.msg ]) result = | |
| fun repo -> | |
| (* create the tmp dir for the repo *) | |
| let* repo_dest = create_tmp ~path:repo in | |
| (* check if dir present, if true then delete and re-clone *) | |
| match OS.Dir.must_exist (Fpath.v repo_dest) with | |
| | Ok repo_dst -> | |
| rm_rf ~path:(Fpath.to_string repo_dst); | |
| run_seq repo | |
| (* run clone cmd*) | |
| | _ -> | |
| let* _ = | |
| run_cmd_to_null @@ git_clone ~repo:(get_repo repo) ~dest:repo_dest | |
| in | |
| (* cd the repo dir *) | |
| let* _ = cd ~dir:repo_dest in | |
| (* run ligo install *) | |
| (* ligo_install_pkgs ~package_dir ~cache_path ~ligo_registry >>= fun _ -> *) | |
| let* _ = run_cmd_to_null @@ ligo_install () in | |
| (* find the main.* file *) | |
| let* src = get_main_path ~repo:repo_dest in | |
| (* compile contract and save the output as a string *) | |
| let* s = run_cmd_to_string (ligo_compile_contract ~src) in | |
| Ok s | |
| let run : unit -> (string * string) list = | |
| fun () -> | |
| List.map ~f:(fun repo -> (repo, run_seq repo)) repos | |
| |> List.fold ~init:[] ~f:(fun init (repo, s) -> | |
| match s with | |
| | Ok s -> (repo, s) :: init | |
| | Error (`Msg msg) -> raise @@ Failure msg) | |
| let get_test_tz_files : path:string -> (string * string) list = | |
| fun ~path -> | |
| let path = Fpath.v path in | |
| OS.Dir.contents path |> function | |
| | Ok files -> | |
| List.map | |
| ~f:(fun file -> | |
| OS.File.read file |> function | |
| | Ok s -> ( | |
| let file = List.hd_exn @@ String.split ~on:'.' @@ List.last_exn @@ Fpath.segs file in | |
| (file, String.strip s)) | |
| | Error (`Msg msg) -> raise @@ Failure msg) | |
| files | |
| | Error (`Msg msg) -> raise @@ Failure msg | |
| let minify : string -> string = | |
| fun tz_file -> | |
| let is_uneccessary : char -> bool = | |
| fun c -> | |
| not | |
| (Char.equal c ' ' || Char.equal c '\t' || Char.equal c '\n' | |
| || Char.equal c '\r') | |
| in | |
| String.filter tz_file ~f:is_uneccessary | |
| module StringMap = Caml.Map.Make (struct type t = string let compare = String.compare end) | |
| let _ = | |
| let test_tz_files = | |
| List.map ~f:(fun (repo, s) -> (repo, minify s)) (get_test_tz_files ~path:"/home/sk/nuke/lpm_tests/tests/sample_install_tz_files") | |
| in | |
| let generated_tz_files = | |
| List.map ~f:(fun (repo, s) -> (repo, minify s)) @@ run () in | |
| List.iter2 ~f:(fun (repo_a, _) (repo_b, _) -> Printf.printf "%s %s\n" repo_a repo_b) test_tz_files generated_tz_files |> fun _ -> | |
| (* map of static sample test files *) | |
| let repo_test_map = Caml.List.to_seq test_tz_files |> StringMap.of_seq in | |
| (* map of generated test files *) | |
| let repo_gen_map = Caml.List.to_seq generated_tz_files |> StringMap.of_seq in | |
| (* assert between static samples and generated tests *) | |
| List.iter ~f:(fun repo -> assert (String.equal (StringMap.find repo repo_test_map) (StringMap.find repo repo_gen_map))) repos |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment