(***********************************************************************)
(*                                                                     *)
(*            cast objet en O'Caml                                     *)
(*                                                                     *)
(*            Emmanuel Chailloux, Equipe PPS, universite P7            *)
(*                                                                     *)
(*                                                                     *)
(***********************************************************************)

(* $Id: test1.ml,v 1.3 2001/09/24 20:25:12 emmanuel Exp $ *)

(* test1.ml : fichier de test 

           point
             |
        point_colore
             |
      point_tres_colore 
 *)


class point a b = 
object
  val mutable  x = a
  val mutable y = b
  method get_x  = x
  method get_y  = y
  method rmoveto dx dy =  x <- dx + x; y <- dy + y
  method to_string () = "("  ^ (string_of_int x) ^ "," ^ (string_of_int y)^")"
end;;


class point_colore  a b  c = 
object
  inherit point  a b as super
  val mutable  color  = c
  method get_color  = c
  method to_string () = (super#to_string()) ^ " : " ^ color
end;;

class point_tres_colore  a b  c = 
object(self)
  inherit point_colore  a b c 
  val mutable  tcolor  = c
  method get_color  = String.concat "" [ "tres "; tcolor ]
  method to_string () =  self#get_color
end;;

let affiche p = print_string (p#to_string()); print_newline();;

let p1 = new point 1 2;;
affiche p1;;
let p2 = new point 2 3;;
affiche p2;;
let np1 = new point_colore 1 2 "bleu";;
affiche np1;;
let np2 = new point_colore 2 3 "rouge";;
affiche np2;;
let p3 =  upcast np1 from point_colore to  point;;
affiche p3;;
let p4 =  upcast np2 from point_colore to  point;;
affiche p4;;
let np3 = downcast p3  from point to point_colore;;
affiche np3;;
let np4 = downcast p4  from point to point_colore;;
affiche np4;;
let npt1 = new point_tres_colore 2 3 "vert";;
affiche npt1;;
let p5 = upcast ( upcast npt1 from point_tres_colore to point_colore) from point_colore to 
point;;
affiche p5;;
let npt2 = downcast p5  from point to point_tres_colore;;
affiche npt2;;
let np6 = downcast p5  from point to point_colore;;
affiche np6;;



print_string "OK";;
print_newline();;


let ptc1 = new point_tres_colore 1 2 "bleu";;

let ppp =  upcast ptc1 from point_tres_colore to point_colore;;
let ppp2 = upcast ppp from point_colore to point;;

let pz1 = (ptc1 :> point);;

try 
  let u =   downcast pz1 from point to point_tres_colore in u#to_string()
 with _ -> "NON";;

try 
  let u =   downcast pz1 from point to point_colore in u#to_string()
 with _ -> "NON";;

let ptc1 = new point_tres_colore 1 2 "bleu";;

let ppp =  upcast ptc1 from point_tres_colore to point_colore;;
let ppp2 = upcast ppp from point_colore to point;;


try 
  let u = downcast ppp2 from point to point_colore in u#to_string()
 with _ -> "NON";;

try 
  let u = downcast ppp2 from point to point_tres_colore in u#to_string()
 with _ -> "NON";;