r32755 - in /branches/upstream/libjavascript-perl/current: ./ lib/ lib/JavaScript/ t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Wed Apr 8 08:52:31 UTC 2009
Author: eloy
Date: Wed Apr 8 08:52:21 2009
New Revision: 32755
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=32755
Log:
[svn-upgrade] Integrating new upstream version, libjavascript-perl (1.12)
Added:
branches/upstream/libjavascript-perl/current/JavaScript_Env.h
branches/upstream/libjavascript-perl/current/PJS_PerlSub.c
branches/upstream/libjavascript-perl/current/PJS_PerlSub.h
branches/upstream/libjavascript-perl/current/t/35-regexp.t
Modified:
branches/upstream/libjavascript-perl/current/Changes
branches/upstream/libjavascript-perl/current/JavaScript.h
branches/upstream/libjavascript-perl/current/JavaScript.xs
branches/upstream/libjavascript-perl/current/MANIFEST
branches/upstream/libjavascript-perl/current/META.yml
branches/upstream/libjavascript-perl/current/Makefile.PL
branches/upstream/libjavascript-perl/current/PJS_Call.c
branches/upstream/libjavascript-perl/current/PJS_Context.c
branches/upstream/libjavascript-perl/current/PJS_Runtime.c
branches/upstream/libjavascript-perl/current/PJS_TypeConversion.c
branches/upstream/libjavascript-perl/current/PJS_Types.h
branches/upstream/libjavascript-perl/current/lib/JavaScript.pm
branches/upstream/libjavascript-perl/current/lib/JavaScript/Boxed.pm
branches/upstream/libjavascript-perl/current/lib/JavaScript/Context.pm
branches/upstream/libjavascript-perl/current/lib/JavaScript/Error.pm
branches/upstream/libjavascript-perl/current/t/02-types-from-perl.t
branches/upstream/libjavascript-perl/current/t/10-round-trip.t
branches/upstream/libjavascript-perl/current/t/12-destroy.t
branches/upstream/libjavascript-perl/current/t/13-in-context.t
branches/upstream/libjavascript-perl/current/t/15-function.t
branches/upstream/libjavascript-perl/current/typemap
Modified: branches/upstream/libjavascript-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/Changes?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/Changes (original)
+++ branches/upstream/libjavascript-perl/current/Changes Wed Apr 8 08:52:21 2009
@@ -1,5 +1,16 @@
Revision history for Perl extension JavaScript.
+1.12 2009-04-04
+ - Guard against stack corruption (Salvador Ortiz Garcia)
+ - 64-bit build issues (Salvador Ortiz Garcia)
+ - Updated Makefile.PL to use new META_* instead of EXTRA_META for repo.
+ - Update UTF8 stuff to work with SM 1.8 (James Duncan)
+ - Added a native PerlSub type that encapsulates Perl subs.
+ - Converts SM regexps to Perl regexps (James Duncan)
+ - Added 'apply' method to bound Perl subs (James Duncan)
+ - JavaScript::Context is now a PJS_Context * (T_PTROBJ) and not a hash
+ - JavaScript::Error now has a stacktrace method that returns the JS stacktrace.
+
1.11 2008-08-23
- Added get_options, has_options and toggle_options so one can enable stuff like strict mode and JIT compilation
if the underlying SpiderMonkey supports it (TraceMonkey ftw!).
Modified: branches/upstream/libjavascript-perl/current/JavaScript.h
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/JavaScript.h?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/JavaScript.h (original)
+++ branches/upstream/libjavascript-perl/current/JavaScript.h Wed Apr 8 08:52:21 2009
@@ -30,6 +30,7 @@
#include "PJS_Common.h"
#include "PJS_PerlArray.h"
#include "PJS_PerlHash.h"
+#include "PJS_PerlSub.h"
#ifdef __cplusplus
}
Modified: branches/upstream/libjavascript-perl/current/JavaScript.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/JavaScript.xs?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/JavaScript.xs (original)
+++ branches/upstream/libjavascript-perl/current/JavaScript.xs Wed Apr 8 08:52:21 2009
@@ -10,8 +10,10 @@
typedef PJS_PerlArray * JavaScript__PerlArray;
typedef PJS_PerlHash * JavaScript__PerlHash;
+typedef PJS_PerlSub * Javascript__PerlSub;
typedef PJS_Class * JavaScript__PerlClass;
typedef PJS_Function * JavaScript__PerlFunction;
+typedef PJS_Context * JavaScript__Context;
MODULE = JavaScript PACKAGE = JavaScript
PROTOTYPES: DISABLE
@@ -111,7 +113,7 @@
MODULE = JavaScript PACKAGE = JavaScript::Context
-PJS_Context *
+JavaScript::Context
jsc_create(rt)
PJS_Runtime *rt;
CODE:
@@ -119,9 +121,17 @@
OUTPUT:
RETVAL
+IV
+jsc_ptr(cx)
+ JavaScript::Context cx;
+ CODE:
+ RETVAL = (IV) cx;
+ OUTPUT:
+ RETVAL
+
int
jsc_destroy(cx)
- PJS_Context *cx;
+ JavaScript::Context cx;
CODE:
PJS_DestroyContext(cx);
RETVAL = 0;
@@ -130,7 +140,7 @@
const char *
jsc_get_version(cx)
- PJS_Context *cx;
+ JavaScript::Context cx;
CODE:
RETVAL = JS_VersionToString(JS_GetVersion(PJS_GetJSContext(cx)));
OUTPUT:
@@ -138,14 +148,14 @@
void
jsc_set_version(cx, version)
- PJS_Context *cx;
+ JavaScript::Context cx;
const char *version;
CODE:
JS_SetVersion(PJS_GetJSContext(cx), JS_StringToVersion(version));
void
jsc_set_branch_handler(cx, handler)
- PJS_Context *cx;
+ JavaScript::Context cx;
SV *handler;
CODE:
if (!SvOK(handler)) {
@@ -168,7 +178,7 @@
void
jsc_bind_function(cx, name, callback)
- PJS_Context *cx;
+ JavaScript::Context cx;
char *name;
SV *callback;
CODE:
@@ -176,7 +186,7 @@
void
jsc_bind_class(cx, name, pkg, cons, fs, static_fs, ps, static_ps, flags)
- PJS_Context *cx;
+ JavaScript::Context cx;
char *name;
char *pkg;
SV *cons;
@@ -190,10 +200,10 @@
int
jsc_bind_value(cx, parent, name, object)
- PJS_Context *cx;
- char *parent;
- char *name;
- SV *object;
+ JavaScript::Context cx;
+ char *parent;
+ char *name;
+ SV *object;
PREINIT:
jsval val, pval;
JSObject *gobj, *pobj;
@@ -221,9 +231,9 @@
void
jsc_unbind_value(cx, parent, name)
- PJS_Context *cx;
- char *parent;
- char *name;
+ JavaScript::Context cx;
+ char *parent;
+ char *name;
PREINIT:
jsval val, pval;
JSObject *gobj, *pobj;
@@ -249,7 +259,7 @@
jsval
jsc_eval(cx, source, name)
- PJS_Context *cx;
+ JavaScript::Context cx;
char *source;
char *name;
PREINIT:
@@ -293,7 +303,7 @@
void
jsc_free_root(cx, root)
- PJS_Context *cx;
+ JavaScript::Context cx;
SV *root;
PREINIT:
jsval *x;
@@ -303,7 +313,7 @@
jsval
jsc_call(cx, function, args)
- PJS_Context *cx;
+ JavaScript::Context cx;
SV *function;
SV *args;
PREINIT:
@@ -350,7 +360,7 @@
SV *
jsc_call_in_context( cx, afunc, args, rcx, class )
- PJS_Context *cx;
+ JavaScript::Context cx;
SV *afunc
SV *args;
SV *rcx;
@@ -406,7 +416,7 @@
int
jsc_can(cx, func_name)
- PJS_Context *cx;
+ JavaScript::Context cx;
char *func_name;
PREINIT:
jsval val;
@@ -428,7 +438,7 @@
U32
jsc_get_options(cx)
- PJS_Context *cx;
+ JavaScript::Context cx;
CODE:
RETVAL = JS_GetOptions(cx->cx);
OUTPUT:
@@ -436,7 +446,7 @@
void
jsc_toggle_options(cx, options)
- PJS_Context *cx;
+ JavaScript::Context cx;
U32 options;
CODE:
JS_ToggleOptions(cx->cx, options);
@@ -460,7 +470,7 @@
PJS_Script *
jss_compile(cx, source)
- PJS_Context *cx;
+ JavaScript::Context cx;
char *source;
PREINIT:
PJS_Script *psc;
Added: branches/upstream/libjavascript-perl/current/JavaScript_Env.h
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/JavaScript_Env.h?rev=32755&op=file
==============================================================================
--- branches/upstream/libjavascript-perl/current/JavaScript_Env.h (added)
+++ branches/upstream/libjavascript-perl/current/JavaScript_Env.h Wed Apr 8 08:52:21 2009
@@ -1,0 +1,16 @@
+/* This file is autogenerated to suite your platform */
+
+#ifndef __JAVASCRIPT_ENV_H__
+#define __JAVASCRIPT_ENV_H__
+
+#define XP_UNIX
+
+#include <jsapi.h>
+#include <jsdbgapi.h>
+#include <jsinterp.h>
+#include <jsfun.h>
+#include <jsobj.h>
+#include <jsprf.h>
+#include <jsscope.h>
+
+#endif
Modified: branches/upstream/libjavascript-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/MANIFEST?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/MANIFEST (original)
+++ branches/upstream/libjavascript-perl/current/MANIFEST Wed Apr 8 08:52:21 2009
@@ -1,10 +1,32 @@
+Changes
CREDITS
-Changes
+dev_tests/bad_eval.pl
+dev_tests/bind_value.pl
+dev_tests/contexts.pl
+dev_tests/cx_leaktest.pl
+dev_tests/function_return.pl
+dev_tests/leaktest.pl
+dev_tests/memory_consumption.pl
+dev_tests/PerlArray.pl
+dev_tests/refs.pl
+dev_tests/returns.pl
+dev_tests/roundtrip.pl
JavaScript.h
JavaScript.xs
+JavaScript_Env.h
+lib/JavaScript.pm
+lib/JavaScript/Boxed.pm
+lib/JavaScript/Context.pm
+lib/JavaScript/Error.pm
+lib/JavaScript/Function.pm
+lib/JavaScript/PerlArray.pm
+lib/JavaScript/PerlHash.pm
+lib/JavaScript/Runtime.pm
+lib/JavaScript/Script.pm
+lib/Test/JavaScript/More.pm
+Makefile.PL
MANIFEST
META.yml
-Makefile.PL
PJS_Call.c
PJS_Call.h
PJS_Class.c
@@ -20,6 +42,8 @@
PJS_PerlArray.h
PJS_PerlHash.c
PJS_PerlHash.h
+PJS_PerlSub.c
+PJS_PerlSub.h
PJS_Property.c
PJS_Property.h
PJS_Runtime.c
@@ -29,28 +53,6 @@
PJS_TypeConversion.h
PJS_Types.h
README
-TODO
-dev_tests/PerlArray.pl
-dev_tests/bad_eval.pl
-dev_tests/bind_value.pl
-dev_tests/contexts.pl
-dev_tests/cx_leaktest.pl
-dev_tests/function_return.pl
-dev_tests/leaktest.pl
-dev_tests/memory_consumption.pl
-dev_tests/refs.pl
-dev_tests/returns.pl
-dev_tests/roundtrip.pl
-lib/JavaScript.pm
-lib/JavaScript/Boxed.pm
-lib/JavaScript/Context.pm
-lib/JavaScript/Error.pm
-lib/JavaScript/Function.pm
-lib/JavaScript/PerlArray.pm
-lib/JavaScript/PerlHash.pm
-lib/JavaScript/Runtime.pm
-lib/JavaScript/Script.pm
-lib/Test/JavaScript/More.pm
t/00-init.t
t/01-types-from-js.t
t/02-types-from-perl.t
@@ -85,8 +87,10 @@
t/32-perlarray.t
t/33-perlhash.t
t/34-options.t
+t/35-regexp.t
t/99-bottles-of-beer.t
t/lib/DummyClass.pm
t/pod-coverage.t
t/pod.t
+TODO
typemap
Modified: branches/upstream/libjavascript-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/META.yml?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/META.yml (original)
+++ branches/upstream/libjavascript-perl/current/META.yml Wed Apr 8 08:52:21 2009
@@ -1,18 +1,25 @@
--- #YAML:1.0
-name: JavaScript
-version: 1.11
-abstract: Perl extension for executing embedded JavaScript
-license: perl
-author:
+name: JavaScript
+version: 1.12
+abstract: Perl extension for executing embedded JavaScript
+author:
- Claes Jakobsson <claesjac at cpan.org>
-generated_by: ExtUtils::MakeMaker version 6.44
-distribution_type: module
-requires:
- Test::Exception: 0
- Test::More: 0
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Test::Exception: 0
+ Test::More: 0
+resources:
+ repository: svn://svn.versed.se/public/Perl/modules/JavaScript
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.50
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
-
-resources:
- repository: svn://svn.versed.se/public/Perl/modules/JavaScript
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libjavascript-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/Makefile.PL?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/Makefile.PL (original)
+++ branches/upstream/libjavascript-perl/current/Makefile.PL Wed Apr 8 08:52:21 2009
@@ -214,10 +214,11 @@
INC => join(" ", map { "-I$_" } @incs),
LICENSE => "perl",
OBJECT => q/$(O_FILES)/,
- EXTRA_META => q{
-resources:
- repository: svn://svn.versed.se/public/Perl/modules/JavaScript
-},
+ META_MERGE => {
+ resources => {
+ repository => "svn://svn.versed.se/public/Perl/modules/JavaScript"
+ }
+ },
);
sub get_paths {
Modified: branches/upstream/libjavascript-perl/current/PJS_Call.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/PJS_Call.c?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/PJS_Call.c (original)
+++ branches/upstream/libjavascript-perl/current/PJS_Call.c Wed Apr 8 08:52:21 2009
@@ -53,7 +53,13 @@
for (arg = 0; arg < argc; arg++) {
SV *sv = sv_newmortal();
+
+ PUTBACK ; /* Make perl take note of our local SP*/
+
JSVALToSV(cx, NULL, argv[arg], &sv);
+
+ SPAGAIN ; /* Just to be safe */
+
XPUSHs(sv);
}
Modified: branches/upstream/libjavascript-perl/current/PJS_Context.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/PJS_Context.c?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/PJS_Context.c (original)
+++ branches/upstream/libjavascript-perl/current/PJS_Context.c Wed Apr 8 08:52:21 2009
@@ -12,6 +12,7 @@
#include "PJS_Class.h"
#include "PJS_PerlArray.h"
#include "PJS_PerlHash.h"
+#include "PJS_PerlSub.h"
/* Global class, does nothing */
static JSClass global_class = {
@@ -95,9 +96,7 @@
croak("Failed to create JSContext");
}
-#ifdef JSOPTION_DONT_REPORT_UNCAUGHT
JS_SetOptions(pcx->cx, JSOPTION_DONT_REPORT_UNCAUGHT);
-#endif
obj = JS_NewObject(pcx->cx, &global_class, NULL, NULL);
if (JS_InitStandardClasses(pcx->cx, obj) == JS_FALSE) {
@@ -117,6 +116,11 @@
if (PJS_InitPerlHashClass(pcx, obj) == JS_FALSE) {
PJS_DestroyContext(pcx);
croak("Perl classes not loaded properly.");
+ }
+
+ if (PJS_InitPerlSubClass(pcx, obj) == JS_FALSE) {
+ PJS_DestroyContext(pcx);
+ croak("Perl class 'PerlSub' not loaded properly.");
}
pcx->rt = rt;
@@ -136,13 +140,27 @@
if (pcx == NULL) {
return;
}
-
- hv_clear(pcx->function_by_name);
- hv_clear(pcx->class_by_name);
- hv_clear(pcx->class_by_package);
-
+
+ if (pcx->function_by_name) {
+ hv_undef(pcx->function_by_name);
+ pcx->function_by_name = NULL;
+ }
+
+ if (pcx->class_by_name) {
+ hv_undef(pcx->class_by_name);
+ pcx->class_by_name = NULL;
+ }
+
+ if (pcx->class_by_package) {
+ hv_undef(pcx->class_by_package);
+ pcx->class_by_package = NULL;
+ }
+
/* Destory context */
- JS_DestroyContext(pcx->cx);
+ if (pcx->cx) {
+ JS_DestroyContext(pcx->cx);
+ pcx->cx = NULL;
+ }
Safefree(pcx);
}
Added: branches/upstream/libjavascript-perl/current/PJS_PerlSub.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/PJS_PerlSub.c?rev=32755&op=file
==============================================================================
--- branches/upstream/libjavascript-perl/current/PJS_PerlSub.c (added)
+++ branches/upstream/libjavascript-perl/current/PJS_PerlSub.c Wed Apr 8 08:52:21 2009
@@ -1,0 +1,142 @@
+#include "XSUB.h"
+
+#include "JavaScript_Env.h"
+
+#include "PJS_Context.h"
+#include "PJS_Class.h"
+#include "PJS_PerlSub.h"
+
+static PJS_PerlSub * PJS_NewPerlSub();
+static void perlsub_finalize(JSContext *cx, JSObject *obj);
+static JSBool perlsub_call(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval);
+static JSBool perlsub_apply(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval);
+
+static const char *PerlSubPkg = "JavaScript::PerlSub";
+
+static JSClass perlsub_class = {
+ "PerlSub", JSCLASS_HAS_PRIVATE,
+ JS_PropertyStub, JS_PropertyStub,
+ JS_PropertyStub, JS_PropertyStub,
+ JS_EnumerateStub, JS_ResolveStub,
+ JS_ConvertStub, perlsub_finalize,
+ NULL,
+ NULL,
+ perlsub_call,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+};
+
+static JSPropertySpec perlsub_props[] = {
+ {0, 0, 0, 0, 0}
+};
+
+static JSFunctionSpec perlsub_methods[] = {
+ {"apply", perlsub_apply, 2, 0, 0},
+ {0, 0, 0, 0 ,0}
+};
+
+PJS_PerlSub * PJS_NewPerlSub() {
+ dTHX;
+ PJS_PerlSub *obj;
+
+ Newz(1, obj, 1, PJS_PerlSub);
+ obj->cv = NULL;
+
+ return obj;
+}
+
+JSObject * PJS_NewPerlSubObject(JSContext *cx, JSObject *parent, SV *ref) {
+ dTHX;
+ JSObject *obj = JS_NewObject(cx, &perlsub_class, NULL, parent);
+ PJS_PerlSub *sub = PJS_NewPerlSub();
+ sub->cv = SvREFCNT_inc(ref);
+ SV *sv = newSV(0);
+ sv_setref_pv(sv, "JavaScript::PerlSub", (void*) sub);
+ JS_SetPrivate(cx, obj, (void *) sv);
+
+ return obj;
+
+}
+
+JSObject *PJS_InitPerlSubClass(PJS_Context *pcx, JSObject *global) {
+ dTHX;
+ PJS_Class *cls;
+
+ Newz(1, cls, 1, PJS_Class);
+
+ cls->pkg = savepv(PerlSubPkg);
+ cls->clasp = &perlsub_class;
+
+ cls->proto = JS_InitClass(
+ pcx->cx, global, NULL, &perlsub_class, NULL, 0,
+ perlsub_props, perlsub_methods,
+ NULL, NULL
+ );
+
+ PJS_store_class(pcx, cls);
+
+ return cls->proto;
+}
+
+static void perlsub_finalize(JSContext *cx, JSObject *obj) {
+ dTHX;
+ SV *self = (SV *) JS_GetPrivate(cx, obj);
+ if (self) {
+ IV tmp = SvIV((SV *) SvRV((SV *) self));
+ PJS_PerlSub *sub = INT2PTR(PJS_PerlSub *, tmp);
+ SvREFCNT_dec(sub->cv);
+ SvREFCNT_dec(self);
+ }
+}
+
+static JSBool perlsub_apply(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
+ dTHX;
+
+ jsuint jsarrlen;
+ jsuint index;
+ jsval *arg_list;
+ jsval elem;
+
+ JSObject *object = JSVAL_TO_OBJECT(argv[1]);
+
+ /* flatten the array, as perl wants $this, arg1, arg2, arg3, etc... */
+ JS_GetArrayLength(cx, object, &jsarrlen);
+ Newz(1, arg_list, jsarrlen + 1, jsval);
+ arg_list[0] = argv[0];
+ for ( index = 0; index < jsarrlen; index++ ) {
+ JS_GetElement(cx, object, index, &elem);
+ arg_list[index+1] = elem;
+ }
+
+ SV *fn = (SV *) JS_GetPrivate(cx, (JSObject *) obj);
+ if (fn != NULL) {
+ IV tmp = SvIV((SV *) SvRV((SV *) fn));
+ PJS_PerlSub *sub = INT2PTR(PJS_PerlSub *, tmp);
+ if (perl_call_sv_with_jsvals(cx, obj, sub->cv, NULL, jsarrlen+1, arg_list, rval) < 0) {
+ return JS_FALSE;
+ }
+
+ return JS_TRUE;
+ }
+
+ return JS_FALSE;
+}
+
+static JSBool perlsub_call(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
+ dTHX;
+ SV *self = (SV *) JS_GetPrivate(cx, (JSObject *) argv[-2]);
+ if (self != NULL) {
+ IV tmp = SvIV((SV *) SvRV((SV *) self));
+ PJS_PerlSub *sub = INT2PTR(PJS_PerlSub *, tmp);
+ if (perl_call_sv_with_jsvals(cx, obj, sub->cv, NULL, argc, argv, rval) < 0) {
+ return JS_FALSE;
+ }
+
+ return JS_TRUE;
+ }
+
+ return JS_FALSE;
+}
Added: branches/upstream/libjavascript-perl/current/PJS_PerlSub.h
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/PJS_PerlSub.h?rev=32755&op=file
==============================================================================
--- branches/upstream/libjavascript-perl/current/PJS_PerlSub.h (added)
+++ branches/upstream/libjavascript-perl/current/PJS_PerlSub.h Wed Apr 8 08:52:21 2009
@@ -1,0 +1,40 @@
+/*!
+ @header PJS_PerlSub.h
+ @abstract Types and functions related the JS native class PerlSub
+*/
+
+#ifndef __PJS_PERLSUB_H__
+#define __PJS_PERLSUB_H__
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#include "JavaScript_Env.h"
+
+#include "PJS_Types.h"
+#include "PJS_Common.h"
+
+struct PJS_PerlSub {
+ SV *cv;
+};
+
+PJS_EXTERN JSObject *
+PJS_NewPerlSubObject(JSContext *cx, JSObject *parent, SV *ref);
+
+/*! @function PJS_InitPerlSubClass
+ @abstract Initiailizes the Perl sub class
+ @param pcx The context to init the class in
+ @param global The global object for the context
+*/
+PJS_EXTERN JSObject *
+PJS_InitPerlSubClass(PJS_Context *pcx, JSObject *global);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
Modified: branches/upstream/libjavascript-perl/current/PJS_Runtime.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/PJS_Runtime.c?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/PJS_Runtime.c (original)
+++ branches/upstream/libjavascript-perl/current/PJS_Runtime.c Wed Apr 8 08:52:21 2009
@@ -21,7 +21,7 @@
SV *scx, *rv;
int rc;
JSTrapStatus status = JSTRAP_CONTINUE;
-
+
if (handler) {
ENTER ;
SAVETMPS ;
@@ -67,13 +67,17 @@
if(runtime == NULL) {
croak("Failed to allocate memoery for PJS_Runtime");
}
-
+
+#ifdef JS_C_STRINGS_ARE_UTF8 && JS_VERSION >= 180
+ JS_SetCStringsAreUTF8();
+#endif
+
runtime->rt = JS_NewRuntime(maxbytes);
if(runtime->rt == NULL) {
Safefree(runtime);
croak("Failed to create runtime");
}
-
+
return runtime;
}
Modified: branches/upstream/libjavascript-perl/current/PJS_TypeConversion.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/PJS_TypeConversion.c?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/PJS_TypeConversion.c (original)
+++ branches/upstream/libjavascript-perl/current/PJS_TypeConversion.c Wed Apr 8 08:52:21 2009
@@ -225,16 +225,7 @@
warn("returning references to primitive types is not supported yet");
}
else if(type == SVt_PVCV) {
- JSObject *newobj;
- JSFunction *jsfun;
- SvREFCNT_inc(ref);
-
- jsfun = JS_NewFunction(cx, perl_call_jsfunc, 0, 0, NULL, NULL);
- newobj = JS_GetFunctionObject(jsfun);
- /* put the cv as a property on the function object */
- if (JS_DefineProperty(cx, newobj, "_perl_func", PRIVATE_TO_JSVAL(ref), NULL, NULL, 0) == JS_FALSE) {
- warn("Failed to defined property for _perl_func");
- }
+ JSObject *newobj = PJS_NewPerlSubObject(cx, obj, ref);
*rval = OBJECT_TO_JSVAL(newobj);
}
else {
@@ -340,6 +331,29 @@
sv_2mortal(newSViv(PTR2IV(x))), NULL));
return JS_TRUE;
}
+ else if (!strcmp(JS_GET_CLASS(cx,object)->name, "RegExp")) {
+ jsval src;
+
+ if ( JS_GetProperty(cx, object, "source", &src) == JS_TRUE ) {
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ SV *arg = sv_newmortal();
+ sv_setpv(arg, JS_GetStringBytes(JS_ValueToString(cx, src)));
+ XPUSHs(arg);
+ PUTBACK;
+ call_pv("JavaScript::_compile_string_re", G_SCALAR);
+ SPAGAIN;
+ sv_setsv(*sv, POPs);
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return JS_TRUE;
+ }
+
+ return JS_FALSE;
+ }
else if (OBJ_IS_NATIVE(object) &&
(OBJ_GET_CLASS(cx, object)->flags & JSCLASS_HAS_PRIVATE) &&
(strcmp(OBJ_GET_CLASS(cx, object)->name, "Error") != 0)) {
Modified: branches/upstream/libjavascript-perl/current/PJS_Types.h
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/PJS_Types.h?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/PJS_Types.h (original)
+++ branches/upstream/libjavascript-perl/current/PJS_Types.h Wed Apr 8 08:52:21 2009
@@ -19,6 +19,7 @@
typedef struct PJS_Script PJS_Script;
typedef struct PJS_PerlArray PJS_PerlArray;
typedef struct PJS_PerlHash PJS_PerlHash;
+typedef struct PJS_PerlSub PJS_PerlSub;
#ifdef __cplusplus
}
Modified: branches/upstream/libjavascript-perl/current/lib/JavaScript.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/lib/JavaScript.pm?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/lib/JavaScript.pm (original)
+++ branches/upstream/libjavascript-perl/current/lib/JavaScript.pm Wed Apr 8 08:52:21 2009
@@ -23,7 +23,7 @@
our %EXPORT_TAGS = ( all => [@EXPORT_OK] );
-our $VERSION = "1.11";
+our $VERSION = "1.12";
our $MAXBYTES = 1024 ** 2;
@@ -75,6 +75,11 @@
sub create_runtime {
my $pkg = shift;
return JavaScript::Runtime->new(@_);
+}
+
+sub _compile_string_re {
+ my $s_re = shift;
+ return qr/$s_re/;
}
bootstrap JavaScript $VERSION;
Modified: branches/upstream/libjavascript-perl/current/lib/JavaScript/Boxed.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/lib/JavaScript/Boxed.pm?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/lib/JavaScript/Boxed.pm (original)
+++ branches/upstream/libjavascript-perl/current/lib/JavaScript/Boxed.pm Wed Apr 8 08:52:21 2009
@@ -35,7 +35,7 @@
my $cx = $self->context();
- JavaScript::Context::jsc_free_root( $self->context->{_impl}, $self->jsvalue);
+ JavaScript::Context::jsc_free_root( $self->context, $self->jsvalue);
}
1;
Modified: branches/upstream/libjavascript-perl/current/lib/JavaScript/Context.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/lib/JavaScript/Context.pm?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/lib/JavaScript/Context.pm (original)
+++ branches/upstream/libjavascript-perl/current/lib/JavaScript/Context.pm Wed Apr 8 08:52:21 2009
@@ -4,24 +4,23 @@
use warnings;
use Carp qw(croak);
-use Scalar::Util qw(weaken);
+use Scalar::Util qw(weaken refaddr);
use JavaScript;
my %Context;
+my %Runtime;
sub new {
my ($pkg, $runtime) = @_;
- $pkg = ref $pkg || $pkg;
-
- my $cx_ptr = jsc_create($runtime->{_impl});
-
- my $self = bless { _impl => $cx_ptr }, $pkg;
-
- $Context{$$cx_ptr} = $self;
- weaken($Context{$$cx_ptr});
- $self->{runtime} = $runtime;
+ my $self = jsc_create($runtime->{_impl});
+
+ my $ptr = $self->jsc_ptr;
+
+ $Context{$ptr} = $self;
+ weaken($Context{$ptr});
+ $Runtime{$ptr} = $runtime;
return $self;
}
@@ -33,7 +32,7 @@
my @caller = caller();
$name ||= "$caller[0] line $caller[2]";
- my $rval = jsc_eval($self->{_impl}, $source, $name);
+ my $rval = jsc_eval($self, $source, $name);
return $rval;
}
@@ -47,7 +46,7 @@
my $source = <$in>;
close($in);
- my $rval = jsc_eval($self->{_impl}, $source, $file);
+ my $rval = jsc_eval($self, $source, $file);
return $rval;
}
@@ -55,13 +54,13 @@
sub find {
my ($self, $context) = @_;
- $context = $$context if ref $context eq 'SCALAR';
-
- if (!exists $Context{$context}) {
+ my $ptr = ref $context ? $context->ptr : $context;
+
+ if (!exists $Context{$ptr}) {
croak "Can't find context $context";
}
- return $Context{$context};
+ return $Context{$ptr};
}
sub call {
@@ -69,13 +68,13 @@
my $function = shift;
my $args = [@_];
- return jsc_call($self->{_impl}, $function, $args);
+ return jsc_call($self, $function, $args);
}
sub can {
my ($self, $method) = @_;
- return jsc_can($self->{_impl}, $method);
+ return jsc_can($self, $method);
}
# Functions for binding perl stuff into JS namespace
@@ -247,7 +246,7 @@
# Flags
my $flags = $args{flags};
- jsc_bind_class($self->{_impl}, $name, $pkg, $cons, $fs, $static_fs, $ps, $static_ps, $flags);
+ jsc_bind_class($self, $name, $pkg, $cons, $fs, $static_fs, $ps, $static_ps, $flags);
return;
}
@@ -276,7 +275,7 @@
next;
}
- jsc_bind_value($self->{_impl}, $parent,
+ jsc_bind_value($self, $parent,
$paths[$num], $num == $#paths ? $object : {});
}
@@ -289,7 +288,7 @@
my @paths = split /\./, $name;
$name = pop @paths;
my $parent = join(".", @paths);
- jsc_unbind_value($self->{_impl}, $parent, $name);
+ jsc_unbind_value($self, $parent, $name);
}
sub set_branch_handler {
@@ -297,25 +296,25 @@
$handler = _resolve_method($handler, 1);
- jsc_set_branch_handler($self->{_impl}, $handler);
+ jsc_set_branch_handler($self, $handler);
}
sub compile {
my $self = shift;
my $source = shift;
- my $script = JavaScript::Script->new($self->{_impl}, $source);
+ my $script = JavaScript::Script->new($self, $source);
return $script;
}
sub get_version {
my ($self, $version) = @_;
- return jsc_get_version($self->{_impl});
+ return jsc_get_version($self);
}
sub set_version {
my ($self, $version) = @_;
- jsc_set_version($self->{_impl}, $version);
+ jsc_set_version($self, $version);
1;
}
@@ -329,7 +328,7 @@
sub get_options {
my ($self) = @_;
- my $options = jsc_get_options($self->{_impl});
+ my $options = jsc_get_options($self);
return grep { $options & $options_by_tag{$_} } keys %options_by_tag;
}
@@ -351,7 +350,7 @@
$options |= 1 if exists $options_by_tag{lc $_};
}
- jsc_toggle_options($self->{_impl}, $options);
+ jsc_toggle_options($self, $options);
1;
}
@@ -359,11 +358,14 @@
sub _destroy {
my $self = shift;
- return unless $self->{'_impl'};
- delete $Context{${$self->{_impl}}};
- jsc_destroy($self->{'_impl'} );
- delete $self->{'_impl'};
- delete $self->{runtime};
+ return unless $self;
+ my $ptr = $self->jsc_ptr;
+ return unless exists $Context{$ptr};
+ delete $Context{$ptr};
+ jsc_destroy($self);
+
+ delete $Runtime{$ptr};
+
return 1;
}
@@ -667,6 +669,10 @@
Toggle the options on the underlying JSContext
+=item jsc_ptr ( PJS_Context *context )
+
+Return the address of the context for identification purposes.
+
=back
=end PRIVATE
Modified: branches/upstream/libjavascript-perl/current/lib/JavaScript/Error.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/lib/JavaScript/Error.pm?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/lib/JavaScript/Error.pm (original)
+++ branches/upstream/libjavascript-perl/current/lib/JavaScript/Error.pm Wed Apr 8 08:52:21 2009
@@ -20,6 +20,14 @@
sub line {
return $_[0]->{lineNumber};
+}
+
+sub stacktrace {
+ my $stack = $_[0]->{stack};
+ return () unless $stack;
+ return map {
+ /^(.*?)\@(.*?):(\d+)$/ && { function => $1, file => $2, lineno => $3 }
+ } split /\n/, $stack;
}
1;
@@ -51,6 +59,10 @@
A stringification of the exception in the format C<$message at $line in $file>
+=item stacktrace
+
+Returns the stacktrace for the exception as a list of hashrefs containing C<function>, C<file> and C<lineno>.
+
=back
=head1 OVERLOADED OPERATIONS
Modified: branches/upstream/libjavascript-perl/current/t/02-types-from-perl.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/t/02-types-from-perl.t?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/t/02-types-from-perl.t (original)
+++ branches/upstream/libjavascript-perl/current/t/02-types-from-perl.t Wed Apr 8 08:52:21 2009
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 19;
+use Test::More tests => 20;
use strict;
use warnings;
@@ -96,6 +96,9 @@
ok(i == 2, "Complex ok");
}
+function test_function(v1) {
+ v1();
+}
END_OF_CODE
$cx1->call(test_undefined => undef);
@@ -106,3 +109,4 @@
$cx1->call(test_array => [], [1, 2, 3]);
$cx1->call(test_hash => {}, { a => 1, b => 2 });
$cx1->call(test_complex => { a => [1, 2, 3], b => { c => 1 } });
+$cx1->call(test_function => sub { ok(1); });
Modified: branches/upstream/libjavascript-perl/current/t/10-round-trip.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/t/10-round-trip.t?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/t/10-round-trip.t (original)
+++ branches/upstream/libjavascript-perl/current/t/10-round-trip.t Wed Apr 8 08:52:21 2009
@@ -58,6 +58,7 @@
my $foo = Foo->new();
$foo->{std} = 10;
+$cx1->bind_function(println => sub { print STDERR @_, "\n"; });
$cx1->bind_function( name => 'debug',
func => sub { warn Dumper(@_) } );
$cx1->bind_function( name => 'isa_ok',
@@ -105,6 +106,7 @@
try {
throw_foo();
} catch (e) {
+ println("Here");
isa_ok( e, "Foo" ); // this test passes, but if run, breaks the next test
is( e.std, 5, "std is correct" );
is( e.wrapped_value, 4, "wrapped is correct" );
Modified: branches/upstream/libjavascript-perl/current/t/12-destroy.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/t/12-destroy.t?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/t/12-destroy.t (original)
+++ branches/upstream/libjavascript-perl/current/t/12-destroy.t Wed Apr 8 08:52:21 2009
@@ -19,4 +19,5 @@
ok( my $rt1 = JavaScript::Runtime->new(), "created new runtime" );
ok( my $cx1 = $rt1->create_context(), "created context" );
}
+
ok( 1, "left scope, hopefully they're gone.");
Modified: branches/upstream/libjavascript-perl/current/t/13-in-context.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/t/13-in-context.t?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/t/13-in-context.t (original)
+++ branches/upstream/libjavascript-perl/current/t/13-in-context.t Wed Apr 8 08:52:21 2009
@@ -20,7 +20,7 @@
my $obj = { message => 'okay called from inside context' };
my $result = JavaScript::Context::jsc_call_in_context(
- $cx1->{_impl},
+ $cx1,
$fn,
[],
{%{$obj}},
Modified: branches/upstream/libjavascript-perl/current/t/15-function.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/t/15-function.t?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/t/15-function.t (original)
+++ branches/upstream/libjavascript-perl/current/t/15-function.t Wed Apr 8 08:52:21 2009
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 7;
+use Test::More tests => 8;
use strict;
use warnings;
@@ -48,11 +48,19 @@
ok( my $rv = $cx1->eval( $code ), "eval'd code" );
is( $rv, "called test function from perl space okay", "roundtrip");
-SKIP: {
- eval "use List::Util";
- skip ("List::Util is not installed", 1) if $@;
- no warnings 'once';
- is ($cx1->call('perl_apply', sub { return List::Util::reduce { $a + $b } @_ },
- 1, 2, 3, 4),
- 10, 'invoke perlsub from javascript');
-}
+eval "use List::Util";
+skip ("List::Util is not installed", 1) if $@;
+no warnings 'once';
+is ($cx1->call('perl_apply', sub { my $self = shift; return List::Util::reduce { $a + $b } @_ },
+ 1, 2, 3, 4),
+ 10, 'invoke perlsub from javascript');
+
+$cx1->bind_function(
+ testapply => sub {
+ my $self = shift;
+ return $self
+ }
+ );
+
+my $result = $cx1->eval(q!testapply.apply({ test: 1 }, []);!);
+is_deeply( $result, { test => 1}, "test that apply _really_ does what it should");
Added: branches/upstream/libjavascript-perl/current/t/35-regexp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/t/35-regexp.t?rev=32755&op=file
==============================================================================
--- branches/upstream/libjavascript-perl/current/t/35-regexp.t (added)
+++ branches/upstream/libjavascript-perl/current/t/35-regexp.t Wed Apr 8 08:52:21 2009
@@ -1,0 +1,14 @@
+#!perl
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Test::More 'no_plan';
+
+use_ok('JavaScript');
+ok( my $rt = JavaScript::Runtime->new );
+ok( my $cx = $rt->create_context );
+
+ok( my $res = $cx->eval(q!/foo/!) );
+diag(Dumper( $res ));
+isa_ok($res, 'Regexp');
Modified: branches/upstream/libjavascript-perl/current/typemap
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjavascript-perl/current/typemap?rev=32755&op=diff
==============================================================================
--- branches/upstream/libjavascript-perl/current/typemap (original)
+++ branches/upstream/libjavascript-perl/current/typemap Wed Apr 8 08:52:21 2009
@@ -1,15 +1,16 @@
TYPEMAP
-PJS_Runtime * T_PTRREF
-PJS_Context * T_PTRREF
-PJS_Script * T_PTRREF
+JavaScript::Context T_PTROBJ
JavaScript::PerlArray T_PTROBJ
-JavaScript::PerlHash T_PTROBJ
JavaScript::PerlClass T_PTROBJ
JavaScript::PerlFunction T_PTROBJ
+JavaScript::PerlHash T_PTROBJ
+JavaScript::PerlSub T_PTROBJ
JSFunction * T_PTROBJ
+jsval jsval
+PJS_Runtime * T_PTRREF
+PJS_Script * T_PTRREF
PJS_TrapHandler * T_PTRREF
-jsval jsval
OUTPUT
More information about the Pkg-perl-cvs-commits
mailing list