From 186f65548798769d55c2581b55b41ce1bbd6fe90 Mon Sep 17 00:00:00 2001 From: rich Date: Fri, 28 Jan 2005 23:09:30 +0000 Subject: [PATCH] Added 'make test' and some test scripts which exercise parts of the code. Enabled refcounting by default, and fixed many refcounting bugs. It should use a lot less memory now. Added address_of_[sah]v to get the address of those things for debugging. --- Makefile | 68 +++++++++++++++++++++++------------------- Makefile.config | 12 ++++---- README | 11 +++++-- examples/.cvsignore | 10 ++----- perl.ml | 6 +++- perl.mli | 28 ++++++++++++++---- perl_c.c | 79 ++++++++++++++++++++++++++++++++++++++++++++++--- test/.cvsignore | 5 ++++ test/001-start.ml | 3 ++ test/010-load.ml | 13 ++++++++ test/020-eval.ml | 11 +++++++ test/030-call-method.ml | 13 ++++++++ test/030-call.ml | 12 ++++++++ test/100-sv.ml | 32 ++++++++++++++++++++ test/110-av.ml | 41 +++++++++++++++++++++++++ test/120-hv.ml | 27 +++++++++++++++++ test/140-ref.ml | 30 +++++++++++++++++++ 17 files changed, 342 insertions(+), 59 deletions(-) create mode 100644 test/.cvsignore create mode 100644 test/001-start.ml create mode 100644 test/010-load.ml create mode 100644 test/020-eval.ml create mode 100644 test/030-call-method.ml create mode 100644 test/030-call.ml create mode 100644 test/100-sv.ml create mode 100644 test/110-av.ml create mode 100644 test/120-hv.ml create mode 100644 test/140-ref.ml diff --git a/Makefile b/Makefile index a92c178..0080c47 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ # Interface to Perl from OCaml. # Copyright (C) 2003 Merjis Ltd. -# $Id: Makefile,v 1.28 2004-12-11 15:40:08 rich Exp $ +# $Id: Makefile,v 1.29 2005-01-28 23:09:30 rich Exp $ include Makefile.config @@ -59,35 +59,39 @@ perl4caml.cma: perl.cmo perl_c.o $(WRAPPERS) perl4caml.cmxa: perl.cmx perl_c.o $(WRAPPERS:.cmo=.cmx) $(OCAMLMKLIB) -o perl4caml $(LIBPERL) $^ -all-examples: examples/test examples/loadpage examples/google \ +all-examples: examples/test.bc examples/loadpage.bc examples/google.bc \ examples/test.opt examples/loadpage.opt examples/google.opt \ - examples/parsedate examples/parsedate.opt - -examples/test: examples/test.cmo - $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@ - -examples/test.opt: examples/test.cmx - $(OCAMLOPT) $(OCAMLOPTFLAGS) -cclib -L. perl4caml.cmxa \ - $(DYNALOADER_HACK) $^ -o $@ - -examples/loadpage: examples/loadpage.cmo - $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@ - -examples/loadpage.opt: examples/loadpage.cmx - $(OCAMLOPT) $(OCAMLOPTFLAGS) -cclib -L. perl4caml.cmxa \ - $(DYNALOADER_HACK) $^ -o $@ - -examples/google: examples/google.cmo - $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@ - -examples/google.opt: examples/google.cmx - $(OCAMLOPT) $(OCAMLOPTFLAGS) -cclib -L. perl4caml.cmxa \ - $(DYNALOADER_HACK) $^ -o $@ + examples/parsedate.bc examples/parsedate.opt + +TEST_PROGRAMS := $(patsubst %.ml,%.bc,$(wildcard test/*.ml)) \ + $(patsubst %.ml,%.opt,$(wildcard test/*.ml)) + +test: $(TEST_PROGRAMS) run-tests + +check: test + +run-tests: + @fails=0; count=0; \ + export LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH; \ + for prog in $(TEST_PROGRAMS); do \ + if ! $$prog; then \ + echo Test $$prog failed; \ + fails=$$(($$fails+1)); \ + fi; \ + count=$$(($$count+1)); \ + done; \ + if [ $$fails -eq 0 ]; then \ + echo All tests succeeded.; \ + exit 0; \ + else \ + echo $$fails/$$count tests failed.; \ + exit 1; \ + fi -examples/parsedate: examples/parsedate.cmo +%.bc: %.cmo $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@ -examples/parsedate.opt: examples/parsedate.cmx +%.opt: %.cmx $(OCAMLOPT) $(OCAMLOPTFLAGS) -cclib -L. perl4caml.cmxa \ $(DYNALOADER_HACK) $^ -o $@ @@ -109,12 +113,14 @@ META: META.in Makefile.config # Clean. -JUNKFILES = core *~ *.bak *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so *.opt +JUNKFILES = core *~ *.bak *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so \ + *.bc *.opt clean: - rm -f META examples/test examples/loadpage examples/google \ - examples/parsedate - for d in . examples wrappers; do (cd $$d; rm -f $(JUNKFILES)); done + rm -f META + for d in . examples test wrappers; do \ + (cd $$d; rm -f $(JUNKFILES)); \ + done # Build dependencies. @@ -194,4 +200,4 @@ html/index.html: $(wildcard *.ml) $(wildcard *.mli) $(wildcard wrappers/*.ml) mkdir html -$(OCAMLDOC) $(OCAMLDOCFLAGS) -d html $^ -.PHONY: depend dist check-manifest html dpkg \ No newline at end of file +.PHONY: depend dist check-manifest html dpkg test run-tests \ No newline at end of file diff --git a/Makefile.config b/Makefile.config index 13e36ee..67c0dcb 100644 --- a/Makefile.config +++ b/Makefile.config @@ -1,5 +1,5 @@ # perl4caml configuration -*- Makefile -*- -# $Id: Makefile.config,v 1.20 2004-12-11 15:40:09 rich Exp $ +# $Id: Makefile.config,v 1.21 2005-01-28 23:09:31 rich Exp $ # PERLINCDIR # Directory containing the Perl include files, eg. . @@ -22,12 +22,12 @@ OCAMLLIBDIR := $(shell ocamlc -where) # which will turn on experimental support for reference counting. # Without this none of the Perl structures that you allocate will get # freed. With this we try to map Perl's reference counting onto -# OCaml's garbage collection by using finalizers. There are some -# problems with this code at the moment, hence it is disabled by -# default. +# OCaml's garbage collection by using finalizers. Although the +# feature is marked "EXPERIMENTAL", I have fixed most of the bugs +# and it's now turned on by default. -EXTRA_CFLAGS := -#EXTRA_CFLAGS := -DPERL4CAML_REFCOUNTING_EXPERIMENTAL=1 +#EXTRA_CFLAGS := +EXTRA_CFLAGS := -DPERL4CAML_REFCOUNTING_EXPERIMENTAL=1 #EXTRA_CFLAGS := -I/Users/rich/OCaml/lib/ocaml/std-lib #EXTRA_CFLAGS := -g diff --git a/README b/README index 885beaf..535fe86 100644 --- a/README +++ b/README @@ -1,6 +1,6 @@ perl4caml Copyright (C) 2003 Merjis Ltd. (http://www.merjis.com/) -$Id: README,v 1.3 2003-11-02 13:19:57 rich Exp $ +$Id: README,v 1.4 2005-01-28 23:09:31 rich Exp $ perl4caml allows you to use Perl code within Objective CAML (OCaml), thus neatly side-stepping the old problem with OCaml which was that it @@ -24,9 +24,14 @@ perl4caml was mainly written by Richard W.M. Jones (3) Type 'make'. -(4) Type 'make install' as root to install. +(4) It's recommended that you run the automatic tests by using 'make test'. + You should see 'All tests succeeded.' If not, please report this + to me (rich@annexia.org). If Perl gives any warnings, such as + 'Attempt to free unreferenced scalar', please also report this. -(5) Try some of the examples in the examples/ directory (some of these +(5) Type 'make install' as root to install. + +(6) Try some of the examples in the examples/ directory (some of these require that you have certain Perl modules installed). Documentation diff --git a/examples/.cvsignore b/examples/.cvsignore index 725d37b..1fa692f 100644 --- a/examples/.cvsignore +++ b/examples/.cvsignore @@ -3,11 +3,5 @@ *.cmx *.cma *.cmxa -test -loadpage -google -parsedate -test.opt -loadpage.opt -google.opt -parsedate.opt \ No newline at end of file +*.bc +*.opt \ No newline at end of file diff --git a/perl.ml b/perl.ml index cdbfa7c..23bc833 100644 --- a/perl.ml +++ b/perl.ml @@ -1,6 +1,6 @@ (* Interface to Perl from OCaml. * Copyright (C) 2003 Merjis Ltd. - * $Id: perl.ml,v 1.12 2004-11-25 22:16:17 rich Exp $ + * $Id: perl.ml,v 1.13 2005-01-28 23:09:31 rich Exp $ *) type sv @@ -61,6 +61,10 @@ let string_of_sv_t = function | SVt_PVGV -> "SVt_PVGV" | SVt_PVMG -> "SVt_PVMG" +external address_of_sv : sv -> Nativeint.t = "perl4caml_address_of_sv" +external address_of_av : av -> Nativeint.t = "perl4caml_address_of_av" +external address_of_hv : hv -> Nativeint.t = "perl4caml_address_of_hv" + external scalarref : sv -> sv = "perl4caml_scalarref" external arrayref : av -> sv = "perl4caml_arrayref" external hashref : hv -> sv = "perl4caml_hashref" diff --git a/perl.mli b/perl.mli index 778de58..05c353a 100644 --- a/perl.mli +++ b/perl.mli @@ -2,7 +2,7 @@ * * Copyright (C) 2003 Merjis Ltd. * - * $Id: perl.mli,v 1.12 2004-03-03 12:39:20 rich Exp $ + * $Id: perl.mli,v 1.13 2005-01-28 23:09:32 rich Exp $ *) type sv @@ -60,10 +60,10 @@ type sv_t = SVt_NULL | SVt_NV (** Floating point scalar. *) | SVt_PV (** String scalar. *) | SVt_RV (** Reference. *) - | SVt_PVAV (** Array ref. *) - | SVt_PVHV (** Hash ref. *) - | SVt_PVCV (** Code ref. *) - | SVt_PVGV (** Glob. *) + | SVt_PVAV (** Array. *) + | SVt_PVHV (** Hash. *) + | SVt_PVCV (** Code. *) + | SVt_PVGV (** Glob (possibly a file handle). *) | SVt_PVMG (** Blessed or magical scalar. *) val sv_type : sv -> sv_t (** Return the type of data contained in an [SV]. Somewhat equivalent to @@ -72,6 +72,19 @@ val sv_type : sv -> sv_t val string_of_sv_t : sv_t -> string (** Return a printable string for an [sv_t] ([SV] type). *) +val address_of_sv : sv -> Nativeint.t +(** Returns the address of the SV. Useful for debugging since + * Perl also prints out addresses on internal errors. + *) +val address_of_av : av -> Nativeint.t +(** Returns the address of the AV. Useful for debugging since + * Perl also prints out addresses on internal errors. + *) +val address_of_hv : hv -> Nativeint.t +(** Returns the address of the HV. Useful for debugging since + * Perl also prints out addresses on internal errors. + *) + val scalarref : sv -> sv (** Given a scalar, this returns a reference to the scalar. Note that * because references are [SV]s, this returns [sv]. @@ -128,7 +141,10 @@ val av_clear : av -> unit val av_undef : av -> unit (** Delete the [AV] (and all elements in it). Same as Perl [undef \@av]. *) val av_extend : av -> int -> unit -(** Extend the [AV] so it contains at least [n+1] elements. *) +(** Extend the [AV] so it contains at least [n+1] elements. Note that + * this apparently just changes the amount of allocated storage. The + * extra elements are not visible until you store something in them. + *) val av_map : (sv -> 'a) -> av -> 'a list (** Map a function over the elements in the [AV], return a list of the * results. *) diff --git a/perl_c.c b/perl_c.c index 948de42..1737bc0 100644 --- a/perl_c.c +++ b/perl_c.c @@ -1,6 +1,6 @@ /* Interface to Perl from OCaml. * Copyright (C) 2003 Merjis Ltd. - * $Id: perl_c.c,v 1.19 2004-12-11 15:40:09 rich Exp $ + * $Id: perl_c.c,v 1.20 2005-01-28 23:09:32 rich Exp $ */ #include @@ -200,6 +200,30 @@ perl4caml_sv_type (value svv) } CAMLprim value +perl4caml_address_of_sv (value svv) +{ + CAMLparam1 (svv); + SV *sv = Sv_val (svv); + CAMLreturn (caml_copy_nativeint ((long) sv)); +} + +CAMLprim value +perl4caml_address_of_av (value avv) +{ + CAMLparam1 (avv); + AV *av = Av_val (avv); + CAMLreturn (caml_copy_nativeint ((long) av)); +} + +CAMLprim value +perl4caml_address_of_hv (value hvv) +{ + CAMLparam1 (hvv); + HV *hv = Hv_val (hvv); + CAMLreturn (caml_copy_nativeint ((long) hv)); +} + +CAMLprim value perl4caml_scalarref (value svv) { CAMLparam1 (svv); @@ -248,7 +272,12 @@ perl4caml_deref (value svv) default: caml_invalid_argument ("deref: SV is not a reference to a scalar"); } - rsvv = Val_sv (SvRV (sv)); + sv = SvRV (sv); + /* Increment the reference count because we're creating another + * value pointing at the referenced SV. + */ + sv = SvREFCNT_inc (sv); + rsvv = Val_sv (sv); CAMLreturn (rsvv); } @@ -267,7 +296,12 @@ perl4caml_deref_array (value svv) default: caml_invalid_argument ("deref_array: SV is not a reference to an array"); } - ravv = Val_av ((AV *) SvRV (sv)); + sv = SvRV (sv); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + sv = SvREFCNT_inc (sv); + ravv = Val_av ((AV *) sv); CAMLreturn (ravv); } @@ -286,7 +320,12 @@ perl4caml_deref_hash (value svv) default: caml_invalid_argument ("deref_hash: SV is not a reference to a hash"); } - rhvv = Val_hv ((HV *) SvRV (sv)); + sv = SvRV (sv); + /* Increment the reference count because we're creating another + * value pointing at the referenced HV. + */ + sv = SvREFCNT_inc (sv); + rhvv = Val_hv ((HV *) sv); CAMLreturn (rhvv); } @@ -346,6 +385,10 @@ perl4caml_av_pop (value avv) CAMLparam1 (avv); AV *av = Av_val (avv); SV *sv = av_pop (av); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + sv = SvREFCNT_inc (sv); CAMLreturn (Val_sv (sv)); } @@ -368,6 +411,10 @@ perl4caml_av_shift (value avv) CAMLparam1 (avv); AV *av = Av_val (avv); SV *sv = av_shift (av); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + sv = SvREFCNT_inc (sv); CAMLreturn (Val_sv (sv)); } @@ -398,6 +445,10 @@ perl4caml_av_get (value avv, value i) AV *av = Av_val (avv); SV **svp = av_fetch (av, Int_val (i), 0); if (svp == 0) caml_invalid_argument ("av_get: index out of bounds"); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + *svp = SvREFCNT_inc (*svp); CAMLreturn (Val_sv (*svp)); } @@ -455,6 +506,10 @@ perl4caml_hv_get (value hvv, value key) HV *hv = Hv_val (hvv); SV **svp = hv_fetch (hv, String_val (key), caml_string_length (key), 0); if (svp == 0) caml_raise_not_found (); + /* Increment the reference count because we're creating another + * value pointing at the referenced SV. + */ + SvREFCNT_inc (*svp); CAMLreturn (Val_sv (*svp)); } @@ -505,6 +560,11 @@ perl4caml_get_sv (value optcreate, value name) sv = get_sv (String_val (name), create == Val_true ? TRUE : FALSE); if (sv == NULL) caml_raise_not_found (); + /* Increment the reference count because we're creating another + * value pointing at the referenced SV. + */ + SvREFCNT_inc (sv); + CAMLreturn (Val_sv (sv)); } @@ -519,6 +579,11 @@ perl4caml_get_av (value optcreate, value name) av = get_av (String_val (name), create == Val_true ? TRUE : FALSE); if (av == NULL) caml_raise_not_found (); + /* Increment the reference count because we're creating another + * value pointing at the AV. + */ + SvREFCNT_inc (av); + CAMLreturn (Val_av (av)); } @@ -533,6 +598,11 @@ perl4caml_get_hv (value optcreate, value name) hv = get_hv (String_val (name), create == Val_true ? TRUE : FALSE); if (hv == NULL) caml_raise_not_found (); + /* Increment the reference count because we're creating another + * value pointing at the HV. + */ + SvREFCNT_inc (hv); + CAMLreturn (Val_hv (hv)); } @@ -1061,6 +1131,7 @@ Val_voidptr (void *ptr) static void xv_finalize (value v) { + /*fprintf (stderr, "about to decrement %p\n", Xv_val (v));*/ SvREFCNT_dec ((SV *) Xv_val (v)); } diff --git a/test/.cvsignore b/test/.cvsignore new file mode 100644 index 0000000..bcc0f68 --- /dev/null +++ b/test/.cvsignore @@ -0,0 +1,5 @@ +*.bc +*.opt +*.cmi +*.cmo +*.cmx diff --git a/test/001-start.ml b/test/001-start.ml new file mode 100644 index 0000000..23e113e --- /dev/null +++ b/test/001-start.ml @@ -0,0 +1,3 @@ +(* Does nothing - just check the test harness is working. + * $Id: 001-start.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) diff --git a/test/010-load.ml b/test/010-load.ml new file mode 100644 index 0000000..55ceac0 --- /dev/null +++ b/test/010-load.ml @@ -0,0 +1,13 @@ +(* Load Perl interpreter. + * $Id: 010-load.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +(* The next line does nothing. It just forces OCaml to actually + * reference and hence load the Perl module. + *) +let _ = Perl.int_of_sv;; + +(* Check for memory errors. *) +Gc.full_major () diff --git a/test/020-eval.ml b/test/020-eval.ml new file mode 100644 index 0000000..98348ab --- /dev/null +++ b/test/020-eval.ml @@ -0,0 +1,11 @@ +(* Simple eval. + * $Id: 020-eval.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +let () = + let sv = eval "2+2" in + assert (4 = int_of_sv sv);; + +Gc.full_major () diff --git a/test/030-call-method.ml b/test/030-call-method.ml new file mode 100644 index 0000000..2ebaf78 --- /dev/null +++ b/test/030-call-method.ml @@ -0,0 +1,13 @@ +(* Basic constructor and method calls. + * $Id: 030-call-method.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +let () = + ignore (eval "use IO::File"); + let io = call_class_method "IO::File" "new_tmpfile" [] in + call_method_void io "print" [ sv_of_string "hello, world" ]; + call_method_void io "close" [];; + +Gc.full_major () diff --git a/test/030-call.ml b/test/030-call.ml new file mode 100644 index 0000000..0269ef1 --- /dev/null +++ b/test/030-call.ml @@ -0,0 +1,12 @@ +(* Basic subroutine call. + * $Id: 030-call.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +let () = + ignore (eval "sub test { 42 + $_[0] }"); + let sv = call ~fn:"test" [sv_of_int 10] in + assert (52 = int_of_sv sv);; + +Gc.full_major () diff --git a/test/100-sv.ml b/test/100-sv.ml new file mode 100644 index 0000000..261d141 --- /dev/null +++ b/test/100-sv.ml @@ -0,0 +1,32 @@ +(* Thoroughly test SV-related functions. + * $Id: 100-sv.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +let () = + assert (42 = int_of_sv (sv_of_int 42)); + assert (42. = float_of_sv (sv_of_float 42.)); + assert (true = bool_of_sv (sv_of_bool true)); + assert (false = bool_of_sv (sv_of_bool false)); + assert ("42" = string_of_sv (sv_of_string "42")); + assert ("42" = string_of_sv (sv_of_int 42)); + assert ("1" = string_of_sv (sv_of_bool true)); + (* assert ("" = string_of_sv (sv_of_bool false)); XXX fails XXX *) + assert (sv_is_true (sv_of_bool true)); + assert (sv_is_true (sv_true ())); + assert (not (sv_is_true (sv_false ()))); + assert (sv_is_undef (sv_undef ())); + + let sv = sv_undef () in assert (sv_type sv = SVt_NULL); + let sv = sv_of_int 42 in assert (sv_type sv = SVt_IV); + (* let sv = sv_of_float 42.1 in assert (sv_type sv = SVt_NV); XXX fails XXX*) + let sv = sv_of_string "42" in assert (sv_type sv = SVt_PV); + let sv = eval "\\\"foo\"" in assert (sv_type sv = SVt_RV); + + ignore (eval "$s = 'foo'"); + let sv = get_sv "s" in + assert ("foo" = string_of_sv sv); +;; + +Gc.full_major () diff --git a/test/110-av.ml b/test/110-av.ml new file mode 100644 index 0000000..b1f1b01 --- /dev/null +++ b/test/110-av.ml @@ -0,0 +1,41 @@ +(* Thoroughly test AV-related functions. + * $Id: 110-av.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +let () = + let av = av_empty () in + assert ([] = list_of_av av); + av_push av (sv_of_int 42); + av_push av (sv_of_int 84); + av_unshift av (sv_of_int 21); + av_set av 0 (sv_of_int 11); + assert (3 = av_length av); + assert (84 = int_of_sv (av_pop av)); + assert (2 = av_length av); + assert (11 = int_of_sv (av_shift av)); + assert (1 = av_length av); + assert (42 = int_of_sv (av_pop av)); + av_extend av 3; + av_set av 0 (sv_of_int 11); + av_set av 1 (sv_of_int 22); + av_set av 2 (sv_of_int 33); + av_set av 3 (sv_of_int 44); + assert (4 = av_length av); + assert (33 = int_of_sv (av_get av 2)); + assert (22 = int_of_sv (av_get av 1)); + assert (44 = int_of_sv (av_pop av)); + assert (3 = av_length av); + assert (33 = int_of_sv (av_pop av)); + assert (11 = int_of_sv (av_shift av)); + assert (22 = int_of_sv (av_pop av)); + assert ([] = list_of_av av); + + ignore (eval "@a = ( 'foo', 'bar' )"); + let av = get_av "a" in + assert ("foo" = string_of_sv (av_get av 0)); + assert ("bar" = string_of_sv (av_get av 1)); +;; + +Gc.full_major () diff --git a/test/120-hv.ml b/test/120-hv.ml new file mode 100644 index 0000000..9b8ea1e --- /dev/null +++ b/test/120-hv.ml @@ -0,0 +1,27 @@ +(* Thoroughly test HV-related functions. + * $Id: 120-hv.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +let () = + let hv = hv_empty () in + hv_set hv "foo" (sv_of_int 1); + hv_set hv "bar" (sv_of_int 2); + hv_set hv "foo" (sv_of_int 42); + assert (42 = int_of_sv (hv_get hv "foo")); + assert (2 = int_of_sv (hv_get hv "bar")); + assert (hv_exists hv "foo"); + assert (not (hv_exists hv "baz")); + hv_clear hv; + assert (not (hv_exists hv "foo")); + assert (not (hv_exists hv "bar")); + + ignore (eval "%h = ( foo => 1, bar => 2 )"); + let hv = get_hv "h" in + assert (1 = int_of_sv (hv_get hv "foo")); + assert (2 = int_of_sv (hv_get hv "bar")); + assert (not (hv_exists hv "baz")); + +;; +Gc.full_major () diff --git a/test/140-ref.ml b/test/140-ref.ml new file mode 100644 index 0000000..bf6dd91 --- /dev/null +++ b/test/140-ref.ml @@ -0,0 +1,30 @@ +(* Reference, dereference. + * $Id: 140-ref.ml,v 1.1 2005-01-28 23:09:33 rich Exp $ + *) + +open Perl + +let () = + let sv = sv_of_int 42 in + let sv = scalarref sv in + assert (sv_type sv = SVt_RV); + let sv = deref sv in + assert (42 = int_of_sv sv); + + let av = av_of_string_list [ "foo"; "bar" ] in + let sv = arrayref av in + assert (sv_type sv = SVt_RV); + let av = deref_array sv in + assert (2 = av_length av); + + let hv = hv_empty () in + hv_set hv "foo" (sv_of_int 1); + hv_set hv "bar" (sv_of_int 2); + let sv = hashref hv in + assert (sv_type sv = SVt_RV); + let hv = deref_hash sv in + assert (1 = int_of_sv (hv_get hv "foo")); + assert (2 = int_of_sv (hv_get hv "bar")); +;; + +Gc.full_major () -- 1.8.3.1