examples/test.ml

   1 (* Simple test of the API.
   2  * Copyright (C) 2003 Merjis Ltd.
   3  * $Id: test.ml,v 1.2 2003-10-12 17:33:14 rich Exp $
   4  *)
   5
   6 open Printf
   7
   8 let () =
   9   (* Load "test.pl". *)
  10   Perl.eval "require 'examples/test.pl'";
  11
  12   (* Call some subroutines in [test.pl]. *)
  13   let sv = Perl.call ~fn:"return_one" [] in
  14   printf "return_one returned %d\n" (Perl.int_of_sv sv); flush stdout;
  15
  16   let sv = Perl.call ~fn:"adder" [Perl.sv_of_int 3; Perl.sv_of_int 4] in
  17   printf "adder (3, 4) = %d\n" (Perl.int_of_sv sv); flush stdout;
  18
  19   let svlist = Perl.call_array ~fn:"return_array" [] in
  20   print_string "array returned:";
  21   List.iter (
  22     fun sv ->
  23       printf " %d" (Perl.int_of_sv sv);
  24   ) svlist;
  25   printf "\n"; flush stdout;
  26
  27   let sv = Perl.sv_of_string "return_one" in
  28   let sv = Perl.call ~sv [] in
  29   printf "return_one returned %d\n" (Perl.int_of_sv sv); flush stdout;
  30
  31   (* Call a Perl closure. *)
  32   let sv = Perl.call ~fn:"return_closure" [] in
  33   let sv = Perl.call ~sv [Perl.sv_of_int 3; Perl.sv_of_int 4] in
  34   printf "closure returned %d\n" (Perl.int_of_sv sv); flush stdout;
  35
  36   (* Evaluate a simple expression. *)
  37   Perl.eval "$a = 3";
  38   printf "$a contains %d\n" (Perl.int_of_sv (Perl.get_sv "a")); flush stdout;
  39
  40   (* Test calling methods in the "TestClass" class. *)
  41   let obj = Perl.call_class_method "TestClass" "new" [] in
  42   let sv = Perl.call_method obj "get_foo" [] in
  43   printf "TestClass.foo is %d\n" (Perl.int_of_sv sv); flush stdout;
  44   Perl.call_method obj "set_foo" [Perl.sv_of_int 2];
  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
  48   (* Destroy the interpreter. *)
  49   Perl.destroy ()