X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=generator%2Fgenerator_capitests.ml;h=963ed51417bb3f28abe597aedc01e58ec83fd575;hb=e1c6d1738a2b9123dd08fb4ecff8176daf558f35;hp=f5be3e7cbb54ab9860660fd68d970b1f31c7ec6a;hpb=f93cdf1ed3323b8d9451a7f4f6365ac30ab8ba81;p=libguestfs.git diff --git a/generator/generator_capitests.ml b/generator/generator_capitests.ml index f5be3e7..963ed51 100644 --- a/generator/generator_capitests.ml +++ b/generator/generator_capitests.ml @@ -709,7 +709,7 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | [] -> assert false | name :: args -> (* Look up the command to find out what args/ret it has. *) - let style = + let style_ret, style_args, style_optargs = try let _, style, _, _, _, _, _ = List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in @@ -717,16 +717,24 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = with Not_found -> failwithf "%s: in test, command %s was not found" test_name name in - (* If the call has optional args, fold them all together. We cannot - * test partial optional args yet. - *) - let style = - let ret, args, optargs = style in - ret, args@optargs in - - if List.length (snd style) <> List.length args then - failwithf "%s: in test, wrong number of args given to %s" - test_name name; + (* Match up the arguments strings and argument types. *) + let args, optargs = + let rec loop argts args = + match argts, args with + | (t::ts), (s::ss) -> + let args, rest = loop ts ss in + ((t, s) :: args), rest + | [], ss -> [], ss + | ts, [] -> + failwithf "%s: in test, too few args given to function %s" + test_name name + in + let args, optargs = loop style_args args in + let optargs, rest = loop style_optargs optargs in + if rest <> [] then + failwithf "%s: in test, too many args given to function %s" + test_name name; + args, optargs in pr " {\n"; @@ -764,30 +772,67 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | Pointer _, _ -> (* Difficult to make these pointers in order to run a test. *) assert false - ) (List.combine (snd style) args); - - let error_code = - match fst style with - | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1" - | RInt64 _ -> pr " int64_t r;\n"; "-1" - | RConstString _ | RConstOptString _ -> - pr " const char *r;\n"; "NULL" - | RString _ -> pr " char *r;\n"; "NULL" - | RStringList _ | RHashtable _ -> - pr " char **r;\n"; - pr " size_t i;\n"; - "NULL" - | RStruct (_, typ) -> - pr " struct guestfs_%s *r;\n" typ; "NULL" - | RStructList (_, typ) -> - pr " struct guestfs_%s_list *r;\n" typ; "NULL" - | RBufferOut _ -> - pr " char *r;\n"; - pr " size_t size;\n"; - "NULL" in + ) args; + + if optargs <> [] then ( + pr " struct guestfs_%s_argv optargs;\n" name; + let bitmask = List.fold_left ( + fun bitmask optarg -> + let is_set = + match optarg with + | Bool n, "" -> false + | Bool n, "true" -> + pr " optargs.%s = 1;\n" n; true + | Bool n, "false" -> + pr " optargs.%s = 0;\n" n; true + | Bool n, arg -> + failwithf "boolean optional arg '%s' should be empty string or \"true\" or \"false\"" n + | Int n, "" -> false + | Int n, i -> + let i = + try int_of_string i + with Failure _ -> failwithf "integer optional arg '%s' should be empty string or number" n in + pr " optargs.%s = %d;\n" n i; true + | Int64 n, "" -> false + | Int64 n, i -> + let i = + try Int64.of_string i + with Failure _ -> failwithf "int64 optional arg '%s' should be empty string or number" n in + pr " optargs.%s = %Ld;\n" n i; true + | String n, "NOARG" -> false + | String n, arg -> + pr " optargs.%s = \"%s\";\n" n (c_quote arg); true + | _ -> assert false in + let bitmask = Int64.shift_left bitmask 1 in + let bitmask = if is_set then Int64.succ bitmask else bitmask in + bitmask + ) 0L optargs in + pr " optargs.bitmask = UINT64_C(0x%Lx);\n" bitmask; + ); + + (match style_ret with + | RErr | RInt _ | RBool _ -> pr " int r;\n" + | RInt64 _ -> pr " int64_t r;\n" + | RConstString _ | RConstOptString _ -> + pr " const char *r;\n" + | RString _ -> pr " char *r;\n" + | RStringList _ | RHashtable _ -> + pr " char **r;\n"; + pr " size_t i;\n" + | RStruct (_, typ) -> + pr " struct guestfs_%s *r;\n" typ + | RStructList (_, typ) -> + pr " struct guestfs_%s_list *r;\n" typ + | RBufferOut _ -> + pr " char *r;\n"; + pr " size_t size;\n" + ); pr " suppress_error = %d;\n" (if expect_error then 1 else 0); - pr " r = guestfs_%s (g" name; + if optargs = [] then + pr " r = guestfs_%s (g" name + else + pr " r = guestfs_%s_argv (g" name; (* Generate the parameters. *) List.iter ( @@ -820,20 +865,33 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | Bool _, arg -> let b = bool_of_string arg in pr ", %d" (if b then 1 else 0) | Pointer _, _ -> assert false - ) (List.combine (snd style) args); + ) args; - (match fst style with + (match style_ret with | RBufferOut _ -> pr ", &size" | _ -> () ); + if optargs <> [] then + pr ", &optargs"; + pr ");\n"; - if not expect_error then - pr " if (r == %s)\n" error_code - else - pr " if (r != %s)\n" error_code; - pr " return -1;\n"; + (match errcode_of_ret style_ret, expect_error with + | `CannotReturnError, _ -> () + | `ErrorIsMinusOne, false -> + pr " if (r == -1)\n"; + pr " return -1;\n"; + | `ErrorIsMinusOne, true -> + pr " if (r != -1)\n"; + pr " return -1;\n"; + | `ErrorIsNULL, false -> + pr " if (r == NULL)\n"; + pr " return -1;\n"; + | `ErrorIsNULL, true -> + pr " if (r != NULL)\n"; + pr " return -1;\n"; + ); (* Insert the test code. *) (match test with @@ -841,7 +899,7 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | Some f -> f () ); - (match fst style with + (match style_ret with | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ | RConstOptString _ -> () | RString _ | RBufferOut _ -> pr " free (r);\n"