diff --git a/src/compiler/haxe.ml b/src/compiler/haxe.ml index cb9319eba09..a57269b70db 100644 --- a/src/compiler/haxe.ml +++ b/src/compiler/haxe.ml @@ -75,10 +75,23 @@ let limit_string s offset = in String.concat "" (loop 0 words) -let error ctx msg p = - let msg = try List.assoc msg deprecated with Not_found -> msg in - message ctx (CMError(msg,p)); - ctx.has_error <- true +let rec error ctx msg p = + match ctx.com.pending_messages with + | Some add -> add (fun() -> error ctx msg p) + | None -> + let msg = try List.assoc msg deprecated with Not_found -> msg in + message ctx (CMError(msg,p)); + ctx.has_error <- true + +let rec warning ctx msg p = + match ctx.com.pending_messages with + | Some add -> add (fun() -> warning ctx msg p) + | None -> message ctx (CMWarning(msg,p)) + +let rec info ctx msg p = + match ctx.com.pending_messages with + | Some add -> add (fun() -> info ctx msg p) + | None -> message ctx (CMInfo(msg,p)) let reserved_flags = [ "true";"false";"null";"cross";"js";"lua";"neko";"flash";"php";"cpp";"cs";"java";"python"; @@ -384,8 +397,8 @@ let setup_common_context ctx com = Common.raw_define com "haxe4"; Common.define_value com Define.Haxe (s_version false); Common.define_value com Define.Dce "std"; - com.info <- (fun msg p -> message ctx (CMInfo(msg,p))); - com.warning <- (fun msg p -> message ctx (CMWarning(msg,p))); + com.info <- info ctx; + com.warning <- warning ctx; com.error <- error ctx; let filter_messages = (fun keep_errors predicate -> (List.filter (fun msg -> (match msg with @@ -442,7 +455,7 @@ let process_display_configuration ctx = if com.display.dms_error_policy = EPCollect then (fun s p -> add_diagnostics_message com s p DKCompilerError DisplayTypes.DiagnosticsSeverity.Warning) else - (fun msg p -> message ctx (CMWarning(msg,p))); + warning ctx; com.error <- error ctx; end; Lexer.old_format := Common.defined com Define.OldErrorFormat; diff --git a/src/context/common.ml b/src/context/common.ml index 535b41f4180..104939fb25d 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -212,6 +212,7 @@ type context = { mutable error : string -> pos -> unit; mutable info : string -> pos -> unit; mutable warning : string -> pos -> unit; + mutable pending_messages : ((unit->unit)->unit) option; mutable get_messages : unit -> compiler_message list; mutable filter_messages : (compiler_message -> bool) -> unit; mutable load_extern_type : (string * (path -> pos -> Ast.package option)) list; (* allow finding types which are not in sources *) @@ -496,8 +497,25 @@ let create version s_version args = memory_marker = memory_marker; parser_cache = Hashtbl.create 0; json_out = None; + pending_messages = None; } +exception HoldMessages of exn * (unit->unit) + +let hold_messages com action = + let old_pending = com.pending_messages in + let messages = ref [] in + com.pending_messages <- Some (fun submit -> messages := submit :: !messages); + let submit_all() = List.iter (fun f -> f()) (List.rev !messages) in + let restore() = com.pending_messages <- old_pending; in + try + let result = action() in + restore(); + result,submit_all + with err -> + restore(); + raise (HoldMessages (err,submit_all)) + let log com str = if com.verbose then com.print (str ^ "\n") @@ -817,9 +835,12 @@ let utf16_to_utf8 str = loop 0; Buffer.contents b -let add_diagnostics_message com s p kind sev = - let di = com.shared.shared_display_information in - di.diagnostics_messages <- (s,p,kind,sev) :: di.diagnostics_messages +let rec add_diagnostics_message com s p kind sev = + match com.pending_messages with + | Some add -> add (fun() -> add_diagnostics_message com s p kind sev) + | None -> + let di = com.shared.shared_display_information in + di.diagnostics_messages <- (s,p,kind,sev) :: di.diagnostics_messages open Printer diff --git a/src/typing/calls.ml b/src/typing/calls.ml index 70d45674fa3..e7eaf25f6ef 100644 --- a/src/typing/calls.ml +++ b/src/typing/calls.ml @@ -208,19 +208,24 @@ let rec unify_call_args' ctx el args r callp inline force_inline = | (s,ul,p) :: _ -> arg_error ul s true p end | e :: el,(name,opt,t) :: args -> - begin try - let e = type_against name t e in + try + let e,submit_messages = hold_messages ctx.com (fun() -> type_against name t e) in + submit_messages(); (e,opt) :: loop el args - with - WithTypeError (ul,p)-> + with HoldMessages (err,submit_messages) -> + match err with + | WithTypeError (ul,p)-> if opt && List.length el < List.length args then let e_def = skip name ul t p in (e_def,true) :: loop (e :: el) args else - match List.rev !skipped with + (match List.rev !skipped with | [] -> arg_error ul name opt p | (s,ul,p) :: _ -> arg_error ul s true p - end + ) + | _ -> + submit_messages(); + raise err in let el = try loop el args with exc -> ctx.in_call_args <- in_call_args; raise exc; in ctx.in_call_args <- in_call_args; diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 5e188c1c491..e124809fe1a 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -2201,8 +2201,8 @@ and type_array_decl ctx el with_type p = if !allow_array_dynamic || ctx.untyped || ctx.com.display.dms_error_policy = EPIgnore then t_dynamic else begin - display_error ctx "Arrays of mixed types are only allowed if the type is forced to Array" p; - raise (Error (Unify l, p)) + let msg = "Arrays of mixed types are only allowed if the type is forced to Array" in + raise (Error (Stack (Custom msg, Unify l), p)) end in mk (TArrayDecl el) (ctx.t.tarray t) p diff --git a/tests/misc/projects/Issue5522/Main.hx b/tests/misc/projects/Issue5522/Main.hx new file mode 100644 index 00000000000..ad060c4a483 --- /dev/null +++ b/tests/misc/projects/Issue5522/Main.hx @@ -0,0 +1,10 @@ +class Main { + static function f(?i:Int, fn:Array->Void){} + + static function main() { + f(function(res){ + $type(res); + for (a in res){} + }); + } +} \ No newline at end of file diff --git a/tests/misc/projects/Issue5522/compile.hxml b/tests/misc/projects/Issue5522/compile.hxml new file mode 100644 index 00000000000..fab0aeecc3d --- /dev/null +++ b/tests/misc/projects/Issue5522/compile.hxml @@ -0,0 +1 @@ +--main Main \ No newline at end of file diff --git a/tests/misc/projects/Issue5522/compile.hxml.stderr b/tests/misc/projects/Issue5522/compile.hxml.stderr new file mode 100644 index 00000000000..48e8e76a994 --- /dev/null +++ b/tests/misc/projects/Issue5522/compile.hxml.stderr @@ -0,0 +1 @@ +Main.hx:6: characters 10-13 : Warning : Array \ No newline at end of file diff --git a/tests/misc/projects/Issue8283/compile-fail.hxml.stderr b/tests/misc/projects/Issue8283/compile-fail.hxml.stderr index 46dbe376fb1..c5dd71a34c2 100644 --- a/tests/misc/projects/Issue8283/compile-fail.hxml.stderr +++ b/tests/misc/projects/Issue8283/compile-fail.hxml.stderr @@ -1,4 +1,3 @@ Main.hx:9: characters 35-48 : Arrays of mixed types are only allowed if the type is forced to Array -Main.hx:9: characters 35-48 : Arrays of mixed types are only allowed if the type is forced to Array Main.hx:9: characters 35-48 : String should be Int Main.hx:9: characters 35-48 : For optional function argument 'arr' \ No newline at end of file