|  |  |  | @ -6,7 +6,6 @@ | 
			
		
	
		
			
				
					|  |  |  |  |  *) | 
			
		
	
		
			
				
					|  |  |  |  | open! IStd | 
			
		
	
		
			
				
					|  |  |  |  | module L = Logging | 
			
		
	
		
			
				
					|  |  |  |  | module F = Format | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | module Payload = SummaryPayload.Make (struct | 
			
		
	
		
			
				
					|  |  |  |  |   type t = ClassLoadsDomain.summary | 
			
		
	
	
		
			
				
					|  |  |  | @ -16,24 +15,42 @@ module Payload = SummaryPayload.Make (struct | 
			
		
	
		
			
				
					|  |  |  |  |   let of_payloads (payloads : Payloads.t) = payloads.class_loads | 
			
		
	
		
			
				
					|  |  |  |  | end) | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | let get_java_class = function | 
			
		
	
		
			
				
					|  |  |  |  |   | Typ.Procname.Java java_pname -> | 
			
		
	
		
			
				
					|  |  |  |  |       Some (Typ.Procname.Java.get_class_name java_pname) | 
			
		
	
		
			
				
					|  |  |  |  |   | _ -> | 
			
		
	
		
			
				
					|  |  |  |  |       None | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | let rec exp_fold_over_fields ~f (exp : Exp.t) acc = | 
			
		
	
		
			
				
					|  |  |  |  | let do_call pdesc callee loc init = | 
			
		
	
		
			
				
					|  |  |  |  |   Payload.read pdesc callee |> Option.fold ~init ~f:(ClassLoadsDomain.integrate_summary callee loc) | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | (** fully load a class given the typename *) | 
			
		
	
		
			
				
					|  |  |  |  | let rec load_class proc_desc tenv loc astate class_name = | 
			
		
	
		
			
				
					|  |  |  |  |   (* don't bother if class is already loaded *) | 
			
		
	
		
			
				
					|  |  |  |  |   if ClassLoadsDomain.mem_typename class_name astate then astate | 
			
		
	
		
			
				
					|  |  |  |  |   else | 
			
		
	
		
			
				
					|  |  |  |  |     (* load the class itself *) | 
			
		
	
		
			
				
					|  |  |  |  |     let astate1 = ClassLoadsDomain.add_typename loc astate class_name in | 
			
		
	
		
			
				
					|  |  |  |  |     (* load classes referenced by the class initializer *) | 
			
		
	
		
			
				
					|  |  |  |  |     let astate2 = | 
			
		
	
		
			
				
					|  |  |  |  |       let class_initializer = Typ.Procname.(Java (Java.get_class_initializer class_name)) in | 
			
		
	
		
			
				
					|  |  |  |  |       (* NB may recurse if we are in class init but the shortcircuiting above makes it a no-op *) | 
			
		
	
		
			
				
					|  |  |  |  |       do_call proc_desc class_initializer loc astate1 | 
			
		
	
		
			
				
					|  |  |  |  |     in | 
			
		
	
		
			
				
					|  |  |  |  |     (* finally, recursively load all superclasses *) | 
			
		
	
		
			
				
					|  |  |  |  |     Tenv.lookup tenv class_name | 
			
		
	
		
			
				
					|  |  |  |  |     |> Option.value_map ~default:[] ~f:(fun tstruct -> tstruct.Typ.Struct.supers) | 
			
		
	
		
			
				
					|  |  |  |  |     |> List.fold ~init:astate2 ~f:(load_class proc_desc tenv loc) | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | let rec exp_fold_over_fields ~f ~init (exp : Exp.t) = | 
			
		
	
		
			
				
					|  |  |  |  |   match exp with | 
			
		
	
		
			
				
					|  |  |  |  |   (* TODO Cast? Const literals for class objects? Arrays? *) | 
			
		
	
		
			
				
					|  |  |  |  |   | Var _ | Const _ | Lvar _ | Sizeof _ | Closure _ -> | 
			
		
	
		
			
				
					|  |  |  |  |       acc | 
			
		
	
		
			
				
					|  |  |  |  |       init | 
			
		
	
		
			
				
					|  |  |  |  |   | Cast (_, e) | UnOp (_, e, _) | Exn e | Lindex (e, _) -> | 
			
		
	
		
			
				
					|  |  |  |  |       exp_fold_over_fields ~f e acc | 
			
		
	
		
			
				
					|  |  |  |  |       exp_fold_over_fields ~f ~init e | 
			
		
	
		
			
				
					|  |  |  |  |   | BinOp (_, e1, e2) -> | 
			
		
	
		
			
				
					|  |  |  |  |       exp_fold_over_fields ~f e1 acc |> exp_fold_over_fields ~f e2 | 
			
		
	
		
			
				
					|  |  |  |  |       let init = exp_fold_over_fields ~f ~init e1 in | 
			
		
	
		
			
				
					|  |  |  |  |       exp_fold_over_fields ~f ~init e2 | 
			
		
	
		
			
				
					|  |  |  |  |   | Lfield (e, field, typ) -> | 
			
		
	
		
			
				
					|  |  |  |  |       f field typ acc |> exp_fold_over_fields ~f e | 
			
		
	
		
			
				
					|  |  |  |  |       let init = f init field typ in | 
			
		
	
		
			
				
					|  |  |  |  |       exp_fold_over_fields ~f ~init e | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | let class_of_type (typ : Typ.t) = | 
			
		
	
	
		
			
				
					|  |  |  | @ -44,23 +61,22 @@ let class_of_type (typ : Typ.t) = | 
			
		
	
		
			
				
					|  |  |  |  |       None | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | let add_field_loads_of_exp exp loc astate = | 
			
		
	
		
			
				
					|  |  |  |  |   let f _field typ init = | 
			
		
	
		
			
				
					|  |  |  |  |     class_of_type typ |> Option.map ~f:Typ.Name.name | 
			
		
	
		
			
				
					|  |  |  |  |     |> Option.fold ~init ~f:(ClassLoadsDomain.add_load loc) | 
			
		
	
		
			
				
					|  |  |  |  | let add_field_loads_of_exp proc_desc tenv exp loc init = | 
			
		
	
		
			
				
					|  |  |  |  |   let f init _field typ = | 
			
		
	
		
			
				
					|  |  |  |  |     class_of_type typ |> Option.fold ~init ~f:(load_class proc_desc tenv loc) | 
			
		
	
		
			
				
					|  |  |  |  |   in | 
			
		
	
		
			
				
					|  |  |  |  |   exp_fold_over_fields ~f exp astate | 
			
		
	
		
			
				
					|  |  |  |  |   exp_fold_over_fields ~f ~init exp | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | let exec_instr pdesc astate _ (instr : Sil.instr) = | 
			
		
	
		
			
				
					|  |  |  |  | let exec_instr pdesc tenv astate _ (instr : Sil.instr) = | 
			
		
	
		
			
				
					|  |  |  |  |   match instr with | 
			
		
	
		
			
				
					|  |  |  |  |   | Call (_, Const (Cfun callee), _, loc, _) -> | 
			
		
	
		
			
				
					|  |  |  |  |       Payload.read pdesc callee | 
			
		
	
		
			
				
					|  |  |  |  |       |> Option.fold ~init:astate ~f:(ClassLoadsDomain.integrate_summary callee loc) | 
			
		
	
		
			
				
					|  |  |  |  |       do_call pdesc callee loc astate | 
			
		
	
		
			
				
					|  |  |  |  |   | Load (_, exp, _, loc) | Prune (exp, loc, _, _) -> | 
			
		
	
		
			
				
					|  |  |  |  |       add_field_loads_of_exp exp loc astate | 
			
		
	
		
			
				
					|  |  |  |  |       add_field_loads_of_exp pdesc tenv exp loc astate | 
			
		
	
		
			
				
					|  |  |  |  |   | Store (lexp, _, rexp, loc) -> | 
			
		
	
		
			
				
					|  |  |  |  |       add_field_loads_of_exp lexp loc astate |> add_field_loads_of_exp rexp loc | 
			
		
	
		
			
				
					|  |  |  |  |       add_field_loads_of_exp pdesc tenv lexp loc astate | 
			
		
	
		
			
				
					|  |  |  |  |       |> add_field_loads_of_exp pdesc tenv rexp loc | 
			
		
	
		
			
				
					|  |  |  |  |   | _ -> | 
			
		
	
		
			
				
					|  |  |  |  |       astate | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
	
		
			
				
					|  |  |  | @ -74,7 +90,7 @@ let report_loads proc_desc summary astate = | 
			
		
	
		
			
				
					|  |  |  |  |       Reporting.log_warning summary ~loc ~ltr IssueType.class_load msg | 
			
		
	
		
			
				
					|  |  |  |  |   in | 
			
		
	
		
			
				
					|  |  |  |  |   let pname = Procdesc.get_proc_name proc_desc in | 
			
		
	
		
			
				
					|  |  |  |  |   get_java_class pname | 
			
		
	
		
			
				
					|  |  |  |  |   Typ.Procname.get_class_name pname | 
			
		
	
		
			
				
					|  |  |  |  |   |> Option.iter ~f:(fun clazz -> | 
			
		
	
		
			
				
					|  |  |  |  |          let method_strname = Typ.Procname.get_method pname in | 
			
		
	
		
			
				
					|  |  |  |  |          let fullname = clazz ^ "." ^ method_strname in | 
			
		
	
	
		
			
				
					|  |  |  | @ -82,38 +98,16 @@ let report_loads proc_desc summary astate = | 
			
		
	
		
			
				
					|  |  |  |  |            ClassLoadsDomain.iter report_load astate ) | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | (* if [pdesc] is *not* a class initializer (to avoid infinite recursion), return the  | 
			
		
	
		
			
				
					|  |  |  |  |    class initializer of [pdesc]'s class *) | 
			
		
	
		
			
				
					|  |  |  |  | let class_initializer_of_method pdesc = | 
			
		
	
		
			
				
					|  |  |  |  |   let open Typ.Procname in | 
			
		
	
		
			
				
					|  |  |  |  |   match Procdesc.get_proc_name pdesc with | 
			
		
	
		
			
				
					|  |  |  |  |   | Java java_pname when Java.is_class_initializer java_pname -> | 
			
		
	
		
			
				
					|  |  |  |  |       None | 
			
		
	
		
			
				
					|  |  |  |  |   | Java java_pname -> | 
			
		
	
		
			
				
					|  |  |  |  |       let class_name = Java.get_class_type_name java_pname in | 
			
		
	
		
			
				
					|  |  |  |  |       Some (Java (Java.get_class_initializer class_name)) | 
			
		
	
		
			
				
					|  |  |  |  |   | _ -> | 
			
		
	
		
			
				
					|  |  |  |  |       assert false | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | 
 | 
			
		
	
		
			
				
					|  |  |  |  | let analyze_procedure {Callbacks.proc_desc; summary} = | 
			
		
	
		
			
				
					|  |  |  |  | let analyze_procedure {Callbacks.proc_desc; tenv; summary} = | 
			
		
	
		
			
				
					|  |  |  |  |   let proc_name = Procdesc.get_proc_name proc_desc in | 
			
		
	
		
			
				
					|  |  |  |  |   L.debug Analysis Verbose "CL: ANALYZING %a@." Typ.Procname.pp proc_name ; | 
			
		
	
		
			
				
					|  |  |  |  |   let loc = Procdesc.get_loc proc_desc in | 
			
		
	
		
			
				
					|  |  |  |  |   (* add a load for the method's class *) | 
			
		
	
		
			
				
					|  |  |  |  |   (* load the method's class *) | 
			
		
	
		
			
				
					|  |  |  |  |   let init = | 
			
		
	
		
			
				
					|  |  |  |  |     let class_opt = get_java_class proc_name in | 
			
		
	
		
			
				
					|  |  |  |  |     L.debug Analysis Verbose "CL: CLASS = %a@." (Pp.option F.pp_print_string) class_opt ; | 
			
		
	
		
			
				
					|  |  |  |  |     Option.fold class_opt ~init:ClassLoadsDomain.empty ~f:(ClassLoadsDomain.add_load loc) | 
			
		
	
		
			
				
					|  |  |  |  |   in | 
			
		
	
		
			
				
					|  |  |  |  |   (* add loads done by the static initialization of this method's class *) | 
			
		
	
		
			
				
					|  |  |  |  |   let after_class_init = | 
			
		
	
		
			
				
					|  |  |  |  |     class_initializer_of_method proc_desc | 
			
		
	
		
			
				
					|  |  |  |  |     |> Option.bind ~f:(Payload.read proc_desc) | 
			
		
	
		
			
				
					|  |  |  |  |     (* pretend there is a call to class initializer before the method body *) | 
			
		
	
		
			
				
					|  |  |  |  |     |> Option.fold ~init ~f:(ClassLoadsDomain.integrate_summary proc_name loc) | 
			
		
	
		
			
				
					|  |  |  |  |     Typ.Procname.get_class_type_name proc_name | 
			
		
	
		
			
				
					|  |  |  |  |     |> Option.fold ~init:ClassLoadsDomain.empty ~f:(load_class proc_desc tenv loc) | 
			
		
	
		
			
				
					|  |  |  |  |   in | 
			
		
	
		
			
				
					|  |  |  |  |   let post = Procdesc.fold_instrs proc_desc ~init:after_class_init ~f:(exec_instr proc_desc) in | 
			
		
	
		
			
				
					|  |  |  |  |   let post = Procdesc.fold_instrs proc_desc ~init ~f:(exec_instr proc_desc tenv) in | 
			
		
	
		
			
				
					|  |  |  |  |   report_loads proc_desc summary post ; | 
			
		
	
		
			
				
					|  |  |  |  |   let result = Payload.update_summary post summary in | 
			
		
	
		
			
				
					|  |  |  |  |   L.debug Analysis Verbose "CL: FINISHED ANALYZING %a@." Typ.Procname.pp proc_name ; | 
			
		
	
	
		
			
				
					|  |  |  | 
 |