#6352: add a warning on implicit removal of optional arguments.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14498 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

4 files changed, 16 insertions, 6 deletions

diff --git a/Makefile b/Makefile
index 0f44c66ba8..d5dce813d4 100644
--- a/Makefile
+++ b/Makefile
@@ -17,7 +17,7 @@ include stdlib/StdlibModules
 
 CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
 CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
-COMPFLAGS=-strict-sequence -w +33..39 -warn-error A -bin-annot $(INCLUDES)
+COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot $(INCLUDES)
 LINKFLAGS=
 
 CAMLYACC=boot/ocamlyacc
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 47cbb0ede9..9351572e22 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -2973,8 +2973,8 @@ and type_argument env sarg ty_expected' ty_expected =
             let ty = option_none (instance env ty_arg) sarg.pexp_loc in
             make_args ((l, Some ty, Optional) :: args) ty_fun
         | Tarrow (l,_,ty_res',_) when l = "" || !Clflags.classic ->
-            args, ty_fun, no_labels ty_res'
-        | Tvar _ ->  args, ty_fun, false
+            List.rev args, ty_fun, no_labels ty_res'
+        | Tvar _ ->  List.rev args, ty_fun, false
         |  _ -> [], texp.exp_type, false
       in
       let args, ty_fun', simple_res = make_args [] texp.exp_type in
@@ -3008,11 +3008,13 @@ and type_argument env sarg ty_expected' ty_expected =
           {texp with exp_type = ty_res; exp_desc =
            Texp_apply
              (texp,
-              List.rev args @ ["", Some eta_var, Required])}
+              args @ ["", Some eta_var, Required])}
         in
         { texp with exp_type = ty_fun; exp_desc =
           Texp_function("", [case eta_pat e], Total) }
       in
+      Location.prerr_warning texp.exp_loc
+        (Warnings.Eliminated_optional_arguments (List.map (fun (l, _, _) -> l) args));
       if warn then Location.prerr_warning texp.exp_loc
           (Warnings.Without_principality "eliminated optional argument");
       if is_nonexpansive texp then func texp else
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 3a4e0912f3..58d2753962 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -65,6 +65,7 @@ type t =
   | Open_shadow_label_constructor of string * string (* 45 *)
   | Bad_env_variable of string * string     (* 46 *)
   | Attribute_payload of string * string    (* 47 *)
+  | Eliminated_optional_arguments of string list (* 48 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -121,9 +122,10 @@ let number = function
   | Open_shadow_label_constructor _ -> 45
   | Bad_env_variable _ -> 46
   | Attribute_payload _ -> 47
+  | Eliminated_optional_arguments _ -> 48
 ;;
 
-let last_warning_number = 47
+let last_warning_number = 48
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -226,7 +228,7 @@ let parse_opt flags s =
 let parse_options errflag s = parse_opt (if errflag then error else active) s;;
 
 (* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-32..39-41..42-44-45";;
+let defaults_w = "+a-4-6-7-9-27-29-32..39-41..42-44-45-48";;
 let defaults_warn_error = "-a";;
 
 let () = parse_options false defaults_w;;
@@ -360,6 +362,10 @@ let message = function
       Printf.sprintf "illegal environment variable %s : %s" var s
   | Attribute_payload (a, s) ->
       Printf.sprintf "illegal payload for attribute '%s'.\n%s" a s
+  | Eliminated_optional_arguments sl ->
+      Printf.sprintf "implicit elimination of optional argument%s %s"
+        (if List.length sl = 1 then "" else "s")
+        (String.concat ", " sl)
 ;;
 
 let nerrors = ref 0;;
@@ -453,6 +459,7 @@ let descriptions =
    45, "Open statement shadows an already defined label or constructor.";
    46, "Illegal environment variable";
    47, "Illegal attribute payload";
+   48, "Implicit elimination of optional arguments";
   ]
 ;;
 
diff --git a/utils/warnings.mli b/utils/warnings.mli
index a7c3abd40e..05bf66bdea 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -60,6 +60,7 @@ type t =
   | Open_shadow_label_constructor of string * string (* 45 *)
   | Bad_env_variable of string * string     (* 46 *)
   | Attribute_payload of string * string    (* 47 *)
+  | Eliminated_optional_arguments of string list (* 48 *)
 ;;
 
 val parse_options : bool -> string -> unit;;