new warning for black holes
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6703 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
6d1d85e520
commit
0edba97cf6
2
Makefile
2
Makefile
|
@ -19,7 +19,7 @@ include stdlib/StdlibModules
|
|||
|
||||
CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
|
||||
CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib
|
||||
COMPFLAGS=-warn-error Ay -w Y $(INCLUDES)
|
||||
COMPFLAGS=-warn-error Axy -w Y $(INCLUDES)
|
||||
LINKFLAGS=
|
||||
|
||||
CAMLYACC=boot/ocamlyacc
|
||||
|
|
|
@ -134,9 +134,9 @@ let install_printer ppf lid =
|
|||
raise(Error(Unavailable_module(s, lid))) in
|
||||
let print_function =
|
||||
if is_old_style then
|
||||
(fun formatter repr -> (Obj.obj v) (Obj.obj repr))
|
||||
(fun formatter repr -> Obj.obj v (Obj.obj repr))
|
||||
else
|
||||
(fun formatter repr -> (Obj.obj v) formatter (Obj.obj repr)) in
|
||||
(fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
|
||||
Printval.install_printer path ty_arg ppf print_function
|
||||
|
||||
let remove_printer lid =
|
||||
|
|
|
@ -264,8 +264,8 @@ class text =
|
|||
|
||||
(** this method is not used here but is virtual
|
||||
in a class we will inherit later *)
|
||||
method label ?(no_ : bool option) (_ : string) =
|
||||
failwith "gni" ; ""
|
||||
method label ?(no_ : bool option) (_ : string) : string =
|
||||
failwith "gni"
|
||||
|
||||
(** Return the Texinfo code corresponding to the [text] parameter.*)
|
||||
method texi_of_text t =
|
||||
|
|
|
@ -114,7 +114,7 @@ let digest_interface unit loadpath =
|
|||
close_in ic;
|
||||
raise(Error(Corrupted_interface filename))
|
||||
end;
|
||||
input_value ic;
|
||||
ignore (input_value ic);
|
||||
let crc =
|
||||
match input_value ic with
|
||||
(_, crc) :: _ -> crc
|
||||
|
|
|
@ -56,8 +56,7 @@ let subshell cmd =
|
|||
let r,w = pipe () in
|
||||
match fork () with
|
||||
0 -> close r; dup2 ~src:w ~dst:stdout;
|
||||
execv ~prog:"/bin/sh" ~args:[| "/bin/sh"; "-c"; cmd |];
|
||||
exit 127
|
||||
execv ~prog:"/bin/sh" ~args:[| "/bin/sh"; "-c"; cmd |]
|
||||
| id ->
|
||||
close w;
|
||||
let rc = in_channel_of_descr r in
|
||||
|
|
|
@ -22,7 +22,7 @@ let subshell cmd =
|
|||
match fork () with
|
||||
0 -> close r; dup2 w stdout;
|
||||
close stderr;
|
||||
execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; exit 127
|
||||
execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]
|
||||
| id ->
|
||||
close w;
|
||||
let rc = in_channel_of_descr r in
|
||||
|
|
|
@ -19,7 +19,7 @@ CC=$(BYTECC)
|
|||
CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g
|
||||
CAMLC=../../ocamlcomp.sh -I ../unix
|
||||
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
|
||||
COMPFLAGS=-warn-error Ay -w Y
|
||||
COMPFLAGS=-warn-error Axy -w Y
|
||||
|
||||
C_OBJS=scheduler.o
|
||||
|
||||
|
|
|
@ -23,7 +23,7 @@ CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)
|
|||
CAMLC=../../ocamlcomp.sh
|
||||
CAMLOPT=../../ocamlcompopt.sh
|
||||
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
|
||||
COMPFLAGS=-warn-error Ay -w Y
|
||||
COMPFLAGS=-warn-error Axy -w Y
|
||||
|
||||
OBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \
|
||||
chown.o chroot.o close.o closedir.o connect.o cst2constr.o cstringv.o \
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
Objective Caml version 3.09+dev4 (2004-10-13)
|
||||
Objective Caml version 3.09+dev9 (2004-11-29)
|
||||
|
||||
# * * * # type 'a t = { t : 'a; }
|
||||
# type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
|
||||
|
@ -263,23 +263,23 @@ type 'a u = A of 'a t
|
|||
# - : t * [< `A | `B ] -> int = <fun>
|
||||
# - : [< `A | `B ] * t -> int = <fun>
|
||||
# Characters 0-41:
|
||||
Warning: this pattern-matching is not exhaustive.
|
||||
Warning P: this pattern-matching is not exhaustive.
|
||||
Here is an example of a value that is not matched:
|
||||
(`AnyExtraTag, `AnyExtraTag)
|
||||
- : [> `A | `B ] * [> `A | `B ] -> int = <fun>
|
||||
# Characters 0-29:
|
||||
Warning: this pattern-matching is not exhaustive.
|
||||
Warning P: this pattern-matching is not exhaustive.
|
||||
Here is an example of a value that is not matched:
|
||||
(_, 0)
|
||||
Characters 21-24:
|
||||
Warning: this match case is unused.
|
||||
Warning U: this match case is unused.
|
||||
- : [ `B ] * int -> int = <fun>
|
||||
# Characters 0-29:
|
||||
Warning: this pattern-matching is not exhaustive.
|
||||
Warning P: this pattern-matching is not exhaustive.
|
||||
Here is an example of a value that is not matched:
|
||||
(0, _)
|
||||
Characters 21-24:
|
||||
Warning: this match case is unused.
|
||||
Warning U: this match case is unused.
|
||||
- : int * [ `B ] -> int = <fun>
|
||||
# Characters 69-135:
|
||||
Constraints are not satisfied in this type.
|
||||
|
@ -318,8 +318,8 @@ type bt = 'a ca cb as 'a
|
|||
# val f : unit -> c = <fun>
|
||||
# val f : unit -> c = <fun>
|
||||
# Characters 11-60:
|
||||
Warning: the following private methods were made public implicitly:
|
||||
n
|
||||
Warning X: the following private methods were made public implicitly:
|
||||
n .
|
||||
val f : unit -> < m : int; n : int > = <fun>
|
||||
# Characters 11-56:
|
||||
This object is expected to have type c but has actually type
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
Objective Caml version 3.09+dev4 (2004-10-13)
|
||||
Objective Caml version 3.09+dev9 (2004-11-29)
|
||||
|
||||
# * * * # type 'a t = { t : 'a; }
|
||||
# type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
|
||||
|
@ -144,9 +144,9 @@ This method has type 'a -> 'a which is less general than 'b. 'b -> 'b
|
|||
# Characters 24-28:
|
||||
This expression has type bool but is here used with type int
|
||||
# Characters 27-31:
|
||||
Warning: This use of a polymorphic method is not principal
|
||||
Warning X: this use of a polymorphic method is not principal.
|
||||
Characters 35-39:
|
||||
Warning: This use of a polymorphic method is not principal
|
||||
Warning X: this use of a polymorphic method is not principal.
|
||||
val f4 : id -> int * bool = <fun>
|
||||
# class c : object method m : #id -> int * bool end
|
||||
# class id2 : object method id : 'a -> 'a method mono : int -> int end
|
||||
|
@ -270,23 +270,23 @@ type 'a u = A of 'a t
|
|||
# - : t * [< `A | `B ] -> int = <fun>
|
||||
# - : [< `A | `B ] * t -> int = <fun>
|
||||
# Characters 0-41:
|
||||
Warning: this pattern-matching is not exhaustive.
|
||||
Warning P: this pattern-matching is not exhaustive.
|
||||
Here is an example of a value that is not matched:
|
||||
(`AnyExtraTag, `AnyExtraTag)
|
||||
- : [> `A | `B ] * [> `A | `B ] -> int = <fun>
|
||||
# Characters 0-29:
|
||||
Warning: this pattern-matching is not exhaustive.
|
||||
Warning P: this pattern-matching is not exhaustive.
|
||||
Here is an example of a value that is not matched:
|
||||
(_, 0)
|
||||
Characters 21-24:
|
||||
Warning: this match case is unused.
|
||||
Warning U: this match case is unused.
|
||||
- : [ `B ] * int -> int = <fun>
|
||||
# Characters 0-29:
|
||||
Warning: this pattern-matching is not exhaustive.
|
||||
Warning P: this pattern-matching is not exhaustive.
|
||||
Here is an example of a value that is not matched:
|
||||
(0, _)
|
||||
Characters 21-24:
|
||||
Warning: this match case is unused.
|
||||
Warning U: this match case is unused.
|
||||
- : int * [ `B ] -> int = <fun>
|
||||
# Characters 69-135:
|
||||
Constraints are not satisfied in this type.
|
||||
|
@ -325,8 +325,8 @@ type bt = 'a ca cb as 'a
|
|||
# val f : unit -> c = <fun>
|
||||
# val f : unit -> c = <fun>
|
||||
# Characters 11-60:
|
||||
Warning: the following private methods were made public implicitly:
|
||||
n
|
||||
Warning X: the following private methods were made public implicitly:
|
||||
n .
|
||||
val f : unit -> < m : int; n : int > = <fun>
|
||||
# Characters 11-56:
|
||||
This object is expected to have type c but has actually type
|
||||
|
|
|
@ -179,9 +179,9 @@ let dir_install_printer ppf lid =
|
|||
let v = eval_path path in
|
||||
let print_function =
|
||||
if is_old_style then
|
||||
(fun formatter repr -> (Obj.obj v) (Obj.obj repr))
|
||||
(fun formatter repr -> Obj.obj v (Obj.obj repr))
|
||||
else
|
||||
(fun formatter repr -> (Obj.obj v) formatter (Obj.obj repr)) in
|
||||
(fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
|
||||
install_printer path ty_arg print_function
|
||||
with Exit -> ()
|
||||
|
||||
|
|
|
@ -869,14 +869,27 @@ let rec type_exp env sexp =
|
|||
| Pexp_function _ -> (* defined in type_expect *)
|
||||
type_expect env sexp (newvar())
|
||||
| Pexp_apply(sfunct, sargs) ->
|
||||
begin_def (); (* one more level for non-returning functions *)
|
||||
if !Clflags.principal then begin_def ();
|
||||
let funct = type_exp env sfunct in
|
||||
if !Clflags.principal then begin
|
||||
end_def ();
|
||||
generalize_structure funct.exp_type
|
||||
end;
|
||||
let rec lower_args ty_fun =
|
||||
match (expand_head env ty_fun).desc with
|
||||
Tarrow (l, ty, ty_fun, com) ->
|
||||
unify_var env (newvar()) ty;
|
||||
lower_args ty_fun
|
||||
| _ -> ()
|
||||
in
|
||||
let ty = instance funct.exp_type in
|
||||
end_def ();
|
||||
lower_args ty;
|
||||
begin_def ();
|
||||
let (args, ty_res) = type_application env funct sargs in
|
||||
let funct = {funct with exp_type = instance funct.exp_type} in
|
||||
end_def ();
|
||||
unify_var env (newvar()) funct.exp_type;
|
||||
re {
|
||||
exp_desc = Texp_apply(funct, args);
|
||||
exp_loc = sexp.pexp_loc;
|
||||
|
@ -1462,9 +1475,20 @@ and type_application env funct sargs =
|
|||
instance (result_type omitted ty_fun))
|
||||
| (l1, sarg1) :: sargl ->
|
||||
let (ty1, ty2) =
|
||||
match (expand_head env ty_fun).desc with
|
||||
let ty_fun = expand_head env ty_fun in
|
||||
match ty_fun.desc with
|
||||
Tvar ->
|
||||
let t1 = newvar () and t2 = newvar () in
|
||||
let not_identity = function
|
||||
Texp_ident(_,{val_kind=Val_prim
|
||||
{Primitive.prim_name="%identity"}}) ->
|
||||
false
|
||||
| _ -> true
|
||||
in
|
||||
if ty_fun.level >= t1.level && not_identity funct.exp_desc then
|
||||
Location.prerr_warning sarg1.pexp_loc
|
||||
(Warnings.Other
|
||||
"this argument will not be received by the function.");
|
||||
unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
|
||||
(t1, t2)
|
||||
| Tarrow (l,t1,t2,_) when l = l1
|
||||
|
@ -1771,18 +1795,24 @@ and type_expect ?in_function env sexp ty_expected =
|
|||
(* Typing of statements (expressions whose values are discarded) *)
|
||||
|
||||
and type_statement env sexp =
|
||||
let exp = type_exp env sexp in
|
||||
match (expand_head env exp.exp_type).desc with
|
||||
| Tarrow _ ->
|
||||
Location.prerr_warning sexp.pexp_loc Warnings.Partial_application;
|
||||
exp
|
||||
| Tconstr (p, _, _) when Path.same p Predef.path_unit -> exp
|
||||
| Tvar ->
|
||||
add_delayed_check (fun () -> check_partial_application env exp);
|
||||
exp
|
||||
| _ ->
|
||||
Location.prerr_warning sexp.pexp_loc Warnings.Statement_type;
|
||||
exp
|
||||
begin_def();
|
||||
let exp = type_exp env sexp in
|
||||
end_def();
|
||||
let ty = expand_head env exp.exp_type and tv = newvar() in
|
||||
begin match ty.desc with
|
||||
| Tarrow _ ->
|
||||
Location.prerr_warning sexp.pexp_loc Warnings.Partial_application
|
||||
| Tconstr (p, _, _) when Path.same p Predef.path_unit -> ()
|
||||
| Tvar when ty.level > tv.level ->
|
||||
Location.prerr_warning sexp.pexp_loc
|
||||
(Warnings.Other "this statement never returns.")
|
||||
| Tvar ->
|
||||
add_delayed_check (fun () -> check_partial_application env exp)
|
||||
| _ ->
|
||||
Location.prerr_warning sexp.pexp_loc Warnings.Statement_type
|
||||
end;
|
||||
unify_var env tv ty;
|
||||
exp
|
||||
|
||||
(* Typing of match cases *)
|
||||
|
||||
|
|
Loading…
Reference in New Issue