(***********************************************************************)
(*                                                                     *)
(*                                OCaml                                *)
(*                                                                     *)
               , projet  , INRIA Rocquencourt         
(*                                                                     *)
   Copyright 2001 Institut National de Recherche en Informatique et   
   en Automatique .   All rights reserved .   This file is distributed    
   under the terms of the Q Public License version 1.0 .               
(*                                                                     *)
(***********************************************************************)

(**************************************************************)
(*  This suite tests the pattern-matching compiler            *)
(*  it should just compile and run.                           *)
(*  While compiling the following messages are normal:        *)
(**************************************************************)


 File " morematch.ml " , line 38 , characters 10 - 93 : 
 Warning : this pattern - matching is not exhaustive . 
 Here is an example of a value that is not matched : 
 0 
 File " morematch.ml " , line 376 , characters 2 - 15 : 
 Warning : this match case is unused . 
 File " morematch.ml " , line 443 , characters 2 - 7 : 
 Warning : this match case is unused . 

File "morematch.ml", line 38, characters 10-93:
Warning: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
0
File "morematch.ml", line 376, characters 2-15:
Warning: this match case is unused.
File "morematch.ml", line 443, characters 2-7:
Warning: this match case is unused.
*)

let test msg f arg r =
  if f arg <> r then begin
    prerr_endline msg ;
    failwith "Malaise"
  end
;;

type t = A | B | C | D | E | F
  ;;

let f x = match x with
| A | B | C -> 1
| D | E -> 2
| F -> 3;;

test "un" f C 1 ;
test "un" f D 2 ;
test "un" f F 3 ; ()
;;

let g x = match x with
  1 -> 1
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
| 6 -> 5
| 7 | 8 -> 6
| 9 -> 7
| _ -> assert false
;;

test "deux" g 5 4 ;
test "deux" g 6 5 ;
test "deux" g 9 7 ; ()
;;


let g x = match x with
  1 -> 1
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
| 6 -> 5
| 7 | 8 -> 6
| 9 -> 7
| _ -> 8;;

test "trois" g 10 8
;;

let g x= match  x with
  1 -> 1
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
| 6 -> 5
| 4|5|7 -> 100
| 7 | 8 -> 6
| 9 -> 7
| _ -> 8;;
test "quatre" g 4 4 ;
test "quatre" g 7 100 ; ()
;;


 File " morematch.ml " , line 73 , characters 2 - 5 : 
 Warning U : this sub - pattern is unused . 
 File " morematch.ml " , line 74 , characters 2 - 3 : 
 Warning U : this sub - pattern is unused . 

File "morematch.ml", line 73, characters 2-5:
Warning U: this sub-pattern is unused.
File "morematch.ml", line 74, characters 2-3:
Warning U: this sub-pattern is unused.
*)

let h x =
 match x with
   (1,1) -> 1
| (2|3), 1 -> 2
| 2,(2|3) -> 3
| (4,4) -> 5
| _ -> 100
;;

test "cinq" h (2,2) 3 ;
test "cinq" h (2,1) 2 ;
test "cinq" h (2,4) 100 ; ()
;;

  idem hh ( 2,5 )

let hh x = match x with
| 1,1 -> 1
| 2,1 -> 2
| (2|3),(1|2|3|4) -> 3
| 2,5 -> 4
| (4,4) -> 5
| _ -> 100
;;

let hhh x = match x with
| 1,1 -> 1
| (2|3),1 -> 2
| 2,2 -> 3
| _ -> 100
;;

let h x =
 match x with
   (1,1) -> 1
| 3,1 -> 2
| 2,(2|3) -> 3
| (4,4) -> 5
| _ -> 100
;;

let h x = match x with
  1 -> 1
| 2|3 -> 2
| 4 -> 4
| 5 -> 5
| 6|7 -> 6
| 8 -> 8
| _ -> 100
;;
let f x = match x with
| ((1|2),(3|4))|((3|4),(1|2)) -> 1
| (3,(5|6)) -> 2
| _ -> 3
;;

test "six" f (1,3) 1 ;
test "six" f (3,2) 1 ;
test "six" f (3,5) 2 ;
test "six" f (3,7) 3 ; ()
;;

type tt = {a : bool list ; b : bool}

let f = function
  | {a=([]|[true])} -> 1
  | {a=false::_}|{b=(true|false)}    -> 2
;;

test "sept" f {a=[] ; b = true} 1 ;
test "sept" f {a=[true] ; b = false} 1 ;
test "sept" f {a=[false ; true] ; b = true} 2 ;
test "sept" f {a=[false] ; b = false} 2 ; ()
;;

let f = function
  | (([]|[true]),_) -> 1
  | (false::_,_)|(_,(true|false)) -> 2
;;

test "huit" f ([],true) 1 ;
test "huit" f ([true],false) 1 ;
test "huit" f ([false ; true], true) 2 ;
test "huit" f ([false], false) 2 ; ()
;;


let split_cases = function
   | `Nil | `Cons _ as x -> `A x
   | `Snoc _ as x -> `B x
;;

test "oubli" split_cases `Nil (`A `Nil);
test "oubli" split_cases (`Cons 1) (`A (`Cons 1));
test "oubli" split_cases (`Snoc 1) (`B (`Snoc 1)) ; ()
;;

type t1 = A of int | B of int
let f1 = function
  | (A x | B x) -> x
;;

test "neuf" f1 (A 1) 1 ;
test "neuf" f1 (B 1) 1 ;
;;

type coucou = A of int | B of int * int | C
;;


let g = function
  | (A x | B (_,x)) -> x
  | C -> 0
;;


test "dix" g (A 1) 1 ;
test "dix" g (B (1,2)) 2 ;
;;



let h = function
  | ([x]|[1 ; x ]|[1 ; 2 ; x]) -> x
  | _ -> 0
;;

test "encore" h [1] 1 ;
test "encore" h [1;2] 2 ;
test "encore" h [1;2;3] 3 ;
test "encore" h [0 ; 0] 0 ; ()
;;

let f = function
| (x,(0 as y)) | (y,x) -> y-x
;;

test "foo1" f (1,0) (-1);
test "foo1" f (1,2) (-1)
;;


let f = function (([]|[_]) as x)|(_::([] as x))|(_::_::x)  -> x
;;

test "zob" f [] [] ;
test "zob" f [1] [1] ;
test "zob" f [1;2;3] [3]
;;


type zob = A | B | C | D of zob * int | E of zob * zob

let rec f = function
  | (A | B | C) -> A
  | D (x,i) -> D (f x,i)
  | E (x,_) -> D (f x,0)
;;


test "fin" f B A ;
test "fin" f (D (C,1)) (D (A,1)) ;
test "fin" f (E (C,A)) (D (A,0)) ; ()
;;

type length =
    Char of int | Pixel of int | Percent of int | No of string | Default

let length = function
  | Char n -> n | Pixel n -> n
  | _       -> 0
;;

test "length" length (Char 10) 10 ;
test "length" length (Pixel 20) 20 ;
test "length" length Default 0 ;
test "length" length (Percent 100) 0 ; ()
;;

let length2 = function
  | Char n -> n | Percent n -> n
  | _       -> 0
;;

test "length2" length2 (Char 10) 10 ;
test "length2" length2 (Pixel 20) 0 ;
test "length2" length2 Default 0 ;
test "length2" length2(Percent 100) 100 ; ()
;;

let length3 = function
  | Char _ | No _ -> true
  | _ -> false
;;

test "length3" length3 (Char 10) true ;
test "length3" length3 (No "") true ;
test "length3" length3 (Pixel 20) false ;
test "length3" length3 Default false ;
test "length3" length3(Percent 100) false ; ()
;;

type hevea = A | B | C

let h x = match x with
| A -> 1
| B|C -> 2
;;

test "hevea" h A 1 ;
test "hevea" h B 2 ;
test "hevea" h B 2 ; ()
;;
type lambda =
    Lvar of int
  | Lconst of int
  | Lapply of lambda * lambda list
  | Lfunction of bool  * int list * lambda
  | Llet of  bool * int * lambda * lambda
  | Lletrec of (int * lambda) list * lambda
  | Lprim of string * lambda list
  | Lswitch of lambda * lambda_switch
  | Lstaticfail
  | Lcatch of lambda * lambda
  | Lstaticraise of int * lambda list
  | Lstaticcatch of lambda * (int * int list) * lambda
  | Ltrywith of lambda * int * lambda
  | Lifthenelse of lambda * lambda * lambda
  | Lsequence of lambda * lambda
  | Lwhile of lambda * lambda
  | Lfor of int * lambda * lambda * bool * lambda
  | Lassign of int * lambda
  | Lsend of lambda * lambda * lambda list
  | Levent of lambda * lambda_event
  | Lifused of int * lambda
and lambda_switch =
  { sw_numconsts: int;                  (* Number of integer cases *)
  Integer cases
    sw_numblocks: int;                  (* Number of tag block cases *)
    sw_blocks: (int * lambda) list;     (* Tag block cases *)
    sw_checked: bool ;                  (* True if bound checks needed *)
    sw_nofail: bool}                    (* True if should not fail *)
and lambda_event =
  { lev_loc: int;
    lev_kind: bool ;
    lev_repr: int ref option;
    lev_env: int list }

let rec approx_present v l = true

let rec lower_bind v arg lam = match lam with
| Lifthenelse (cond, ifso, ifnot) -> 1
| Lswitch (ls,({sw_consts=[i,act] ; sw_blocks = []} as _sw))
    when not (approx_present v ls) -> 2
| Lswitch (ls,({sw_consts=[] ; sw_blocks = [i,act]} as _sw))
    when not (approx_present v ls) -> 3
| Llet (true , vv, lv, l) -> 4
| _ -> 5
;;

test "lower_bind" (lower_bind 0 0) (Llet (true,0, Lvar 1, Lvar 2)) 4 ;
test "lower_bind" (lower_bind 0 0) (Lvar 0) 5 ;
test "lower_bind" (lower_bind 0 0) (Lifthenelse (Lvar 0, Lvar 1, Lvar 2)) 1
;;


type field_kind =
    Fvar of field_kind option ref
  | Fpresent
  | Fabsent

let unify_kind (k1, k2) =  match k1, k2 with
    (Fvar r, (Fvar _ | Fpresent))             -> 1
  | (Fpresent, Fvar r)                        -> 2
  | (Fpresent, Fpresent)                      -> 3
  | _                                         -> 4


let r = ref (Some Fpresent)
;;

test "unify"  unify_kind (Fvar r, Fpresent) 1 ;
test "unify"  unify_kind (Fvar r, Fvar r) 1 ;
test "unify"  unify_kind (Fvar r, Fabsent) 4 ;
test "unify"  unify_kind (Fpresent, Fvar r) 2 ;
test "unify"  unify_kind (Fpresent, Fpresent) 3 ;
test "unify"  unify_kind (Fabsent, Fpresent) 4 ; ()
;;


type youyou = A | B | C | D of youyou

let foo (k1, k2) = match k1,k2 with
| D _, (A|D _) -> 1
| (A|B),D _ -> 2
| C,_       -> 3
| _, (A|B|C) -> 4
;;

test "foo2" foo (D A,A) 1 ;
test "foo2" foo (D A,B) 4 ;
test "foo2" foo (A,A) 4 ; ()
;;

type yaya = A | B
;;

let yaya = function
| A,_,_ -> 1
| _,A,_ -> 2
| B,B,_ -> 3
| A,_,(100|103) -> 5
;;

test "yaya" yaya (A,A,0) 1 ;
test "yaya" yaya (B,A,0) 2 ;
test "yaya" yaya (B,B,100) 3 ; ()
;;


 let      | [ ] , _ , _ - > 1 
 | _ , [ ] , _ - > 2 
 | _ : : _ , _ : : _ , _ - > 3 
 | [ ] , _ , ( 100|103|104 ) - > 5 
 | [ ] , _ , ( 100|103 ) - > 6 
 | [ ] , _ , ( 1000|1001|1002|20000 ) - > 7 
 ; ; 

 test " yoyo " yoyo ( [ ] , [ ] , 0 ) 1 ; 
 test " yoyo " yoyo ( [ 1],[],0 ) 2 ; 
 test " yoyo " yoyo ( [ 1],[1],100 ) 3 ; ( ) 
 ; ; 

 let youyou = function 
   | ( 100|103|104 ) - > 1 
   | ( 100|103|101 ) - > 2 
   | ( 1000|1001|1002|20000 ) - > 3 
   | _ - > -1 
 ; ; 

 test " youyou " youyou 100 1 ; 
 test " youyou " youyou 101 2 ; 
 test " youyou " youyou 1000 3 
 ; ; 

let yoyo =  function
| [],_,_ -> 1
| _,[],_ -> 2
| _::_,_::_,_ -> 3
| [],_,(100|103|104) -> 5
| [],_,(100|103) -> 6
| [],_,(1000|1001|1002|20000) -> 7
;;

test "yoyo" yoyo ([],[],0) 1 ;
test "yoyo" yoyo ([1],[],0) 2 ;
test "yoyo" yoyo ([1],[1],100) 3 ; ()
;;

let youyou = function
  | (100|103|104) -> 1
  | (100|103|101) -> 2
  | (1000|1001|1002|20000) -> 3
  | _ -> -1
;;

test "youyou" youyou 100 1 ;
test "youyou" youyou 101 2 ;
test "youyou" youyou 1000 3
;;
*)
type autre =
  |  C | D | E of autre | F of autre * autre | H of autre | I | J | K of string

let rec autre = function
| C,_,_ -> 1
| _,C,_ -> 2
| D,D,_ -> 3
| (D|F (_,_)|H _|K _),_,_ -> 4
| (_, (D|I|E _|F (_, _)|H _|K _), _) -> 8
| (J,J,((C|D) as x |E x|F (_,x))) | (J,_,((C|J) as x)) -> autre (x,x,x)
| (J, J, (I|H _|K _)) -> 9
| I,_,_ -> 6
| E _,_,_ -> 7
;;

 File " morematch.ml " , line 437 , characters 43 - 44 : 
 Warning U : this sub - pattern is unused . 

File "morematch.ml", line 437, characters 43-44:
Warning U: this sub-pattern is unused.
*)
test "autre" autre (J,J,F (D,D)) 3 ;
test "autre" autre (J,J,D) 3 ;
test "autre" autre (J,J,I) 9 ;
test "autre" autre (H I,I,I) 4 ;
test "autre" autre (J,J,H I) 9 ; ()
;;


type youpi = YA | YB | YC
and hola = X | Y | Z | T of hola | U of hola | V of hola

let xyz = function
| YA,_,_ -> 1
| _,YA,_ -> 2
| YB,YB,_ -> 3
| ((YB|YC), (YB|YC), (X|Y|Z|V _|T _)) -> 6
| _,_,(X|U _) -> 8
| _,_,Y -> 5
;;

 File " morematch.ml " , line 459 , characters 7 - 8 : 
 Warning U : this sub - pattern is unused . 
 File " morematch.ml " , line 460 , characters 2 - 7 : 
 Warning U : this match case is unused . 

File "morematch.ml", line 459, characters 7-8:
Warning U: this sub-pattern is unused.
File "morematch.ml", line 460, characters 2-7:
Warning U: this match case is unused.
*)
test "xyz" xyz (YC,YC,X) 6 ;
test "xyz" xyz (YC,YB,U X) 8 ;
test "xyz" xyz (YB,YC,X) 6 ; ()
;;


  Ce test est pour     
let eq (x,y) = x=y
;;

test "eq" eq ("coucou", "coucou") true ; ()
;;

(* Test des gardes, non trivial *)

let is_none = function
  | None -> true
  | _ -> false

let garde x = match x with
| (Some _, _) when is_none (snd x) -> 1
| (Some (pc, _), Some pc') when pc = pc' -> 2
| _ -> 3
;;

test "garde" garde (Some (1,1),None) 1 ;
test "garde" garde (Some (1,1),Some 1) 2 ;
test "garde" garde (Some (2,1),Some 1) 3 ; ()
;;

let orstring = function
  | ("A"|"B"|"C") -> 2
  | "D" -> 3
  | _ -> 4
;;

test "orstring" orstring "A" 2 ;
test "orstring" orstring "B" 2 ;
test "orstring" orstring "C" 2 ;
test "orstring" orstring "D" 3 ;
test "orstring" orstring "E" 4 ; ()
;;

type var_t = [`Variant of [ `Some of string | `None | `Foo] ]

let crash (pat:var_t) =
      match pat with
      | `Variant (`Some tag) -> tag
      | `Variant (`None) -> "none"
      | _ -> "foo"

;;

test "crash" crash (`Variant `None) "none" ;
test "crash" crash (`Variant (`Some "coucou")) "coucou" ;
test "crash" crash (`Variant (`Foo)) "foo" ; ()
;;

let flatgarde c =
let x,y = c in
match x,y with
| (1,2)|(2,3) when y=2 -> 1
| (1,_)|(_,3) -> 2
| _ -> 3
;;

test "flatgarde" flatgarde (1,2) 1 ;
test "flatgarde" flatgarde (1,3) 2 ;
test "flatgarde" flatgarde (2,3) 2 ;
test "flatgarde" flatgarde (2,4) 3 ; ()
;;


(* Les bugs de jerome *)
type f =
  | ABSENT
  | FILE
  | SYMLINK
  | DIRECTORY

type r =
  | Unchanged
  | Deleted
  | Modified
  | PropsChanged
  | Created

let replicaContent2shortString rc =
    let (typ, status) = rc in
    match typ, status with
      _, Unchanged             -> "        "
    | ABSENT, Deleted         -> "deleted "
    | FILE, Created           -> "new file"
    | FILE, Modified          -> "changed "
    | FILE, PropsChanged      -> "props   "
    | SYMLINK, Created        -> "new link"
    | SYMLINK, Modified       -> "chgd lnk"
    | DIRECTORY, Created      -> "new dir "
    | DIRECTORY, Modified     -> "chgd dir"
    | DIRECTORY, PropsChanged -> "props   "
    (* Cases that can't happen... *)

    | ABSENT, (Created | Modified | PropsChanged)
    | SYMLINK, PropsChanged
    | (FILE|SYMLINK|DIRECTORY), Deleted
                                -> "assert false"
;;


test "jerome_constr"
   replicaContent2shortString (ABSENT, Unchanged) "        " ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, Deleted) "deleted " ;
test "jerome_constr"
   replicaContent2shortString (FILE, Modified) "changed " ;
test "jerome_constr"
   replicaContent2shortString (DIRECTORY, PropsChanged) "props   " ;
test "jerome_constr"
   replicaContent2shortString (FILE, Deleted) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (SYMLINK, Deleted) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (SYMLINK, PropsChanged) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (DIRECTORY, Deleted) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, Created) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, Modified) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, PropsChanged) "assert false" ;
;;


let replicaContent2shortString rc =
    let (typ, status) = rc in
    match typ, status with
      _, `Unchanged             -> "        "
    | `ABSENT, `Deleted         -> "deleted "
    | `FILE, `Created           -> "new file"
    | `FILE, `Modified          -> "changed "
    | `FILE, `PropsChanged      -> "props   "
    | `SYMLINK, `Created        -> "new link"
    | `SYMLINK, `Modified       -> "chgd lnk"
    | `DIRECTORY, `Created      -> "new dir "
    | `DIRECTORY, `Modified     -> "chgd dir"
    | `DIRECTORY, `PropsChanged -> "props   "
    (* Cases that can't happen... *)

    | `ABSENT, (`Created | `Modified | `PropsChanged)
    | `SYMLINK, `PropsChanged
    | (`FILE|`SYMLINK|`DIRECTORY), `Deleted
                                -> "assert false"
;;


test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Unchanged) "        " ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Deleted) "deleted " ;
test "jerome_variant"
   replicaContent2shortString (`FILE, `Modified) "changed " ;
test "jerome_variant"
   replicaContent2shortString (`DIRECTORY, `PropsChanged) "props   " ;
test "jerome_variant"
   replicaContent2shortString (`FILE, `Deleted) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`SYMLINK, `Deleted) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`SYMLINK, `PropsChanged) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`DIRECTORY, `Deleted) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Created) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Modified) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `PropsChanged) "assert false" ;
;;

  bug 319

type ab = A of int | B of int
type cd = C | D

let ohl = function
  | (A (p) | B (p)), C -> p
  | (A (p) | B (p)), D -> p
;;

test "ohl" ohl (A 0,C) 0 ;
test "ohl" ohl (B 0,D) 0 ; ()
;;

  bug 324
type pottier =
  | A
  | B
;;

let pottier x =
  match x with
  | (( (A, 1) | (B, 2)),A) -> false
  | _ -> true
;;

test "pottier" pottier ((B,2),A) false ;
test "pottier" pottier ((B,2),B) true ;
test "pottier" pottier ((A,2),A) true ; ()
;;

  bug 325 in bytecode compiler
let coquery q =  match q with
| y,0,([modu;defs]| [defs;modu;_]) -> y+defs-modu
| _ -> 0
;;

test "coquery" coquery (1,0,[1 ; 2 ; 3]) 0 ;
test "coquery" coquery (1,0,[1 ; 2]) 2 ; ()
;;


   Two other variable in or - pat tests 

  Two other variable in or-pat tests
*)
type vars = A of int | B of (int * int) | C
;;


let vars1 = function
  | (A x | B (_,x)) -> x
  | C -> 0
;;

test "vars1" vars1 (A 1) 1 ;
test "vars1" vars1 (B (1,2)) 2 ; ()
;;

let vars2 = function
  | ([x]|[1 ; x ]|[1 ; 2 ; x]) -> x
  | _ -> 0
;;

test"vars2" vars2 [1] 1 ;
test"vars2" vars2 [1;2] 2 ;
test"vars2" vars2 [1;2;3] 3 ;
test"vars2" vars2 [0 ; 0] 0 ; ()
;;

(* Bug 342 *)
type eber = {x:int; y: int; z:bool}

let eber = function
  | {x=a; z=true}
  | {y=a; z=false} -> a
;;

test "eber" eber {x=0 ; y=1 ; z=true} 0 ;
test "eber" eber {x=1 ; y=0 ; z=false} 0 ; ()
;;


  Enchainement des test d'intervalle

let escaped = function
  | '"' | '\\' | '\n' | '\t' -> 2
  | c -> 1
;;

test "escaped" escaped '"' 2 ;
test "escaped" escaped '\\' 2 ;
test "escaped" escaped '\n' 2 ;
test "escaped" escaped '\t' 2 ;
test "escaped" escaped '\000' 1 ;
test "escaped" escaped ' ' 1 ;
test "escaped" escaped '\000' 1 ;
test "escaped" escaped '[' 1 ;
test "escaped" escaped ']' 1 ;
test "escaped" escaped '!' 1 ;
test "escaped" escaped '#' 1 ;
()
;;

  For compilation speed ( due to   )
exception Unknown_Reply of int

type command_reply =
   RPL_TRYAGAIN
 | RPL_TRACEEND
 | RPL_TRACELOG
 | RPL_ADMINEMAIL
 | RPL_ADMINLOC2
 | RPL_ADMINLOC1
 | RPL_ADMINME
 | RPL_LUSERME
 | RPL_LUSERCHANNELS
 | RPL_LUSERUNKNOWN
 | RPL_LUSEROP
 | RPL_LUSERCLIENT
 | RPL_STATSDLINE
 | RPL_STATSDEBUG
 | RPL_STATSDEFINE
 | RPL_STATSBLINE
 | RPL_STATSPING
 | RPL_STATSSLINE
 | RPL_STATSHLINE
 | RPL_STATSOLINE
 | RPL_STATSUPTIME
 | RPL_STATSLLINE
 | RPL_STATSVLINE
 | RPL_SERVLISTEND
 | RPL_SERVLIST
 | RPL_SERVICE
 | RPL_ENDOFSERVICES
 | RPL_SERVICEINFO
 | RPL_UMODEIS
 | RPL_ENDOFSTATS
 | RPL_STATSYLINE
 | RPL_STATSQLINE
 | RPL_STATSKLINE
 | RPL_STATSILINE
 | RPL_STATSNLINE
 | RPL_STATSCLINE
 | RPL_STATSCOMMANDS
 | RPL_STATSLINKINFO
 | RPL_TRACERECONNECT
 | RPL_TRACECLASS
 | RPL_TRACENEWTYPE
 | RPL_TRACESERVICE
 | RPL_TRACESERVER
 | RPL_TRACEUSER
 | RPL_TRACEOPERATOR
 | RPL_TRACEUNKNOWN
 | RPL_TRACEHANDSHAKE
 | RPL_TRACECONNECTING
 | RPL_TRACELINK
 | RPL_NOUSERS
 | RPL_ENDOFUSERS
 | RPL_USERS
 | RPL_USERSSTART
 | RPL_TIME
 | RPL_NOTOPERANYMORE
 | RPL_MYPORTIS
 | RPL_YOURESERVICE
 | RPL_REHASHING
 | RPL_YOUREOPER
 | RPL_ENDOFMOTD
 | RPL_MOTDSTART
 | RPL_ENDOFINFO
 | RPL_INFOSTART
 | RPL_MOTD
 | RPL_INFO
 | RPL_ENDOFBANLIST
 | RPL_BANLIST
 | RPL_ENDOFLINKS
 | RPL_LINKS
 | RPL_CLOSEEND
 | RPL_CLOSING
 | RPL_KILLDONE
 | RPL_ENDOFNAMES
 | RPL_NAMREPLY
 | RPL_ENDOFWHO
 | RPL_WHOREPLY
 | RPL_VERSION
 | RPL_SUMMONING
 | RPL_INVITING
 | RPL_TOPIC
 | RPL_NOTOPIC
 | RPL_CHANNELMODEIS
 | RPL_LISTEND
 | RPL_LIST
 | RPL_LISTSTART
 | RPL_WHOISCHANNELS
 | RPL_ENDOFWHOIS
 | RPL_WHOISIDLE
 | RPL_WHOISCHANOP
 | RPL_ENDOFWHOWAS
 | RPL_WHOWASUSER
 | RPL_WHOISOPERATOR
 | RPL_WHOISSERVER
 | RPL_WHOISUSER
 | RPL_NOWAWAY
 | RPL_UNAWAY
 | RPL_TEXT
 | RPL_ISON
 | RPL_USERHOST
 | RPL_AWAY
 | RPL_NONE

let get_command_reply n =
match n with
   263    ->     RPL_TRYAGAIN
 | 319    ->     RPL_WHOISCHANNELS
 | 318    ->     RPL_ENDOFWHOIS
 | 317    ->     RPL_WHOISIDLE
 | 316    ->     RPL_WHOISCHANOP
 | 369    ->     RPL_ENDOFWHOWAS
 | 314    ->     RPL_WHOWASUSER
 | 313    ->     RPL_WHOISOPERATOR
 | 312    ->     RPL_WHOISSERVER
 | 311    ->     RPL_WHOISUSER
 | 262    ->     RPL_TRACEEND
 | 261    ->     RPL_TRACELOG
 | 259    ->     RPL_ADMINEMAIL
 | 258    ->     RPL_ADMINLOC2
 | 257    ->     RPL_ADMINLOC1
 | 256    ->     RPL_ADMINME
 | 255    ->     RPL_LUSERME
 | 254    ->     RPL_LUSERCHANNELS
 | 253    ->     RPL_LUSERUNKNOWN
 | 252    ->     RPL_LUSEROP
 | 251    ->     RPL_LUSERCLIENT
 | 250    ->     RPL_STATSDLINE
 | 249    ->     RPL_STATSDEBUG
 | 248    ->     RPL_STATSDEFINE
 | 247    ->     RPL_STATSBLINE
 | 246    ->     RPL_STATSPING
 | 245    ->     RPL_STATSSLINE
 | 244    ->     RPL_STATSHLINE
 | 243    ->     RPL_STATSOLINE
 | 242    ->     RPL_STATSUPTIME
 | 241    ->     RPL_STATSLLINE
 | 240    ->     RPL_STATSVLINE
 | 235    ->     RPL_SERVLISTEND
 | 234    ->     RPL_SERVLIST
 | 233    ->     RPL_SERVICE
 | 232    ->     RPL_ENDOFSERVICES
 | 231    ->     RPL_SERVICEINFO
 | 221    ->     RPL_UMODEIS
 | 219    ->     RPL_ENDOFSTATS
 | 218    ->     RPL_STATSYLINE
 | 217    ->     RPL_STATSQLINE
 | 216    ->     RPL_STATSKLINE
 | 215    ->     RPL_STATSILINE
 | 214    ->     RPL_STATSNLINE
 | 213    ->     RPL_STATSCLINE
 | 212    ->     RPL_STATSCOMMANDS
 | 211    ->     RPL_STATSLINKINFO
 | 210    ->     RPL_TRACERECONNECT
 | 209    ->     RPL_TRACECLASS
 | 208    ->     RPL_TRACENEWTYPE
 | 207    ->     RPL_TRACESERVICE
 | 206    ->     RPL_TRACESERVER
 | 205    ->     RPL_TRACEUSER
 | 204    ->     RPL_TRACEOPERATOR
 | 203    ->     RPL_TRACEUNKNOWN
 | 202    ->     RPL_TRACEHANDSHAKE
 | 201    ->     RPL_TRACECONNECTING
 | 200    ->     RPL_TRACELINK
 | 395    ->     RPL_NOUSERS
 | 394    ->     RPL_ENDOFUSERS
 | 393    ->     RPL_USERS
 | 392    ->     RPL_USERSSTART
 | 391    ->     RPL_TIME
 | 385    ->     RPL_NOTOPERANYMORE
 | 384    ->     RPL_MYPORTIS
 | 383    ->     RPL_YOURESERVICE
 | 382    ->     RPL_REHASHING
 | 381    ->     RPL_YOUREOPER
 | 376    ->     RPL_ENDOFMOTD
 | 375    ->     RPL_MOTDSTART
 | 374    ->     RPL_ENDOFINFO
 | 373    ->     RPL_INFOSTART
 | 372    ->     RPL_MOTD
 | 371    ->     RPL_INFO
 | 368    ->     RPL_ENDOFBANLIST
 | 367    ->     RPL_BANLIST
 | 365    ->     RPL_ENDOFLINKS
 | 364    ->     RPL_LINKS
 | 363    ->     RPL_CLOSEEND
 | 362    ->     RPL_CLOSING
 | 361    ->     RPL_KILLDONE
 | 366    ->     RPL_ENDOFNAMES
 | 353    ->     RPL_NAMREPLY
 | 315    ->     RPL_ENDOFWHO
 | 352    ->     RPL_WHOREPLY
 | 351    ->     RPL_VERSION
 | 342    ->     RPL_SUMMONING
 | 341    ->     RPL_INVITING
 | 332    ->     RPL_TOPIC
 | 331    ->     RPL_NOTOPIC
 | 324    ->     RPL_CHANNELMODEIS
 | 323    ->     RPL_LISTEND
 | 322    ->     RPL_LIST
 | 321    ->     RPL_LISTSTART
 | 306    ->     RPL_NOWAWAY
 | 305    ->     RPL_UNAWAY
 | 304    ->     RPL_TEXT
 | 303    ->     RPL_ISON
 | 302    ->     RPL_USERHOST
 | 301    ->     RPL_AWAY
 | 300    ->     RPL_NONE
 | _ -> raise (Unknown_Reply n)

(* Bug 454 *)
type  habert_a=
  | A of habert_c
  | B of habert_c

and habert_c= {lvar:int; lassoc: habert_c;lnb:int}


let habert=function
  | (A {lnb=i}|B {lnb=i}) when i=0 -> 1
  | A {lassoc=({lnb=j});lnb=i} -> 2
  | _ -> 3
;;

let rec ex0 = {lvar=0 ; lnb=0 ; lassoc=ex1}
and ex1 = {lvar=1 ; lnb=1 ; lassoc=ex0} in

test "habert" habert (A ex0) 1 ;
test "habert" habert (B ex0) 1 ;
test "habert" habert (A ex1) 2 ;
test "habert" habert (B ex1) 3 ;

  Problems with interval test in arithmetic mod 2 ^ 31 , bug # 359
  From  

type type_expr = [
  | `TTuple of type_expr list
  | `TConstr of type_expr list
  | `TVar of string
  | `TVariant of string list
  | `TBlock of int
  | `TCopy of type_expr
  ]

and recurs_type_expr = [
  | `TTuple of type_expr list
  | `TConstr of type_expr list
  | `TVariant of string list
  ]


let rec maf te =
    match te with
    | `TCopy te -> 1
    | `TVar _ -> 2
    | `TBlock _ -> 2
    | #recurs_type_expr as desc ->

        let te =
          (match desc with
            `TTuple tl ->
              4
          | `TConstr tl ->
              5
          | `TVariant (row) ->
              6
                )
        in

        te
;;

let base = `TBlock 0
;;

test "maf" maf (`TCopy base) 1 ;
test "maf" maf (`TVar "test") 2 ;
test "maf" maf (`TBlock 0) 2 ;
test "maf" maf (`TTuple []) 4 ;
test "maf" maf (`TConstr []) 5 ;
test "maf" maf (`TVariant []) 6
;;

  PR#1310 
   Using ` ` get_args '' in place or an ad - hoc ` ` matcher '' function for tuples . 
   Has made the compiler [ 3.05 ] to fail . 

  Using ``get_args'' in place or an ad-hoc ``matcher'' function for tuples.
  Has made the compiler [3.05] to fail.
*)
type t_seb = Uin | Uout
;;

let rec seb = function
  | ((i, Uin) | (i, Uout)), Uout -> 1
  | ((j, Uin) | (j, Uout)), Uin ->  2
;;

test "seb" seb ((0,Uin),Uout) 1 ;
test "seb" seb ((0,Uout),Uin) 2 ;
()
;;

  Talk with  
      - type ' b is still open ? ? 
      - better case generation , accept intervals of size 1 when ok_inter is 
        false ( in Switch ) 

     - type 'b is still open ??
     - better case generation, accept intervals of size 1 when ok_inter is
       false (in Switch)
*)


 File " morematch.ml " , line 1060 , characters 8 - 65 : 
 Warning : this pattern - matching is not exhaustive . 
 Here is an example of a value that is not matched : 
 A ` D 

File "morematch.ml", line 1060, characters 8-65:
Warning: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
A `D
*)
type ('a, 'b) t_j = A of 'a | B of 'b * 'a | C

let f = function
  | A (`A|`C) -> 0
  | B (`B,`D) -> 1
  | C -> 2

let g x = try f x with Match_failure _ -> 3

let _ =
  test "jacques" g (A `A) 0 ;
  test "jacques" g (A `C) 0 ;
  test "jacques" g (B (`B,`D)) 1 ;
  test "jacaues" g C 2 ;
   test " jacques " g ( B ( ` A,`D ) ) 3 ; ( * type incorrect expected behavior ?
  ()


   Compilation bug , segfault , because of incorrect compilation 
   of unused match case .. - > " 11 " 

  Compilation bug, segfault, because of incorrect compilation
  of unused match case .. -> "11"
*)

type t_l = A | B

let f = function
  |  _, _, _, _, _, _, _, _, _, _, _, _, _, B, _, _ -> "0"
  |  _, _, _, B, A, _, _, _, _, _, _, _, _, _, _, _ -> "1"
  |  _, _, _, B, _, A, _, _, A, _, _, _, _, _, _, _ -> "2"
  |  _, _, _, _, _, _, _, _, _, _, B, A, _, A, _, _ -> "3"
  |  _, _, _, _, _, _, _, B, _, _, _, _, B, _, A, A -> "4"
  |  A, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "5"
  |  _, _, _, _, _, _, _, B, _, B, _, _, _, _, _, _ -> "6"
  |  _, B, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "7"
  |  _, A, A, _, A, _, B, _, _, _, _, _, _, _, _, B -> "8"
  |  _, _, _, _, B, _, _, _, _, _, _, _, _, _, B, _ -> "9"
  |  _, _, _, _, _, _, _, _, _, _, _, B, _, _, _, _ -> "10"
  |  _, _, _, _, _, A, _, _, _, _, B, _, _, _, _, _ -> "11"
  |  B, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "12"
  |  _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "13"


 File " morematch.ml " , line 1094 , characters 5 - 51 : 
 Warning : this match case is unused . 
 File " morematch.ml " , line 1096 , characters 5 - 51 : 
 Warning : this match case is unused . 

File "morematch.ml", line 1094, characters 5-51:
Warning: this match case is unused.
File "morematch.ml", line 1096, characters 5-51:
Warning: this match case is unused.
*)
let _  =
  test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, B, A, A, A, A) "10" ;
  test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, A, A, A, A, A) "12" ;
 ()


   By   , compilation raised some assert false i make_failactionneg 

  By Gilles Peskine, compilation raised some assert false i make_failactionneg
*)

type bg = [
  | `False
  | `True
  ]

type vg = [
  | `A
  | `B
  | `U of int
  | `V of int
  ]

type tg = {
    v : vg;
    x : bg;
  }

let predg x = true

let rec gilles o = match o with
  | {v = (`U data | `V data); x = `False} when predg o -> 1
  | {v = (`A|`B) ; x = `False}
  | {v = (`U _ | `V _); x = `False}
  | {v = _ ; x = `True}
    -> 2

(*
  Match in trywith should always have a default case
*)

exception Found of string * int
exception Error of string


let lucexn  e =
  try
    try  raise e  with Error msg -> msg
  with Found (s,r) -> s^string_of_int r

let () =
  test "lucexn1" lucexn  (Error "coucou") "coucou" ;
  test "lucexn2" lucexn (Found ("int: ",0)) "int: 0" ;
  ()

(*
  PR#5758: different representations of floats
*)

let pr5758 x str =
  match (x, str) with
  | (1. , "A") -> "Matched A"
  | (1.0, "B") -> "Matched B"
  | (1. , "C") -> "Matched C"
  | result ->
    match result with
    | (1., "A") -> "Failed match A then later matched"
    | _ -> "Failed twice"
;;

let () =
  test "pr5758" (pr5758 1.) "A" "Matched A"
;;

*********************************************************************
                                                                     
                                OCaml                                
                                                                     
                                                                     
                                                                     
*********************************************************************
************************************************************
  This suite tests the pattern-matching compiler            
  it should just compile and run.                           
  While compiling the following messages are normal:        
************************************************************
 Number of integer cases 
 Number of tag block cases 
 Tag block cases 
 True if bound checks needed 
 True if should not fail 
 Test des gardes, non trivial 
 Les bugs de jerome 
 Cases that can't happen... 
 Cases that can't happen... 
 Bug 342 
 Bug 454 

  Match in trywith should always have a default case


  PR#5758: different representations of floats

               , projet  , INRIA Rocquencourt         
   Copyright 2001 Institut National de Recherche en Informatique et   
   en Automatique .   All rights reserved .   This file is distributed    
   under the terms of the Q Public License version 1.0 .               



 File " morematch.ml " , line 38 , characters 10 - 93 : 
 Warning : this pattern - matching is not exhaustive . 
 Here is an example of a value that is not matched : 
 0 
 File " morematch.ml " , line 376 , characters 2 - 15 : 
 Warning : this match case is unused . 
 File " morematch.ml " , line 443 , characters 2 - 7 : 
 Warning : this match case is unused . 

File "morematch.ml", line 38, characters 10-93:
Warning: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
0
File "morematch.ml", line 376, characters 2-15:
Warning: this match case is unused.
File "morematch.ml", line 443, characters 2-7:
Warning: this match case is unused.
*)

let test msg f arg r =
  if f arg <> r then begin
    prerr_endline msg ;
    failwith "Malaise"
  end
;;

type t = A | B | C | D | E | F
  ;;

let f x = match x with
| A | B | C -> 1
| D | E -> 2
| F -> 3;;

test "un" f C 1 ;
test "un" f D 2 ;
test "un" f F 3 ; ()
;;

let g x = match x with
  1 -> 1
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
| 6 -> 5
| 7 | 8 -> 6
| 9 -> 7
| _ -> assert false
;;

test "deux" g 5 4 ;
test "deux" g 6 5 ;
test "deux" g 9 7 ; ()
;;


let g x = match x with
  1 -> 1
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
| 6 -> 5
| 7 | 8 -> 6
| 9 -> 7
| _ -> 8;;

test "trois" g 10 8
;;

let g x= match  x with
  1 -> 1
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
| 6 -> 5
| 4|5|7 -> 100
| 7 | 8 -> 6
| 9 -> 7
| _ -> 8;;
test "quatre" g 4 4 ;
test "quatre" g 7 100 ; ()
;;


 File " morematch.ml " , line 73 , characters 2 - 5 : 
 Warning U : this sub - pattern is unused . 
 File " morematch.ml " , line 74 , characters 2 - 3 : 
 Warning U : this sub - pattern is unused . 

File "morematch.ml", line 73, characters 2-5:
Warning U: this sub-pattern is unused.
File "morematch.ml", line 74, characters 2-3:
Warning U: this sub-pattern is unused.
*)

let h x =
 match x with
   (1,1) -> 1
| (2|3), 1 -> 2
| 2,(2|3) -> 3
| (4,4) -> 5
| _ -> 100
;;

test "cinq" h (2,2) 3 ;
test "cinq" h (2,1) 2 ;
test "cinq" h (2,4) 100 ; ()
;;

  idem hh ( 2,5 )

let hh x = match x with
| 1,1 -> 1
| 2,1 -> 2
| (2|3),(1|2|3|4) -> 3
| 2,5 -> 4
| (4,4) -> 5
| _ -> 100
;;

let hhh x = match x with
| 1,1 -> 1
| (2|3),1 -> 2
| 2,2 -> 3
| _ -> 100
;;

let h x =
 match x with
   (1,1) -> 1
| 3,1 -> 2
| 2,(2|3) -> 3
| (4,4) -> 5
| _ -> 100
;;

let h x = match x with
  1 -> 1
| 2|3 -> 2
| 4 -> 4
| 5 -> 5
| 6|7 -> 6
| 8 -> 8
| _ -> 100
;;
let f x = match x with
| ((1|2),(3|4))|((3|4),(1|2)) -> 1
| (3,(5|6)) -> 2
| _ -> 3
;;

test "six" f (1,3) 1 ;
test "six" f (3,2) 1 ;
test "six" f (3,5) 2 ;
test "six" f (3,7) 3 ; ()
;;

type tt = {a : bool list ; b : bool}

let f = function
  | {a=([]|[true])} -> 1
  | {a=false::_}|{b=(true|false)}    -> 2
;;

test "sept" f {a=[] ; b = true} 1 ;
test "sept" f {a=[true] ; b = false} 1 ;
test "sept" f {a=[false ; true] ; b = true} 2 ;
test "sept" f {a=[false] ; b = false} 2 ; ()
;;

let f = function
  | (([]|[true]),_) -> 1
  | (false::_,_)|(_,(true|false)) -> 2
;;

test "huit" f ([],true) 1 ;
test "huit" f ([true],false) 1 ;
test "huit" f ([false ; true], true) 2 ;
test "huit" f ([false], false) 2 ; ()
;;


let split_cases = function
   | `Nil | `Cons _ as x -> `A x
   | `Snoc _ as x -> `B x
;;

test "oubli" split_cases `Nil (`A `Nil);
test "oubli" split_cases (`Cons 1) (`A (`Cons 1));
test "oubli" split_cases (`Snoc 1) (`B (`Snoc 1)) ; ()
;;

type t1 = A of int | B of int
let f1 = function
  | (A x | B x) -> x
;;

test "neuf" f1 (A 1) 1 ;
test "neuf" f1 (B 1) 1 ;
;;

type coucou = A of int | B of int * int | C
;;


let g = function
  | (A x | B (_,x)) -> x
  | C -> 0
;;


test "dix" g (A 1) 1 ;
test "dix" g (B (1,2)) 2 ;
;;



let h = function
  | ([x]|[1 ; x ]|[1 ; 2 ; x]) -> x
  | _ -> 0
;;

test "encore" h [1] 1 ;
test "encore" h [1;2] 2 ;
test "encore" h [1;2;3] 3 ;
test "encore" h [0 ; 0] 0 ; ()
;;

let f = function
| (x,(0 as y)) | (y,x) -> y-x
;;

test "foo1" f (1,0) (-1);
test "foo1" f (1,2) (-1)
;;


let f = function (([]|[_]) as x)|(_::([] as x))|(_::_::x)  -> x
;;

test "zob" f [] [] ;
test "zob" f [1] [1] ;
test "zob" f [1;2;3] [3]
;;


type zob = A | B | C | D of zob * int | E of zob * zob

let rec f = function
  | (A | B | C) -> A
  | D (x,i) -> D (f x,i)
  | E (x,_) -> D (f x,0)
;;


test "fin" f B A ;
test "fin" f (D (C,1)) (D (A,1)) ;
test "fin" f (E (C,A)) (D (A,0)) ; ()
;;

type length =
    Char of int | Pixel of int | Percent of int | No of string | Default

let length = function
  | Char n -> n | Pixel n -> n
  | _       -> 0
;;

test "length" length (Char 10) 10 ;
test "length" length (Pixel 20) 20 ;
test "length" length Default 0 ;
test "length" length (Percent 100) 0 ; ()
;;

let length2 = function
  | Char n -> n | Percent n -> n
  | _       -> 0
;;

test "length2" length2 (Char 10) 10 ;
test "length2" length2 (Pixel 20) 0 ;
test "length2" length2 Default 0 ;
test "length2" length2(Percent 100) 100 ; ()
;;

let length3 = function
  | Char _ | No _ -> true
  | _ -> false
;;

test "length3" length3 (Char 10) true ;
test "length3" length3 (No "") true ;
test "length3" length3 (Pixel 20) false ;
test "length3" length3 Default false ;
test "length3" length3(Percent 100) false ; ()
;;

type hevea = A | B | C

let h x = match x with
| A -> 1
| B|C -> 2
;;

test "hevea" h A 1 ;
test "hevea" h B 2 ;
test "hevea" h B 2 ; ()
;;
type lambda =
    Lvar of int
  | Lconst of int
  | Lapply of lambda * lambda list
  | Lfunction of bool  * int list * lambda
  | Llet of  bool * int * lambda * lambda
  | Lletrec of (int * lambda) list * lambda
  | Lprim of string * lambda list
  | Lswitch of lambda * lambda_switch
  | Lstaticfail
  | Lcatch of lambda * lambda
  | Lstaticraise of int * lambda list
  | Lstaticcatch of lambda * (int * int list) * lambda
  | Ltrywith of lambda * int * lambda
  | Lifthenelse of lambda * lambda * lambda
  | Lsequence of lambda * lambda
  | Lwhile of lambda * lambda
  | Lfor of int * lambda * lambda * bool * lambda
  | Lassign of int * lambda
  | Lsend of lambda * lambda * lambda list
  | Levent of lambda * lambda_event
  | Lifused of int * lambda
and lambda_switch =
  Integer cases
and lambda_event =
  { lev_loc: int;
    lev_kind: bool ;
    lev_repr: int ref option;
    lev_env: int list }

let rec approx_present v l = true

let rec lower_bind v arg lam = match lam with
| Lifthenelse (cond, ifso, ifnot) -> 1
| Lswitch (ls,({sw_consts=[i,act] ; sw_blocks = []} as _sw))
    when not (approx_present v ls) -> 2
| Lswitch (ls,({sw_consts=[] ; sw_blocks = [i,act]} as _sw))
    when not (approx_present v ls) -> 3
| Llet (true , vv, lv, l) -> 4
| _ -> 5
;;

test "lower_bind" (lower_bind 0 0) (Llet (true,0, Lvar 1, Lvar 2)) 4 ;
test "lower_bind" (lower_bind 0 0) (Lvar 0) 5 ;
test "lower_bind" (lower_bind 0 0) (Lifthenelse (Lvar 0, Lvar 1, Lvar 2)) 1
;;


type field_kind =
    Fvar of field_kind option ref
  | Fpresent
  | Fabsent

let unify_kind (k1, k2) =  match k1, k2 with
    (Fvar r, (Fvar _ | Fpresent))             -> 1
  | (Fpresent, Fvar r)                        -> 2
  | (Fpresent, Fpresent)                      -> 3
  | _                                         -> 4


let r = ref (Some Fpresent)
;;

test "unify"  unify_kind (Fvar r, Fpresent) 1 ;
test "unify"  unify_kind (Fvar r, Fvar r) 1 ;
test "unify"  unify_kind (Fvar r, Fabsent) 4 ;
test "unify"  unify_kind (Fpresent, Fvar r) 2 ;
test "unify"  unify_kind (Fpresent, Fpresent) 3 ;
test "unify"  unify_kind (Fabsent, Fpresent) 4 ; ()
;;


type youyou = A | B | C | D of youyou

let foo (k1, k2) = match k1,k2 with
| D _, (A|D _) -> 1
| (A|B),D _ -> 2
| C,_       -> 3
| _, (A|B|C) -> 4
;;

test "foo2" foo (D A,A) 1 ;
test "foo2" foo (D A,B) 4 ;
test "foo2" foo (A,A) 4 ; ()
;;

type yaya = A | B
;;

let yaya = function
| A,_,_ -> 1
| _,A,_ -> 2
| B,B,_ -> 3
| A,_,(100|103) -> 5
;;

test "yaya" yaya (A,A,0) 1 ;
test "yaya" yaya (B,A,0) 2 ;
test "yaya" yaya (B,B,100) 3 ; ()
;;


 let      | [ ] , _ , _ - > 1 
 | _ , [ ] , _ - > 2 
 | _ : : _ , _ : : _ , _ - > 3 
 | [ ] , _ , ( 100|103|104 ) - > 5 
 | [ ] , _ , ( 100|103 ) - > 6 
 | [ ] , _ , ( 1000|1001|1002|20000 ) - > 7 
 ; ; 

 test " yoyo " yoyo ( [ ] , [ ] , 0 ) 1 ; 
 test " yoyo " yoyo ( [ 1],[],0 ) 2 ; 
 test " yoyo " yoyo ( [ 1],[1],100 ) 3 ; ( ) 
 ; ; 

 let youyou = function 
   | ( 100|103|104 ) - > 1 
   | ( 100|103|101 ) - > 2 
   | ( 1000|1001|1002|20000 ) - > 3 
   | _ - > -1 
 ; ; 

 test " youyou " youyou 100 1 ; 
 test " youyou " youyou 101 2 ; 
 test " youyou " youyou 1000 3 
 ; ; 

let yoyo =  function
| [],_,_ -> 1
| _,[],_ -> 2
| _::_,_::_,_ -> 3
| [],_,(100|103|104) -> 5
| [],_,(100|103) -> 6
| [],_,(1000|1001|1002|20000) -> 7
;;

test "yoyo" yoyo ([],[],0) 1 ;
test "yoyo" yoyo ([1],[],0) 2 ;
test "yoyo" yoyo ([1],[1],100) 3 ; ()
;;

let youyou = function
  | (100|103|104) -> 1
  | (100|103|101) -> 2
  | (1000|1001|1002|20000) -> 3
  | _ -> -1
;;

test "youyou" youyou 100 1 ;
test "youyou" youyou 101 2 ;
test "youyou" youyou 1000 3
;;
*)
type autre =
  |  C | D | E of autre | F of autre * autre | H of autre | I | J | K of string

let rec autre = function
| C,_,_ -> 1
| _,C,_ -> 2
| D,D,_ -> 3
| (D|F (_,_)|H _|K _),_,_ -> 4
| (_, (D|I|E _|F (_, _)|H _|K _), _) -> 8
| (J,J,((C|D) as x |E x|F (_,x))) | (J,_,((C|J) as x)) -> autre (x,x,x)
| (J, J, (I|H _|K _)) -> 9
| I,_,_ -> 6
| E _,_,_ -> 7
;;

 File " morematch.ml " , line 437 , characters 43 - 44 : 
 Warning U : this sub - pattern is unused . 

File "morematch.ml", line 437, characters 43-44:
Warning U: this sub-pattern is unused.
*)
test "autre" autre (J,J,F (D,D)) 3 ;
test "autre" autre (J,J,D) 3 ;
test "autre" autre (J,J,I) 9 ;
test "autre" autre (H I,I,I) 4 ;
test "autre" autre (J,J,H I) 9 ; ()
;;


type youpi = YA | YB | YC
and hola = X | Y | Z | T of hola | U of hola | V of hola

let xyz = function
| YA,_,_ -> 1
| _,YA,_ -> 2
| YB,YB,_ -> 3
| ((YB|YC), (YB|YC), (X|Y|Z|V _|T _)) -> 6
| _,_,(X|U _) -> 8
| _,_,Y -> 5
;;

 File " morematch.ml " , line 459 , characters 7 - 8 : 
 Warning U : this sub - pattern is unused . 
 File " morematch.ml " , line 460 , characters 2 - 7 : 
 Warning U : this match case is unused . 

File "morematch.ml", line 459, characters 7-8:
Warning U: this sub-pattern is unused.
File "morematch.ml", line 460, characters 2-7:
Warning U: this match case is unused.
*)
test "xyz" xyz (YC,YC,X) 6 ;
test "xyz" xyz (YC,YB,U X) 8 ;
test "xyz" xyz (YB,YC,X) 6 ; ()
;;


  Ce test est pour     
let eq (x,y) = x=y
;;

test "eq" eq ("coucou", "coucou") true ; ()
;;


let is_none = function
  | None -> true
  | _ -> false

let garde x = match x with
| (Some _, _) when is_none (snd x) -> 1
| (Some (pc, _), Some pc') when pc = pc' -> 2
| _ -> 3
;;

test "garde" garde (Some (1,1),None) 1 ;
test "garde" garde (Some (1,1),Some 1) 2 ;
test "garde" garde (Some (2,1),Some 1) 3 ; ()
;;

let orstring = function
  | ("A"|"B"|"C") -> 2
  | "D" -> 3
  | _ -> 4
;;

test "orstring" orstring "A" 2 ;
test "orstring" orstring "B" 2 ;
test "orstring" orstring "C" 2 ;
test "orstring" orstring "D" 3 ;
test "orstring" orstring "E" 4 ; ()
;;

type var_t = [`Variant of [ `Some of string | `None | `Foo] ]

let crash (pat:var_t) =
      match pat with
      | `Variant (`Some tag) -> tag
      | `Variant (`None) -> "none"
      | _ -> "foo"

;;

test "crash" crash (`Variant `None) "none" ;
test "crash" crash (`Variant (`Some "coucou")) "coucou" ;
test "crash" crash (`Variant (`Foo)) "foo" ; ()
;;

let flatgarde c =
let x,y = c in
match x,y with
| (1,2)|(2,3) when y=2 -> 1
| (1,_)|(_,3) -> 2
| _ -> 3
;;

test "flatgarde" flatgarde (1,2) 1 ;
test "flatgarde" flatgarde (1,3) 2 ;
test "flatgarde" flatgarde (2,3) 2 ;
test "flatgarde" flatgarde (2,4) 3 ; ()
;;


type f =
  | ABSENT
  | FILE
  | SYMLINK
  | DIRECTORY

type r =
  | Unchanged
  | Deleted
  | Modified
  | PropsChanged
  | Created

let replicaContent2shortString rc =
    let (typ, status) = rc in
    match typ, status with
      _, Unchanged             -> "        "
    | ABSENT, Deleted         -> "deleted "
    | FILE, Created           -> "new file"
    | FILE, Modified          -> "changed "
    | FILE, PropsChanged      -> "props   "
    | SYMLINK, Created        -> "new link"
    | SYMLINK, Modified       -> "chgd lnk"
    | DIRECTORY, Created      -> "new dir "
    | DIRECTORY, Modified     -> "chgd dir"
    | DIRECTORY, PropsChanged -> "props   "

    | ABSENT, (Created | Modified | PropsChanged)
    | SYMLINK, PropsChanged
    | (FILE|SYMLINK|DIRECTORY), Deleted
                                -> "assert false"
;;


test "jerome_constr"
   replicaContent2shortString (ABSENT, Unchanged) "        " ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, Deleted) "deleted " ;
test "jerome_constr"
   replicaContent2shortString (FILE, Modified) "changed " ;
test "jerome_constr"
   replicaContent2shortString (DIRECTORY, PropsChanged) "props   " ;
test "jerome_constr"
   replicaContent2shortString (FILE, Deleted) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (SYMLINK, Deleted) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (SYMLINK, PropsChanged) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (DIRECTORY, Deleted) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, Created) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, Modified) "assert false" ;
test "jerome_constr"
   replicaContent2shortString (ABSENT, PropsChanged) "assert false" ;
;;


let replicaContent2shortString rc =
    let (typ, status) = rc in
    match typ, status with
      _, `Unchanged             -> "        "
    | `ABSENT, `Deleted         -> "deleted "
    | `FILE, `Created           -> "new file"
    | `FILE, `Modified          -> "changed "
    | `FILE, `PropsChanged      -> "props   "
    | `SYMLINK, `Created        -> "new link"
    | `SYMLINK, `Modified       -> "chgd lnk"
    | `DIRECTORY, `Created      -> "new dir "
    | `DIRECTORY, `Modified     -> "chgd dir"
    | `DIRECTORY, `PropsChanged -> "props   "

    | `ABSENT, (`Created | `Modified | `PropsChanged)
    | `SYMLINK, `PropsChanged
    | (`FILE|`SYMLINK|`DIRECTORY), `Deleted
                                -> "assert false"
;;


test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Unchanged) "        " ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Deleted) "deleted " ;
test "jerome_variant"
   replicaContent2shortString (`FILE, `Modified) "changed " ;
test "jerome_variant"
   replicaContent2shortString (`DIRECTORY, `PropsChanged) "props   " ;
test "jerome_variant"
   replicaContent2shortString (`FILE, `Deleted) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`SYMLINK, `Deleted) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`SYMLINK, `PropsChanged) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`DIRECTORY, `Deleted) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Created) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `Modified) "assert false" ;
test "jerome_variant"
   replicaContent2shortString (`ABSENT, `PropsChanged) "assert false" ;
;;

  bug 319

type ab = A of int | B of int
type cd = C | D

let ohl = function
  | (A (p) | B (p)), C -> p
  | (A (p) | B (p)), D -> p
;;

test "ohl" ohl (A 0,C) 0 ;
test "ohl" ohl (B 0,D) 0 ; ()
;;

  bug 324
type pottier =
  | A
  | B
;;

let pottier x =
  match x with
  | (( (A, 1) | (B, 2)),A) -> false
  | _ -> true
;;

test "pottier" pottier ((B,2),A) false ;
test "pottier" pottier ((B,2),B) true ;
test "pottier" pottier ((A,2),A) true ; ()
;;

  bug 325 in bytecode compiler
let coquery q =  match q with
| y,0,([modu;defs]| [defs;modu;_]) -> y+defs-modu
| _ -> 0
;;

test "coquery" coquery (1,0,[1 ; 2 ; 3]) 0 ;
test "coquery" coquery (1,0,[1 ; 2]) 2 ; ()
;;


   Two other variable in or - pat tests 

  Two other variable in or-pat tests
*)
type vars = A of int | B of (int * int) | C
;;


let vars1 = function
  | (A x | B (_,x)) -> x
  | C -> 0
;;

test "vars1" vars1 (A 1) 1 ;
test "vars1" vars1 (B (1,2)) 2 ; ()
;;

let vars2 = function
  | ([x]|[1 ; x ]|[1 ; 2 ; x]) -> x
  | _ -> 0
;;

test"vars2" vars2 [1] 1 ;
test"vars2" vars2 [1;2] 2 ;
test"vars2" vars2 [1;2;3] 3 ;
test"vars2" vars2 [0 ; 0] 0 ; ()
;;

type eber = {x:int; y: int; z:bool}

let eber = function
  | {x=a; z=true}
  | {y=a; z=false} -> a
;;

test "eber" eber {x=0 ; y=1 ; z=true} 0 ;
test "eber" eber {x=1 ; y=0 ; z=false} 0 ; ()
;;


  Enchainement des test d'intervalle

let escaped = function
  | '"' | '\\' | '\n' | '\t' -> 2
  | c -> 1
;;

test "escaped" escaped '"' 2 ;
test "escaped" escaped '\\' 2 ;
test "escaped" escaped '\n' 2 ;
test "escaped" escaped '\t' 2 ;
test "escaped" escaped '\000' 1 ;
test "escaped" escaped ' ' 1 ;
test "escaped" escaped '\000' 1 ;
test "escaped" escaped '[' 1 ;
test "escaped" escaped ']' 1 ;
test "escaped" escaped '!' 1 ;
test "escaped" escaped '#' 1 ;
()
;;

  For compilation speed ( due to   )
exception Unknown_Reply of int

type command_reply =
   RPL_TRYAGAIN
 | RPL_TRACEEND
 | RPL_TRACELOG
 | RPL_ADMINEMAIL
 | RPL_ADMINLOC2
 | RPL_ADMINLOC1
 | RPL_ADMINME
 | RPL_LUSERME
 | RPL_LUSERCHANNELS
 | RPL_LUSERUNKNOWN
 | RPL_LUSEROP
 | RPL_LUSERCLIENT
 | RPL_STATSDLINE
 | RPL_STATSDEBUG
 | RPL_STATSDEFINE
 | RPL_STATSBLINE
 | RPL_STATSPING
 | RPL_STATSSLINE
 | RPL_STATSHLINE
 | RPL_STATSOLINE
 | RPL_STATSUPTIME
 | RPL_STATSLLINE
 | RPL_STATSVLINE
 | RPL_SERVLISTEND
 | RPL_SERVLIST
 | RPL_SERVICE
 | RPL_ENDOFSERVICES
 | RPL_SERVICEINFO
 | RPL_UMODEIS
 | RPL_ENDOFSTATS
 | RPL_STATSYLINE
 | RPL_STATSQLINE
 | RPL_STATSKLINE
 | RPL_STATSILINE
 | RPL_STATSNLINE
 | RPL_STATSCLINE
 | RPL_STATSCOMMANDS
 | RPL_STATSLINKINFO
 | RPL_TRACERECONNECT
 | RPL_TRACECLASS
 | RPL_TRACENEWTYPE
 | RPL_TRACESERVICE
 | RPL_TRACESERVER
 | RPL_TRACEUSER
 | RPL_TRACEOPERATOR
 | RPL_TRACEUNKNOWN
 | RPL_TRACEHANDSHAKE
 | RPL_TRACECONNECTING
 | RPL_TRACELINK
 | RPL_NOUSERS
 | RPL_ENDOFUSERS
 | RPL_USERS
 | RPL_USERSSTART
 | RPL_TIME
 | RPL_NOTOPERANYMORE
 | RPL_MYPORTIS
 | RPL_YOURESERVICE
 | RPL_REHASHING
 | RPL_YOUREOPER
 | RPL_ENDOFMOTD
 | RPL_MOTDSTART
 | RPL_ENDOFINFO
 | RPL_INFOSTART
 | RPL_MOTD
 | RPL_INFO
 | RPL_ENDOFBANLIST
 | RPL_BANLIST
 | RPL_ENDOFLINKS
 | RPL_LINKS
 | RPL_CLOSEEND
 | RPL_CLOSING
 | RPL_KILLDONE
 | RPL_ENDOFNAMES
 | RPL_NAMREPLY
 | RPL_ENDOFWHO
 | RPL_WHOREPLY
 | RPL_VERSION
 | RPL_SUMMONING
 | RPL_INVITING
 | RPL_TOPIC
 | RPL_NOTOPIC
 | RPL_CHANNELMODEIS
 | RPL_LISTEND
 | RPL_LIST
 | RPL_LISTSTART
 | RPL_WHOISCHANNELS
 | RPL_ENDOFWHOIS
 | RPL_WHOISIDLE
 | RPL_WHOISCHANOP
 | RPL_ENDOFWHOWAS
 | RPL_WHOWASUSER
 | RPL_WHOISOPERATOR
 | RPL_WHOISSERVER
 | RPL_WHOISUSER
 | RPL_NOWAWAY
 | RPL_UNAWAY
 | RPL_TEXT
 | RPL_ISON
 | RPL_USERHOST
 | RPL_AWAY
 | RPL_NONE

let get_command_reply n =
match n with
   263    ->     RPL_TRYAGAIN
 | 319    ->     RPL_WHOISCHANNELS
 | 318    ->     RPL_ENDOFWHOIS
 | 317    ->     RPL_WHOISIDLE
 | 316    ->     RPL_WHOISCHANOP
 | 369    ->     RPL_ENDOFWHOWAS
 | 314    ->     RPL_WHOWASUSER
 | 313    ->     RPL_WHOISOPERATOR
 | 312    ->     RPL_WHOISSERVER
 | 311    ->     RPL_WHOISUSER
 | 262    ->     RPL_TRACEEND
 | 261    ->     RPL_TRACELOG
 | 259    ->     RPL_ADMINEMAIL
 | 258    ->     RPL_ADMINLOC2
 | 257    ->     RPL_ADMINLOC1
 | 256    ->     RPL_ADMINME
 | 255    ->     RPL_LUSERME
 | 254    ->     RPL_LUSERCHANNELS
 | 253    ->     RPL_LUSERUNKNOWN
 | 252    ->     RPL_LUSEROP
 | 251    ->     RPL_LUSERCLIENT
 | 250    ->     RPL_STATSDLINE
 | 249    ->     RPL_STATSDEBUG
 | 248    ->     RPL_STATSDEFINE
 | 247    ->     RPL_STATSBLINE
 | 246    ->     RPL_STATSPING
 | 245    ->     RPL_STATSSLINE
 | 244    ->     RPL_STATSHLINE
 | 243    ->     RPL_STATSOLINE
 | 242    ->     RPL_STATSUPTIME
 | 241    ->     RPL_STATSLLINE
 | 240    ->     RPL_STATSVLINE
 | 235    ->     RPL_SERVLISTEND
 | 234    ->     RPL_SERVLIST
 | 233    ->     RPL_SERVICE
 | 232    ->     RPL_ENDOFSERVICES
 | 231    ->     RPL_SERVICEINFO
 | 221    ->     RPL_UMODEIS
 | 219    ->     RPL_ENDOFSTATS
 | 218    ->     RPL_STATSYLINE
 | 217    ->     RPL_STATSQLINE
 | 216    ->     RPL_STATSKLINE
 | 215    ->     RPL_STATSILINE
 | 214    ->     RPL_STATSNLINE
 | 213    ->     RPL_STATSCLINE
 | 212    ->     RPL_STATSCOMMANDS
 | 211    ->     RPL_STATSLINKINFO
 | 210    ->     RPL_TRACERECONNECT
 | 209    ->     RPL_TRACECLASS
 | 208    ->     RPL_TRACENEWTYPE
 | 207    ->     RPL_TRACESERVICE
 | 206    ->     RPL_TRACESERVER
 | 205    ->     RPL_TRACEUSER
 | 204    ->     RPL_TRACEOPERATOR
 | 203    ->     RPL_TRACEUNKNOWN
 | 202    ->     RPL_TRACEHANDSHAKE
 | 201    ->     RPL_TRACECONNECTING
 | 200    ->     RPL_TRACELINK
 | 395    ->     RPL_NOUSERS
 | 394    ->     RPL_ENDOFUSERS
 | 393    ->     RPL_USERS
 | 392    ->     RPL_USERSSTART
 | 391    ->     RPL_TIME
 | 385    ->     RPL_NOTOPERANYMORE
 | 384    ->     RPL_MYPORTIS
 | 383    ->     RPL_YOURESERVICE
 | 382    ->     RPL_REHASHING
 | 381    ->     RPL_YOUREOPER
 | 376    ->     RPL_ENDOFMOTD
 | 375    ->     RPL_MOTDSTART
 | 374    ->     RPL_ENDOFINFO
 | 373    ->     RPL_INFOSTART
 | 372    ->     RPL_MOTD
 | 371    ->     RPL_INFO
 | 368    ->     RPL_ENDOFBANLIST
 | 367    ->     RPL_BANLIST
 | 365    ->     RPL_ENDOFLINKS
 | 364    ->     RPL_LINKS
 | 363    ->     RPL_CLOSEEND
 | 362    ->     RPL_CLOSING
 | 361    ->     RPL_KILLDONE
 | 366    ->     RPL_ENDOFNAMES
 | 353    ->     RPL_NAMREPLY
 | 315    ->     RPL_ENDOFWHO
 | 352    ->     RPL_WHOREPLY
 | 351    ->     RPL_VERSION
 | 342    ->     RPL_SUMMONING
 | 341    ->     RPL_INVITING
 | 332    ->     RPL_TOPIC
 | 331    ->     RPL_NOTOPIC
 | 324    ->     RPL_CHANNELMODEIS
 | 323    ->     RPL_LISTEND
 | 322    ->     RPL_LIST
 | 321    ->     RPL_LISTSTART
 | 306    ->     RPL_NOWAWAY
 | 305    ->     RPL_UNAWAY
 | 304    ->     RPL_TEXT
 | 303    ->     RPL_ISON
 | 302    ->     RPL_USERHOST
 | 301    ->     RPL_AWAY
 | 300    ->     RPL_NONE
 | _ -> raise (Unknown_Reply n)

type  habert_a=
  | A of habert_c
  | B of habert_c

and habert_c= {lvar:int; lassoc: habert_c;lnb:int}


let habert=function
  | (A {lnb=i}|B {lnb=i}) when i=0 -> 1
  | A {lassoc=({lnb=j});lnb=i} -> 2
  | _ -> 3
;;

let rec ex0 = {lvar=0 ; lnb=0 ; lassoc=ex1}
and ex1 = {lvar=1 ; lnb=1 ; lassoc=ex0} in

test "habert" habert (A ex0) 1 ;
test "habert" habert (B ex0) 1 ;
test "habert" habert (A ex1) 2 ;
test "habert" habert (B ex1) 3 ;

  Problems with interval test in arithmetic mod 2 ^ 31 , bug # 359
  From  

type type_expr = [
  | `TTuple of type_expr list
  | `TConstr of type_expr list
  | `TVar of string
  | `TVariant of string list
  | `TBlock of int
  | `TCopy of type_expr
  ]

and recurs_type_expr = [
  | `TTuple of type_expr list
  | `TConstr of type_expr list
  | `TVariant of string list
  ]


let rec maf te =
    match te with
    | `TCopy te -> 1
    | `TVar _ -> 2
    | `TBlock _ -> 2
    | #recurs_type_expr as desc ->

        let te =
          (match desc with
            `TTuple tl ->
              4
          | `TConstr tl ->
              5
          | `TVariant (row) ->
              6
                )
        in

        te
;;

let base = `TBlock 0
;;

test "maf" maf (`TCopy base) 1 ;
test "maf" maf (`TVar "test") 2 ;
test "maf" maf (`TBlock 0) 2 ;
test "maf" maf (`TTuple []) 4 ;
test "maf" maf (`TConstr []) 5 ;
test "maf" maf (`TVariant []) 6
;;

  PR#1310 
   Using ` ` get_args '' in place or an ad - hoc ` ` matcher '' function for tuples . 
   Has made the compiler [ 3.05 ] to fail . 

  Using ``get_args'' in place or an ad-hoc ``matcher'' function for tuples.
  Has made the compiler [3.05] to fail.
*)
type t_seb = Uin | Uout
;;

let rec seb = function
  | ((i, Uin) | (i, Uout)), Uout -> 1
  | ((j, Uin) | (j, Uout)), Uin ->  2
;;

test "seb" seb ((0,Uin),Uout) 1 ;
test "seb" seb ((0,Uout),Uin) 2 ;
()
;;

  Talk with  
      - type ' b is still open ? ? 
      - better case generation , accept intervals of size 1 when ok_inter is 
        false ( in Switch ) 

     - type 'b is still open ??
     - better case generation, accept intervals of size 1 when ok_inter is
       false (in Switch)
*)


 File " morematch.ml " , line 1060 , characters 8 - 65 : 
 Warning : this pattern - matching is not exhaustive . 
 Here is an example of a value that is not matched : 
 A ` D 

File "morematch.ml", line 1060, characters 8-65:
Warning: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
A `D
*)
type ('a, 'b) t_j = A of 'a | B of 'b * 'a | C

let f = function
  | A (`A|`C) -> 0
  | B (`B,`D) -> 1
  | C -> 2

let g x = try f x with Match_failure _ -> 3

let _ =
  test "jacques" g (A `A) 0 ;
  test "jacques" g (A `C) 0 ;
  test "jacques" g (B (`B,`D)) 1 ;
  test "jacaues" g C 2 ;
   test " jacques " g ( B ( ` A,`D ) ) 3 ; ( * type incorrect expected behavior ?
  ()


   Compilation bug , segfault , because of incorrect compilation 
   of unused match case .. - > " 11 " 

  Compilation bug, segfault, because of incorrect compilation
  of unused match case .. -> "11"
*)

type t_l = A | B

let f = function
  |  _, _, _, _, _, _, _, _, _, _, _, _, _, B, _, _ -> "0"
  |  _, _, _, B, A, _, _, _, _, _, _, _, _, _, _, _ -> "1"
  |  _, _, _, B, _, A, _, _, A, _, _, _, _, _, _, _ -> "2"
  |  _, _, _, _, _, _, _, _, _, _, B, A, _, A, _, _ -> "3"
  |  _, _, _, _, _, _, _, B, _, _, _, _, B, _, A, A -> "4"
  |  A, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "5"
  |  _, _, _, _, _, _, _, B, _, B, _, _, _, _, _, _ -> "6"
  |  _, B, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "7"
  |  _, A, A, _, A, _, B, _, _, _, _, _, _, _, _, B -> "8"
  |  _, _, _, _, B, _, _, _, _, _, _, _, _, _, B, _ -> "9"
  |  _, _, _, _, _, _, _, _, _, _, _, B, _, _, _, _ -> "10"
  |  _, _, _, _, _, A, _, _, _, _, B, _, _, _, _, _ -> "11"
  |  B, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "12"
  |  _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "13"


 File " morematch.ml " , line 1094 , characters 5 - 51 : 
 Warning : this match case is unused . 
 File " morematch.ml " , line 1096 , characters 5 - 51 : 
 Warning : this match case is unused . 

File "morematch.ml", line 1094, characters 5-51:
Warning: this match case is unused.
File "morematch.ml", line 1096, characters 5-51:
Warning: this match case is unused.
*)
let _  =
  test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, B, A, A, A, A) "10" ;
  test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, A, A, A, A, A) "12" ;
 ()


   By   , compilation raised some assert false i make_failactionneg 

  By Gilles Peskine, compilation raised some assert false i make_failactionneg
*)

type bg = [
  | `False
  | `True
  ]

type vg = [
  | `A
  | `B
  | `U of int
  | `V of int
  ]

type tg = {
    v : vg;
    x : bg;
  }

let predg x = true

let rec gilles o = match o with
  | {v = (`U data | `V data); x = `False} when predg o -> 1
  | {v = (`A|`B) ; x = `False}
  | {v = (`U _ | `V _); x = `False}
  | {v = _ ; x = `True}
    -> 2


exception Found of string * int
exception Error of string


let lucexn  e =
  try
    try  raise e  with Error msg -> msg
  with Found (s,r) -> s^string_of_int r

let () =
  test "lucexn1" lucexn  (Error "coucou") "coucou" ;
  test "lucexn2" lucexn (Found ("int: ",0)) "int: 0" ;
  ()


let pr5758 x str =
  match (x, str) with
  | (1. , "A") -> "Matched A"
  | (1.0, "B") -> "Matched B"
  | (1. , "C") -> "Matched C"
  | result ->
    match result with
    | (1., "A") -> "Failed match A then later matched"
    | _ -> "Failed twice"
;;

let () =
  test "pr5758" (pr5758 1.) "A" "Matched A"
;;
