(* A collection of tests for F90 offshoring *)

let numtests = ref 0;;
let failed = ref 0;;
let passed = ref 0;;

let outp (b:bool) = 
   incr numtests;
   if b then
  (incr passed;
    Printf.printf "OK %d\n" !numtests;
    flush stdout)
  else
    (incr failed;
    Printf.printf "ERROR %d.\n" !numtests;
    flush stdout;
    exit 0);;

(* -------------------------------------------- *)
(* -- Expression testing. --  *)
(* -------------------------------------------- *)

(* Arithmetic operators.  *)
let a = .<(1 + 1) + 1>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<((3 + 5) - 1) * (6 / 2)>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<24 mod 5>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* Max and min operators.  *)
let a = .<min 3 10>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<max 3 10>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<min (22 / 11) (9 * 3)>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<max (max 3 4) 5>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* Bitwise shifts.  *)
let a = .<0x1f asr 2>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<0x23c lsr 8>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<1 lsl 4>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* Bitwise operators.  *)
let a = .<0xfffe land 0xf>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<0xe lor 1>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<0x3 lxor 1>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<(0x3 lxor 1) lxor 1>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* If-then-else (and relational operators).  *)
let a = .<if 5 < 6 then 55 else 66>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<if 2=2 then 22 else 0>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<9 * (if 0 >= 6 then 3 else 1)>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<1 + (if 6 >= 0 then (if 1=2 then 5 else 10) else (38))>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let z = (if 5 < 6 then 55 else 66) in z>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* Casts.  *)
let a = .<let ret = ref 0 in
         (if (5.0 +. (float_of_int 3)) < 9.0 then
            ret := 10
         else ret := 11);
         !ret>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<2 + (int_of_float)4.5>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* Unary minus.  *)
let a = .<int_of_float (5.0 +. -. .~(.<0.0>.))>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<- .~(.<0>.)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* Pred/succ. *)
let a = .<let a = 1 in (5 + (succ a))>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let a = 9 in (5 + (pred a))>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* -------------------------------------------- *)
(* -- "let" testing. --  *)
(* -------------------------------------------- *)

(* Simple and not-so-simple involving integer values.  *)

let a = .<let a = 4 in 5 + a>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let a = 4*2 in
             let b = 10 in
              a + b >. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let a = 6/2 in
             let b = 10 in
             let c = 1 in
             a + b - c >. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a =  .<let (z_1232289) = 1 in
              let (z_1232290) = 1 in
              let (z_1232291) = ((z_1232289) + (z_1232290)) in
              ((z_1232291) + (z_1232289))>.  in let b = ((.! a) == (.!{F} a)) in outp b;;


(* -------------------------------------------- *)
(* Testing of function declarations and application.  *)
(* -------------------------------------------- *)

let a = .<let f a = a * 3 in f 8>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let f a = a * 3 in (f 8) + (f 2)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let f a = a * 3 in (let b = 3 in b+(f 2))>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let rec rf n = let rv = ref 0 in (if n = 0 then rv := 1 else rv := (1+rf (n-1))); !rv in rf 5>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let f (a,b) = a + b in f (10,12)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let f (a,b,c) = max a (max b c) + 0 in f (5,3,1)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let f (a,fx) = let rv = ref 0 in (if fx>0.0 then rv := a+1 else rv := a+10); !rv in f (4,12.0)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let f a = a + 1 in
             let g b = f b in
             g 6>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let f a = a + 1 in
             let g b = f b in
             let h (x,y,z) = (f x) * (g y) - z in
             h (2, 3, 4)>. in let b = ((.! a) == (.!{F} a)) in outp b;;


(* The power function.  *)
let a = .<
  let even n = (n mod 2) = 0 in
  let square x = x*x in
  let rec power (n, x) =
    let retval = ref 0 in
    (if n=0 then retval := 1
    else if even n then retval := square (power ((n/2), x))
         else retval := x*(power ((n-1), x))); !retval in
  power(5,2)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* -------------------------------------------- *)
(* Testing of imperative features and control structures:
   Reference types, while and for loops, sequences, matches.  *)
(* -------------------------------------------- *)

let a = .<let ar = ref 10 in !ar>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let ar = 10 in let foo arg = ar + arg+ 5 in foo 1>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let ar = ref 10 in let foo arg = !ar + arg * 9 in foo 2>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let a = ref 0 in for i=1 to 10 do a:=!a+5 done; !a>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let ar = ref 10 in ar := !ar + 1; ar := !ar * 3; !ar>.in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let x = ref 32 in x := !(x)+10; !x>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .< let x = 17 in
   let y = ref 18 in
   let z = 24 in
   y:=(!y)+z; y := (!y)/2; y:=(!y)+21; !y
>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let rv = ref 5 in 
             let sel = 123 in
              (match sel with
                 123 -> rv := !rv + 20; rv := !rv - 1
               | 567 -> rv := !rv * 3
               | _ -> rv := 0);
             !rv>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let a = 10 in
             let b = a / 2 in
             let ret = ref 0 in
             ret := !ret + 4;
             let foo (i,j,k) =
               (match i with
                   0 -> ret := a+j
                 | 1 -> ret := b+k
                 | _ -> ret := j+k); !ret
             in foo (3,4,5)>. in let b = ((.! a) == (.!{F} a)) in outp b;;


let a = .<let sum = ref 0 in for i = 1 to 8 do sum:=!sum+1 done; !sum>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let r = ref 32 in for i = 10 downto 2 do (let a = 6 in r:=i+a) done; !r>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let ri = ref 1 in let j = 10 in let ret = ref 0 in while !ri < j do  ret := !ri; ri:=!ri+2 done; !ret>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let ret = ref 0 in while 0 = 1 do (while 2 = 3 do (while 4 = 5 do ret:=!ret+1  done) done) done; !ret>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let r = ref 0 in 
             let g (x,y) = r:=!r+(x+y); !r in
             while g (1,2) <= 0 do g (2,3) done; !r>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* Incr/decr.  *)
let a = .<let r = ref 10 in incr r; incr r; !r>. in let b = ((.! a) == (.!{F} a)) in outp b;;
let a = .<let r = ref 80 in decr r; decr r; !r>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* -------------------------------------------- *)
(* Testing of arrays.  *)
(* -------------------------------------------- *)

(* --- Dot product. ---  *)
let a = .<
let n = 10 in
let a = Array.make 10 0.0 in
let b = Array.make 10 0.0 in
  for i = 0 to n-1 do
      a.(i) <- float ((i mod 7 + i * 3) mod 97);
      b.(i) <- float ((((n-3*i-1) mod 4) + i * 2) mod 95)
  done;
let dot nnn = 
 let res = ref 0.0 in
  (for i = 0 to nnn-1 do
    res := (a.(i) *. b.(i) +. !res)
   done;
   !res)
 in int_of_float ((dot 10) /. 10.0) 
>. in let b = ((.! a) == (.!{F} a)) in outp b;;


(* --- Chebyshev approximation.  Adapted from mex/chebychev.ml for
       Ocaml->C subset. --- *)
let a = .<
let func x = x *. x in
let approx (n, xa, xb) =
let k  = ref 0 in 
let j  = ref 0 in
let xm = ref 0.0 in
let xp = ref  0.0 in
let sm = ref 0.0 in
let c  = Array.make 10 0.0 in
let f  = Array.make (11) 0.0 in
let pi = 3.14 in
 begin
  xp := (xb+.xa)/. 2.0;
  xm := (xb-.xa)/. 2.0;
  for k = 1 to n do
    f.(k) <- func(!xp +. !xm*.cos(pi*.((float k)-.0.5)/.2.0))
  done;

  for j = 0 to (n-1) do
    sm := 0.0;
    for k = 1 to n do
      sm := !sm +. f.(k)*.cos(pi*.(float j)*.((float k)-.0.5)/. (float n))
    done;
    c.(j) <- (2.0/.(float n))*. !sm
  done;

  (* Compute checksum (for comparing translator answer to Ocaml answer). *)
  let checksum = ref 0.0 in
  for cs = 0 to (n-1) do
    checksum := !checksum +. c.(cs) 
  done;
 (int_of_float (!checksum *. 100.0)) mod 255
 end
in approx (10, 1.0, 2.0)
>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* --- Matrix multiply --- *)
let a = .<
let nn = 3 in
let aa = Array.make_matrix 3 3 0.0 in
let bb = Array.make_matrix 3 3 0.0 in
let cc = Array.make_matrix 3 3 0.0 in
  for i = 0 to (nn-1) do
    for j = 0 to (nn-1) do
      aa.(i).(j) <- 3.0;
      bb.(i).(j) <- 2.0;
      cc.(i).(j) <- 0.0;
    done;
  done;

let matmul (n) =
  let sum = ref 0.0 in
  for i = 0 to (n-1) do
    for j = 0 to (n-1) do
      sum := 0.0;
      for k = 0 to (n-1) do
        sum := !sum +. aa.(i).(k) *. bb.(k).(j)
      done;
      cc.(i).(j) <- !sum;
    done;
  done;

  (* Compute a checksum.  *)
  let checksum = ref 0 in
  for i = 0 to (n-1) do
    for j = 0 to (n-1) do
      checksum := !checksum + (int_of_float cc.(i).(j))
    done;
  done;
  !checksum
  in matmul (3)
>. in let b = ((.! a) == (.!{F} a)) in outp b;;


(* -------------------------------------------- *)
(* More testing of if-then-else (imperative style).  *)
(* -------------------------------------------- *)

let a = .<let x = ref 5 in 
        if !x < 4 then
          x := !x * 3
        else    
          x := !x + 1;
        !x>. in let b = ((.! a) == (.!{F} a)) in outp b;; 

let a = .<let x = ref 3 in 
        let a = 21 in
        if !x < 4 then
          begin
          x := !x * 3;
          x := !x + 1
          end
        else    
          x := !x + 1;
          x := !x + 3;
        a+(!x)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

let a = .<let verdad (a,b) = 
          let s = ref 0.0 in
          if a <= b then
            begin
            for i=a to b do
              if i < 3 then
                s := !s +. 5.0
              else
                s := !s +. 2.0
            done
            end
          else 
            begin
            for i=b downto a do
              if i > 3 then
                s := !s +. 1.0 
              else
                s := !s +. 3.0
            done
           end;
           int_of_float !s
         in verdad (2, 5)>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* -------------------------------------------- *)
(* Miscellaneous regression tests.  *)
(* -------------------------------------------- *)

let a = .<let rv = ref 5 in
        let sel = 123 in
          (match sel with
             123 -> let x = 3 in rv := !rv + x + 20; rv := !rv - 1
           | 567 -> rv := !rv * 3
           | _ -> rv := 0);
        !rv>. in let b = ((.! a) == (.!{F} a)) in outp b;;

(* -------------------------------------------- *)

Printf.printf "# tests passed: %d\n" !passed;;
Printf.printf "# tests failed: %d\n" !failed;;
if (!numtests <> (!passed + !failed)) then
  begin
  Printf.printf "Error: %d tests were not executed!\n" 
   (!numtests - (!passed + !failed))
  end
;;
