upstream: https://github.com/stedolan/crowbar
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

feat(crowbar): use alcotest as property-testing runner, keep AFL mode

Replace the custom cmdliner-based runner with Alcotest.run_with_args,
preserving crowbar CLI flags (--seed, --repeat, --infinite,
--crowbar-verbose) via cmdliner term integration. AFL mode is detected
by checking if the last argv is an existing file. Also replace Str.split
with String.split_on_char to drop the str dependency.

+96 -143
+1
crowbar.opam
··· 14 14 depends: [ 15 15 "dune" {>= "2.9"} 16 16 "ocaml" {>= "4.08"} 17 + "alcotest" 17 18 "cmdliner" {>= "1.1.0"} 18 19 "afl-persistent" {>= "1.1"} 19 20 "calendar" {>= "2.00" & with-test}
+1
dune-project
··· 19 19 ) 20 20 (depends 21 21 (ocaml (>= "4.08")) 22 + alcotest 22 23 (cmdliner (>= 1.1.0)) 23 24 (afl-persistent (>= "1.1")) 24 25 ("calendar" (and (>= "2.00") :with-test))
+93 -142
src/crowbar.ml
··· 418 418 pp ppf "%s" (Printexc.to_string e); 419 419 bt 420 420 |> Printexc.raw_backtrace_to_string 421 - |> Str.split (Str.regexp "\n") 421 + |> String.split_on_char '\n' 422 422 |> List.iter (pp ppf "@,%s") in 423 423 match status with 424 424 | TestPass pvs -> ··· 450 450 let src_of_seed seed = 451 451 Random (prng_state_of_seed seed) 452 452 453 - let run_test ~mode ~silent ?(verbose=false) (Test (name, gens, f)) = 454 - let show_status_line ?(clear=false) stat = 455 - Printf.printf "%s: %s\n" name stat; 456 - if clear then print_newline (); 457 - flush stdout in 458 - let ppf = Format.std_formatter in 459 - if not silent && Unix.isatty Unix.stdout then 460 - show_status_line ~clear:false "...."; 461 - let status = match mode with 462 - | `Once state -> 463 - run_once gens f state 464 - | `Repeat (iters, seedseed) -> 465 - let worst_status = ref (TestPass (fun _ () -> ())) in 466 - let npass = ref 0 in 467 - let nbad = ref 0 in 468 - let seedsrc = prng_state_of_seed seedseed in 469 - while !npass < iters && classify_status !worst_status = `Pass do 470 - let seed = Random.State.int64 seedsrc Int64.max_int in 471 - let state = { chan = src_of_seed seed; 472 - buf = Bytes.make 256 '0'; 473 - offset = 0; len = 0 } in 474 - let status = run_once gens f state in 475 - begin match classify_status status with 476 - | `Pass -> incr npass 477 - | `Bad -> incr nbad 478 - | `Fail -> 479 - worst_status := status 480 - end; 481 - done; 482 - let status = !worst_status in 483 - status in 484 - if silent && verbose && classify_status status = `Fail then begin 485 - show_status_line 486 - ~clear:true "FAIL"; 487 - pp ppf "%a@." print_status status; 488 - end; 489 - if not silent then begin 490 - match classify_status status with 491 - | `Pass -> 492 - show_status_line 493 - ~clear:true "PASS"; 494 - if verbose then pp ppf "%a@." print_status status 495 - | `Fail -> 496 - show_status_line 497 - ~clear:true "FAIL"; 498 - pp ppf "%a@." print_status status; 499 - | `Bad -> 500 - show_status_line 501 - ~clear:true "BAD"; 502 - pp ppf "%a@." print_status status; 503 - end; 504 - status 453 + (* {1 Property-testing runner (Alcotest)} *) 454 + 455 + type config = { 456 + seed : int64 option; 457 + repeat : int; 458 + verbose_crowbar : bool; 459 + infinite : bool; 460 + } 461 + 462 + let config_term = 463 + let open Cmdliner in 464 + let seed = 465 + let doc = "The seed (an int64) for the PRNG." in 466 + Arg.(value & opt (some int64) None & info ["s"; "seed"] ~doc) in 467 + let repeat = 468 + let doc = "The number of times to repeat the test." in 469 + Arg.(value & opt int 5000 & info ["r"; "repeat"] ~doc) in 470 + let verbose_flag = 471 + let doc = "Print information on each passing test." in 472 + Arg.(value & flag & info ["crowbar-verbose"] ~doc) in 473 + let infinite = 474 + let doc = "Run until a failure is found." in 475 + Arg.(value & flag & info ["i"; "infinite"] ~doc) in 476 + Term.(const (fun seed repeat verbose_crowbar infinite -> 477 + { seed; repeat; verbose_crowbar; infinite }) 478 + $ seed $ repeat $ verbose_flag $ infinite) 479 + 480 + let run_property_test (Test (_name, gens, f)) config = 481 + let seed = match config.seed with 482 + | Some s -> s 483 + | None -> Random.int64 Int64.max_int in 484 + let seedsrc = prng_state_of_seed seed in 485 + let npass = ref 0 in 486 + let failure = ref None in 487 + let max_iter = if config.infinite then max_int else config.repeat in 488 + while !npass < max_iter && Option.is_none !failure do 489 + let s = Random.State.int64 seedsrc Int64.max_int in 490 + let state = { chan = src_of_seed s; 491 + buf = Bytes.make 256 '0'; 492 + offset = 0; len = 0 } in 493 + let status = run_once gens f state in 494 + match classify_status status with 495 + | `Pass -> 496 + incr npass; 497 + if config.verbose_crowbar then 498 + Printf.printf " pass %d\n%!" !npass 499 + | `Bad -> () 500 + | `Fail -> failure := Some status 501 + done; 502 + match !failure with 503 + | None -> () 504 + | Some status -> 505 + Alcotest.fail (Format.asprintf "%a" print_status status) 506 + 507 + let run_with_alcotest tests = 508 + let test_cases = List.map (fun (Test (name, _, _) as test) -> 509 + Alcotest.test_case name `Quick (run_property_test test) 510 + ) tests in 511 + Alcotest.run_with_args "crowbar" config_term ["crowbar", test_cases] 512 + 513 + (* {1 AFL runner} *) 505 514 506 515 exception TestFailure 507 - let run_all_tests seed repeat file verbosity infinity tests = 508 - match file with 509 - | None -> 510 - let seed = match seed with 511 - | Some seed -> seed 512 - | None -> Random.int64 (Int64.max_int) 516 + 517 + let run_afl tests file = 518 + AflPersistent.run (fun () -> 519 + let fd = Unix.openfile file [Unix.O_RDONLY] 0o000 in 520 + let state = { chan = Fd fd; buf = Bytes.make 256 '0'; 521 + offset = 0; len = 0 } in 522 + let status = 523 + try 524 + let test = List.nth tests (choose_int (List.length tests) state) in 525 + let (Test (_, gens, f)) = test in 526 + run_once gens f state 527 + with 528 + | BadTest s -> BadInput s 513 529 in 514 - if infinity then 515 - (* infinite QuickCheck mode *) 516 - let rec go ntests alltests tests = match tests with 517 - | [] -> 518 - go ntests alltests alltests 519 - | t :: rest -> 520 - if ntests mod 10000 = 0 then Printf.eprintf "\r%d%!" ntests; 521 - let chan = src_of_seed seed in 522 - let state = { chan ; buf = Bytes.make 256 '0'; offset = 0; len = 0 } in 523 - match classify_status (run_test ~mode:(`Once state) ~silent:true ~verbose:true t) with 524 - | `Fail -> Printf.printf "%d tests passed before first failure\n%!" ntests 525 - | _ -> go (ntests + 1) alltests rest in 526 - let () = go 0 tests tests in 527 - 1 528 - else 529 - (* limited-run QuickCheck mode *) 530 - let failures = ref 0 in 531 - let () = tests |> List.iter (fun t -> 532 - match (run_test ~mode:(`Repeat (repeat, seed)) ~silent:false t |> classify_status) with 533 - | `Fail -> failures := !failures + 1 534 - | _ -> () 535 - ) 536 - in 537 - !failures 538 - | Some file -> 539 - (* AFL mode *) 540 - let verbose = List.length verbosity > 0 in 541 - let () = AflPersistent.run (fun () -> 542 - let fd = Unix.openfile file [Unix.O_RDONLY] 0o000 in 543 - let state = { chan = Fd fd; buf = Bytes.make 256 '0'; 544 - offset = 0; len = 0 } in 545 - let status = 546 - try run_test ~mode:(`Once state) ~silent:false ~verbose @@ 547 - List.nth tests (choose_int (List.length tests) state) 548 - with 549 - BadTest s -> BadInput s 550 - in 551 - Unix.close fd; 552 - match classify_status status with 553 - | `Pass | `Bad -> () 554 - | `Fail -> 555 - Printexc.record_backtrace false; 556 - raise TestFailure) 557 - in 558 - 0 (* failures come via the exception mechanism above *) 530 + Unix.close fd; 531 + match classify_status status with 532 + | `Pass | `Bad -> () 533 + | `Fail -> 534 + Printexc.record_backtrace false; 535 + raise TestFailure) 536 + 537 + let detect_afl_file () = 538 + let n = Array.length Sys.argv in 539 + if n >= 2 then 540 + let last = Sys.argv.(n - 1) in 541 + if Sys.file_exists last then Some last 542 + else None 543 + else None 559 544 560 545 let last_generated_name = ref 0 561 546 let generate_name () = ··· 570 555 | Some name -> name in 571 556 registered_tests := Test (name, gens, f) :: !registered_tests 572 557 573 - (* cmdliner stuff *) 574 - 575 - let randomness_file = 576 - let doc = "A file containing some bytes, consulted in constructing test cases. \ 577 - When `afl-fuzz` is calling the test binary, use `@@` to indicate that \ 578 - `afl-fuzz` should put its test case here \ 579 - (e.g. `afl-fuzz -i input -o output ./my_crowbar_test @@`). Re-run a test by \ 580 - supplying the test file here \ 581 - (e.g. `./my_crowbar_test output/crashes/id:000000`). If no file is \ 582 - specified, the test will use OCaml's Random module as a source of \ 583 - randomness for a predefined number of rounds." in 584 - Cmdliner.Arg.(value & pos 0 (some file) None & info [] ~doc ~docv:"FILE") 585 - 586 - let seed = 587 - let doc = "The seed (an int64) for the PRNG. Use as an alternative to FILE 588 - when running in non-AFL (quickcheck) mode." in 589 - Cmdliner.Arg.(value & opt (some int64) None & info ["s"; "seed"] ~doc ~docv:"SEED") 590 - 591 - let repeat = 592 - let doc = "The number of times to repeat the test in quick-check." in 593 - Cmdliner.Arg.(value & opt int 5000 & info ["r"; "repeat"] ~doc ~docv:"REPEAT") 594 - 595 - let verbosity = 596 - let doc = "Print information on each test as it's conducted." in 597 - Cmdliner.Arg.(value & flag_all & info ["v"; "verbose"] ~doc ~docv:"VERBOSE") 598 - 599 - let infinity = 600 - let doc = "In non-AFL (quickcheck) mode, continue running until a test failure is \ 601 - discovered. No attempt is made to track which tests have already been run, \ 602 - so some tests may be repeated, and if there are no failures reachable, the \ 603 - test will never terminate without outside intervention." in 604 - Cmdliner.Arg.(value & flag & info ["i"] ~doc ~docv:"INFINITE") 605 - 606 - let crowbar_info = Cmdliner.Cmd.info @@ Filename.basename Sys.argv.(0) 607 - 608 558 let () = 609 559 at_exit (fun () -> 610 560 let t = !registered_tests in ··· 612 562 match t with 613 563 | [] -> () 614 564 | t -> 615 - let cmd = Cmdliner.Term.(const run_all_tests $ seed $ repeat $ randomness_file $ verbosity $ 616 - infinity $ const (List.rev t)) in 617 - exit @@ Cmdliner.Cmd.eval' ~catch:false (Cmdliner.Cmd.v crowbar_info cmd) 565 + let tests = List.rev t in 566 + match detect_afl_file () with 567 + | Some file -> run_afl tests file 568 + | None -> run_with_alcotest tests 618 569 ) 619 570 620 571 module Syntax = struct
+1 -1
src/dune
··· 1 1 (library 2 2 (public_name crowbar) 3 - (libraries cmdliner afl-persistent str)) 3 + (libraries alcotest cmdliner afl-persistent unix))