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.
# 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
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 $@
# 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.
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
# 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. <EXTERN.h>.
# 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
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
(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
*.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
(* 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
| 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"
*
* 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
| 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
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].
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. *)
/* 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 <stdio.h>
}
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);
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);
}
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);
}
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);
}
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));
}
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));
}
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));
}
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));
}
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));
}
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));
}
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));
}
static void
xv_finalize (value v)
{
+ /*fprintf (stderr, "about to decrement %p\n", Xv_val (v));*/
SvREFCNT_dec ((SV *) Xv_val (v));
}
--- /dev/null
+*.bc
+*.opt
+*.cmi
+*.cmo
+*.cmx
--- /dev/null
+(* Does nothing - just check the test harness is working.
+ * $Id: 001-start.ml,v 1.1 2005-01-28 23:09:33 rich Exp $
+ *)
--- /dev/null
+(* 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 ()
--- /dev/null
+(* 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 ()
--- /dev/null
+(* 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 ()
--- /dev/null
+(* 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 ()
--- /dev/null
+(* 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 ()
--- /dev/null
+(* 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 ()
--- /dev/null
+(* 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 ()
--- /dev/null
+(* 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 ()
git.annexia.org / perl4caml.git / commitdiff