Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Issue 41: Signed-off-by: Jadesola Bello <[email protected]> #44

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open

Issue 41: Signed-off-by: Jadesola Bello <[email protected]> #44

Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
aab242e
embed errors instead of throwing Signed-off-by: Jadesola Bello <jades…
Mar 18, 2023
12e72c9
chore: resolve missing args error
Mar 19, 2023
b294c32
chore: change validate_extension_point_exn
Mar 22, 2023
772991e
chore: attempt at throwing exception lists
Mar 22, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 42 additions & 24 deletions src/ppx_inline_test.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -168,38 +168,56 @@ let validate_tag tag =
;;

let validate_extension_point_exn ~name_of_ppx_rewriter ~loc ~tags =
let errors = ref [] in
Has_tests.set true;
if not (can_use_test_extensions ())
then
Location.raise_errorf
~loc
"%s: extension is disabled because the tests would be ignored (the build system \
didn't pass -inline-test-lib. With jenga or dune, this usually happens when \
writing tests in files that are part of an executable stanza, but only library \
stanzas support inline tests)"
name_of_ppx_rewriter;
List.iter tags ~f:(fun tag ->
match validate_tag tag with
| Ok () -> ()
| Error hint ->
let hint =
match hint with
| None -> ""
| Some hint -> "\n" ^ hint
in
Location.raise_errorf
~loc
"%s: %S is not a valid tag for inline tests.%s"
if not (can_use_test_extensions ()) then
let error_msg =
Printf.sprintf
"%s: extension is disabled because the tests would be ignored (the build system \
didn't pass -inline-test-lib. With jenga or dune, this usually happens when \
writing tests in files that are part of an executable stanza, but only library \
stanzas support inline tests)"
name_of_ppx_rewriter
tag
hint)
in
errors := error_msg :: !errors
else
List.iter tags ~f:(fun tag ->
match validate_tag tag with
| Ok () -> ()
| Error hint ->
let hint =
match hint with
| None -> ""
| Some hint -> "\n" ^ hint
in
let error_msg =
Printf.sprintf "%s: %S is not a valid tag for inline tests.%s"
name_of_ppx_rewriter tag hint
in
errors := error_msg :: !errors
);
!errors
;;

let name_of_ppx_rewriter = "ppx_inline_test"

let throw_exception_list ~loc ~(errs: string list) =
match errs with
| [] -> () (* list is empty, do nothing *)
| _ ->
let ast_builder = Ast_builder.make loc in
List.iter errs ~f:(fun err ->
(* loop through errs and raise an error for each one *)
Ast_builder.Default.( pexp_extension ~loc:loc
(Location.error_extensionf ~loc:loc err
))
)
;;

let expand_test ~loc ~path:_ ~name:id ~tags e =
let loc = { loc with loc_ghost = true } in
validate_extension_point_exn ~name_of_ppx_rewriter ~loc ~tags;
let errs = validate_extension_point_exn ~name:name_of_ppx_rewriter ~loc ~tags in
throw_exception_list loc errs;
apply_to_descr "test" ~loc (Some e) id tags [%expr fun () -> [%e e]]
;;

Expand Down