generator/generator_checks.ml

   1 (* libguestfs
   2  * Copyright (C) 2009-2010 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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
  17  *)
  18
  19 (* Please read generator/README first. *)
  20
  21 open Generator_types
  22 open Generator_utils
  23 open Generator_actions
  24
  25 (* Check function names etc. for consistency. *)
  26 let () =
  27   let contains_uppercase str =
  28     let len = String.length str in
  29     let rec loop i =
  30       if i >= len then false
  31       else (
  32         let c = str.[i] in
  33         if c >= 'A' && c <= 'Z' then true
  34         else loop (i+1)
  35       )
  36     in
  37     loop 0
  38   in
  39
  40   (* Check function names. *)
  41   List.iter (
  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;
  45       if name = "" then
  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."
  51           name
  52   ) (all_functions @ fish_commands);
  53
  54   (* Check function parameter/return names. *)
  55   List.iter (
  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"
  60             name n;
  61         if String.contains n '-' || String.contains n '_' then
  62           failwithf "%s param/ret %s should not contain '-' or '_'"
  63             name n;
  64         if n = "value" then
  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;
  72
  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.
  82          *)
  83         let reserved = [
  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";
  91           "interface";
  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";
  99           ] in
 100         if List.mem n reserved then
 101           failwithf "%s has param/ret using reserved word %s" name n;
 102       in
 103
 104       let ret, args, optargs = style in
 105
 106       (match ret with
 107        | RErr -> ()
 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 ->
 112            check_arg_ret_name n
 113       );
 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;
 116   ) all_functions;
 117
 118   (* Check only certain types allowed in optargs. *)
 119   List.iter (
 120     fun (name, (_, _, optargs), _, _, _, _, _) ->
 121       if List.length optargs > 64 then
 122         failwithf "maximum of 64 optional args allowed for %s" name;
 123
 124       List.iter (
 125         function
 126         | Bool _ | Int _ | Int64 _ | String _ -> ()
 127         | _ ->
 128             failwithf "optional args of %s can only have type Bool|Int|Int64|String" name
 129       ) optargs
 130   ) all_functions;
 131
 132   (* Some parameter types not supported for daemon functions. *)
 133   List.iter (
 134     fun (name, (_, args, optargs), _, _, _, _, _) ->
 135       let check_arg_type = function
 136         | Pointer _ ->
 137             failwithf "Pointer is not supported for daemon function %s."
 138               name
 139         | _ -> ()
 140       in
 141       List.iter check_arg_type args;
 142       List.iter check_arg_type optargs;
 143   ) daemon_functions;
 144
 145   (* Check short descriptions. *)
 146   List.iter (
 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);
 154
 155   (* Check long descriptions. *)
 156   List.iter (
 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);
 161
 162   (* Check proc_nrs. *)
 163   List.iter (
 164     fun (name, _, proc_nr, _, _, _, _) ->
 165       if proc_nr <= 0 then
 166         failwithf "daemon function %s should have proc_nr > 0" name
 167   ) daemon_functions;
 168
 169   List.iter (
 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;
 174
 175   let proc_nrs =
 176     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
 177       daemon_functions in
 178   let proc_nrs =
 179     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
 180   let rec loop = function
 181     | [] -> ()
 182     | [_] -> ()
 183     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
 184         loop rest
 185     | (name1,nr1) :: (name2,nr2) :: _ ->
 186         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
 187           name1 name2 nr1 nr2
 188   in
 189   loop proc_nrs;
 190
 191   (* Check flags. *)
 192   List.iter (
 193     fun (name, _, _, flags, _, _, _) ->
 194       List.iter (
 195         function
 196         | ProtocolLimitWarning
 197         | DangerWillRobinson
 198         | FishOutput _
 199         | NotInFish
 200         | NotInDocs
 201         | Progress -> ()
 202         | FishAlias n ->
 203             if contains_uppercase n then
 204               failwithf "%s: guestfish alias %s should not contain uppercase chars" name n;
 205             if String.contains n '_' then
 206               failwithf "%s: guestfish alias %s should not contain '_'" name n
 207         | DeprecatedBy n ->
 208             (* 'n' must be a cross-ref to the name of another action. *)
 209             if not (List.exists (
 210                       function
 211                       | (n', _, _, _, _, _, _) when n = n' -> true
 212                       | _ -> false
 213                     ) all_functions) then
 214               failwithf "%s: DeprecatedBy flag must be cross-reference to another action" name
 215         | Optional n ->
 216             if contains_uppercase n then
 217               failwithf "%s: Optional group name %s should not contain uppercase chars" name n;
 218             if String.contains n '-' || String.contains n '_' then
 219               failwithf "%s: Optional group name %s should not contain '-' or '_'" name n
 220       ) flags
 221   ) (all_functions @ fish_commands);
 222
 223   (* Check tests. *)
 224   List.iter (
 225     function
 226       (* Ignore functions that have no tests.  We generate a
 227        * warning when the user does 'make check' instead.
 228        *)
 229     | name, _, _, _, [], _, _ -> ()
 230     | name, _, _, _, tests, _, _ ->
 231         let funcs =
 232           List.map (
 233             fun (_, _, test) ->
 234               match seq_of_test test with
 235               | [] ->
 236                   failwithf "%s has a test containing an empty sequence" name
 237               | cmds -> List.map List.hd cmds
 238           ) tests in
 239         let funcs = List.flatten funcs in
 240
 241         let tested = List.mem name funcs in
 242
 243         if not tested then
 244           failwithf "function %s has tests but does not test itself" name
 245   ) all_functions