merlint: Remove ppxlib dependency, use Merlin.Dump directly

+1 -1

.ocamlformat

··· 1 - version=0.27.0 1 + version=0.28.1

+8 -7

fuzz/fuzz_block.ml

··· 18 18 else data ^ String.make (sector_size - String.length data) '\x00' 19 19 in 20 20 match Block.write blk sector padded with 21 - | Error _ -> () (* Acceptable - may be invalid sector *) 21 + | Error _ -> () (* Acceptable - may be invalid sector *) 22 22 | Ok () -> ( 23 23 match Block.read blk sector with 24 24 | Error e -> fail (Fmt.str "read failed: %a" Block.pp_error e) ··· 28 28 let test_sub_mapping data start_sector sub_start sub_len read_sector = 29 29 let sectors = 100L in 30 30 let blk = Block.of_memory ~sector_size ~sectors in 31 - let start_sector = Int64.of_int (start_sector mod 50) in 31 + let _start_sector = Int64.of_int (start_sector mod 50) in 32 32 let sub_start = Int64.of_int (sub_start mod 25) in 33 33 let sub_len = Int64.of_int (max 1 (sub_len mod 20)) in 34 - let read_sector = Int64.of_int (read_sector mod (Int64.to_int sub_len)) in 34 + let read_sector = Int64.of_int (read_sector mod Int64.to_int sub_len) in 35 35 (* Write to original device *) 36 36 let padded = 37 37 if String.length data >= sector_size then String.sub data 0 sector_size 38 38 else data ^ String.make (sector_size - String.length data) '\x00' 39 39 in 40 40 let target = Int64.add sub_start read_sector in 41 - if target >= 0L && target < sectors then ( 41 + if target >= 0L && target < sectors then 42 42 match Block.write blk target padded with 43 43 | Error _ -> () 44 - | Ok () -> 44 + | Ok () -> ( 45 45 let sub = Block.sub blk ~start:sub_start ~sectors:sub_len in 46 46 if read_sector >= 0L && read_sector < sub_len then 47 47 match Block.read sub read_sector with ··· 75 75 | Ok () -> ( 76 76 match Block.read crc_blk 0L with 77 77 | Ok _ -> fail "CRC should have detected corruption" 78 - | Error (`Read_error _) -> () (* Expected *) 79 - | Error e -> fail (Fmt.str "unexpected error: %a" Block.pp_error e)))) 78 + | Error (`Read_error _) -> () (* Expected *) 79 + | Error e -> 80 + fail (Fmt.str "unexpected error: %a" Block.pp_error e)))) 80 81 81 82 (* Test read_many returns concatenated sectors *) 82 83 let test_read_many_concat count =

+89 -131

lib/block.ml

··· 4 4 ---------------------------------------------------------------------------*) 5 5 6 6 type info = { read_write : bool; sector_size : int; sectors : int64 } 7 - 8 - type error = 9 - [ `Disconnected | `Read_error of string | `Invalid_sector of int64 ] 10 - 7 + type error = [ `Disconnected | `Read_error of string | `Invalid_sector of int64 ] 11 8 type write_error = [ error | `Write_error of string | `Read_only ] 12 9 13 10 let pp_error ppf = function ··· 34 31 35 32 let info (T { state; impl = (module I) }) = I.info state 36 33 let read (T { state; impl = (module I) }) sector = I.read state sector 37 - let write (T { state; impl = (module I) }) sector data = I.write state sector data 34 + 35 + let write (T { state; impl = (module I) }) sector data = 36 + I.write state sector data 37 + 38 38 let sync (T { state; impl = (module I) }) = I.sync state 39 39 let close (T { state; impl = (module I) }) = I.close state 40 40 ··· 76 76 77 77 let read t sector = 78 78 if t.closed then Error `Disconnected 79 - else if sector < 0L || sector >= t.sectors then Error (`Invalid_sector sector) 79 + else if sector < 0L || sector >= t.sectors then 80 + Error (`Invalid_sector sector) 80 81 else 81 82 let off = Int64.to_int sector * t.sector_size in 82 83 Ok (Bytes.sub_string t.data off t.sector_size) ··· 99 100 let of_memory ~sector_size ~sectors = 100 101 let size = Int64.to_int sectors * sector_size in 101 102 let state = 102 - { Memory.data = Bytes.make size '\x00'; sector_size; sectors; closed = false } 103 + { 104 + Memory.data = Bytes.make size '\x00'; 105 + sector_size; 106 + sectors; 107 + closed = false; 108 + } 103 109 in 104 110 T { state; impl = (module Memory) } 105 111 ··· 112 118 for i = 0 to len - 1 do 113 119 Bytes.set data i (Bigarray.Array1.get ba i) 114 120 done; 115 - let state = 116 - { Memory.data; sector_size; sectors; closed = false } 117 - in 121 + let state = { Memory.data; sector_size; sectors; closed = false } in 118 122 T { state; impl = (module Memory) } 119 123 124 + (* Read-only wrapper *) 125 + module ReadOnly = struct 126 + type state = { inner : t } 127 + 128 + let info t = 129 + let i = info t.inner in 130 + { i with read_write = false } 131 + 132 + let read t sector = read t.inner sector 133 + let write _ _ _ = Error `Read_only 134 + let sync t = sync t.inner 135 + let close t = close t.inner 136 + end 137 + 138 + let read_only t = 139 + let state = { ReadOnly.inner = t } in 140 + T { state; impl = (module ReadOnly) } 141 + 120 142 let of_string ~sector_size data = 121 143 let len = String.length data in 122 144 if len mod sector_size <> 0 then 123 145 invalid_arg "string length must be multiple of sector_size"; 124 146 let sectors = Int64.of_int (len / sector_size) in 125 147 let state = 126 - { 127 - Memory.data = Bytes.of_string data; 128 - sector_size; 129 - sectors; 130 - closed = false; 131 - } 148 + { Memory.data = Bytes.of_string data; sector_size; sectors; closed = false } 132 149 in 133 150 (* Return read-only by wrapping *) 134 151 let t = T { state; impl = (module Memory) } in ··· 148 165 149 166 let read t sector = 150 167 if t.closed then Error `Disconnected 151 - else if sector < 0L || sector >= t.sectors then Error (`Invalid_sector sector) 168 + else if sector < 0L || sector >= t.sectors then 169 + Error (`Invalid_sector sector) 152 170 else 153 171 try 154 - let off = Optint.Int63.of_int64 (Int64.mul sector (Int64.of_int t.sector_size)) in 172 + let off = 173 + Optint.Int63.of_int64 (Int64.mul sector (Int64.of_int t.sector_size)) 174 + in 155 175 let buf = Cstruct.create t.sector_size in 156 176 Eio.File.pread_exact t.file ~file_offset:off [ buf ]; 157 177 Ok (Cstruct.to_string buf) ··· 165 185 Error (`Write_error "data length must equal sector size") 166 186 else 167 187 try 168 - let off = Optint.Int63.of_int64 (Int64.mul sector (Int64.of_int t.sector_size)) in 188 + let off = 189 + Optint.Int63.of_int64 (Int64.mul sector (Int64.of_int t.sector_size)) 190 + in 169 191 let buf = Cstruct.of_string data in 170 192 Eio.File.pwrite_all t.file ~file_offset:off [ buf ]; 171 193 Ok () 172 194 with exn -> Error (`Write_error (Printexc.to_string exn)) 173 195 174 - let sync t = 175 - if not t.closed then Eio.File.sync t.file 196 + let sync t = if not t.closed then Eio.File.sync t.file 176 197 177 198 let close t = 178 199 if not t.closed then ( ··· 187 208 match create with 188 209 | Some sectors -> 189 210 let size = Int64.mul sectors (Int64.of_int sector_size) in 190 - let f = 191 - Eio.Path.open_out ~sw path ~create:(`Or_truncate 0o644) 192 - in 211 + let f = Eio.Path.open_out ~sw path ~create:(`Or_truncate 0o644) in 193 212 (* Extend file to size *) 194 213 Eio.File.truncate f (Optint.Int63.of_int64 size); 195 214 (f :> Eio.File.rw_ty Eio.Resource.t) 196 215 | None -> 197 - Eio.Path.open_out ~sw path ~create:`Never 198 - |> fun f -> (f :> Eio.File.rw_ty Eio.Resource.t) 216 + Eio.Path.open_out ~sw path ~create:`Never |> fun f -> 217 + (f :> Eio.File.rw_ty Eio.Resource.t) 199 218 in 200 219 let stat = Eio.File.stat file in 201 220 let size = Optint.Int63.to_int64 stat.size in ··· 203 222 let state = { File.file; sector_size; sectors; closed = false } in 204 223 T { state; impl = (module File) } 205 224 206 - (* Flow implementation *) 207 - module Flow = struct 208 - type state = { 209 - flow : Eio.Flow.two_way_ty Eio.Resource.t; 210 - info : info; 211 - mutable closed : bool; 212 - } 213 - 214 - let info t = t.info 215 - 216 - let read t sector = 217 - if t.closed then Error `Disconnected 218 - else if sector < 0L || sector >= t.info.sectors then 219 - Error (`Invalid_sector sector) 220 - else 221 - try 222 - let off = Optint.Int63.of_int64 (Int64.mul sector (Int64.of_int t.info.sector_size)) in 223 - let buf = Cstruct.create t.info.sector_size in 224 - let file = Eio.Resource.get t.flow Eio.File.Pi.Rw in 225 - Eio.File.Rw.pread_exact file ~file_offset:off [ buf ]; 226 - Ok (Cstruct.to_string buf) 227 - with exn -> Error (`Read_error (Printexc.to_string exn)) 228 - 229 - let write t sector data = 230 - if t.closed then Error `Disconnected 231 - else if not t.info.read_write then Error `Read_only 232 - else if sector < 0L || sector >= t.info.sectors then 233 - Error (`Invalid_sector sector) 234 - else if String.length data <> t.info.sector_size then 235 - Error (`Write_error "data length must equal sector size") 236 - else 237 - try 238 - let off = Optint.Int63.of_int64 (Int64.mul sector (Int64.of_int t.info.sector_size)) in 239 - let buf = Cstruct.of_string data in 240 - let file = Eio.Resource.get t.flow Eio.File.Pi.Rw in 241 - Eio.File.Rw.pwrite_all file ~file_offset:off [ buf ]; 242 - Ok () 243 - with exn -> Error (`Write_error (Printexc.to_string exn)) 244 - 245 - let sync t = 246 - if not t.closed then 247 - try 248 - let file = Eio.Resource.get t.flow Eio.File.Pi.Rw in 249 - Eio.File.Rw.sync file 250 - with _ -> () 251 - 252 - let close t = t.closed <- true 253 - end 254 - 255 - let of_flow ~sw:_ ~info flow = 256 - let state = 257 - { Flow.flow = (flow :> Eio.Flow.two_way_ty Eio.Resource.t); info; closed = false } 258 - in 259 - T { state; impl = (module Flow) } 260 - 261 - (* Read-only wrapper *) 262 - module ReadOnly = struct 263 - type state = { inner : t } 264 - 265 - let info t = 266 - let i = info t.inner in 267 - { i with read_write = false } 268 - 269 - let read t sector = read t.inner sector 270 - let write _ _ _ = Error `Read_only 271 - let sync t = sync t.inner 272 - let close t = close t.inner 273 - end 274 - 275 - let read_only t = 276 - let state = { ReadOnly.inner = t } in 277 - T { state; impl = (module ReadOnly) } 278 - 279 225 (* Sub-device wrapper *) 280 226 module Sub = struct 281 227 type state = { inner : t; start : int64; sectors : int64 } ··· 315 261 crc := Int32.logxor !crc (Int32.of_int byte); 316 262 for _ = 0 to 7 do 317 263 let mask = Int32.neg (Int32.logand !crc 1l) in 318 - crc := Int32.logxor (Int32.shift_right_logical !crc 1) (Int32.logand 0x82F63B78l mask) 264 + crc := 265 + Int32.logxor 266 + (Int32.shift_right_logical !crc 1) 267 + (Int32.logand 0x82F63B78l mask) 319 268 done 320 269 done; 321 270 Int32.logxor !crc 0xFFFFFFFFl ··· 323 272 let encode_crc crc = 324 273 let b = Bytes.create 4 in 325 274 Bytes.set b 0 (Char.chr (Int32.to_int (Int32.logand crc 0xFFl))); 326 - Bytes.set b 1 (Char.chr (Int32.to_int (Int32.logand (Int32.shift_right_logical crc 8) 0xFFl))); 327 - Bytes.set b 2 (Char.chr (Int32.to_int (Int32.logand (Int32.shift_right_logical crc 16) 0xFFl))); 275 + Bytes.set b 1 276 + (Char.chr 277 + (Int32.to_int (Int32.logand (Int32.shift_right_logical crc 8) 0xFFl))); 278 + Bytes.set b 2 279 + (Char.chr 280 + (Int32.to_int (Int32.logand (Int32.shift_right_logical crc 16) 0xFFl))); 328 281 Bytes.set b 3 (Char.chr (Int32.to_int (Int32.shift_right_logical crc 24))); 329 282 Bytes.to_string b 330 283 ··· 349 302 let stored_crc = decode_crc raw t.data_size in 350 303 let computed_crc = crc32c data in 351 304 if stored_crc <> computed_crc then 352 - Error (`Read_error (Printf.sprintf "CRC mismatch: stored=%lx computed=%lx" stored_crc computed_crc)) 305 + Error 306 + (`Read_error 307 + (Printf.sprintf "CRC mismatch: stored=%lx computed=%lx" 308 + stored_crc computed_crc)) 353 309 else Ok data 354 310 355 311 let write t sector data = ··· 381 337 let current_pos = ref 0 in 382 338 let remaining = ref length in 383 339 let current_data = ref "" in 384 - Bytesrw.Bytes.Reader.create ~slice_length:i.sector_size @@ fun () -> 340 + Bytesrw.Bytes.Reader.make ~slice_length:i.sector_size @@ fun () -> 385 341 if !remaining <= 0L then Bytesrw.Bytes.Slice.eod 386 342 else if !current_pos >= String.length !current_data then ( 387 343 (* Read next sector *) ··· 390 346 | Ok data -> 391 347 current_data := data; 392 348 current_pos := 0; 393 - incr_sector current_sector; 349 + current_sector := Int64.succ !current_sector; 394 350 let len = min (String.length data) (Int64.to_int !remaining) in 395 351 remaining := Int64.sub !remaining (Int64.of_int len); 396 352 current_pos := len; 397 - Bytesrw.Bytes.Slice.make (Bytes.unsafe_of_string data) ~first:0 ~length:len) 353 + Bytesrw.Bytes.Slice.make 354 + (Bytes.unsafe_of_string data) 355 + ~first:0 ~length:len) 398 356 else Bytesrw.Bytes.Slice.eod 399 - 400 - and incr_sector r = r := Int64.succ !r 401 357 402 358 let to_writer t ~offset = 403 359 let i = info t in ··· 416 372 Buffer.clear buffer; 417 373 current_sector := Int64.succ !current_sector) 418 374 in 419 - Bytesrw.Bytes.Writer.create ~slice_length:i.sector_size @@ fun slice -> 420 - let data = Bytes.sub_string (Bytesrw.Bytes.Slice.bytes slice) 421 - (Bytesrw.Bytes.Slice.first slice) 422 - (Bytesrw.Bytes.Slice.length slice) 423 - in 424 - Buffer.add_string buffer data; 425 - while Buffer.length buffer >= i.sector_size do 426 - let sector_data = Buffer.sub buffer 0 i.sector_size in 427 - let _ = write t !current_sector sector_data in 428 - current_sector := Int64.succ !current_sector; 429 - let remaining = Buffer.sub buffer i.sector_size (Buffer.length buffer - i.sector_size) in 430 - Buffer.clear buffer; 431 - Buffer.add_string buffer remaining 432 - done; 433 - Bytesrw.Bytes.Slice.length slice 375 + Bytesrw.Bytes.Writer.make ~slice_length:i.sector_size @@ fun slice -> 376 + if Bytesrw.Bytes.Slice.is_eod slice then flush () 377 + else begin 378 + let data = 379 + Bytes.sub_string 380 + (Bytesrw.Bytes.Slice.bytes slice) 381 + (Bytesrw.Bytes.Slice.first slice) 382 + (Bytesrw.Bytes.Slice.length slice) 383 + in 384 + Buffer.add_string buffer data; 385 + while Buffer.length buffer >= i.sector_size do 386 + let sector_data = Buffer.sub buffer 0 i.sector_size in 387 + let _ = write t !current_sector sector_data in 388 + current_sector := Int64.succ !current_sector; 389 + let remaining = 390 + Buffer.sub buffer i.sector_size (Buffer.length buffer - i.sector_size) 391 + in 392 + Buffer.clear buffer; 393 + Buffer.add_string buffer remaining 394 + done 395 + end 434 396 435 397 (* Generic operations *) 436 398 ··· 448 410 in 449 411 loop 0L init 450 412 451 - let iter ~f t = 452 - fold ~f:(fun sector data () -> f sector data) t () 413 + let iter ~f t = fold ~f:(fun sector data () -> f sector data) t () 453 414 454 415 type compare_error = 455 416 [ error ··· 480 441 in 481 442 loop 0L 482 443 483 - type copy_error = 484 - [ write_error 485 - | `Different_sizes 486 - | `Different_sector_sizes ] 444 + type copy_error = [ write_error | `Different_sizes | `Different_sector_sizes ] 487 445 488 446 let pp_copy_error ppf = function 489 447 | #write_error as e -> pp_write_error ppf e ··· 525 483 else 526 484 match read src sector with 527 485 | Error e -> Error (e :> copy_error) 528 - | Ok data -> 486 + | Ok data -> ( 529 487 if is_zero data then loop (Int64.succ sector) 530 488 else 531 489 match write dst sector data with 532 490 | Error e -> Error (e :> copy_error) 533 - | Ok () -> loop (Int64.succ sector) 491 + | Ok () -> loop (Int64.succ sector)) 534 492 in 535 493 loop 0L 536 494

+5 -11

lib/block.mli

··· 118 118 If provided, creates the file with this many sectors if it doesn't exist. 119 119 @param sector_size Sector size in bytes (must be power of 2, >= 512). *) 120 120 121 - val of_flow : 122 - sw:Eio.Switch.t -> 123 - info:info -> 124 - #Eio.Flow.two_way -> 125 - t 126 - (** [of_flow ~sw ~info flow] wraps an Eio two-way flow as a block device. The 127 - flow must support seeking. Used for raw device access. *) 128 - 129 121 (** {1 Combinators} *) 130 122 131 123 val read_only : t -> t ··· 149 141 t -> 150 142 'a -> 151 143 ('a, error) result 152 - (** [fold ~f t init] folds [f] over every sector in the device. [f sector data acc] 153 - is called for each sector in order. Stops on first error. *) 144 + (** [fold ~f t init] folds [f] over every sector in the device. 145 + [f sector data acc] is called for each sector in order. Stops on first 146 + error. *) 154 147 155 - val iter : f:(int64 -> string -> (unit, error) result) -> t -> (unit, error) result 148 + val iter : 149 + f:(int64 -> string -> (unit, error) result) -> t -> (unit, error) result 156 150 (** [iter ~f t] iterates [f] over every sector. *) 157 151 158 152 type compare_error =

+21 -13

test/test_block.ml

··· 77 77 Alcotest.(check int64) "sub sectors" 3L info.sectors; 78 78 (* Read from sub (sector 0 of sub = sector 3 of original) *) 79 79 match Block.read sub 0L with 80 - | Ok data -> 81 - Alcotest.(check char) "sub read" 'D' data.[0] 80 + | Ok data -> Alcotest.(check char) "sub read" 'D' data.[0] 82 81 | Error e -> Alcotest.fail (Fmt.str "%a" Block.pp_error e) 83 82 84 83 let test_read_many () = ··· 102 101 let crc_blk = Block.with_crc32c blk in 103 102 let info = Block.info crc_blk in 104 103 (* Effective sector size is reduced by 4 bytes for CRC *) 105 - Alcotest.(check int) "effective sector_size" (sector_size - 4) info.sector_size; 104 + Alcotest.(check int) 105 + "effective sector_size" (sector_size - 4) info.sector_size; 106 106 let data = String.make (sector_size - 4) 'X' in 107 107 (match Block.write crc_blk 0L data with 108 108 | Ok () -> () ··· 119 119 | Ok () -> () 120 120 | Error e -> Alcotest.fail (Fmt.str "%a" Block.pp_write_error e)); 121 121 (* Corrupt the underlying data *) 122 - let raw = match Block.read blk 0L with Ok d -> d | Error _ -> Alcotest.fail "read" in 122 + let raw = 123 + match Block.read blk 0L with Ok d -> d | Error _ -> Alcotest.fail "read" 124 + in 123 125 let corrupted = Bytes.of_string raw in 124 126 Bytes.set corrupted 0 'Z'; 125 127 (match Block.write blk 0L (Bytes.to_string corrupted) with ··· 133 135 | Error e -> Alcotest.fail (Fmt.str "wrong error: %a" Block.pp_error e) 134 136 135 137 let test_of_string () = 136 - let original = String.init (sector_size * 3) (fun i -> Char.chr ((i mod 26) + 65)) in 138 + let original = 139 + String.init (sector_size * 3) (fun i -> Char.chr ((i mod 26) + 65)) 140 + in 137 141 let blk = Block.of_string ~sector_size original in 138 142 let info = Block.info blk in 139 143 Alcotest.(check bool) "read_only" false info.read_write; ··· 177 181 | Ok () -> () 178 182 | Error e -> Alcotest.fail (Fmt.str "%a" Block.pp_write_error e) 179 183 done; 180 - match Block.fold ~f:(fun _ data acc -> Ok (acc + Char.code data.[0])) blk 0 with 184 + match 185 + Block.fold ~f:(fun _ data acc -> Ok (acc + Char.code data.[0])) blk 0 186 + with 181 187 | Ok sum -> 182 188 (* A=65, B=66, C=67, D=68, E=69 => sum = 335 *) 183 189 Alcotest.(check int) "fold sum" 335 sum ··· 210 216 match Block.compare a b with 211 217 | Ok () -> Alcotest.fail "should have detected difference" 212 218 | Error (`Contents_differ 5L) -> () 213 - | Error e -> Alcotest.fail (Fmt.str "wrong error: %a" Block.pp_compare_error e) 219 + | Error e -> 220 + Alcotest.fail (Fmt.str "wrong error: %a" Block.pp_compare_error e) 214 221 215 222 let test_copy () = 216 223 let src = Block.of_memory ~sector_size ~sectors:10L in ··· 264 271 done 265 272 266 273 let test_is_zero () = 267 - Alcotest.(check bool) "all zeros" true (Block.is_zero (String.make 512 '\x00')); 274 + Alcotest.(check bool) 275 + "all zeros" true 276 + (Block.is_zero (String.make 512 '\x00')); 268 277 Alcotest.(check bool) "not zeros" false (Block.is_zero "hello"); 269 - Alcotest.(check bool) "one non-zero" false (Block.is_zero (String.make 511 '\x00' ^ "x")) 278 + Alcotest.(check bool) 279 + "one non-zero" false 280 + (Block.is_zero (String.make 511 '\x00' ^ "x")) 270 281 271 282 let suite = 272 283 [ ··· 306 317 Alcotest.test_case "roundtrip" `Quick test_crc32c; 307 318 Alcotest.test_case "corruption" `Quick test_crc32c_corruption; 308 319 ] ); 309 - ( "file", 310 - [ 311 - Alcotest.test_case "roundtrip" `Quick test_file; 312 - ] ); 320 + ("file", [ Alcotest.test_case "roundtrip" `Quick test_file ]); 313 321 ]

Configure Feed

Configure Feed