test.ml

   1 (* Simple test of the API.
   2  * Copyright (C) 2003 Merjis Ltd.
   3  * $Id: test.ml,v 1.2 2003-10-12 10:52:00 rich Exp $
   4  *)
   5
   6 open Printf
   7
   8 let () =
   9   (* Arguments passed to the Perl "command line". Loads [test.pl] *)
  10   let args = [| ""; "-wT"; "test.pl" |] in
  11
  12   (* Create the Perl interpreter. *)
  13   let pl = Perl.create ~args () in
  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"));
  42
  43   (* Destroy the interpreter. *)
  44   Perl.destroy pl