Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file bisect_common.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248(* This file is part of Bisect_ppx, released under the MIT license. See
LICENSE.md for details, or visit
https://github.com/aantron/bisect_ppx/blob/master/LICENSE.md. *)typepoint_definition={offset:int;identifier:int;}(* Utility functions *)lettry_finallyxfh=letres=tryfxwithe->(tryhxwith_->());raiseein(tryhxwith_->());reslettry_in_channelbinxf=letopen_ch=ifbinthenopen_in_binelseopen_inintry_finally(open_chx)f(close_in_noerr)lettry_out_channelbinxf=letopen_ch=ifbinthenopen_out_binelseopen_outintry_finally(open_chx)f(close_out_noerr)(* I/O functions *)(* filename + reason *)exceptionInvalid_fileofstring*stringletmagic_number_rtd="BISECTOUT3"moduleWriter:sigtype'atvalint:inttvalstring:stringtvalpair:'at->'bt->('a*'b)tvalarray:'at->'aarraytvalwrite:'at->'a->stringend=structtype'at=Buffer.t->'a->unitletw=Printf.bprintfletintbi=wb" %i"iletstringbs=wb" %i %s"(String.lengths)sletpairleftrightb(l,r)=leftbl;rightbrletarrayelementba=wb" %i"(Array.lengtha);Array.iter(elementb)aletwritewriterv=letb=Buffer.create4096inBuffer.add_stringbmagic_number_rtd;writerbv;Buffer.contentsbendmoduleReader:sigtype'atvalint:inttvalstring:stringtvalpair:'at->'bt->('a*'b)tvalarray:'at->'aarraytvalread:'at->filename:string->'aend=structtype'at=Buffer.t->in_channel->'aletjunkc=tryignore(input_charc)withEnd_of_file->()letintbc=Buffer.clearb;letrecloop()=matchinput_charcwith|exceptionEnd_of_file->()|' '->()|c->Buffer.add_charbc;loop()inloop();int_of_string(Buffer.contentsb)letstringbc=letlength=intbcinlets=really_input_stringclengthinjunkc;sletpairleftrightbc=letl=leftbcinletr=rightbcinl,rletarrayelementbc=letlength=intbcinArray.initlength(fun_index->elementbc)letreadreader~filename=try_in_channeltruefilenamebeginfunc->letmagic_number_in_file=tryreally_input_stringc(String.lengthmagic_number_rtd)withEnd_of_file->raise(Invalid_file(filename,"unexpected end of file while reading magic number"))inifmagic_number_in_file<>magic_number_rtdthenraise(Invalid_file(filename,"bad magic number"));junkc;letb=Buffer.create4096intryreaderbcwithe->raise(Invalid_file(filename,"exception reading data: "^Printexc.to_stringe))endendlettable:(string,intarray*string)Hashtbl.tLazy.t=lazy(Hashtbl.create17)letruntime_data_to_string()=letdata=Hashtbl.fold(funkvacc->(k,v)::acc)(Lazy.forcetable)[]inmatchdatawith|[]->None|_->Array.of_listdata|>Writer.(write(array(pairstring(pair(arrayint)string))))|>funs->Somesletwrite_runtime_datachannel=letdata=matchruntime_data_to_string()with|Somes->s|None->Writer.(write(arrayint))[||]inoutput_stringchanneldatalet()=Random.self_init()letrandom_filenamebase_name=Printf.sprintf"%s%09d.coverage"base_name(abs(Random.int1000000000))letwrite_pointspoints=letpoints_array=Array.of_listpointsinArray.sortcomparepoints_array;Marshal.to_stringpoints_array[]letget_relative_pathfile=ifFilename.is_relativefilethenfileelseletcwd=Sys.getcwd()inletcwd_end=String.lengthcwdinletsep_length=String.lengthFilename.dir_sepinletsep_end=sep_length+cwd_endintryifString.subfile0cwd_end=cwd&&String.subfilecwd_endsep_length=Filename.dir_septhenString.subfilesep_end(String.lengthfile-sep_end)elsefilewithInvalid_argument_->fileletread_runtime_datafilename=Reader.(read(array(pairstring(pair(arrayint)string))))~filename|>Array.to_list|>List.map(fun(file,data)->get_relative_pathfile,data)letread_pointss=letpoints_array:point_definitionarray=Marshal.from_strings0inArray.sortcomparepoints_array;Array.to_listpoints_arrayletregister_filefile~point_count~point_definitions=letpoint_state=Array.makepoint_count0inlettable=Lazy.forcetableinifnot(Hashtbl.memtablefile)thenHashtbl.addtablefile(point_state,point_definitions);`Staged(funpoint_index->letcurrent_count=point_state.(point_index)inpoint_state.(point_index)<-ifcurrent_count<max_intthencurrent_count+1elsecurrent_count)letbisect_file=refNoneletbisect_silent=refNonetypeoptions=(Arg.key*Arg.spec*Arg.doc)listletdeprecatedbinarybasenameoptions=letmakemake_specfn=(basename,make_spec(funv->Printf.eprintf"%s argument '%s' is deprecated.\n"binarybasename;Printf.eprintf"Use '-%s' instead.\n"basename;Printf.eprintf"This requires Bisect_ppx >= 2.0.0.\n";fnv)," Deprecated")inlet(_,spec,_)=options|>List.find(fun(option,_,_)->option="-"^basename)inletdeprecated_option=matchspecwith|Arg.Unitf->make(funf->Arg.Unitf)f|Arg.Setr->make(funf->Arg.Unitf)(fun()->r:=true)|Arg.Stringf->make(funf->Arg.Stringf)f|Arg.Set_stringr->make(funf->Arg.Stringf)((:=)r)|Arg.Intf->make(funf->Arg.Intf)f|_->prerr_endlinebasename;assertfalseinoptions@[deprecated_option]