Commits

camlspotter committed 4af5788

more typeloc for objects (and found a bug)

  • Participants
  • Parent commits 6de6e59
  • Branches typeloc

Comments (0)

Files changed (4)

testsuite/typeloc/obj_meth_call.ml

+let f x = 
+  x#m;  (* ok *)
+  [x; 1]
+

testsuite/typeloc/obj_new.ml

+class t = object end
+let _ = [ new t;  (* NG, wrong position is reported! *)
+          None ]
       unify_fields env t1' t2'
   | _ ->
     let loc1 = t1'.tyloc and loc2 = t2'.tyloc in
+Format.eprintf "UNIFLOC %a and %a@." Location.print (match loc1 with Some l -> l | None -> Location.none) Location.print (match loc2 with Some l -> l | None -> Location.none);
     begin match !umode with
     | Expression ->
         occur !env t1' t2';

typing/typecore.ml

 let unify_exp env exp expected_ty =
   (* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type
     Printtyp.raw_type_expr expected_ty; *)
-    unify_exp_types exp.exp_loc env exp.exp_type expected_ty
+  unify_exp_types exp.exp_loc env exp.exp_type expected_ty
 
 let rec type_exp env sexp =
   (* We now delegate everything to type_expect *)
         exp_type = body.exp_type;
         exp_env = env }
   | Pexp_send (e, met) ->
-      (* CR jfuruse: typeloc *)
       if !Clflags.principal then begin_def ();
       let obj = type_exp env e in
+      (* tyloc: obj is required to have an object type *)
+      ignore (set_loc loc obj.exp_type);
       begin try
         let (meth, exp, typ) =
           match obj.exp_desc with
             rue {
               exp_desc = Texp_new (cl_path, cl, cl_decl);
               exp_loc = loc; exp_extra = [];
-              exp_type = instance_def ty;
+              exp_type = copy_with_loc loc (instance_def ty);
               exp_env = env }
         end
   | Pexp_setinstvar (lab, snewval) ->