2 * Copyright (C) 2009-2010 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 (* Please read generator/README first. *)
23 open Generator_actions
25 (* Check function names etc. for consistency. *)
27 let contains_uppercase str =
28 let len = String.length str in
30 if i >= len then false
33 if c >= 'A' && c <= 'Z' then true
40 (* Check function names. *)
42 fun (name, _, _, _, _, _, _) ->
43 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
44 failwithf "function name %s does not need 'guestfs' prefix" name;
46 failwithf "function name is empty";
47 if name.[0] < 'a' || name.[0] > 'z' then
48 failwithf "function name %s must start with lowercase a-z" name;
49 if String.contains name '-' then
50 failwithf "function name %s should not contain '-', use '_' instead."
52 ) (all_functions @ fish_commands);
54 (* Check function parameter/return names. *)
56 fun (name, style, _, _, _, _, _) ->
57 let check_arg_ret_name n =
58 if contains_uppercase n then
59 failwithf "%s param/ret %s should not contain uppercase chars"
61 if String.contains n '-' || String.contains n '_' then
62 failwithf "%s param/ret %s should not contain '-' or '_'"
65 failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
66 if n = "int" || n = "char" || n = "short" || n = "long" then
67 failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
68 if n = "i" || n = "n" then
69 failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
70 if n = "argv" || n = "args" then
71 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
73 (* List Haskell, OCaml and C keywords here.
74 * http://www.haskell.org/haskellwiki/Keywords
75 * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
76 * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
77 * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
78 * |perl -pe 's/(.+)/"$1";/'|fmt -70
79 * Omitting _-containing words, since they're handled above.
80 * Omitting the OCaml reserved word, "val", is ok,
81 * and saves us from renaming several parameters.
84 "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
85 "char"; "class"; "const"; "constraint"; "continue"; "data";
86 "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
87 "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
88 "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
89 "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
90 "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
92 "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
93 "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
94 "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
95 "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
96 "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
97 "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
98 "volatile"; "when"; "where"; "while";
100 if List.mem n reserved then
101 failwithf "%s has param/ret using reserved word %s" name n;
104 let ret, args, optargs = style in
108 | RInt n | RInt64 n | RBool n
109 | RConstString n | RConstOptString n | RString n
110 | RStringList n | RStruct (n, _) | RStructList (n, _)
111 | RHashtable n | RBufferOut n ->
114 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) args;
115 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) optargs;
118 (* Check only certain types allowed in optargs. *)
120 fun (name, (_, _, optargs), _, _, _, _, _) ->
121 if List.length optargs > 64 then
122 failwithf "maximum of 64 optional args allowed for %s" name;
126 | Bool _ | Int _ | Int64 _ | String _ -> ()
128 failwithf "optional args of %s can only have type Bool|Int|Int64|String" name
132 (* Some parameter types not supported for daemon functions. *)
134 fun (name, (_, args, optargs), _, _, _, _, _) ->
135 let check_arg_type = function
137 failwithf "Pointer is not supported for daemon function %s."
141 List.iter check_arg_type args;
142 List.iter check_arg_type optargs;
145 (* Check short descriptions. *)
147 fun (name, _, _, _, _, shortdesc, _) ->
148 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
149 failwithf "short description of %s should begin with lowercase." name;
150 let c = shortdesc.[String.length shortdesc-1] in
151 if c = '\n' || c = '.' then
152 failwithf "short description of %s should not end with . or \\n." name
153 ) (all_functions @ fish_commands);
155 (* Check long descriptions. *)
157 fun (name, _, _, _, _, _, longdesc) ->
158 if longdesc.[String.length longdesc-1] = '\n' then
159 failwithf "long description of %s should not end with \\n." name
160 ) (all_functions @ fish_commands);
162 (* Check proc_nrs. *)
164 fun (name, _, proc_nr, _, _, _, _) ->
166 failwithf "daemon function %s should have proc_nr > 0" name
170 fun (name, _, proc_nr, _, _, _, _) ->
171 if proc_nr <> -1 then
172 failwithf "non-daemon function %s should have proc_nr -1" name
173 ) non_daemon_functions;
176 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
179 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
180 let rec loop = function
183 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
185 | (name1,nr1) :: (name2,nr2) :: _ ->
186 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
193 fun (name, _, _, flags, _, _, _) ->
196 | ProtocolLimitWarning
202 if contains_uppercase n then
203 failwithf "%s: guestfish alias %s should not contain uppercase chars" name n;
204 if String.contains n '_' then
205 failwithf "%s: guestfish alias %s should not contain '_'" name n
207 (* 'n' must be a cross-ref to the name of another action. *)
208 if not (List.exists (
210 | (n', _, _, _, _, _, _) when n = n' -> true
212 ) all_functions) then
213 failwithf "%s: DeprecatedBy flag must be cross-reference to another action" name
215 if contains_uppercase n then
216 failwithf "%s: Optional group name %s should not contain uppercase chars" name n;
217 if String.contains n '-' || String.contains n '_' then
218 failwithf "%s: Optional group name %s should not contain '-' or '_'" name n
220 ) (all_functions @ fish_commands);
225 (* Ignore functions that have no tests. We generate a
226 * warning when the user does 'make check' instead.
228 | name, _, _, _, [], _, _ -> ()
229 | name, _, _, _, tests, _, _ ->
233 match seq_of_test test with
235 failwithf "%s has a test containing an empty sequence" name
236 | cmds -> List.map List.hd cmds
238 let funcs = List.flatten funcs in
240 let tested = List.mem name funcs in
243 failwithf "function %s has tests but does not test itself" name