X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fgenerator.ml;h=2230ab8d6bc29c2a5d787c9288925317c3260913;hb=71fa671c6dd4decccb3d99941a5d02b0d13e0152;hp=b0a715896a9c3a927b1f11e6c25d75af19e69463;hpb=469224a9eca9b575063e6a1ca1b1d97adb3448cb;p=libguestfs.git diff --git a/src/generator.ml b/src/generator.ml index b0a7158..2230ab8 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -25,7 +25,7 @@ * After editing this file, run it (./src/generator.ml) to regenerate * all the output files. * - * IMPORTANT: This script should not print any warnings. If it prints + * IMPORTANT: This script should NOT print any warnings. If it prints * warnings, you should treat them as errors. * [Need to add -warn-error to ocaml command line] *) @@ -482,6 +482,7 @@ details."); "\ This is just a shortcut for listing C C and sorting the resulting nodes into alphabetical order."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -616,23 +617,69 @@ let iteri f xs = in loop 0 xs -(* 'pr' prints to the current output file. *) -let chan = ref stdout -let pr fs = ksprintf (output_string !chan) fs - let name_of_argt = function String n | OptString n | Bool n | Int n -> n (* Check function names etc. for consistency. *) let check_functions () = + let contains_uppercase str = + let len = String.length str in + let rec loop i = + if i >= len then false + else ( + let c = str.[i] in + if c >= 'A' && c <= 'Z' then true + else loop (i+1) + ) + in + loop 0 + in + + (* Check function names. *) List.iter ( - fun (name, _, _, _, _, longdesc) -> + fun (name, _, _, _, _, _) -> + if String.length name >= 7 && String.sub name 0 7 = "guestfs" then + failwithf "function name %s does not need 'guestfs' prefix" name; + if contains_uppercase name then + failwithf "function name %s should not contain uppercase chars" name; if String.contains name '-' then - failwithf "function name '%s' should not contain '-', use '_' instead." - name; + failwithf "function name %s should not contain '-', use '_' instead." + name + ) all_functions; + + (* Check function parameter/return names. *) + List.iter ( + fun (name, style, _, _, _, _) -> + let check_arg_ret_name n = + if contains_uppercase n then + failwithf "%s param/ret %s should not contain uppercase chars" + name n; + if String.contains n '-' || String.contains n '_' then + failwithf "%s param/ret %s should not contain '-' or '_'" + name n; + if n = "value" then + failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n + in + + (match fst style with + | Err -> () + | RInt n | RBool n | RConstString n | RString n + | RStringList n | RPVList n | RVGList n | RLVList n -> + check_arg_ret_name n + | RIntBool (n,m) -> + check_arg_ret_name n; + check_arg_ret_name m + ); + List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style) + ) all_functions; + + (* Check long dscriptions. *) + List.iter ( + fun (name, _, _, _, _, longdesc) -> if longdesc.[String.length longdesc-1] = '\n' then failwithf "long description of %s should not end with \\n." name ) all_functions; + (* Check proc_nrs. *) List.iter ( fun (name, _, proc_nr, _, _, _) -> if proc_nr <= 0 then @@ -656,16 +703,20 @@ let check_functions () = | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 -> loop rest | (name1,nr1) :: (name2,nr2) :: _ -> - failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)" + failwithf "%s and %s have conflicting procedure numbers (%d, %d)" name1 name2 nr1 nr2 in loop proc_nrs +(* 'pr' prints to the current output file. *) +let chan = ref stdout +let pr fs = ksprintf (output_string !chan) fs + +(* Generate a header block in a number of standard styles. *) type comment_style = CStyle | HashStyle | OCamlStyle type license = GPLv2 | LGPLv2 -(* Generate a header block in a number of standard styles. *) -let rec generate_header comment license = +let generate_header comment license = let c = match comment with | CStyle -> pr "/* "; " *" | HashStyle -> pr "# "; "#" @@ -714,8 +765,10 @@ let rec generate_header comment license = ); pr "\n" +(* Start of main code generation functions below this line. *) + (* Generate the pod documentation for the C API. *) -and generate_actions_pod () = +let rec generate_actions_pod () = List.iter ( fun (shortname, style, _, flags, _, longdesc) -> let name = "guestfs_" ^ shortname in @@ -743,16 +796,16 @@ I.\n\n" I.\n\n" | RIntBool _ -> pr "This function returns a C. -I after use.>.\n\n" +I after use>.\n\n" | RPVList _ -> pr "This function returns a C. -I after use.>.\n\n" +I after use>.\n\n" | RVGList _ -> pr "This function returns a C. -I after use.>.\n\n" +I after use>.\n\n" | RLVList _ -> pr "This function returns a C. -I after use.>.\n\n" +I after use>.\n\n" ); if List.mem ProtocolLimitWarning flags then pr "Because of the message protocol, there is a transfer limit @@ -791,8 +844,9 @@ and generate_structs_pod () = ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols] (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and - * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We - * have to use an underscore instead of a dash because otherwise + * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. + * + * We have to use an underscore instead of a dash because otherwise * rpcgen generates incorrect code. * * This header is NOT exported to clients, but see also generate_structs_h. @@ -2510,6 +2564,15 @@ let output_to filename = let () = check_functions (); + if not (Sys.file_exists "configure.ac") then ( + eprintf "\ +You are probably running this from the wrong directory. +Run it from the top source directory using the command + src/generator.ml +"; + exit 1 + ); + let close = output_to "src/guestfs_protocol.x" in generate_xdr (); close ();