diff options
| author | Jacques Garrigue <garrigue@math.nagoya-u.ac.jp> | 2015-11-30 16:45:44 +0900 |
|---|---|---|
| committer | Jacques Garrigue <garrigue@math.nagoya-u.ac.jp> | 2015-11-30 16:45:44 +0900 |
| commit | a1bb57048cebbfa1a173d8574371d38d3635e1fc (patch) | |
| tree | 71888a08fc555380b131815f9e4d4628bade800d | |
| parent | 29341616288a9f260b32857fa37202fe17c75f73 (diff) | |
| download | ocaml-a1bb57048cebbfa1a173d8574371d38d3635e1fc.tar.gz | |
Fix PR#6946
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | testsuite/tests/typing-misc-bugs/pr6946_bad.ml | 2 | ||||
| -rw-r--r-- | testsuite/tests/typing-warnings/application.ml | 2 | ||||
| -rw-r--r-- | testsuite/tests/typing-warnings/application.ml.reference | 13 | ||||
| -rw-r--r-- | typing/typecore.ml | 13 |
5 files changed, 28 insertions, 3 deletions
@@ -290,6 +290,7 @@ Bug fixes: - PR#6945 and GPR#227: protect Sys and Unix functions against string arguments containing the null character '\000' (c-cube and Xavier Leroy, report by Daniel Bünzli) +- PR#6946: Uncaught exception with wrong type for "%ignore" - PR#6954: Infinite loop in type checker with module aliases - PR#6972, GPR#276: 4.02.3 regression on documentation comments in .cmt files (Leo White, report by Olivier Andrieu) diff --git a/testsuite/tests/typing-misc-bugs/pr6946_bad.ml b/testsuite/tests/typing-misc-bugs/pr6946_bad.ml new file mode 100644 index 0000000000..bbaefe9054 --- /dev/null +++ b/testsuite/tests/typing-misc-bugs/pr6946_bad.ml @@ -0,0 +1,2 @@ +external foo : int = "%ignore";; +let _ = foo ();; diff --git a/testsuite/tests/typing-warnings/application.ml b/testsuite/tests/typing-warnings/application.ml new file mode 100644 index 0000000000..a0c420616f --- /dev/null +++ b/testsuite/tests/typing-warnings/application.ml @@ -0,0 +1,2 @@ +let _ = ignore (+);; +let _ = raise Exit 3;; diff --git a/testsuite/tests/typing-warnings/application.ml.reference b/testsuite/tests/typing-warnings/application.ml.reference new file mode 100644 index 0000000000..da825fd089 --- /dev/null +++ b/testsuite/tests/typing-warnings/application.ml.reference @@ -0,0 +1,13 @@ + +# Characters 15-18: + let _ = ignore (+);; + ^^^ +Warning 5: this function application is partial, +maybe some arguments are missing. +- : unit = () +# Characters 19-20: + let _ = raise Exit 3;; + ^ +Warning 20: this argument will not be used by the function. +Exception: Pervasives.Exit. +# diff --git a/typing/typecore.ml b/typing/typecore.ml index e76ea19615..0dcff0e57b 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -3508,10 +3508,17 @@ and type_application env funct sargs = type_unknown_args args omitted ty_fun0 (sargs @ more_sargs) in - match funct.exp_desc, sargs with + let is_ignore funct = + match funct.exp_desc with + Texp_ident (_, _, {val_kind=Val_prim{Primitive.prim_name="%ignore"}}) -> + (try ignore (filter_arrow env (instance env funct.exp_type) Nolabel); + true + with Unify _ -> false) + | _ -> false + in + match sargs with (* Special case for ignore: avoid discarding warning *) - Texp_ident (_, _, {val_kind=Val_prim{Primitive.prim_name="%ignore"}}), - [Nolabel, sarg] -> + [Nolabel, sarg] when is_ignore funct -> let ty_arg, ty_res = filter_arrow env (instance env funct.exp_type) Nolabel in |