(* Le principe des tests pour un seul fichier est de faire la même opération 
dans le fichier "/" de notre système de fichier et dans le fichier 
"Simplefs.ref". *)

open Common
module type USERFS = Simplefs.USERFS;;
module type ROOT = sig val root : string end;;
module type SCRIPT = functor (U : USERFS) -> functor (F : ROOT) -> sig end;;

(* On rend le module Unix compatible avec USERFS *)
module Munix : USERFS = struct 
  module C = Common
  module Flag = struct type open_flag = O_RDWR | O_CREAT end
      (* Tmp est utilisé pour cacher le type open_flag, car il faut le redéfinir *)
  module Tmp :  sig
    type file_descr
    type file_perm = int
    val openfile : string -> Flag.open_flag list -> file_perm -> file_descr
    val close : file_descr -> unit
    type seek_command = SEEK_SET | SEEK_CUR | SEEK_END
    val lseek : file_descr -> int -> seek_command -> int
    val read : file_descr -> string -> int -> int -> int
    val write : file_descr -> string -> int -> int -> int
    val ftruncate : file_descr -> int -> unit
    val stat : string -> stats
    val sync : unit -> unit
    val umount : unit -> unit
  end = struct
    include Unix 
    let stat name = 
      let st = stat name in { 
      C.st_dev = st.st_dev; 
      C.st_nlink = st.Unix.st_nlink; 
      C.st_size = st.Unix.st_size; 
      C.st_ino = st.Unix.st_ino; 
      C.st_kind = 
      match st.st_kind with S_DIR -> C.S_DIR | _ -> C.S_REG; 
    }
    let openfile name flags = 
      let convert = function
          Flag.O_RDWR -> O_RDWR | Flag.O_CREAT -> O_CREAT in
      Unix.openfile name (List.map convert flags)
        
    let sync() = () 
    let umount () = () 
  end
  include Tmp 
  type open_flag = Flag.open_flag = O_RDWR | O_CREAT
end;;

type res = Val of string | Size of int;;
module RunScript (S : SCRIPT) (U : USERFS) (F : ROOT) = 
  struct
    module Run = S (U) (F)
    open U
    let size = (stat F.root).st_size
    let file = String.create size
    let desc = openfile F.root  [ O_RDWR; O_CREAT; ] 0o666 
        (* On recopie le fichier dans une chaîne *)
    let rec copy_loop len =
      if len > 0 then
        let r = read desc file (size - len) len in
        if r = 0 then Size (len)
        else copy_loop (len - r)
      else 
        if read desc "/" 0 1 = 0 then Val file
        else Size (0 - len)
    let res = copy_loop size
    let _ = close desc
  end;;

module type RES = sig val res : string end;;
module Apply (S : SCRIPT) : RES = 
  struct
    let basename = "Simplefs"
    let res = 
      let _ = 
        try 
          let cmd =  String.concat " " [
            "tar"; "-z"; "-xf"; basename ^ ".tgz"; 
          ] in
          let n = Sys.command cmd in
          if n > 0 then 
            let _ = 
              Printf.eprintf
                "Cannot find or untar %s\n" (basename ^ ".tgz") in
            exit 1
        with exn ->
          Printf.eprintf
            "L'extraction de l'archive %s à échoué\n%!" (basename ^ ".tgz");
          exit 2
      in
      try 
        let module Fimg = struct let name = basename ^ ".img" end in
        let module U =  Simplefs.Mount (Disk.Opendisk (Fimg)) in
        let module Froot = struct let root = "/" end in
        let module Ftmp = struct let root = basename ^ ".tmp" end in
        let module B1 = RunScript(S) (U) (Froot) in
        let module B2 = RunScript(S) (Munix) (Ftmp) in
        (* let module D = Disk.Opendisk (Fimg) in *)
        (* let () = D.print(); D.close(); print_newline() in *)
        (* On compare les résultats *)
        match B1.res, B2.res with
        | Val s1, Val s2 when s1 = s2 -> "test OK"
        | Val s1, Val s2 -> 
            Printf.sprintf 
              "test failed: content differs\n[%s]\n[%s]" s1 s2
        | Size n, _ when n > 0 -> "FAILED: size too large"
        | Size n, _  -> "failed: size too small"
        | _, Size s2 -> "Error during test" 
        with exn -> 
          "Exception: " ^ (Printexc.to_string exn)
  end ;;

(* On écrit maintenant une série de script qui seront exécutés sur le
   fichier root de notre système de fichier et comparés à une simulation
   dans un fichier standard *)

module Read (U : USERFS) (F : ROOT) = 
  struct
    open U
    let desc = openfile F.root [ O_RDWR; O_CREAT; ] 0o666
    let _ = close desc
  end;;

module Ftruncate (U : USERFS) (F : ROOT) = 
  struct
    open U
    let desc = openfile F.root [ O_RDWR; O_CREAT; ] 0o666
    let _ = ftruncate desc 20
    let _ = close desc
  end;;

module Write0 (U : USERFS) (F : ROOT) = 
  struct
    open U
    let desc = openfile F.root [ O_RDWR; O_CREAT; ] 0o666
    let str =  "Une petite phrase"
    let _ = write desc str  0 (String.length str)
    let _ = close desc
  end;;

module Write1 (U : USERFS) (F : ROOT) = 
  struct
    open U
    let desc = openfile F.root [ O_RDWR; O_CREAT; ] 0o666
    let str =  "Une très longue phrase qui prend beaucoup plus qu'un bloc"
    let _ = ftruncate desc 20
    let _ = write desc str  2 (String.length str - 3)
    let _ = 
      for i = 0 to 4 do ignore (write desc str  0 (String.length str)) done
    let _ = close desc
  end;;

module Lseek0 (U : USERFS) (F : ROOT) = 
  struct
    open U
    let desc = openfile F.root [ O_RDWR; O_CREAT; ] 0o666
    let n = lseek desc 500 SEEK_END
    let _ = close desc
  end;;

module Lseek1 (U : USERFS) (F : ROOT) = 
  struct
    open U
    let desc = openfile F.root [ O_RDWR; O_CREAT; ] 0o666
    let str = "quelque chose avant le seek et le truncate" 
    let _ = lseek desc 300 SEEK_SET
    let _ = write desc str  0 (String.length str)
    let _ = lseek desc (-200) SEEK_END
    let str = "quelque chose avant le seek et le truncate" 
    let _ = for i = 0 to 4 do ignore(write desc str  0 (String.length str))done
    let _ = ftruncate desc 17
    let _ = lseek desc 12 SEEK_SET
    let str = "QUELQUE CHOSE APRÈS LE TRUNCATE" 
    let _ = for i = 0 to 4 do ignore(write desc str  0 (String.length str))done
    let _ = close desc
  end;;

(* On peut ajouter d'autres tests ici *)

let () = 
  (* on effectue les test en série *)
  let run q r = Printf.printf "%s: %s\n%!" q r in
  run "read" 
    (let module R = Apply(Read) in R.res); 
  run "ftruncate"
    (let module R = Apply(Ftruncate) in R.res); 
  run "write0 (petite écriture)"
    (let module R = Apply(Write0) in R.res); 
  run "write1 (écriture, truncature, puis allocation de bloc)"
    (let module R = Apply(Write1) in R.res); 
  run "lseek0 (déplacement sans écriture)"
    (let module R = Apply(Lseek0) in R.res); 
  run "lseek1 (déplacement avec création d'un bloc vide)"
    (let module R = Apply(Lseek1) in R.res); 
  ();;