test passing

src/passes/12-compiler/compiler_program.ml

@@ -23,6 +23,16 @@ them. please report this to the developers." in
       [ ("location", fun () -> loc) ;
       ] in
     error ~data title content
+
+  let raw_michelson_parsing_error code =
+    let title () = "Error while parsing Michelson code insertion" in
+    let content () = "Unable to parse the michelson code" in
+    let data = [ 
+      ("code", fun () -> code);
+      (* TODO : add location in Mini-c *)
+      (* ("location", fun () -> Format.asprintf "%a" Location.pp location); *)
+    ] in
+    error ~data title content
 end
 open Errors
 
@@ -484,7 +494,9 @@ and translate_expression (expr:expression) (env:environment) : michelson result
       ]
     )
   | E_raw_michelson (code, type_anno) -> 
-      let code = trace_tzresult (simple_error "lol") @@
+      let r = Str.regexp "^{|\\(.*\\)|}$\\|^\"\\(.*\\)\"" in
+      let code = Str.replace_first r "{\\1}" code in (*remplace the string quotes or varbatim symbol by michelson's code delimiters  *)
+      let%bind code = Proto_alpha_utils.Trace.trace_tzresult (raw_michelson_parsing_error code) @@
       Tezos_micheline.Micheline_parser.no_parsing_error @@ Michelson_parser.V1.parse_expression ~check:false code in
       let code = Tezos_micheline.Micheline.root code.expanded in
       let%bind ty = Compiler_type.type_ type_anno in

src/test/contracts/michelson_insertion.ligo

@@ -1,4 +1,5 @@
 // Test michelson insertion in PascaLIGO
 
-function michelson_add (var n : nat) : nat is
+function michelson_add (var n : nat * nat ) : nat is block {
-  [%Michelson {| DUP;ADD |} : nat -> nat ]
+  const f : (nat * nat -> nat)= [%Michelson ({| UNPAIR; ADD |} : nat *nat -> nat)];
+} with f (n)

src/test/contracts/michelson_insertion.mligo

@@ -1,5 +1,4 @@
 // Test michelson insertion in CameLIGO
 
-let michelson_add (n : nat) : nat =
+let michelson_add (n : nat * nat) : nat =
-  let f : nat -> nat = [%Michelson ({| DUP;ADD |} : nat -> nat) ] in
+  [%Michelson ({| UNPAIR;ADD |} : nat * nat -> nat) ] n
-  f n

src/test/contracts/michelson_insertion.religo

@@ -1,4 +1,4 @@
 // Test michelson insertion in ReasonLIGO
 
-let michelson_add = (n : nat) : nat =>
+let michelson_add = (n : (nat, nat)) : nat =>
-  [%Michelson {| DUP;ADD |} : nat => nat ]
+  [%Michelson ({| UNPAIR;ADD |} : ((nat, nat) => nat)) ](n);

src/test/integration_tests.ml

@@ -1759,6 +1759,21 @@ let fibo_mligo () : unit result =
   let make_expected = (e_int 42) in
   expect_eq program "main" make_input make_expected
 
+let michelson_insertion program : unit result =
+  let%bind program = program in
+  let make_input = fun n -> e_pair (e_nat n) (e_nat 1) in
+  let make_expected = fun n -> e_nat (n+1) in
+  expect_eq_n_pos program "michelson_add" make_input make_expected
+
+let michelson_insertion_ligo () : unit result =
+  michelson_insertion @@ type_file "./contracts/michelson_insertion.ligo"
+
+let michelson_insertion_mligo () : unit result =
+  michelson_insertion @@ mtype_file "./contracts/michelson_insertion.mligo"
+
+let michelson_insertion_religo () : unit result =
+  michelson_insertion @@ retype_file "./contracts/michelson_insertion.religo"
+
 let website1_ligo () : unit result =
   let%bind program = type_file "./contracts/website1.ligo" in
   let make_input = fun n-> e_pair (e_int n) (e_int 42) in
@@ -2519,6 +2534,9 @@ let main = test_suite "Integration (End to End)" [
     (* test "fibo2 (mligo)" fibo2_mligo ; *)
     (* test "fibo3 (mligo)" fibo3_mligo ; *)
     (* test "fibo4 (mligo)" fibo4_mligo ; *)
+    test "michelson inserion ligo" michelson_insertion_ligo;
+    test "michelson inserion mligo" michelson_insertion_mligo;
+    test "michelson inserion religo" michelson_insertion_religo;
     test "website1 ligo" website1_ligo ;
     test "website2 ligo" website2_ligo ;
     test "website2 (mligo)" website2_mligo ;