Dan Korostelev 5 年之前
父节点
当前提交
1e24fe4b8a
共有 2 个文件被更改,包括 20 次插入15 次删除
  1. 15 13
      src/typing/finalization.ml
  2. 5 2
      src/typing/typerBase.ml

+ 15 - 13
src/typing/finalization.ml

@@ -13,34 +13,36 @@ let get_main ctx types =
 	match ctx.com.main_class with
 	| None -> None
 	| Some path ->
-		let p = null_pos in
 		let pack,name = path in
-		let m = Typeload.load_module ctx (pack,name) p in
+		let m = Typeload.load_module ctx (pack,name) null_pos in
 		let c,f =
-			let p = ref p in
 			try
 				match m.m_statics with
 				| None ->
 					raise Not_found
 				| Some c ->
-					p := c.cl_pos;
 					c, PMap.find "main" c.cl_statics
-			with Not_found -> try
-				let t = Typeload.find_type_in_module_raise m name null_pos in
+			with Not_found ->
+				let error concrete p = error ("Invalid -main : Module " ^ s_type_path path ^ " does not have a main function " ^ concrete) p in
+				let t = 
+					try Typeload.find_type_in_module m name
+					with Not_found -> error ("or a class named " ^ name) { pfile = relative_path ctx m.m_extra.m_file; pmin = 0; pmax = 0}
+				in
 				match t with
-				| TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ ->
-					error ("Invalid -main : " ^ s_type_path path ^ " is not a class") null_pos
+				| TEnumDecl { e_pos = pos } | TTypeDecl { t_pos = pos } | TAbstractDecl { a_pos = pos } ->
+					error ("and " ^ name ^ " is not a class") pos
 				| TClassDecl c ->
-					p := c.cl_pos;
-					c, PMap.find "main" c.cl_statics
-			with Not_found ->
-				error ("Invalid -main : " ^ s_type_path path ^ " does not have static function main") !p
+					let f =
+						try PMap.find "main" c.cl_statics
+						with Not_found -> error ("and class " ^ name ^ " does not have static function main") c.cl_pos
+					in
+					c, f
 		in
 		let ft = Type.field_type f in
 		let fmode, r = 
 			match follow ft with
 			| TFun ([],r) -> FStatic (c,f), r
-			| _ -> error ("Invalid -main : " ^ s_type_path path ^ " has invalid main function") c.cl_pos
+			| _ -> error ("Invalid -main : " ^ s_type_path path ^ " has invalid main function") f.cf_pos
 		in
 		let emain = type_module_type ctx (TClassDecl c) None null_pos in
 		let main = mk (TCall (mk (TField (emain,fmode)) ft null_pos,[])) r null_pos in

+ 5 - 2
src/typing/typerBase.ml

@@ -30,9 +30,12 @@ let relative_path ctx file =
 	let rec loop = function
 		| [] -> file
 		| path :: l ->
-			let spath = String.lowercase (slashes path) in
+			let spath = String.lowercase (slashes (Path.get_full_path path)) in
 			let slen = String.length spath in
-			if slen > 0 && slen < flen && String.sub fpath_lower 0 slen = spath then String.sub fpath slen (flen - slen) else loop l
+			if slen > 0 && slen < flen && String.sub fpath_lower 0 slen = spath then
+				path ^ String.sub fpath slen (flen - slen)
+			else
+				loop l
 	in
 	loop ctx.com.Common.class_path