this repo has no description
Test
+143
-40
+48
-31
lib/impl.ml
+48
-31
lib/impl.ml
···
7
7
8
8
let modname_of_id id = "Cell__" ^ id
9
9
10
+
let is_mangled_broken orig src =
11
+
String.length orig <> String.length src
12
+
(* ||
13
+
Seq.exists2 (fun c c' ->
14
+
(c' = ' ' || c = c')) (String.to_seq orig) (String.to_seq src) *)
15
+
16
+
let mangle_toplevel is_toplevel orig_source deps =
17
+
let src =
18
+
if not is_toplevel then
19
+
orig_source
20
+
else
21
+
if
22
+
String.length orig_source < 2 || orig_source.[0] <> '#' || orig_source.[1] <> ' '
23
+
then (Logs.err (fun m -> m "xx Warning, ignoring toplevel block without a leading '# '.\n%!"); orig_source)
24
+
else begin
25
+
try
26
+
let s = String.sub orig_source 2 (String.length orig_source - 2) in
27
+
let list = Ocamltop.parse_toplevel s in
28
+
let buff = Buffer.create 100 in
29
+
List.iter (fun (phr, junk, output) ->
30
+
Printf.bprintf buff " %s%s\n" phr (String.make (String.length junk) ' ');
31
+
let s = List.map (fun x ->
32
+
Printf.sprintf "%s" (String.make (String.length x) ' ')) output
33
+
in
34
+
Buffer.add_string buff (String.concat "\n" s);
35
+
()) list;
36
+
Buffer.contents buff
37
+
with e ->
38
+
Logs.err (fun m -> m "Error in mangle_toplevel: %s" (Printexc.to_string e));
39
+
let ppf = Format.err_formatter in
40
+
let _ = Location.report_exception ppf e in
41
+
orig_source
42
+
end
43
+
in
44
+
let line1 = List.map (fun id ->
45
+
Printf.sprintf "open %s" (modname_of_id id)) deps |> String.concat " " in
46
+
let line1 = line1 ^ ";;\n" in
47
+
Logs.debug (fun m -> m "Line1: %s\n%!" line1);
48
+
Logs.debug (fun m -> m "Source: %s\n%!" src);
49
+
if is_mangled_broken orig_source src
50
+
then (
51
+
Printf.printf "Warning: mangled source is broken\n%!";
52
+
Printf.printf "orig length: %d\n%!" (String.length orig_source);
53
+
Printf.printf "src length: %d\n%!" (String.length src);
54
+
failwith "broken"
55
+
);
56
+
line1, src
57
+
10
58
module JsooTopPpx = struct
11
59
open Js_of_ocaml_compiler.Stdlib
12
60
···
673
721
Some (from, to_, wdispatch source query)
674
722
end
675
723
676
-
let mangle_toplevel is_toplevel orig_source deps =
677
-
let src =
678
-
if not is_toplevel then
679
-
orig_source
680
-
else
681
-
if
682
-
String.length orig_source < 2 || orig_source.[0] <> '#' || orig_source.[1] <> ' '
683
-
then (Logs.err (fun m -> m "xx Warning, ignoring toplevel block without a leading '# '.\n%!"); orig_source)
684
-
else begin
685
-
try
686
-
let s = String.sub orig_source 2 (String.length orig_source - 2) in
687
-
let list = Ocamltop.parse_toplevel s in
688
-
let buff = Buffer.create 100 in
689
-
List.iter (fun (phr, junk, output) ->
690
-
Printf.bprintf buff " %s%s\n" phr (String.make (String.length junk) ' ');
691
-
List.iter (fun x ->
692
-
Printf.bprintf buff " %s\n" (String.make (String.length x) ' ')) output) list;
693
-
Buffer.contents buff
694
-
with e ->
695
-
Logs.err (fun m -> m "Error in mangle_toplevel: %s" (Printexc.to_string e));
696
-
let ppf = Format.err_formatter in
697
-
let _ = Location.report_exception ppf e in
698
-
orig_source
699
-
end
700
-
in
701
-
let line1 = List.map (fun id ->
702
-
Printf.sprintf "open %s" (modname_of_id id)) deps |> String.concat " " in
703
-
let line1 = line1 ^ ";;\n" in
704
-
Logs.debug (fun m -> m "Line1: %s\n%!" line1);
705
-
Logs.debug (fun m -> m "Source: %s\n%!" src);
706
-
line1, src
707
724
708
725
let complete_prefix _id _deps is_toplevel source position =
709
726
try begin
+1
-1
lib/ocamltop.ml
+1
-1
lib/ocamltop.ml
+6
-3
lib/toplexer.mll
+6
-3
lib/toplexer.mll
···
7
7
| ((_ # '\n')* as junk) {
8
8
(junk, (false, false, []))
9
9
}
10
-
| eof { ("", (false, false, [])) }
10
+
| ((_ # '\n')* as junk) eof { (junk, (false, false, [])) }
11
11
12
12
and line_prefix acc = parse
13
13
| " " {
···
25
25
26
26
and line acc = parse
27
27
| ((_ # '\n')* as line) "\n" {
28
-
line_prefix (line :: acc) lexbuf
28
+
line_prefix ((" "^line) :: acc) lexbuf
29
29
}
30
30
| ((_ # '\n')* as line) eof {
31
-
false, false, List.rev (line :: acc)
31
+
false, false, List.rev ((" "^line) :: acc)
32
32
}
33
33
34
34
and output_line_legacy c acc = parse
···
37
37
}
38
38
| ((_ # '\n')* as line) "\n" (_ as c') {
39
39
output_line_legacy c' ((String.make 1 c ^ line) :: acc) lexbuf
40
+
}
41
+
| ((_ # '\n')* as line) "\n" eof {
42
+
false, true, List.rev ("" :: (String.make 1 c ^ line) :: acc)
40
43
}
41
44
| (_ # '\n')* as line eof {
42
45
false, true, List.rev ((String.make 1 c ^ line) :: acc)
+3
-2
test/libtest/dune
+3
-2
test/libtest/dune
+85
-3
test/libtest/parse_test.ml
+85
-3
test/libtest/parse_test.ml
···
3
3
Format.fprintf ppf "(%a,%a,%a)" f1 v1 f2 v2 f3 v3
4
4
let fmt = Fmt.Dump.(list (triple string string (list string)))
5
5
6
-
let _ =
7
-
let phr = Js_top_worker.Ocamltop.parse_toplevel "# foo;; junk\n bar\n# baz;;\n moo\n# unterminated;; foo" in
8
-
Format.printf "%a" fmt phr;
6
+
let print phr =
7
+
Format.printf "%a" fmt phr
8
+
9
+
let check phrase =
10
+
let output = snd (Js_top_worker.Impl.mangle_toplevel true phrase []) in
11
+
print_endline "input:";
12
+
print_endline phrase;
13
+
print_endline "output:";
14
+
print_endline output;
15
+
let output_mapped = String.map (fun c -> if c = ' ' then '.' else c) output in
16
+
print_endline "output mapped:";
17
+
print_endline output_mapped
18
+
19
+
let%expect_test _ =
20
+
check "# foo;; junk\n bar\n# baz;;\n moo\n# unterminated;; foo\n";
21
+
[%expect.unreachable]
22
+
[@@expect.uncaught_exn {|
23
+
(* CR expect_test_collector: This test expectation appears to contain a backtrace.
24
+
This is strongly discouraged as backtraces are fragile.
25
+
Please change this test to not include a backtrace. *)
26
+
27
+
(Failure broken)
28
+
Called from unknown location
29
+
Called from unknown location
30
+
Called from unknown location
31
+
Called from unknown location
32
+
33
+
Trailing output
34
+
---------------
35
+
Warning: mangled source is broken
36
+
orig length: 54
37
+
src length: 52 |}]
38
+
39
+
let%expect_test _ =
40
+
check "# 1+2;;\n- 3 : int\n \n";
41
+
[%expect{|
42
+
input:
43
+
# 1+2;;
44
+
- 3 : int
45
+
46
+
47
+
output:
48
+
1+2;;
49
+
50
+
51
+
52
+
output mapped:
53
+
..1+2;;
54
+
.........
55
+
.. |}]
56
+
57
+
let%expect_test _ =
58
+
check "# 1+2;;";
59
+
[%expect.unreachable]
60
+
[@@expect.uncaught_exn {|
61
+
(* CR expect_test_collector: This test expectation appears to contain a backtrace.
62
+
This is strongly discouraged as backtraces are fragile.
63
+
Please change this test to not include a backtrace. *)
64
+
65
+
(Failure broken)
66
+
Called from unknown location
67
+
Called from unknown location
68
+
Called from unknown location
69
+
Called from unknown location
70
+
71
+
Trailing output
72
+
---------------
73
+
Warning: mangled source is broken
74
+
orig length: 7
75
+
src length: 8 |}]
76
+
77
+
let%expect_test _ =
78
+
check "# 1+2;;\nx\n";
79
+
[%expect{|
80
+
input:
81
+
# 1+2;;
82
+
x
83
+
84
+
output:
85
+
1+2;;
86
+
87
+
88
+
output mapped:
89
+
..1+2;;
90
+
. |}]