Source file compare_core.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
open! Core
open! Import
module Unix = Core_unix
include Patdiff_kernel.Compare_core
include Make (Patdiff_core)

(* Returns a Hunk.t list, ready to be printed *)
let compare_files (config : Configuration.t) ~prev_file ~next_file =
  let prev = In_channel.read_all (File_name.real_name_exn prev_file) in
  let next = In_channel.read_all (File_name.real_name_exn next_file) in
  Comparison_result.create
    config
    ~prev:{ name = File_name.display_name prev_file; text = prev }
    ~next:{ name = File_name.display_name next_file; text = next }
    ~compare_assuming_text:(fun config ~prev ~next ->
      let prev_lines, prev_file_newline = File_helpers.lines_of_contents prev.text in
      let next_lines, next_file_newline = File_helpers.lines_of_contents next.text in
      File_helpers.warn_if_no_trailing_newline
        ~warn:(eprintf "No newline at the end of %s\n%!")
        ~prev:(prev_file_newline, prev.name)
        ~next:(next_file_newline, next.name)
        ~warn_if_no_trailing_newline_in_both:config.warn_if_no_trailing_newline_in_both;
      Private.compare_lines config ~prev:prev_lines ~next:next_lines)
;;

(* Print hunks to stdout *)
let print hunks ~file_names ~(config : Configuration.t) =
  let prev_file, next_file = file_names in
  if Comparison_result.has_no_diff hunks
  then (
    if config.double_check
    then (
      match
        Unix.system
          (sprintf
             "cmp -s %s %s"
             (Sys.quote (File_name.real_name_exn prev_file))
             (Sys.quote (File_name.real_name_exn next_file)))
      with
      | Ok () -> ()
      | Error (`Exit_non_zero 1) ->
        printf "There are no differences except those filtered by your settings\n%!"
      | Error _ -> ()))
  else if (* Only print if -quiet is not set *)
          not config.quiet
  then (
    let output = config.output in
    let rules = config.rules in
    match hunks with
    | Binary_same -> assert false
    | Binary_different { prev_is_binary; next_is_binary } ->
      Printf.printf
        "%s\n"
        (File_helpers.binary_different_message
           ~config
           ~prev_file
           ~prev_is_binary
           ~next_file
           ~next_is_binary)
    | Hunks hunks ->
      Patdiff_core.print
        hunks
        ~file_names
        ~output
        ~rules
        ~location_style:config.location_style)
;;

let diff_files_internal (config : Configuration.t) ~prev_file ~next_file =
  let hunks = compare_files ~prev_file ~next_file config in
  print hunks ~file_names:(prev_file, next_file) ~config;
  if Comparison_result.has_no_diff hunks then `Same else `Different
;;

let with_alt (config : Configuration.t) ~prev ~next : File_name.t * File_name.t =
  ( Real { real_name = prev; alt_name = config.prev_alt }
  , Real { real_name = next; alt_name = config.next_alt } )
;;

let diff_files (config : Configuration.t) ~prev_file ~next_file =
  let prev_file, next_file = with_alt config ~prev:prev_file ~next:next_file in
  diff_files_internal config ~prev_file ~next_file
;;

let is_reg file =
  match Unix.stat (File_name.real_name_exn file) with
  | { st_kind = S_REG; _ } -> true
  | _ -> false
;;

let is_dir file =
  match Unix.stat (File_name.real_name_exn file) with
  | { st_kind = S_DIR; _ } -> true
  | _ -> false
;;

let rec diff_dirs_internal (config : Configuration.t) ~prev_dir ~next_dir ~file_filter =
  assert (is_dir prev_dir);
  assert (is_dir next_dir);
  let set_of_dir dir =
    (* Get a list of files for this directory only; do not descend farther
       (We recursively call diff_dirs later if we need to descend.) *)
    let file_filter =
      match file_filter with
      | None -> Fn.const true
      | Some file_filter -> file_filter
    in
    Sys_unix.ls_dir (File_name.real_name_exn dir)
    |> List.filter ~f:(fun x ->
         let x = File_name.real_name_exn dir ^/ x in
         match Unix.stat x with
         | exception Unix.Unix_error (ENOENT, _, _) ->
           (* If the file disappeared during listing, let's pretend it didn't exist.
           This is important when the file is [-exclude]d because we don't want to create
           noise for excluded files, but it's also not too bad if the file is [-include]d
        *)
           false
         | stats -> file_filter (x, stats))
    |> String.Set.of_list
  in
  let prev_set = set_of_dir prev_dir in
  let next_set = set_of_dir next_dir in
  (* Get unique files *)
  let union = Set.union prev_set next_set in
  let prev_uniques = Set.diff union next_set in
  let next_uniques = Set.diff union prev_set in
  let handle_unique which file ~dir =
    printf !"Only in %{File_name#hum}: %s\n%!" dir file;
    (* Diff unique files against /dev/null, if desired *)
    if not config.mask_uniques
    then (
      let file = File_name.append dir file in
      if is_reg file
      then (
        let diff = diff_files_internal config in
        let null = File_name.dev_null in
        match which with
        | `Prev -> ignore (diff ~prev_file:file ~next_file:null : [ `Different | `Same ])
        | `Next -> ignore (diff ~prev_file:null ~next_file:file : [ `Different | `Same ])))
  in
  Set.iter prev_uniques ~f:(handle_unique `Prev ~dir:prev_dir);
  Set.iter next_uniques ~f:(handle_unique `Next ~dir:next_dir);
  (* Get differences *)
  let inter = Set.inter prev_set next_set in
  let exit_code = ref `Same in
  let diff file =
    let prev_file = File_name.append prev_dir file in
    let next_file = File_name.append next_dir file in
    if is_reg prev_file && is_reg next_file
    then (
      let hunks = compare_files ~prev_file ~next_file config in
      if not (Comparison_result.has_no_diff hunks)
      then (
        exit_code := `Different;
        (* Print the diff if not -quiet *)
        match config.quiet with
        | false -> print hunks ~file_names:(prev_file, next_file) ~config
        | true ->
          printf
            !"Files %{File_name#hum} and %{File_name#hum} differ\n%!"
            prev_file
            next_file))
    else if is_dir prev_file && is_dir next_file
    then
      if not config.shallow
      then (
        match
          diff_dirs_internal ~prev_dir:prev_file ~next_dir:next_file config ~file_filter
        with
        | `Same -> ()
        | `Different -> exit_code := `Different)
      else
        printf
          !"Common subdirectories: %{File_name#hum} and %{File_name#hum}\n%!"
          prev_file
          next_file
    else (
      exit_code := `Different;
      printf
        !"Files %{File_name#hum} and %{File_name#hum} are not the same type\n%!"
        prev_file
        next_file)
  in
  Set.iter inter ~f:diff;
  if Set.is_empty prev_uniques && Set.is_empty next_uniques
  then !exit_code
  else `Different
;;

let diff_dirs (config : Configuration.t) ~prev_dir ~next_dir ~file_filter =
  let prev_dir, next_dir = with_alt config ~prev:prev_dir ~next:next_dir in
  if not (is_dir prev_dir)
  then
    invalid_argf !"diff_dirs: prev_dir '%{File_name#hum}' is not a directory" prev_dir ();
  if not (is_dir next_dir)
  then
    invalid_argf !"diff_dirs: next_dir '%{File_name#hum}' is not a directory" next_dir ();
  diff_dirs_internal config ~prev_dir ~next_dir ~file_filter
;;