examples/test.ml

   1 (* Simple test of the API.
   2  * Copyright (C) 2003 Merjis Ltd.
   3  * $Id: test.ml,v 1.3 2003-10-15 16:51:12 rich Exp $
   4  *)
   5
   6 open Printf
   7
   8 (* XXX Hack to workaround some sort of linking bug in OCaml. Without this
   9  * the Perl module isn't initialized and this code crashes.
  10  *)
  11 let f = Pl_Net_Google.may
  12
  13 let () =
  14   (* Load "test.pl". *)
  15   Perl.eval "require 'examples/test.pl'";
  16
  17   (* Call some subroutines in [test.pl]. *)
  18   let sv = Perl.call ~fn:"return_one" [] in
  19   printf "return_one returned %d\n" (Perl.int_of_sv sv); flush stdout;
  20
  21   let sv = Perl.call ~fn:"adder" [Perl.sv_of_int 3; Perl.sv_of_int 4] in
  22   printf "adder (3, 4) = %d\n" (Perl.int_of_sv sv); flush stdout;
  23
  24   let svlist = Perl.call_array ~fn:"return_array" [] in
  25   print_string "array returned:";
  26   List.iter (
  27     fun sv ->
  28       printf " %d" (Perl.int_of_sv sv);
  29   ) svlist;
  30   printf "\n"; flush stdout;
  31
  32   let sv = Perl.sv_of_string "return_one" in
  33   let sv = Perl.call ~sv [] in
  34   printf "return_one returned %d\n" (Perl.int_of_sv sv); flush stdout;
  35
  36   (* Call a Perl closure. *)
  37   let sv = Perl.call ~fn:"return_closure" [] in
  38   let sv = Perl.call ~sv [Perl.sv_of_int 3; Perl.sv_of_int 4] in
  39   printf "closure returned %d\n" (Perl.int_of_sv sv); flush stdout;
  40
  41   (* Evaluate a simple expression. *)
  42   Perl.eval "$a = 3";
  43   printf "$a contains %d\n" (Perl.int_of_sv (Perl.get_sv "a")); flush stdout;
  44
  45   (* Test calling methods in the "TestClass" class. *)
  46   let obj = Perl.call_class_method "TestClass" "new" [] in
  47   let sv = Perl.call_method obj "get_foo" [] in
  48   printf "TestClass.foo is %d\n" (Perl.int_of_sv sv); flush stdout;
  49   Perl.call_method obj "set_foo" [Perl.sv_of_int 2];
  50   let sv = Perl.call_method obj "get_foo" [] in
  51   printf "TestClass.foo is %d\n" (Perl.int_of_sv sv); flush stdout;
  52
  53   (* Destroy the interpreter. *)
  54   Perl.destroy (Perl.current_interpreter ())