PR#6876: improve warning 6 by listing the omitted labels.

(Eyyüb Sari)

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

7 files changed, 31 insertions, 7 deletions

diff --git a/Changes b/Changes
index 5f4516351f..e9bab00a90 100644
--- a/Changes
+++ b/Changes
@@ -128,6 +128,8 @@ Features wishes:
   (Simon Cruanes)
 * PR#6816: reject integer and float literals followed by alphanum
   (Hugo Heuzard)
+- PR#6876: improve warning 6 by listing the omitted labels.
+  (Eyyüb Sari)
 - GPR#111: `(f [@taillcall]) x y` warns if `f x y` is not a tail-call
   (Simon Cruanes)
 - GPR#118: ocamldep -allow-approx: fallback to a lexer-based approximation
diff --git a/testsuite/tests/warnings/w06.ml b/testsuite/tests/warnings/w06.ml
new file mode 100644
index 0000000000..106d75d828
--- /dev/null
+++ b/testsuite/tests/warnings/w06.ml
@@ -0,0 +1,6 @@
+let foo ~bar = () (* one label *)
+
+let bar ~foo ~baz = () (* two labels *)
+
+let _ = foo 2
+let _ = bar 4 2
diff --git a/testsuite/tests/warnings/w06.reference b/testsuite/tests/warnings/w06.reference
new file mode 100644
index 0000000000..0c95916c56
--- /dev/null
+++ b/testsuite/tests/warnings/w06.reference
@@ -0,0 +1,4 @@
+File "w06.ml", line 5, characters 8-11:
+Warning 6: label bar was omitted in the application of this function.
+File "w06.ml", line 6, characters 8-11:
+Warning 6: labels foo, baz were omitted in the application of this function.
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index fab7063c68..aeec7bf33c 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -1004,7 +1004,11 @@ and class_expr cl_num val_env met_env scl =
         List.for_all (fun (l,_) -> l = Nolabel) sargs &&
         List.exists (fun l -> l <> Nolabel) labels &&
         begin
-          Location.prerr_warning cl.cl_loc Warnings.Labels_omitted;
+          Location.prerr_warning
+	    cl.cl_loc
+	    (Warnings.Labels_omitted
+	       (List.map Printtyp.string_of_label
+			 (List.filter ((<>) Nolabel) labels)));
           true
         end
       in
diff --git a/typing/typecore.ml b/typing/typecore.ml
index e1cea18b08..09afcd8a39 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -3273,7 +3273,11 @@ and type_application env funct sargs =
       List.length labels = List.length sargs &&
       List.for_all (fun (l,_) -> l = Nolabel) sargs &&
       List.exists (fun l -> l <> Nolabel) labels &&
-      (Location.prerr_warning funct.exp_loc Warnings.Labels_omitted;
+      (Location.prerr_warning
+	 funct.exp_loc
+	 (Warnings.Labels_omitted
+	    (List.map Printtyp.string_of_label
+		      (List.filter ((<>) Nolabel) labels)));
        true)
     end
   in
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 154f0e6563..8e67881e4c 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -23,7 +23,7 @@ type t =
   | Deprecated of string                    (*  3 *)
   | Fragile_match of string                 (*  4 *)
   | Partial_application                     (*  5 *)
-  | Labels_omitted                          (*  6 *)
+  | Labels_omitted of string list           (*  6 *)
   | Method_override of string list          (*  7 *)
   | Partial_match of string                 (*  8 *)
   | Non_closed_record_pattern of string     (*  9 *)
@@ -82,7 +82,7 @@ let number = function
   | Deprecated _ -> 3
   | Fragile_match _ -> 4
   | Partial_application -> 5
-  | Labels_omitted -> 6
+  | Labels_omitted _ -> 6
   | Method_override _ -> 7
   | Partial_match _ -> 8
   | Non_closed_record_pattern _ -> 9
@@ -260,8 +260,12 @@ let message = function
   | Partial_application ->
       "this function application is partial,\n\
        maybe some arguments are missing."
-  | Labels_omitted ->
-      "labels were omitted in the application of this function."
+  | Labels_omitted [] -> assert false
+  | Labels_omitted [l] ->
+     "label " ^ l ^ " was omitted in the application of this function."
+  | Labels_omitted ls ->
+     "labels " ^ String.concat ", " ls ^
+       " were omitted in the application of this function."
   | Method_override [lab] ->
       "the method " ^ lab ^ " is overridden."
   | Method_override (cname :: slist) ->
diff --git a/utils/warnings.mli b/utils/warnings.mli
index c9ab96cc3a..1d41612540 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -18,7 +18,7 @@ type t =
   | Deprecated of string                    (*  3 *)
   | Fragile_match of string                 (*  4 *)
   | Partial_application                     (*  5 *)
-  | Labels_omitted                          (*  6 *)
+  | Labels_omitted of string list           (*  6 *)
   | Method_override of string list          (*  7 *)
   | Partial_match of string                 (*  8 *)
   | Non_closed_record_pattern of string     (*  9 *)