Further tuning for initial release.
[perl4caml.git] / examples / test.ml
1 (* Simple test of the API.
2  * Copyright (C) 2003 Merjis Ltd.
3  * $Id: test.ml,v 1.5 2003-10-16 11:03:52 rich Exp $
4  *)
5
6 open Printf
7
8 let () =
9   (* Perform a full collection - good way to find bugs in initialization code*)
10   Gc.full_major ();
11
12   (* Load "test.pl". *)
13   Perl.eval "require 'examples/test.pl'";
14
15   (* Call some subroutines in [test.pl]. *)
16   let sv = Perl.call ~fn:"return_one" [] in
17   printf "return_one returned %d\n" (Perl.int_of_sv sv); flush stdout;
18
19   let sv = Perl.call ~fn:"adder" [Perl.sv_of_int 3; Perl.sv_of_int 4] in
20   printf "adder (3, 4) = %d\n" (Perl.int_of_sv sv); flush stdout;
21
22   let svlist = Perl.call_array ~fn:"return_array" [] in
23   print_string "array returned:";
24   List.iter (
25     fun sv ->
26       printf " %d" (Perl.int_of_sv sv);
27   ) svlist;
28   printf "\n"; flush stdout;
29
30   let sv = Perl.sv_of_string "return_one" in
31   let sv = Perl.call ~sv [] in
32   printf "return_one returned %d\n" (Perl.int_of_sv sv); flush stdout;
33
34   (* Call a Perl closure. *)
35   let sv = Perl.call ~fn:"return_closure" [] in
36   let sv = Perl.call ~sv [Perl.sv_of_int 3; Perl.sv_of_int 4] in
37   printf "closure returned %d\n" (Perl.int_of_sv sv); flush stdout;
38
39   (* Evaluate a simple expression. *)
40   Perl.eval "$a = 3";
41   printf "$a contains %d\n" (Perl.int_of_sv (Perl.get_sv "a")); flush stdout;
42
43   (* Test calling methods in the "TestClass" class. *)
44   let obj = Perl.call_class_method "TestClass" "new" [] in
45   let sv = Perl.call_method obj "get_foo" [] in
46   printf "TestClass.foo is %d\n" (Perl.int_of_sv sv); flush stdout;
47   Perl.call_method obj "set_foo" [Perl.sv_of_int 2];
48   let sv = Perl.call_method obj "get_foo" [] in
49   printf "TestClass.foo is %d\n" (Perl.int_of_sv sv); flush stdout;
50
51   (* Destroy the interpreter. *)
52   Perl.destroy (Perl.current_interpreter ());
53
54   (* Perform a full collection - good way to find GC/allocation bugs. *)
55   Gc.full_major ()