From 1f5882e53d452f3ec00d2278f8bd970c15ce6b23 Mon Sep 17 00:00:00 2001 From: Jacques Garrigue Date: Tue, 19 Feb 2013 03:12:36 +0000 Subject: Replace error by warning for PR#5835 git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13298 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- typing/typeclass.ml | 5 ++++- typing/typecore.ml | 7 ++++--- 2 files changed, 8 insertions(+), 4 deletions(-) (limited to 'typing') diff --git a/typing/typeclass.ml b/typing/typeclass.ml index fee65fad66..b81f8de1fa 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -958,8 +958,11 @@ and class_expr cl_num val_env met_env scl = Btype.extract_label name more_sargs in (l', sarg0, sargs @ sargs1, sargs2) in + if optional = Required && Btype.is_optional l' then + Location.prerr_warning sarg0.pexp_loc + (Warnings.Nonoptional_label l); sargs, more_sargs, - if Btype.is_optional l' || not (Btype.is_optional l) then + if optional = Required || Btype.is_optional l' then Some (type_argument val_env sarg0 ty ty) else let ty0 = extract_option_type val_env ty in diff --git a/typing/typecore.ml b/typing/typecore.ml index f13e715852..6ff79925e0 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -2952,10 +2952,11 @@ and type_application env funct sargs = (Warnings.Not_principal "commuting this argument"); (l', sarg0, sargs @ sargs1, sargs2) in - sargs, more_sargs, if optional = Required && is_optional l' then - raise(Error(sarg0.pexp_loc, env, Apply_wrong_label(l', ty_fun'))) - else if optional = Required || is_optional l' then + Location.prerr_warning sarg0.pexp_loc + (Warnings.Nonoptional_label l); + sargs, more_sargs, + if optional = Required || is_optional l' then Some (fun () -> type_argument env sarg0 ty ty0) else begin may_warn sarg0.pexp_loc -- cgit v1.2.1