diff --git a/CHANGES.md b/CHANGES.md index c131d0d6..dffcbf3d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,8 @@ Unreleased * atddiff now supports options for filtering the findings based on the direction of the incompatibility (`--backward`, `--forward`) or based on the name of the affected types (`--types`) (#365) +* atddiff: new option `--output-format json` for exporting the results to + JSON (#360) 2.13.0 (2023-10-15) ------------------- diff --git a/atddiff/Makefile b/atddiff/Makefile index 13b1fcda..6e00f8c4 100644 --- a/atddiff/Makefile +++ b/atddiff/Makefile @@ -13,3 +13,9 @@ build: .PHONY: test test: $(MAKE) -C test + +# Update the output format of atddiff by running 'make types'. +# This requires an external installation of the atdgen command. +.PHONY: types +types: + $(MAKE) -C src/lib types diff --git a/atddiff/src/bin/Atddiff_main.ml b/atddiff/src/bin/Atddiff_main.ml index abe60259..c3f5629e 100644 --- a/atddiff/src/bin/Atddiff_main.ml +++ b/atddiff/src/bin/Atddiff_main.ml @@ -12,6 +12,7 @@ type conf = { filter: Atddiff.filter; json_defaults_old: bool; json_defaults_new: bool; + output_format: Atddiff.output_format; exit_success: bool; version: bool; } @@ -42,6 +43,7 @@ let run conf = ~filter:conf.filter ~json_defaults_old:conf.json_defaults_old ~json_defaults_new:conf.json_defaults_new + ~output_format:conf.output_format conf.old_file conf.new_file in let exit_code, data = match out_data with @@ -151,6 +153,19 @@ let json_defaults_new_term : bool Term.t = in Arg.value (Arg.flag info) +let output_format_term : Atddiff.output_format Term.t = + let info = + Arg.info ["output-format"; "f"] + ~doc:( + "Output JSON instead of text. The format is specified by the file \ + Atddiff_output.atd that's included in the source distribution of \ + ATD. At the time of writing, its location is \ + https://github.com/ahrefs/atd/blob/master/atddiff/src/lib/Atddiff_output.atd") + in + Arg.value (Arg.opt (Arg.enum ["text", Atddiff.Text; + "json", Atddiff.JSON]) + Atddiff.Text info) + let exit_success_term : bool Term.t = let info = Arg.info ["exit-success"] @@ -213,6 +228,7 @@ let cmdline_term run = old_file new_file out_file backward forward types json_defaults json_defaults_old json_defaults_new + output_format exit_success version = let filter = let module A = Atddiff in @@ -239,6 +255,7 @@ let cmdline_term run = filter; json_defaults_old; json_defaults_new; + output_format; exit_success; version; } @@ -253,6 +270,7 @@ let cmdline_term run = $ json_defaults_term $ json_defaults_old_term $ json_defaults_new_term + $ output_format_term $ exit_success_term $ version_term ) diff --git a/atddiff/src/lib/Atddiff.ml b/atddiff/src/lib/Atddiff.ml index 2fc8bac1..836a1375 100644 --- a/atddiff/src/lib/Atddiff.ml +++ b/atddiff/src/lib/Atddiff.ml @@ -2,6 +2,8 @@ Internal Atddiff library used by the 'atddiff' command. *) +module T = Atddiff_output_t + type simple_filter = | Affected_type_name of string | Backward @@ -17,10 +19,7 @@ type output_format = Text | JSON let version = Version.version -let format_json res : string = - failwith "JSON output: not implemented" - -let rec select_finding filter (x : Types.finding * string list) = +let rec select_finding filter (x : T.full_finding) = match filter with | Or filters -> List.exists (fun filter -> select_finding filter x) filters @@ -29,17 +28,14 @@ let rec select_finding filter (x : Types.finding * string list) = | Not filter -> not (select_finding filter x) | Filter (Affected_type_name name) -> - let _, names = x in - List.mem name names + List.mem name x.affected_types | Filter Backward -> - let finding, _ = x in - (match finding.direction with + (match x.finding.direction with | Backward | Both -> true | Forward -> false ) | Filter Forward -> - let finding, _ = x in - (match finding.direction with + (match x.finding.direction with | Forward | Both -> true | Backward -> false ) @@ -67,12 +63,13 @@ let compare_files } in Compare.asts options ast1 ast2 in - match res with + match res.findings with | [] -> Ok () - | res -> - let res = List.filter (select_finding filter) res in + | findings -> + let res : T.result = + { findings = List.filter (select_finding filter) findings } in Error ( match output_format with | Text -> Format_text.to_string res - | JSON -> format_json res + | JSON -> Format_JSON.to_string res ^ "\n" ) diff --git a/atddiff/src/lib/Types.ml b/atddiff/src/lib/Atddiff_output.atd similarity index 55% rename from atddiff/src/lib/Types.ml rename to atddiff/src/lib/Atddiff_output.atd index 73d2b409..227f20cb 100644 --- a/atddiff/src/lib/Types.ml +++ b/atddiff/src/lib/Atddiff_output.atd @@ -1,17 +1,46 @@ (* Type definitions used to build comparison results + + We don't derive OCaml serializers from this file with atdgen due to + circular dependencies but we derive the OCaml types by calling atdgen + and keeping the result under source control: + + atdgen -t Atddiff_output.atd + + This provides an ATD specification to users who consume the JSON + output of the atddiff. *) -type direction = Backward | Forward | Both +type position = { + path: string; + line: int; + column: int; +} + +type location = { + start: position; + end : position; +} + +type direction = [ Backward | Forward | Both ] -type incompatibility_kind = - | Missing_field of { field_name: string } - | Missing_variant of { variant_name: string } - | Missing_variant_argument of { variant_name: string } - | Default_required of { field_name: string } +type field_info = { + field_name: string +} + +type variant_info = { + variant_name: string +} + +type incompatibility_kind = [ + | Missing_field of field_info + | Missing_variant of variant_info + | Missing_variant_argument of variant_info + | Default_required of field_info | Incompatible_type | Deleted_type | Added_type +] (* Important things we want to report: @@ -49,20 +78,22 @@ type incompatibility_kind = type finding = { direction: direction; kind: incompatibility_kind; - location_old: Atd.Ast.loc option; - location_new: Atd.Ast.loc option; + location_old: location option; + location_new: location option; (* The description should not mention the affected root type definition so as to allow the deduplication of findings. *) description: string; } -(* - A result is a list of unique findings and the list of root types - affected by the finding. +type full_finding = { + finding: finding; + affected_types: string list; +} - For now, we don't try to identify root type renames so each finding is - associated to just one root type name which exists in one or both versions - of the file. +(* + A result is a list of unique findings. *) -type result = (finding * string list) list +type result = { + findings: full_finding list; +} diff --git a/atddiff/src/lib/Atddiff_output_t.ml b/atddiff/src/lib/Atddiff_output_t.ml new file mode 100644 index 00000000..c096bd9a --- /dev/null +++ b/atddiff/src/lib/Atddiff_output_t.ml @@ -0,0 +1,34 @@ +(* Auto-generated from "Atddiff_output.atd" *) +[@@@ocaml.warning "-27-32-33-35-39"] + +type variant_info = { variant_name: string } + +type position = { path: string; line: int; column: int } + +type location = { start: position; end_ (*atd end *): position } + +type field_info = { field_name: string } + +type incompatibility_kind = + Missing_field of field_info + | Missing_variant of variant_info + | Missing_variant_argument of variant_info + | Default_required of field_info + | Incompatible_type + | Deleted_type + | Added_type + + +type direction = Backward | Forward | Both + +type finding = { + direction: direction; + kind: incompatibility_kind; + location_old: location option; + location_new: location option; + description: string +} + +type full_finding = { finding: finding; affected_types: string list } + +type result = { findings: full_finding list } diff --git a/atddiff/src/lib/Atddiff_output_t.mli b/atddiff/src/lib/Atddiff_output_t.mli new file mode 100644 index 00000000..c096bd9a --- /dev/null +++ b/atddiff/src/lib/Atddiff_output_t.mli @@ -0,0 +1,34 @@ +(* Auto-generated from "Atddiff_output.atd" *) +[@@@ocaml.warning "-27-32-33-35-39"] + +type variant_info = { variant_name: string } + +type position = { path: string; line: int; column: int } + +type location = { start: position; end_ (*atd end *): position } + +type field_info = { field_name: string } + +type incompatibility_kind = + Missing_field of field_info + | Missing_variant of variant_info + | Missing_variant_argument of variant_info + | Default_required of field_info + | Incompatible_type + | Deleted_type + | Added_type + + +type direction = Backward | Forward | Both + +type finding = { + direction: direction; + kind: incompatibility_kind; + location_old: location option; + location_new: location option; + description: string +} + +type full_finding = { finding: finding; affected_types: string list } + +type result = { findings: full_finding list } diff --git a/atddiff/src/lib/Compare.ml b/atddiff/src/lib/Compare.ml index f08baa6a..d338e878 100644 --- a/atddiff/src/lib/Compare.ml +++ b/atddiff/src/lib/Compare.ml @@ -28,8 +28,8 @@ *) open Printf -open Types module A = Atd.Ast +open Atddiff_output_t (* Sets of names: type names, variant names, field names. It's used to detect names that are in common between the two ATD files, @@ -100,7 +100,7 @@ let report_deleted_types defs name_set = Some (([name], []), { direction = Backward; kind = Deleted_type; - location_old = Some loc; + location_old = Some (loc |> Loc.of_atd_loc); location_new = None; description = sprintf "The definition for type '%s' no longer exists." @@ -117,7 +117,7 @@ let report_added_types defs name_set = direction = Forward; kind = Deleted_type; location_old = None; - location_new = Some loc; + location_new = Some (loc |> Loc.of_atd_loc); description = sprintf "There is a new type named '%s'." name }) else @@ -368,8 +368,8 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Both; kind = Incompatible_type; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "Type names '%s' and '%s' are not the same and \ may not be compatible." @@ -385,8 +385,8 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Both; kind = Incompatible_type; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "Incompatible type variables are being used."; } @@ -402,8 +402,8 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Both; kind = Incompatible_type; - location_old = Some (A.loc_of_type_expr e1); - location_new = Some (A.loc_of_type_expr e2); + location_old = Some (A.loc_of_type_expr e1 |> Loc.of_atd_loc); + location_new = Some (A.loc_of_type_expr e2 |> Loc.of_atd_loc); description = sprintf "Incompatible kinds of types: %s is now %s." (kind_of_expr e1) (a_kind_of_expr e2); @@ -432,7 +432,7 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Backward; kind = Missing_variant { variant_name = json_name }; - location_old = Some loc; + location_old = Some (loc |> Loc.of_atd_loc); location_new = None; description = sprintf "Case '%s' disappeared." json_name } @@ -444,7 +444,7 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : direction = Backward; kind = Missing_variant { variant_name = json_name }; location_old = None; - location_new = Some loc; + location_new = Some (loc |> Loc.of_atd_loc); description = sprintf "Case '%s' is new." json_name } ); @@ -460,8 +460,8 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Both; kind = Missing_variant_argument { variant_name = json_name }; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "Case '%s' no longer has an argument." json_name } @@ -469,8 +469,8 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Both; kind = Missing_variant_argument { variant_name = json_name }; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "Case '%s' used to not have an argument." json_name } @@ -503,7 +503,7 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Forward; kind = Missing_field { field_name = json_name }; - location_old = Some loc; + location_old = Some (loc |> Loc.of_atd_loc); location_new = None; description = sprintf "Required field '%s' disappeared." json_name } @@ -519,7 +519,7 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : direction = Backward; kind = Missing_field { field_name = json_name }; location_old = None; - location_new = Some loc; + location_new = Some (loc |> Loc.of_atd_loc); description = sprintf "Required field '%s' is new." json_name } ); @@ -540,8 +540,8 @@ let report_structural_mismatches options def_tbl1 def_tbl2 shared_types : add stacks { direction = Forward; kind = Default_required { field_name = json_name }; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "\ Formerly required field '%s' is now optional but has a default value. @@ -555,8 +555,8 @@ implementations can read newer data. If this is already the case, use add stacks { direction = Forward; kind = Missing_field { field_name = json_name }; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "Formerly required field '%s' is now optional." json_name @@ -567,8 +567,8 @@ implementations can read newer data. If this is already the case, use add stacks { direction = Backward; kind = Default_required { field_name = json_name }; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "\ Newly required field '%s' was optional but had a default value. @@ -582,8 +582,8 @@ then there's no problem and you should use add stacks { direction = Backward; kind = Missing_field { field_name = json_name }; - location_old = Some loc1; - location_new = Some loc2; + location_old = Some (loc1 |> Loc.of_atd_loc); + location_new = Some (loc2 |> Loc.of_atd_loc); description = sprintf "Formerly optional field '%s' is now required." json_name @@ -599,8 +599,8 @@ then there's no problem and you should use add stacks { direction = Both; kind = Incompatible_type; - location_old = Some (A.loc_of_type_expr e1); - location_new = Some (A.loc_of_type_expr e2); + location_old = Some (A.loc_of_type_expr e1 |> Loc.of_atd_loc); + location_new = Some (A.loc_of_type_expr e2 |> Loc.of_atd_loc); description = sprintf "Incompatible tuple lengths"; } else @@ -629,12 +629,12 @@ let finding_group (a : finding) = | None, Some _ -> 3 | Some _, Some _ -> 4 -let compare_opt_location (a : Atd.Loc.t option) (b : Atd.Loc.t option) = +let compare_opt_location (a : Loc.t option) (b : Loc.t option) = match a, b with | Some _, None -> -1 | None, Some _ -> 1 | None, None -> 0 - | Some a, Some b -> Atd.Loc.compare a b + | Some a, Some b -> Loc.compare a b (* Compare results so as to sort them in the following order: 1. Exists only in the old file @@ -656,7 +656,7 @@ let compare_findings (a : finding) (b : finding) = if c <> 0 then c else Stdlib.compare a b -let group_and_sort_findings xs = +let group_and_sort_findings xs : full_finding list = let tbl = Hashtbl.create 100 in xs |> List.iter (fun ((affected_names1, affected_names2), finding) -> @@ -675,11 +675,11 @@ let group_and_sort_findings xs = We could be more precise about equivalence between old and new names. Would it help the user? *) let all_affected_names = Strings.union affected_names1 affected_names2 in - (finding, - Strings.elements all_affected_names) + { finding; + affected_types = Strings.elements all_affected_names } :: acc) tbl [] - |> List.sort (fun (a, _) (b, _) -> compare_findings a b) + |> List.sort (fun a b -> compare_findings a.finding b.finding) (* Expectations: @@ -725,5 +725,8 @@ let asts options (ast1 : A.full_module) (ast2 : A.full_module) : result = ] |> List.flatten in - findings - |> group_and_sort_findings + let findings = + findings + |> group_and_sort_findings + in + { findings } diff --git a/atddiff/src/lib/Compare.mli b/atddiff/src/lib/Compare.mli index a0b0ee17..a2d0a27f 100644 --- a/atddiff/src/lib/Compare.mli +++ b/atddiff/src/lib/Compare.mli @@ -12,4 +12,5 @@ type options = { } val asts : - options -> Atd.Ast.full_module -> Atd.Ast.full_module -> Types.result + options -> Atd.Ast.full_module -> Atd.Ast.full_module -> + Atddiff_output_t.result diff --git a/atddiff/src/lib/Format_JSON.ml b/atddiff/src/lib/Format_JSON.ml new file mode 100644 index 00000000..ceaf5a1a --- /dev/null +++ b/atddiff/src/lib/Format_JSON.ml @@ -0,0 +1,78 @@ +(* + Convert (tediously) the atddiff findings to JSON. +*) + +open Atddiff_output_t +type json = Yojson.Safe.t + +let string x : json = `String x + +let option f opt : json = + match opt with + | Some x -> f x + | None -> `Null + +let remove_null_fields xs : (string * json) list = + List.filter (function (_, `Null) -> false | _ -> true) xs + +let fmt_direction (x : direction) : json = + match x with + | Backward -> `String "Backward" + | Forward -> `String "Forward" + | Both -> `String "Both" + +let fmt_field_info { field_name } : json = + `Assoc [ "field_name", `String field_name ] + +let fmt_variant_info { variant_name } : json = + `Assoc [ "variant_name", `String variant_name ] + +let fmt_kind (x : incompatibility_kind) : json = + match x with + | Missing_field x -> `List [`String "Missing_field"; fmt_field_info x] + | Missing_variant x -> `List [`String "Missing_variant"; fmt_variant_info x] + | Missing_variant_argument x -> + `List [`String "Missing_variant_argument"; fmt_variant_info x] + | Default_required x -> `List [`String "Default_required"; fmt_field_info x] + | Incompatible_type -> `String "Incompatible_type" + | Deleted_type -> `String "Deleted_type" + | Added_type -> `String "Added_type" + +let fmt_position (x : position) : json = + `Assoc [ + "path", `String x.path; + "line", `Int x.line; + "column", `Int x.column; + ] + +let fmt_location (x : location) : json = + `Assoc [ + "start", fmt_position x.start; + "end", fmt_position x.end_; + ] + +let fmt_finding (x : finding) : json = + `Assoc (remove_null_fields [ + "direction", fmt_direction x.direction; + "kind", fmt_kind x.kind; + "location_old", option fmt_location x.location_old; + "location_new", option fmt_location x.location_new; + "description", `String x.description; + ]) + +let fmt_full_finding (x : full_finding) : json = + `Assoc [ + "finding", fmt_finding x.finding; + "affected_types", `List (List.map string x.affected_types); + ] + +let to_yojson (x : result) : json = + `Assoc [ + "findings", `List (List.map fmt_full_finding x.findings) + ] + +let to_string x = + x + |> to_yojson + |> Yojson.Safe.to_string + |> Yojson.Safe.prettify diff --git a/atddiff/src/lib/Format_JSON.mli b/atddiff/src/lib/Format_JSON.mli new file mode 100644 index 00000000..360d12ef --- /dev/null +++ b/atddiff/src/lib/Format_JSON.mli @@ -0,0 +1,5 @@ +(* + Convert (tediously) the atddiff findings to JSON. +*) + +val to_string : Atddiff_output_t.result -> string diff --git a/atddiff/src/lib/Format_text.ml b/atddiff/src/lib/Format_text.ml index 55a7d2c5..53da6f9a 100644 --- a/atddiff/src/lib/Format_text.ml +++ b/atddiff/src/lib/Format_text.ml @@ -3,17 +3,23 @@ *) open Printf -open Types +module T = Atddiff_output_t -let format_loc_text opt_loc = - match opt_loc with - | None -> "" - | Some loc -> Atd.Ast.string_of_loc loc ^ "\n" +let format_loc_text opt_loc1 opt_loc2 = + match opt_loc1, opt_loc2 with + | None, None -> "" + | Some loc, None | None, Some loc -> + Loc.to_string loc + | Some loc1, Some loc2 -> + sprintf "%s\n%s" + (Loc.to_string loc1) + (Loc.to_string loc2) -let format_incompatibility_text buf ((x : finding), affected_types) = +let format_incompatibility_text buf (x : T.full_finding) = + let finding = x.finding in let is_certain = (* TODO: more clearly distinguish Warning from Error? *) - match x.kind with + match finding.kind with | Missing_field _ -> true | Missing_variant _ -> true | Missing_variant_argument _ -> true @@ -23,7 +29,7 @@ let format_incompatibility_text buf ((x : finding), affected_types) = | Added_type -> false in let dir = - match x.direction, is_certain with + match finding.direction, is_certain with | Forward, true -> "Forward incompatibility" | Backward, true -> "Backward incompatibility" | Both, true -> "Incompatibility in both directions" @@ -33,21 +39,21 @@ let format_incompatibility_text buf ((x : finding), affected_types) = in bprintf buf "\ %s: -%s%s%s +%s: +%s The following types are affected:%s " dir - (format_loc_text x.location_old) - (format_loc_text x.location_new) - x.description - (affected_types + (format_loc_text finding.location_old finding.location_new) + finding.description + (x.affected_types |> List.map (fun name -> "\n " ^ name) |> String.concat "") -let to_string (res : result) : string = +let to_string (res : T.result) : string = let buf = Buffer.create 1000 in List.iter (fun x -> format_incompatibility_text buf x; Buffer.add_char buf '\n' - ) res; + ) res.findings; Buffer.contents buf diff --git a/atddiff/src/lib/Format_text.mli b/atddiff/src/lib/Format_text.mli index ee024054..44677233 100644 --- a/atddiff/src/lib/Format_text.mli +++ b/atddiff/src/lib/Format_text.mli @@ -2,4 +2,4 @@ Format comparison results in a human-readable form *) -val to_string : Types.result -> string +val to_string : Atddiff_output_t.result -> string diff --git a/atddiff/src/lib/Loc.ml b/atddiff/src/lib/Loc.ml new file mode 100644 index 00000000..72e2bdcc --- /dev/null +++ b/atddiff/src/lib/Loc.ml @@ -0,0 +1,57 @@ +(* + Yet another Loc module. + + This one differs from Atd.Loc because it uses a JSON-friendly type. +*) + +module T = Atddiff_output_t + +type t = T.location + +let position_of_lexing_pos (x : Lexing.position) : T.position = + { + path = x.pos_fname; + line = x.pos_lnum; + column = x.pos_cnum - x.pos_bol; + } + +let of_atd_loc (start, end_) : t = + { + start = position_of_lexing_pos start; + end_ = position_of_lexing_pos end_ + } + +let compare_pos (a : T.position) (b : T.position) = + let c = String.compare a.path b.path in + if c <> 0 then c + else + let c = Int.compare a.line b.line in + if c <> 0 then c + else + Int.compare a.column b.column + +(* Compare two locations so as to sort them by: + 1. file path + 2. start position in the file + 3. end position in the file +*) +let compare (a : t) (b : t) = + let c = compare_pos a.start b.start in + if c <> 0 then c + else + compare_pos a.end_ b.end_ + +let to_string ({start; end_} : t) = + if start.line = end_.line then + Printf.sprintf "File %S, line %i, characters %i-%i" + start.path + start.line + start.column + end_.column + else + Printf.sprintf "File %S, line %i, character %i to line %i, character %i" + start.path + start.line + start.column + end_.line + end_.column diff --git a/atddiff/src/lib/Loc.mli b/atddiff/src/lib/Loc.mli new file mode 100644 index 00000000..46d3228b --- /dev/null +++ b/atddiff/src/lib/Loc.mli @@ -0,0 +1,17 @@ +(* + Yet another Loc module. + + This one differs from Atd.Loc because it uses a JSON-friendly type. +*) + +type t = Atddiff_output_t.location + +val of_atd_loc : Atd.Loc.t -> t + +val compare : t -> t -> int + +(* Produce something like + + File "atddiff/src/bin/Atddiff_main.ml", lines 247-256, characters 8-5 +*) +val to_string : t -> string diff --git a/atddiff/src/lib/Makefile b/atddiff/src/lib/Makefile new file mode 100644 index 00000000..8dc48625 --- /dev/null +++ b/atddiff/src/lib/Makefile @@ -0,0 +1,14 @@ +# +# Generate a .ml file containing just the type definitions derived from +# an ATD file. +# +# We don't generate code that exercises the atdgen runtime library +# due to circular dependencies but atddiff users can. +# + +# This requires an external installation of the atdgen command. +.PHONY: types +types: Atddiff_output_t.ml + +Atddiff_output_t.ml: Atddiff_output.atd + atdgen -t Atddiff_output.atd diff --git a/atddiff/src/lib/dune b/atddiff/src/lib/dune index 72ab6f31..fc018c62 100644 --- a/atddiff/src/lib/dune +++ b/atddiff/src/lib/dune @@ -2,5 +2,6 @@ (name atddiff) (libraries atd + yojson ) ) diff --git a/atddiff/test/default/backward_incompatible_record.expected.txt b/atddiff/test/default/backward_incompatible_record.expected.txt index c44635e8..bbdc3d42 100644 --- a/atddiff/test/default/backward_incompatible_record.expected.txt +++ b/atddiff/test/default/backward_incompatible_record.expected.txt @@ -1,12 +1,12 @@ Backward incompatibility: -File "backward_incompatible_record_new.atd", line 2, characters 2-18 +File "backward_incompatible_record_new.atd", line 2, characters 2-18: Required field 'added_field' is new. The following types are affected: backward_incompatible_record Backward incompatibility: File "backward_incompatible_record_old.atd", line 2, characters 2-31 -File "backward_incompatible_record_new.atd", line 3, characters 2-23 +File "backward_incompatible_record_new.atd", line 3, characters 2-23: Formerly optional field 'becomes_required' is now required. The following types are affected: backward_incompatible_record diff --git a/atddiff/test/default/backward_incompatible_record_if_implicit_defaults.expected.txt b/atddiff/test/default/backward_incompatible_record_if_implicit_defaults.expected.txt index b3250439..12d75a88 100644 --- a/atddiff/test/default/backward_incompatible_record_if_implicit_defaults.expected.txt +++ b/atddiff/test/default/backward_incompatible_record_if_implicit_defaults.expected.txt @@ -1,6 +1,6 @@ Possible backward incompatibility: File "backward_incompatible_record_if_implicit_defaults_old.atd", line 2, characters 2-24 -File "backward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-23 +File "backward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-23: Newly required field 'becomes_required' was optional but had a default value. If old implementations in use always populate the JSON field with a value (using atdgen's option -j-defaults or equivalent), diff --git a/atddiff/test/default/backward_incompatible_variant.expected.txt b/atddiff/test/default/backward_incompatible_variant.expected.txt index 6d67a78b..e955fd8e 100644 --- a/atddiff/test/default/backward_incompatible_variant.expected.txt +++ b/atddiff/test/default/backward_incompatible_variant.expected.txt @@ -1,5 +1,5 @@ Backward incompatibility: -File "backward_incompatible_variant_old.atd", line 1, characters 43-44 +File "backward_incompatible_variant_old.atd", line 1, characters 43-44: Case 'B' disappeared. The following types are affected: backward_incompatible_variant diff --git a/atddiff/test/default/changed_renamed.expected.txt b/atddiff/test/default/changed_renamed.expected.txt index fb0e1c0b..41981376 100644 --- a/atddiff/test/default/changed_renamed.expected.txt +++ b/atddiff/test/default/changed_renamed.expected.txt @@ -1,6 +1,6 @@ Incompatibility in both directions: File "changed_renamed_old.atd", line 10, characters 22-26 -File "changed_renamed_new.atd", line 10, characters 22-28 +File "changed_renamed_new.atd", line 10, characters 22-28: Type names 'int' and 'float' are not the same and may not be compatible. The following types are affected: new_name diff --git a/atddiff/test/default/forward_incompatible_record.expected.txt b/atddiff/test/default/forward_incompatible_record.expected.txt index 2e672069..893bd502 100644 --- a/atddiff/test/default/forward_incompatible_record.expected.txt +++ b/atddiff/test/default/forward_incompatible_record.expected.txt @@ -1,12 +1,12 @@ Forward incompatibility: -File "forward_incompatible_record_old.atd", line 2, characters 2-20 +File "forward_incompatible_record_old.atd", line 2, characters 2-20: Required field 'removed_field' disappeared. The following types are affected: forward_incompatible_record Forward incompatibility: File "forward_incompatible_record_old.atd", line 3, characters 2-23 -File "forward_incompatible_record_new.atd", line 2, characters 2-31 +File "forward_incompatible_record_new.atd", line 2, characters 2-31: Formerly required field 'becomes_optional' is now optional. The following types are affected: forward_incompatible_record diff --git a/atddiff/test/default/forward_incompatible_record_if_implicit_defaults.expected.txt b/atddiff/test/default/forward_incompatible_record_if_implicit_defaults.expected.txt index cbbe6191..3e9eadbd 100644 --- a/atddiff/test/default/forward_incompatible_record_if_implicit_defaults.expected.txt +++ b/atddiff/test/default/forward_incompatible_record_if_implicit_defaults.expected.txt @@ -1,6 +1,6 @@ Possible forward incompatibility: File "forward_incompatible_record_if_implicit_defaults_old.atd", line 2, characters 2-23 -File "forward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-24 +File "forward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-24: Formerly required field 'becomes_optional' is now optional but has a default value. You must ensure that new implementations always populate the JSON field with a value (using atdgen's option -j-defaults or equivalent) so that older diff --git a/atddiff/test/default/forward_incompatible_variant.expected.txt b/atddiff/test/default/forward_incompatible_variant.expected.txt index 1573c3fb..a31fbad8 100644 --- a/atddiff/test/default/forward_incompatible_variant.expected.txt +++ b/atddiff/test/default/forward_incompatible_variant.expected.txt @@ -1,5 +1,5 @@ Backward incompatibility: -File "forward_incompatible_variant_new.atd", line 1, characters 42-43 +File "forward_incompatible_variant_new.atd", line 1, characters 42-43: Case 'B' is new. The following types are affected: forward_incompatible_variant diff --git a/atddiff/test/default/json_field_name_change.expected.txt b/atddiff/test/default/json_field_name_change.expected.txt index 08f843d0..5375b256 100644 --- a/atddiff/test/default/json_field_name_change.expected.txt +++ b/atddiff/test/default/json_field_name_change.expected.txt @@ -1,23 +1,23 @@ Forward incompatibility: -File "json_field_name_change_old.atd", line 2, characters 2-26 +File "json_field_name_change_old.atd", line 2, characters 2-26: Required field 'a!' disappeared. The following types are affected: with_field_renames Forward incompatibility: -File "json_field_name_change_old.atd", line 3, characters 2-9 +File "json_field_name_change_old.atd", line 3, characters 2-9: Required field 'b' disappeared. The following types are affected: with_field_renames Backward incompatibility: -File "json_field_name_change_new.atd", line 2, characters 2-9 +File "json_field_name_change_new.atd", line 2, characters 2-9: Required field 'a' is new. The following types are affected: with_field_renames Backward incompatibility: -File "json_field_name_change_new.atd", line 3, characters 2-27 +File "json_field_name_change_new.atd", line 3, characters 2-27: Required field 'bee' is new. The following types are affected: with_field_renames diff --git a/atddiff/test/default/json_repr_change.expected.txt b/atddiff/test/default/json_repr_change.expected.txt index c8a30675..faa42ba7 100644 --- a/atddiff/test/default/json_repr_change.expected.txt +++ b/atddiff/test/default/json_repr_change.expected.txt @@ -1,6 +1,6 @@ Incompatibility in both directions: File "json_repr_change_old.atd", line 2, characters 21-40 -File "json_repr_change_new.atd", line 2, characters 21-61 +File "json_repr_change_new.atd", line 2, characters 21-61: Incompatible kinds of types: list/array is now a map. The following types are affected: incompatible_record diff --git a/atddiff/test/default/json_variant_name_change.expected.txt b/atddiff/test/default/json_variant_name_change.expected.txt index e8b66ec9..5ac3837c 100644 --- a/atddiff/test/default/json_variant_name_change.expected.txt +++ b/atddiff/test/default/json_variant_name_change.expected.txt @@ -1,47 +1,47 @@ Backward incompatibility: -File "json_variant_name_change_old.atd", line 2, characters 4-5 +File "json_variant_name_change_old.atd", line 2, characters 4-5: Case 'A' disappeared. The following types are affected: with_constructor_renames Backward incompatibility: -File "json_variant_name_change_old.atd", line 3, characters 4-12 +File "json_variant_name_change_old.atd", line 3, characters 4-12: Case 'B' disappeared. The following types are affected: with_constructor_renames Backward incompatibility: -File "json_variant_name_change_old.atd", line 4, characters 4-23 +File "json_variant_name_change_old.atd", line 4, characters 4-23: Case 'cee' disappeared. The following types are affected: with_constructor_renames Backward incompatibility: -File "json_variant_name_change_old.atd", line 5, characters 4-30 +File "json_variant_name_change_old.atd", line 5, characters 4-30: Case 'dee' disappeared. The following types are affected: with_constructor_renames Backward incompatibility: -File "json_variant_name_change_new.atd", line 2, characters 4-22 +File "json_variant_name_change_new.atd", line 2, characters 4-22: Case 'a!' is new. The following types are affected: with_constructor_renames Backward incompatibility: -File "json_variant_name_change_new.atd", line 3, characters 4-29 +File "json_variant_name_change_new.atd", line 3, characters 4-29: Case 'b!' is new. The following types are affected: with_constructor_renames Backward incompatibility: -File "json_variant_name_change_new.atd", line 4, characters 4-5 +File "json_variant_name_change_new.atd", line 4, characters 4-5: Case 'C' is new. The following types are affected: with_constructor_renames Backward incompatibility: -File "json_variant_name_change_new.atd", line 5, characters 4-12 +File "json_variant_name_change_new.atd", line 5, characters 4-12: Case 'D' is new. The following types are affected: with_constructor_renames diff --git a/atddiff/test/default/recursive.expected.txt b/atddiff/test/default/recursive.expected.txt index 0d7122a1..ac197f51 100644 --- a/atddiff/test/default/recursive.expected.txt +++ b/atddiff/test/default/recursive.expected.txt @@ -1,5 +1,5 @@ Backward incompatibility: -File "recursive_new.atd", line 9, characters 52-53 +File "recursive_new.atd", line 9, characters 52-53: Case 'B' is new. The following types are affected: changed_recursive diff --git a/atddiff/test/default/swapped_type_parameters.expected.txt b/atddiff/test/default/swapped_type_parameters.expected.txt index 8034e85c..264e800e 100644 --- a/atddiff/test/default/swapped_type_parameters.expected.txt +++ b/atddiff/test/default/swapped_type_parameters.expected.txt @@ -1,6 +1,6 @@ Incompatibility in both directions: File "swapped_type_parameters_old.atd", line 3, characters 0-61 -File "swapped_type_parameters_new.atd", line 3, characters 0-61 +File "swapped_type_parameters_new.atd", line 3, characters 0-61: Incompatible type variables are being used. The following types are affected: swapped_type_parameters diff --git a/atddiff/test/default/type_arity_change.expected.txt b/atddiff/test/default/type_arity_change.expected.txt index 1ec92ba8..9fa1d0f4 100644 --- a/atddiff/test/default/type_arity_change.expected.txt +++ b/atddiff/test/default/type_arity_change.expected.txt @@ -1,6 +1,6 @@ Incompatibility in both directions: File "type_arity_change_old.atd", line 1, characters 0-48 -File "type_arity_change_new.atd", line 1, characters 0-42 +File "type_arity_change_new.atd", line 1, characters 0-42: Incompatible type variables are being used. The following types are affected: type_arity_change diff --git a/atddiff/test/default/type_name_change.expected.txt b/atddiff/test/default/type_name_change.expected.txt index 9c26de46..39801919 100644 --- a/atddiff/test/default/type_name_change.expected.txt +++ b/atddiff/test/default/type_name_change.expected.txt @@ -1,23 +1,23 @@ Possible backward incompatibility: -File "type_name_change_old.atd", line 2, characters 0-33 +File "type_name_change_old.atd", line 2, characters 0-33: The definition for type 'old_name_for_root_type' no longer exists. The following types are affected: old_name_for_root_type Possible backward incompatibility: -File "type_name_change_old.atd", line 5, characters 0-56 +File "type_name_change_old.atd", line 5, character 0 to line 7, character 1: The definition for type 'old_name_for_root_type_with_changes' no longer exists. The following types are affected: old_name_for_root_type_with_changes Possible forward incompatibility: -File "type_name_change_new.atd", line 2, characters 0-33 +File "type_name_change_new.atd", line 2, characters 0-33: There is a new type named 'new_name_for_root_type'. The following types are affected: new_name_for_root_type Possible forward incompatibility: -File "type_name_change_new.atd", line 5, characters 0-58 +File "type_name_change_new.atd", line 5, character 0 to line 7, character 1: There is a new type named 'new_name_for_root_type_with_changes'. The following types are affected: new_name_for_root_type_with_changes diff --git a/atddiff/test/filter/filter.expected.txt b/atddiff/test/filter/filter.expected.txt index fe067930..94201126 100644 --- a/atddiff/test/filter/filter.expected.txt +++ b/atddiff/test/filter/filter.expected.txt @@ -1,6 +1,6 @@ Incompatibility in both directions: File "filter_old.atd", line 7, characters 16-20 -File "filter_new.atd", line 7, characters 16-23 +File "filter_new.atd", line 7, characters 16-23: Type names 'int' and 'string' are not the same and may not be compatible. The following types are affected: a diff --git a/atddiff/test/filter_backward/filter.expected.txt b/atddiff/test/filter_backward/filter.expected.txt index 9687c585..cf55878b 100644 --- a/atddiff/test/filter_backward/filter.expected.txt +++ b/atddiff/test/filter_backward/filter.expected.txt @@ -1,5 +1,5 @@ Backward incompatibility: -File "filter_new.atd", line 6, characters 2-18 +File "filter_new.atd", line 6, characters 2-18: Required field 'added_field' is new. The following types are affected: a @@ -7,7 +7,7 @@ The following types are affected: Incompatibility in both directions: File "filter_old.atd", line 7, characters 16-20 -File "filter_new.atd", line 7, characters 16-23 +File "filter_new.atd", line 7, characters 16-23: Type names 'int' and 'string' are not the same and may not be compatible. The following types are affected: a diff --git a/atddiff/test/filter_forward/filter.expected.txt b/atddiff/test/filter_forward/filter.expected.txt index 4d76774b..d2d468de 100644 --- a/atddiff/test/filter_forward/filter.expected.txt +++ b/atddiff/test/filter_forward/filter.expected.txt @@ -1,5 +1,5 @@ Forward incompatibility: -File "filter_old.atd", line 6, characters 2-20 +File "filter_old.atd", line 6, characters 2-20: Required field 'deleted_field' disappeared. The following types are affected: a @@ -7,7 +7,7 @@ The following types are affected: Incompatibility in both directions: File "filter_old.atd", line 7, characters 16-20 -File "filter_new.atd", line 7, characters 16-23 +File "filter_new.atd", line 7, characters 16-23: Type names 'int' and 'string' are not the same and may not be compatible. The following types are affected: a diff --git a/atddiff/test/generate-dune-rules b/atddiff/test/generate-dune-rules index ddac8f70..da2a00ce 100755 --- a/atddiff/test/generate-dune-rules +++ b/atddiff/test/generate-dune-rules @@ -52,6 +52,7 @@ folders=" json_defaults json_defaults_old json_defaults_new + json_output " for folder in $folders; do @@ -77,6 +78,9 @@ for folder in $folders; do json_defaults_new) atddiff_options="--exit-success --json-defaults-new" ;; + json_output) + atddiff_options="--exit-success --output-format json" + ;; *) echo "Error: Unknown atddiff command for test folder $folder" >&2 exit 1 diff --git a/atddiff/test/json_defaults_new/backward_incompatible_record_if_implicit_defaults.expected.txt b/atddiff/test/json_defaults_new/backward_incompatible_record_if_implicit_defaults.expected.txt index b3250439..12d75a88 100644 --- a/atddiff/test/json_defaults_new/backward_incompatible_record_if_implicit_defaults.expected.txt +++ b/atddiff/test/json_defaults_new/backward_incompatible_record_if_implicit_defaults.expected.txt @@ -1,6 +1,6 @@ Possible backward incompatibility: File "backward_incompatible_record_if_implicit_defaults_old.atd", line 2, characters 2-24 -File "backward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-23 +File "backward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-23: Newly required field 'becomes_required' was optional but had a default value. If old implementations in use always populate the JSON field with a value (using atdgen's option -j-defaults or equivalent), diff --git a/atddiff/test/json_defaults_old/forward_incompatible_record_if_implicit_defaults.expected.txt b/atddiff/test/json_defaults_old/forward_incompatible_record_if_implicit_defaults.expected.txt index cbbe6191..3e9eadbd 100644 --- a/atddiff/test/json_defaults_old/forward_incompatible_record_if_implicit_defaults.expected.txt +++ b/atddiff/test/json_defaults_old/forward_incompatible_record_if_implicit_defaults.expected.txt @@ -1,6 +1,6 @@ Possible forward incompatibility: File "forward_incompatible_record_if_implicit_defaults_old.atd", line 2, characters 2-23 -File "forward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-24 +File "forward_incompatible_record_if_implicit_defaults_new.atd", line 2, characters 2-24: Formerly required field 'becomes_optional' is now optional but has a default value. You must ensure that new implementations always populate the JSON field with a value (using atdgen's option -j-defaults or equivalent) so that older diff --git a/atddiff/test/json_output/all_errors.expected.txt b/atddiff/test/json_output/all_errors.expected.txt new file mode 100644 index 00000000..83764bc6 --- /dev/null +++ b/atddiff/test/json_output/all_errors.expected.txt @@ -0,0 +1,282 @@ +{ + "findings": [ + { + "finding": { + "direction": "Backward", + "kind": "Deleted_type", + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 1, "column": 0 }, + "end": { "path": "all_errors_old.atd", "line": 1, "column": 18 } + }, + "description": "The definition for type 'deleted' no longer exists." + }, + "affected_types": [ "deleted" ] + }, + { + "finding": { + "direction": "Forward", + "kind": [ "Missing_field", { "field_name": "deleted_field" } ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 4, "column": 2 }, + "end": { "path": "all_errors_old.atd", "line": 4, "column": 20 } + }, + "description": "Required field 'deleted_field' disappeared." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Forward", + "kind": [ "Missing_field", { "field_name": "renamed_field" } ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 9, "column": 2 }, + "end": { "path": "all_errors_old.atd", "line": 9, "column": 20 } + }, + "description": "Required field 'renamed_field' disappeared." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ "Missing_variant", { "variant_name": "Deleted_case" } ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 13, "column": 4 }, + "end": { "path": "all_errors_old.atd", "line": 13, "column": 16 } + }, + "description": "Case 'Deleted_case' disappeared." + }, + "affected_types": [ "changed_variant", "indirect_changes" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ + "Missing_variant", { "variant_name": "Deleted_case_with_arg" } + ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 14, "column": 4 }, + "end": { "path": "all_errors_old.atd", "line": 14, "column": 35 } + }, + "description": "Case 'Deleted_case_with_arg' disappeared." + }, + "affected_types": [ "changed_variant", "indirect_changes" ] + }, + { + "finding": { + "direction": "Forward", + "kind": "Deleted_type", + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 1, "column": 0 }, + "end": { "path": "all_errors_new.atd", "line": 1, "column": 18 } + }, + "description": "There is a new type named 'created'." + }, + "affected_types": [ "created" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ "Missing_field", { "field_name": "new_field" } ], + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 4, "column": 2 }, + "end": { "path": "all_errors_new.atd", "line": 4, "column": 16 } + }, + "description": "Required field 'new_field' is new." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ "Missing_field", { "field_name": "RENAMED_FIELD" } ], + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 9, "column": 2 }, + "end": { "path": "all_errors_new.atd", "line": 9, "column": 48 } + }, + "description": "Required field 'RENAMED_FIELD' is new." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ "Missing_variant", { "variant_name": "New_case" } ], + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 13, "column": 4 }, + "end": { "path": "all_errors_new.atd", "line": 13, "column": 12 } + }, + "description": "Case 'New_case' is new." + }, + "affected_types": [ "changed_variant", "indirect_changes" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ + "Missing_variant", { "variant_name": "New_case_with_arg" } + ], + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 14, "column": 4 }, + "end": { "path": "all_errors_new.atd", "line": 14, "column": 28 } + }, + "description": "Case 'New_case_with_arg' is new." + }, + "affected_types": [ "changed_variant", "indirect_changes" ] + }, + { + "finding": { + "direction": "Forward", + "kind": [ "Missing_field", { "field_name": "becomes_optional" } ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 5, "column": 2 }, + "end": { "path": "all_errors_old.atd", "line": 5, "column": 23 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 5, "column": 2 }, + "end": { "path": "all_errors_new.atd", "line": 5, "column": 31 } + }, + "description": "Formerly required field 'becomes_optional' is now optional." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Forward", + "kind": [ + "Default_required", + { "field_name": "becomes_optional_with_default" } + ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 6, "column": 2 }, + "end": { "path": "all_errors_old.atd", "line": 6, "column": 36 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 6, "column": 2 }, + "end": { "path": "all_errors_new.atd", "line": 6, "column": 37 } + }, + "description": "Formerly required field 'becomes_optional_with_default' is now optional but has a default value.\nYou must ensure that new implementations always populate the JSON field\nwith a value (using atdgen's option -j-defaults or equivalent) so that older\nimplementations can read newer data. If this is already the case, use\n'atddiff --json-defaults-new' to disable this warning." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ "Missing_field", { "field_name": "becomes_required" } ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 7, "column": 2 }, + "end": { "path": "all_errors_old.atd", "line": 7, "column": 31 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 7, "column": 2 }, + "end": { "path": "all_errors_new.atd", "line": 7, "column": 23 } + }, + "description": "Formerly optional field 'becomes_required' is now required." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Backward", + "kind": [ + "Default_required", + { "field_name": "with_default_becomes_required" } + ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 8, "column": 2 }, + "end": { "path": "all_errors_old.atd", "line": 8, "column": 37 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 8, "column": 2 }, + "end": { "path": "all_errors_new.atd", "line": 8, "column": 36 } + }, + "description": "Newly required field 'with_default_becomes_required' was optional but had a default value.\nIf old implementations in use always populate the JSON field\nwith a value (using atdgen's option -j-defaults or equivalent),\nthen there's no problem and you should use\n'atddiff --json-defaults-old' to disable this warning." + }, + "affected_types": [ "changed_record", "indirect_changes" ] + }, + { + "finding": { + "direction": "Both", + "kind": [ + "Missing_variant_argument", { "variant_name": "Added_arg" } + ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 15, "column": 4 }, + "end": { "path": "all_errors_old.atd", "line": 15, "column": 13 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 15, "column": 4 }, + "end": { "path": "all_errors_new.atd", "line": 15, "column": 22 } + }, + "description": "Case 'Added_arg' used to not have an argument." + }, + "affected_types": [ "changed_variant", "indirect_changes" ] + }, + { + "finding": { + "direction": "Both", + "kind": [ + "Missing_variant_argument", { "variant_name": "Removed_arg" } + ], + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 16, "column": 4 }, + "end": { "path": "all_errors_old.atd", "line": 16, "column": 22 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 16, "column": 4 }, + "end": { "path": "all_errors_new.atd", "line": 16, "column": 15 } + }, + "description": "Case 'Removed_arg' no longer has an argument." + }, + "affected_types": [ "changed_variant", "indirect_changes" ] + }, + { + "finding": { + "direction": "Both", + "kind": "Incompatible_type", + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 17, "column": 18 }, + "end": { "path": "all_errors_old.atd", "line": 17, "column": 22 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 17, "column": 18 }, + "end": { "path": "all_errors_new.atd", "line": 17, "column": 23 } + }, + "description": "Type names 'int' and 'bool' are not the same and may not be compatible." + }, + "affected_types": [ "changed_variant", "indirect_changes" ] + }, + { + "finding": { + "direction": "Both", + "kind": "Incompatible_type", + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 26, "column": 20 }, + "end": { "path": "all_errors_old.atd", "line": 26, "column": 60 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 26, "column": 20 }, + "end": { "path": "all_errors_new.atd", "line": 26, "column": 39 } + }, + "description": "Incompatible kinds of types: map is now a list/array." + }, + "affected_types": [ "changed_map1" ] + }, + { + "finding": { + "direction": "Both", + "kind": "Incompatible_type", + "location_old": { + "start": { "path": "all_errors_old.atd", "line": 27, "column": 20 }, + "end": { "path": "all_errors_old.atd", "line": 27, "column": 39 } + }, + "location_new": { + "start": { "path": "all_errors_new.atd", "line": 27, "column": 20 }, + "end": { "path": "all_errors_new.atd", "line": 27, "column": 60 } + }, + "description": "Incompatible kinds of types: list/array is now a map." + }, + "affected_types": [ "changed_map2" ] + } + ] +} diff --git a/atddiff/test/json_output/all_errors_new.atd b/atddiff/test/json_output/all_errors_new.atd new file mode 100644 index 00000000..f313af79 --- /dev/null +++ b/atddiff/test/json_output/all_errors_new.atd @@ -0,0 +1,27 @@ +type created = int + +type changed_record = { + new_field: int; + ?becomes_optional: int option; + ~becomes_optional_with_default: int; + becomes_required: int; + with_default_becomes_required: int; + renamed_field : int; +} + +type changed_variant = [ + | New_case + | New_case_with_arg of int + | Added_arg of float + | Removed_arg + | Changed_arg of bool + | Renamed_case +] + +type indirect_changes = { + record: changed_record; + variant: changed_variant; +} + +type changed_map1 = (string * int) list +type changed_map2 = (string * int) list diff --git a/atddiff/test/json_output/all_errors_old.atd b/atddiff/test/json_output/all_errors_old.atd new file mode 100644 index 00000000..64c7d8e3 --- /dev/null +++ b/atddiff/test/json_output/all_errors_old.atd @@ -0,0 +1,27 @@ +type deleted = int + +type changed_record = { + deleted_field: int; + becomes_optional: int; + becomes_optional_with_default: int; + ?becomes_required: int option; + ~with_default_becomes_required: int; + renamed_field: int; +} + +type changed_variant = [ + | Deleted_case + | Deleted_case_with_arg of string + | Added_arg + | Removed_arg of int + | Changed_arg of int + | Renamed_case +] + +type indirect_changes = { + record: changed_record; + variant: changed_variant; +} + +type changed_map1 = (string * int) list +type changed_map2 = (string * int) list diff --git a/atddiff/test/json_output/dune b/atddiff/test/json_output/dune new file mode 100644 index 00000000..fc7ad3b2 --- /dev/null +++ b/atddiff/test/json_output/dune @@ -0,0 +1,12 @@ +; Generated by ./generate-dune-rules +; For adding tests, read the instructions in the Makefile. +(rule + (targets all_errors.txt) + (deps all_errors_old.atd all_errors_new.atd) + (action (run %{bin:atddiff} %{deps} -o %{targets} --exit-success --output-format json))) + +(rule + (alias runtest) + (deps all_errors.txt) + (action (diff all_errors.expected.txt all_errors.txt))) +