blob: d1225ed0e31f44f94c9fd37443c22c985756d080 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
(* TEST
ocamllex_flags = "-q"
*)
{
}
let ws = [' ''\t']
let nl = '\n'
let constr = ['A'-'Z']['a'-'z''A'-'Z''0'-'9''_']*
let int = ['0'-'9']+
let mnemo = ['a'-'z']['a'-'z''-']*['a'-'z']
rule seek_let_number_function = parse
| ws* "let" ws+ "number" ws* "=" ws* "function" ws* '\n'
{ () }
| [^'\n']* '\n'
{ seek_let_number_function lexbuf }
and constructors = parse
| ws* '|' ws* (constr as c) (ws* '_')? ws* "->" ws* (int as n) [^'\n']* '\n'
{ (c, int_of_string n) :: constructors lexbuf }
| ws* ";;" ws* '\n'
{ [] }
and mnemonics = parse
| ws* (int as n) ws+ '[' (mnemo as s) ']' [^'\n']* '\n'
{ (s, int_of_string n) :: mnemonics lexbuf }
| [^'\n']* '\n'
{ mnemonics lexbuf }
| eof
{ [] }
{
let ocamlsrcdir = Sys.getenv "ocamlsrcdir"
let ocamlrun = Sys.getenv "ocamlrun"
let constructors =
let ic = open_in Filename.(concat ocamlsrcdir (concat "utils" "warnings.ml")) in
Fun.protect ~finally:(fun () -> close_in_noerr ic)
(fun () ->
let lexbuf = Lexing.from_channel ic in
seek_let_number_function lexbuf;
constructors lexbuf
)
let mnemonics =
let stdout = "warn-help.out" in
let n =
Sys.command
Filename.(quote_command ~stdout
ocamlrun [concat ocamlsrcdir "ocamlc"; "-warn-help"])
in
assert (n = 0);
let ic = open_in stdout in
Fun.protect ~finally:(fun () -> close_in_noerr ic)
(fun () ->
let lexbuf = Lexing.from_channel ic in
mnemonics lexbuf
)
let mnemonic_of_constructor s =
String.map (function '_' -> '-' | c -> Char.lowercase_ascii c) s
let deprecated_warnings = function
| 3 | 25 | 31 -> true
| _ -> false
let () =
List.iter (fun (s, n) ->
let f (c, m) = mnemonic_of_constructor c = s && n = m in
match List.exists f constructors, deprecated_warnings n with
| true, false -> ()
| false, true -> ()
| false, false ->
Printf.printf "Could not find constructor corresponding to mnemonic %S (%d)\n%!" s n
| true, true ->
Printf.printf "Found constructor for deprecated warnings %S (%d)\n%!" s n
) mnemonics
let _ =
List.fold_left (fun first (c, m) ->
if List.mem (mnemonic_of_constructor c, m) mnemonics then first
else begin
if first then print_endline "Constructors without associated mnemonic:";
print_endline c;
false
end
) true constructors
}
|
