r24218 - in /trunk/libjavascript-perl: ./ debian/ dev_tests/ lib/ lib/JavaScript/ t/

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Tue Aug 12 19:54:44 UTC 2008


Author: gregoa
Date: Tue Aug 12 19:54:41 2008
New Revision: 24218

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24218
Log:
New upstream release.

Added:
    trunk/libjavascript-perl/PJS_PerlArray.c
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/PJS_PerlArray.c
    trunk/libjavascript-perl/PJS_PerlArray.h
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/PJS_PerlArray.h
    trunk/libjavascript-perl/PJS_PerlHash.c
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/PJS_PerlHash.c
    trunk/libjavascript-perl/PJS_PerlHash.h
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/PJS_PerlHash.h
    trunk/libjavascript-perl/dev_tests/PerlArray.pl
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/dev_tests/PerlArray.pl
    trunk/libjavascript-perl/dev_tests/contexts.pl
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/dev_tests/contexts.pl
    trunk/libjavascript-perl/dev_tests/function_return.pl
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/dev_tests/function_return.pl
    trunk/libjavascript-perl/lib/JavaScript/PerlArray.pm
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/lib/JavaScript/PerlArray.pm
    trunk/libjavascript-perl/lib/JavaScript/PerlHash.pm
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/lib/JavaScript/PerlHash.pm
    trunk/libjavascript-perl/t/32-perlarray.t
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/t/32-perlarray.t
    trunk/libjavascript-perl/t/33-perlhash.t
      - copied unchanged from r24217, branches/upstream/libjavascript-perl/current/t/33-perlhash.t
Modified:
    trunk/libjavascript-perl/Changes
    trunk/libjavascript-perl/JavaScript.h
    trunk/libjavascript-perl/JavaScript.xs
    trunk/libjavascript-perl/MANIFEST
    trunk/libjavascript-perl/META.yml
    trunk/libjavascript-perl/Makefile.PL
    trunk/libjavascript-perl/PJS_Class.c
    trunk/libjavascript-perl/PJS_Class.h
    trunk/libjavascript-perl/PJS_Common.h
    trunk/libjavascript-perl/PJS_Context.c
    trunk/libjavascript-perl/PJS_Context.h
    trunk/libjavascript-perl/PJS_TypeConversion.c
    trunk/libjavascript-perl/PJS_Types.h
    trunk/libjavascript-perl/README
    trunk/libjavascript-perl/debian/changelog
    trunk/libjavascript-perl/lib/JavaScript.pm
    trunk/libjavascript-perl/lib/JavaScript/Context.pm
    trunk/libjavascript-perl/t/04-prototypes.t
    trunk/libjavascript-perl/t/05-deep-assign.t
    trunk/libjavascript-perl/t/06-bind-object.t
    trunk/libjavascript-perl/t/20-bind-class.t
    trunk/libjavascript-perl/t/23-unicode.t
    trunk/libjavascript-perl/t/30-refcount.t
    trunk/libjavascript-perl/typemap

Modified: trunk/libjavascript-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/Changes?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/Changes (original)
+++ trunk/libjavascript-perl/Changes Tue Aug 12 19:54:41 2008
@@ -1,5 +1,17 @@
 Revision history for Perl extension JavaScript.
 
+1.10  2008-08-11
+    - Warn user that JS_THREADSAFE is not what's recommended.
+    - Added a native PerlHash type that encapsulates a Perl hash reference in JavaScript.
+    - Added a native PerlArray type that encapsulates a Perl array reference in JavaScript.
+    - Changed the linked list that stores bound classes to a pair of HVs storing JavaScript::PerlClass objects instead
+      which are basically just PJS_Class* instances.
+    - Changed the linked list that stores bound functions to an HV storing JavaScript::PerlFunction objects instead
+      which are basically just PJS_Function* instances.
+    - Fixed a couple of problems that cause contexts no to be destroyed when supposed to
+    - Added resources section to META.yml with pointer to repository
+    - Improved the test suite a bit by naming tests
+    
 1.09  2008-08-03
     - It's now possible to set and get the version of JS our context is dealing with since in
       some cases such as using 'let' and 'yield' we actually have to specify that we want

Modified: trunk/libjavascript-perl/JavaScript.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/JavaScript.h?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/JavaScript.h (original)
+++ trunk/libjavascript-perl/JavaScript.h Tue Aug 12 19:54:41 2008
@@ -28,6 +28,8 @@
 #include "PJS_Script.h"
 #include "PJS_TypeConversion.h"
 #include "PJS_Common.h"
+#include "PJS_PerlArray.h"
+#include "PJS_PerlHash.h"
 
 #ifdef __cplusplus
 }

Modified: trunk/libjavascript-perl/JavaScript.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/JavaScript.xs?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/JavaScript.xs (original)
+++ trunk/libjavascript-perl/JavaScript.xs Tue Aug 12 19:54:41 2008
@@ -7,6 +7,11 @@
 #ifndef FUN_OBJECT(fun)
 #define FUN_OBJECT(fun) (jsval)(fun->object)
 #endif
+
+typedef PJS_PerlArray * JavaScript__PerlArray;
+typedef PJS_PerlHash *  JavaScript__PerlHash;
+typedef PJS_Class *     JavaScript__PerlClass;
+typedef PJS_Function *  JavaScript__PerlFunction;
 
 MODULE = JavaScript     PACKAGE = JavaScript
 PROTOTYPES: DISABLE
@@ -463,3 +468,82 @@
         RETVAL = psc;
     OUTPUT:
         RETVAL
+
+MODULE = JavaScript     PACKAGE = JavaScript::PerlArray
+
+JavaScript::PerlArray
+new(pkg)
+    const char *pkg;
+    PREINIT:
+        PJS_PerlArray *array;
+    CODE:
+        array = PJS_NewPerlArray();
+        RETVAL = array;
+    OUTPUT:
+        RETVAL
+
+AV *
+get_ref(obj)
+    JavaScript::PerlArray obj;
+    CODE:
+        RETVAL = obj->av;
+    OUTPUT:
+        RETVAL
+
+void
+DESTROY(obj)
+    JavaScript::PerlArray obj;
+    CODE:
+        if (obj->av != NULL) {
+            av_undef(obj->av);
+        }
+        obj->av = NULL;
+        Safefree(obj);
+
+MODULE = JavaScript     PACKAGE = JavaScript::PerlHash
+
+JavaScript::PerlHash
+new(pkg)
+    const char *pkg;
+    PREINIT:
+        PJS_PerlHash *hash;
+    CODE:
+        hash = PJS_NewPerlHash();
+        RETVAL = hash;
+    OUTPUT:
+        RETVAL
+
+HV *
+get_ref(obj)
+    JavaScript::PerlHash obj;
+    CODE:
+        RETVAL = obj->hv;
+    OUTPUT:
+        RETVAL
+
+void
+DESTROY(obj)
+    JavaScript::PerlHash obj;
+    CODE:
+        if (obj->hv != NULL) {
+            hv_undef(obj->hv);
+        }
+        obj->hv = NULL;
+        Safefree(obj);
+
+MODULE = JavaScript     PACKAGE = JavaScript::PerlClass
+
+void
+DESTROY(cls)
+    JavaScript::PerlClass cls;
+    CODE:
+        PJS_free_class(cls);
+
+
+MODULE = JavaScript     PACKAGE = JavaScript::PerlFunction
+
+void
+DESTROY(func)
+    JavaScript::PerlFunction func;
+    CODE:
+        PJS_DestroyFunction(func);

Modified: trunk/libjavascript-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/MANIFEST?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/MANIFEST (original)
+++ trunk/libjavascript-perl/MANIFEST Tue Aug 12 19:54:41 2008
@@ -16,6 +16,10 @@
 PJS_Exceptions.h
 PJS_Function.c
 PJS_Function.h
+PJS_PerlArray.c
+PJS_PerlArray.h
+PJS_PerlHash.c
+PJS_PerlHash.h
 PJS_Property.c
 PJS_Property.h
 PJS_Runtime.c
@@ -26,9 +30,12 @@
 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
@@ -39,6 +46,8 @@
 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
@@ -73,6 +82,8 @@
 t/29-exceptions.t
 t/30-refcount.t
 t/31-version.t
+t/32-perlarray.t
+t/33-perlhash.t
 t/99-bottles-of-beer.t
 t/lib/DummyClass.pm
 t/pod-coverage.t

Modified: trunk/libjavascript-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/META.yml?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/META.yml (original)
+++ trunk/libjavascript-perl/META.yml Tue Aug 12 19:54:41 2008
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                JavaScript
-version:             1.09
+version:             1.10
 abstract:            Perl extension for executing embedded JavaScript
 license:             perl
 author:              
@@ -13,3 +13,6 @@
 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

Modified: trunk/libjavascript-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/Makefile.PL?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/Makefile.PL (original)
+++ trunk/libjavascript-perl/Makefile.PL Tue Aug 12 19:54:41 2008
@@ -110,6 +110,14 @@
 else {
     my $enable_threadsafe = prompt("Is your SpiderMonkey compiled with JS_THREADSAFE (most things will fail if you answer wrong)? [y/N]");
     push @defines, "JS_THREADSAFE" if $enable_threadsafe eq "y";
+}
+
+if (grep /^JS_THREADSAFE$/, @defines) {
+   print "Whoa there! Attention! You have asked me to build a JavaScript.pm that links against a SpiderMonkey built with ";
+   print "JS_THREADSAFE defined. Although must things will proabaly work as expected some might not and I really ";
+   print "don't put much effort into supporting JS_THREADSAFE (actually none expect accept some patches). ";
+   print "If you are using a JS_THREADSAFE it's likely because your OS vendor supplied the SpiderMonkey libs you're using ";
+   print "and instead I recommend you to download and build your own SpiderMonkey libs that doesn't use JS_THREADSAFE.\n";
 }
 
 # Check if we need to enable JS_C_STRINGS_ARE_UTF8?
@@ -205,7 +213,11 @@
     LIBS            => ["$libs -l${lib}"], # e.g., "-lm"
     INC             => join(" ", map { "-I$_" } @incs),
     LICENSE         => "perl",
-    OBJECT          => q/$(O_FILES)/, 
+    OBJECT          => q/$(O_FILES)/,
+    EXTRA_META      => q{
+resources:
+    repository: svn://svn.versed.se/public/Perl/modules/JavaScript
+},
 );
 
 sub get_paths {

Modified: trunk/libjavascript-perl/PJS_Class.c
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/PJS_Class.c?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/PJS_Class.c (original)
+++ trunk/libjavascript-perl/PJS_Class.c Tue Aug 12 19:54:41 2008
@@ -80,12 +80,17 @@
     PJS_free_JSPropertySpec(pcls->ps);
     PJS_free_JSPropertySpec(pcls->static_ps);
     
+    if (pcls->flags & PJS_FREE_JSCLASS) {
+        Safefree(pcls->clasp->name);
+        Safefree(pcls->clasp);
+    }
+    
     Safefree(pcls);
 }
 
 void PJS_bind_class(PJS_Context *pcx, char *name, char *pkg, SV *cons, HV *fs, HV *static_fs, HV *ps, HV *static_ps, U32 flags) {
     PJS_Class *pcls;
-
+    
     if (pcx == NULL) {
         croak("Can't bind_class in an undefined context");
     }
@@ -162,10 +167,25 @@
 
     /* refcount constructor */
     pcls->cons = SvREFCNT_inc(cons);
-    
-    /* Add class to list of classes in context */
-    pcls->_next = pcx->classes;
-    pcx->classes = pcls;
+    pcls->flags |= PJS_FREE_JSCLASS;
+    
+    PJS_store_class(pcx, pcls);
+}
+
+void PJS_store_class(PJS_Context *pcx, PJS_Class *cls) {
+    /* Add class to list of classes in contexts */
+    SV *sv = newSV(0);
+	sv_setref_pv(sv, "JavaScript::PerlClass", (void*) cls);
+	
+    if (cls->clasp->name != NULL) {
+        SvREFCNT_inc(sv);
+        hv_store(pcx->class_by_name, cls->clasp->name, strlen(cls->clasp->name), sv, 0);
+    }
+    
+    if (cls->pkg != NULL) {
+        SvREFCNT_inc(sv);
+        hv_store(pcx->class_by_package, cls->pkg, strlen(cls->pkg), sv, 0);
+    }
 }
 
 void PJS_finalize(JSContext *cx, JSObject *obj) {

Modified: trunk/libjavascript-perl/PJS_Class.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/PJS_Class.h?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/PJS_Class.h (original)
+++ trunk/libjavascript-perl/PJS_Class.h Tue Aug 12 19:54:41 2008
@@ -20,7 +20,7 @@
 struct PJS_Class {
     /* Clasp */
     JSClass *clasp;
-
+	
     /* Package name in Perl */
     char *pkg;
       
@@ -74,6 +74,9 @@
 PJS_EXTERN JSBool
 PJS_invoke_perl_object_method(JSContext *, JSObject *, uintN , jsval *, jsval *);
 
+PJS_EXTERN void
+PJS_store_class(PJS_Context *pcx, PJS_Class *cls);
+
 /*!  @functiongroup Query functions */
 
 PJS_EXTERN const char *

Modified: trunk/libjavascript-perl/PJS_Common.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/PJS_Common.h?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/PJS_Common.h (original)
+++ trunk/libjavascript-perl/PJS_Common.h Tue Aug 12 19:54:41 2008
@@ -41,10 +41,11 @@
 */
 #define PJS_BOXED_PACKAGE     "JavaScript::Boxed"
 
-#define PJS_PROP_PRIVATE      0x1
-#define PJS_PROP_READONLY     0x2
-#define PJS_PROP_ACCESSOR     0x4
-#define PJS_CLASS_NO_INSTANCE 0x1
+#define PJS_PROP_PRIVATE      	0x1
+#define PJS_PROP_READONLY     	0x2
+#define PJS_PROP_ACCESSOR     	0x4
+#define PJS_CLASS_NO_INSTANCE	0x1
+#define PJS_FREE_JSCLASS		0x2
 
 #define _IS_UNDEF(a) (SvANY(a) == SvANY(&PL_sv_undef))
 

Modified: trunk/libjavascript-perl/PJS_Context.c
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/PJS_Context.c?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/PJS_Context.c (original)
+++ trunk/libjavascript-perl/PJS_Context.c Tue Aug 12 19:54:41 2008
@@ -10,6 +10,8 @@
 #include "PJS_Context.h"
 #include "PJS_Runtime.h"
 #include "PJS_Class.h"
+#include "PJS_PerlArray.h"
+#include "PJS_PerlHash.h"
 
 /* Global class, does nothing */
 static JSClass global_class = {
@@ -20,53 +22,50 @@
 };
 
 PJS_Function * PJS_GetFunctionByName(PJS_Context *cx, const char *name) {
-    PJS_Function *function;
-
-    function = cx->functions;
-
-    while(function != NULL) {
-        if(strcmp(PJS_GetFunctionName(function), name) == 0) {
-            return function;
-        }
-        
-        function = function->_next;
-    }
-
-    return NULL;
-}
-
+    PJS_Function *func = NULL;
+    SV **sv;
+    IV tmp;
+
+    sv = hv_fetch(cx->function_by_name, name, strlen(name), 0);
+    if (sv == NULL) {
+        return NULL;
+    }
+    tmp = SvIV((SV *) SvRV(*sv));
+    func = INT2PTR(PJS_Function *, tmp);
+        
+    return func;
+}
+    
 PJS_Class * 
 PJS_GetClassByName(PJS_Context *cx, const char *name) {
     PJS_Class *cls = NULL;
-    
-    cls = cx->classes;
-    
-    while (cls != NULL) {
-        if (strcmp(PJS_GetClassName(cls), name) == 0) {
-            return cls;
-        }
-        
-        cls = cls->_next;
-    }
-    
-    return NULL;
+    SV        **sv;
+    IV        tmp;
+
+    sv = hv_fetch(cx->class_by_name, name, strlen(name), 0);
+    if (sv == NULL) {
+        return NULL;
+    }
+    tmp = SvIV((SV *) SvRV(*sv));
+    cls = INT2PTR(PJS_Class *, tmp);
+        
+    return cls;
 }
 
 PJS_Class *
 PJS_GetClassByPackage(PJS_Context *cx, const char *pkg) {
     PJS_Class *cls = NULL;
-    
-    cls = cx->classes;
-
-    while (cls != NULL) {
-        if (cls->pkg != NULL && strcmp(PJS_GetClassPackage(cls), pkg) == 0) {
-            return cls;
-        }
-        
-        cls = cls->_next;
-    }
-    
-    return NULL;
+    SV        **sv;
+    IV        tmp;
+    
+    sv = hv_fetch(cx->class_by_package, pkg, strlen(pkg), 0);
+    if (sv == NULL) {
+        return NULL;
+    }
+    tmp = SvIV((SV *) SvRV(*sv));
+    cls = INT2PTR(PJS_Class *, tmp);
+    
+    return cls;
 }
 
 /*
@@ -105,11 +104,23 @@
         PJS_DestroyContext(pcx);
         croak("Standard classes not loaded properly.");
     }
-
+    
+    pcx->function_by_name = newHV();
+    pcx->class_by_name = newHV();
+    pcx->class_by_package = newHV();
+    
+    if (PJS_InitPerlArrayClass(pcx, obj) == JS_FALSE) {
+        PJS_DestroyContext(pcx);
+        croak("Perl classes not loaded properly.");        
+    }
+
+    if (PJS_InitPerlHashClass(pcx, obj) == JS_FALSE) {
+        PJS_DestroyContext(pcx);
+        croak("Perl classes not loaded properly.");        
+    }
+
+    pcx->rt = rt;
     /* Add context to context list */
-    pcx->functions = NULL;
-    pcx->classes = NULL;
-    pcx->rt = rt;
     pcx->next = rt->list;
     rt->list = pcx;
 
@@ -122,30 +133,14 @@
   Free memory occupied by PJS_Context structure
 */
 void PJS_DestroyContext(PJS_Context *pcx) {
-    PJS_Function *pfunc, *pfunc_next;
-    PJS_Class *pcls, *pcls_next;
-
     if (pcx == NULL) {
         return;
     }
     
-    pfunc = pcx->functions;
-    
-    /* Check if we have any bound functions */
-    while (pfunc != NULL) {
-        pfunc_next = pfunc->_next;
-        PJS_DestroyFunction(pfunc);
-        pfunc = pfunc_next;
-    }
-
-    pcls = pcx->classes;
-    /* Check if we have any bound classes */
-    while (pcls != NULL) {
-        pcls_next = pcls->_next;
-        PJS_free_class(pcls);
-        pcls = pcls_next;
-    }
-
+    hv_clear(pcx->function_by_name);
+    hv_clear(pcx->class_by_name);
+    hv_clear(pcx->class_by_package);
+        
     /* Destory context */
     JS_DestroyContext(pcx->cx);
 
@@ -156,6 +151,7 @@
 PJS_DefineFunction(PJS_Context *inContext, const char *functionName, SV *perlCallback) {
     PJS_Function *function;
     JSContext    *js_context = inContext->cx;
+    SV *sv;
     
     if (PJS_GetFunctionByName(inContext, functionName) != NULL) {
         warn("Function named '%s' is already defined in the context");
@@ -173,10 +169,14 @@
         return NULL;
     }
 
-    /* Insert function in context linked list */
-    function->_next = inContext->functions;
-    inContext->functions = function;      
-
+    sv = newSV(0);
+	sv_setref_pv(sv, "JavaScript::PerlFunction", (void*) function);
+	
+    if (functionName != NULL) {
+        SvREFCNT_inc(sv);
+        hv_store(inContext->function_by_name, functionName, strlen(functionName), sv, 0);
+    }
+    
     return function;
 }
 

Modified: trunk/libjavascript-perl/PJS_Context.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/PJS_Context.h?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/PJS_Context.h (original)
+++ trunk/libjavascript-perl/PJS_Context.h Tue Aug 12 19:54:41 2008
@@ -26,11 +26,12 @@
     JSContext *cx;
 
     /* Pointer to the first callback item that is registered */
-    PJS_Function *functions;
+	HV *function_by_name;
 
     /* Pointer to the first bound class */
-    PJS_Class *classes;
-
+	HV *class_by_name;
+	HV *class_by_package;
+	
     PJS_Context *next;      /* Pointer to the next created context */
     PJS_Runtime *rt;
 

Modified: trunk/libjavascript-perl/PJS_TypeConversion.c
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/PJS_TypeConversion.c?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/PJS_TypeConversion.c (original)
+++ trunk/libjavascript-perl/PJS_TypeConversion.c Tue Aug 12 19:54:41 2008
@@ -51,11 +51,12 @@
             return JS_TRUE;
         }
         
+        /* ugly hack, this needs to be nicer */
         if((pcx = PJS_GET_CONTEXT(cx)) == NULL) {
             *rval = JSVAL_VOID;
             return JS_FALSE;
         }
-        
+                
         if((pjsc = PJS_GetClassByPackage(pcx, name)) == NULL) {
             *rval = JSVAL_VOID;
             return JS_FALSE;
@@ -342,7 +343,6 @@
             else if (OBJ_IS_NATIVE(object) &&
                      (OBJ_GET_CLASS(cx, object)->flags & JSCLASS_HAS_PRIVATE) &&
                      (strcmp(OBJ_GET_CLASS(cx, object)->name, "Error") != 0)) {
-
                 /* Object with a private means the actual perl object is there */
                 /* This is kludgy because function is also object with private,
                    we need to turn this to use hidden property on object */

Modified: trunk/libjavascript-perl/PJS_Types.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/PJS_Types.h?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/PJS_Types.h (original)
+++ trunk/libjavascript-perl/PJS_Types.h Tue Aug 12 19:54:41 2008
@@ -17,6 +17,8 @@
 typedef struct PJS_TrapHandler PJS_TrapHandler;
 typedef struct PJS_Runtime PJS_Runtime;
 typedef struct PJS_Script PJS_Script;
+typedef struct PJS_PerlArray PJS_PerlArray;
+typedef struct PJS_PerlHash PJS_PerlHash;
 
 #ifdef __cplusplus
 }

Modified: trunk/libjavascript-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/README?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/README (original)
+++ trunk/libjavascript-perl/README Tue Aug 12 19:54:41 2008
@@ -32,10 +32,10 @@
 INSTALLATION
 ------------
 
-To install JavaScript.pm, make sure you have libjs installed. Otherwize, grab a recent one from ftp://ftp.mozilla.org/pub/js. The module is tested with 1.5 and later.
+To install JavaScript.pm, make sure you have libjs installed. Otherwize, grab a recent one from ftp://ftp.mozilla.org/pub/js. The module requires 1.7 or later.
 
-Debian users can alternatively install the libsmjs-dev package by doing
-> apt-get install libsmjs-dev
+Debian users can alternatively install the libmozjs-dev package by doing
+> apt-get install libmozjs0g-dev
 
 Makefile.PL will ask a number of questions regarding threading, utf8 and e4x support. Prompting for this can be disabled by 
 setting their respective environment variable to a true (1) or false value (2)
@@ -74,7 +74,7 @@
 COPYRIGHT
 ---------
 
-Copyright (c) 2001 - 2007, Claes Jakobsson C<< <claesjac at cpan.org> >>. All rights reserved.
+Copyright (c) 2001 - 2008, Claes Jakobsson C<< <claesjac at cpan.org> >>. All rights reserved.
 
 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See http://dev.perl.org/licenses/artistic.html

Modified: trunk/libjavascript-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/debian/changelog?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/debian/changelog (original)
+++ trunk/libjavascript-perl/debian/changelog Tue Aug 12 19:54:41 2008
@@ -1,4 +1,4 @@
-libjavascript-perl (1.09-1) UNRELEASED; urgency=low
+libjavascript-perl (1.10-1) UNRELEASED; urgency=low
 
   TODO:
   the packaging should be ok, but there are many compiler warnings.

Modified: trunk/libjavascript-perl/lib/JavaScript.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/lib/JavaScript.pm?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/lib/JavaScript.pm (original)
+++ trunk/libjavascript-perl/lib/JavaScript.pm Tue Aug 12 19:54:41 2008
@@ -23,7 +23,7 @@
 
 our %EXPORT_TAGS = ( all => [@EXPORT_OK] );
 
-our $VERSION = '1.09';
+our $VERSION = "1.10";
 
 our $MAXBYTES = 1024 ** 2;
 
@@ -70,6 +70,11 @@
     }
         
     return 1;
+}
+
+sub create_runtime {
+    my $pkg = shift;
+    return JavaScript::Runtime->new(@_);
 }
 
 bootstrap JavaScript $VERSION;
@@ -126,6 +131,10 @@
 
 =over 4
 
+=item create_runtime ( ... )
+
+Shortcut for C<JavaScript::Runtime->new(...)>.
+
 =item get_engine_version
 
 In scalar context it returns a string describing the engine such as C<JavaScript-C 1.5 2004-09-24>.

Modified: trunk/libjavascript-perl/lib/JavaScript/Context.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/lib/JavaScript/Context.pm?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/lib/JavaScript/Context.pm (original)
+++ trunk/libjavascript-perl/lib/JavaScript/Context.pm Tue Aug 12 19:54:41 2008
@@ -19,10 +19,8 @@
     
     my $self = bless { _impl => $cx_ptr }, $pkg;
 
-    $Context{${$cx_ptr}} = $self;
-    
-    weaken($Context{$cx_ptr});
-
+    $Context{$$cx_ptr} = $self;
+    weaken($Context{$$cx_ptr});
     $self->{runtime} = $runtime;
     
     return $self;
@@ -327,6 +325,7 @@
     delete $Context{${$self->{_impl}}};
     jsc_destroy($self->{'_impl'} );
     delete $self->{'_impl'};
+    delete $self->{runtime};
     return 1;
 }
 

Modified: trunk/libjavascript-perl/t/04-prototypes.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/t/04-prototypes.t?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/t/04-prototypes.t (original)
+++ trunk/libjavascript-perl/t/04-prototypes.t Tue Aug 12 19:54:41 2008
@@ -21,7 +21,7 @@
 ok($cx1->eval(q{
   foo.prototype.bar = function() { return 1 };
   1;
-}));
+}), "Assign to prototype ok");
 
 is($cx1->eval(q/ ( new foo() ).bar() /), 1, "can call prototype methods");
 

Modified: trunk/libjavascript-perl/t/05-deep-assign.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/t/05-deep-assign.t?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/t/05-deep-assign.t (original)
+++ trunk/libjavascript-perl/t/05-deep-assign.t Tue Aug 12 19:54:41 2008
@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 18;
+use Test::More tests => 20;
 
 use strict;
 use warnings;
@@ -12,17 +12,17 @@
 my $rt1 = JavaScript::Runtime->new();
 my $cx1 = $rt1->create_context();
 
-lives_ok { $cx1->bind_function( name => 'foo.bar.baz', func => sub { return 8 } ) };
-lives_ok { $cx1->bind_value( 'egg.spam.spam' => "urrrgh" ) };
+lives_ok { $cx1->bind_function( name => 'foo.bar.baz', func => sub { return 8 } ) } "bound foo.bar.baz as function ok";
+lives_ok { $cx1->bind_value( 'egg.spam.spam' => "urrrgh" ) } "bound egg.spam.span as vaulue ok";
 
 is( $cx1->eval(q!foo.bar.baz()!), 8, "got 8" );
 is( $cx1->eval(q!egg.spam.spam!), 'urrrgh', "beans are off" );
 
-lives_ok { $cx1->bind_value( spam => 'urrrgh' ) };
+lives_ok { $cx1->bind_value( spam => 'urrrgh' ) } "bind value ok";
 is( $cx1->eval(q!spam!), 'urrrgh', "beans are off" );
 is( $cx1->eval(q!foo.bar.baz()!), 8, "got 8" );
 
-lives_ok { $cx1->bind_value( 'egg.yolk.spam' => "got me?" ) };
+lives_ok { $cx1->bind_value( 'egg.yolk.spam' => "got me?" ) } "bound egg.yolk.spam ok";
 
 is( $cx1->eval(q!egg.yolk.spam!), 'got me?', "beans are off" );
 is( $cx1->eval(q!egg.spam.spam!), 'urrrgh', "beans are off" );
@@ -30,11 +30,12 @@
 throws_ok { $cx1->bind_value( 'spam' => "urrgh" ); } qr/spam already exists, unbind it first/;
 throws_ok { $cx1->bind_value( 'egg.yolk.spam' => "got me again?" ); } qr/egg.yolk.spam already exists, unbind it first/;
 
-lives_ok { $cx1->unbind_value("spam"); };
-lives_ok { $cx1->unbind_value("egg.yolk.spam") };
-
-lives_ok { $cx1->bind_value( spam => 1 ) };
-lives_ok { $cx1->bind_value( 'egg.yolk.spam' => 2 ) };
+lives_ok { $cx1->unbind_value("spam"); } "unbound spam ok";
+ok(!defined $cx1->eval("spam;"), "unbound spam really is ok");
+lives_ok { $cx1->unbind_value("egg.yolk.spam") } "unbound egg.yolk.spam ok";
+ok(!defined $cx1->eval("egg.yolk.spam"), "unbound egg.yolk.spam really is ok");
+lives_ok { $cx1->bind_value( spam => 1 ) } "rebound spam ok";
+lives_ok { $cx1->bind_value( 'egg.yolk.spam' => 2 ) } "rebound egg.yolk.spam ok";
 
 is( $cx1->eval(q!spam!), 1, "got 1" );
 is( $cx1->eval(q!egg.yolk.spam!), 2, "got 2" );

Modified: trunk/libjavascript-perl/t/06-bind-object.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/t/06-bind-object.t?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/t/06-bind-object.t (original)
+++ trunk/libjavascript-perl/t/06-bind-object.t Tue Aug 12 19:54:41 2008
@@ -5,7 +5,8 @@
 use strict;
 use warnings;
 
-use Test::More tests => 13;
+use Test::More tests => 14;
+use Test::Exception;
 
 use JavaScript;
 
@@ -59,49 +60,50 @@
 
 my $foo = new Foo();
 
-$cx1->bind_object('FooSan', $foo);
+lives_ok { $cx1->bind_object('FooSan', $foo) } "bound object FooSan ok";
 
-isa_ok($cx1->eval("FooSan;"), "Foo");
+isa_ok($cx1->eval("FooSan;"), "Foo", "returned object is-a Foo");
 
-is($cx1->eval("FooSan.bar();"), 5);
+is($cx1->eval("FooSan.bar();"), 5, "Calling method bar() on bound object");
 
 $cx1->eval(q{
 FooSan.std = 1;
 });
 
-is($foo->{std}, 1);
+is($foo->{std}, 1, "Assignment to property in object");
 
 $foo->{std} = 3;
 
-is($cx1->eval(q{ FooSan.std }), 3);
+is($cx1->eval(q{ FooSan.std }), 3, "Reading property in object");
 
 $cx1->eval(q!
 FooSan.wrapped_value = 1;
 !);
 
-ok($foo->{"setter_called"});
+ok($foo->{"setter_called"}, "Assignment to property with setter");
 
-ok($foo->{wrapped} == 1);
+ok($foo->{wrapped} == 1, "Assigned value is 1");
 
-ok($cx1 && ref($cx1)); # somehow disappeared during development
+ok($cx1 && ref($cx1), "Still have context after calling setter"); # somehow disappeared during development
 
 $foo->{wrapped} = 2;
 
 ok($cx1->eval(q{
     FooSan.wrapped_value
-}) == 2);
-ok($foo->{"getter_called"});
+}) == 2, "Calling getter");
+ok($foo->{"getter_called"}, "Reading from property with getter");
 
-ok($cx1 && ref($cx1)); # somehow disappeared during development
+ok($cx1 && ref($cx1), "Still have context after calling getter"); # somehow disappeared during development
 
+$foo->{"getter_called"} = 0;
 
 $cx1->eval(q{
 FooSan.wrapped_value = FooSan.wrapped_value + 1;
 });
-ok($foo->{"getter_called"});
+ok($foo->{"getter_called"}, "Calling getter and setter");
 
-ok($cx1 && ref($cx1)); # somehow disappeared during development
+ok($cx1 && ref($cx1), "Still have context after both getter and setter"); # somehow disappeared during development
 
-ok($foo->{wrapped} == 3);
+ok($foo->{wrapped} == 3, "Value is correct (3)");
 
 

Modified: trunk/libjavascript-perl/t/20-bind-class.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/t/20-bind-class.t?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/t/20-bind-class.t (original)
+++ trunk/libjavascript-perl/t/20-bind-class.t Tue Aug 12 19:54:41 2008
@@ -26,23 +26,23 @@
     $cx1->bind_class(name => "Foo",
                      constructor => sub {
                          my $pkg = shift;
-                         is($pkg, "Foo");
+                         is($pkg, "Foo", "package is Foo in Foo constructor");
                          return Foo->new();
                      }
                  );
     my $o = $cx1->eval("new Foo();");
-    isa_ok($o, "Foo");
+    isa_ok($o, "Foo", "new Foo(); returns instanceof Foo");
 
     $cx1->bind_class(name => "Bar",
                      constructor => sub {
                          my $pkg = shift;
-                         is($pkg, "Foo");
+                         is($pkg, "Foo", "package is Foo in Bar constructor");
                          return $pkg->new();
                      },
                      package => "Foo",
                  );
     my $p = $cx1->eval("new Bar()");
-    isa_ok($o, "Foo");    
+    isa_ok($o, "Foo", "new Bar() returns instanceof Foo");    
 }
 
 {
@@ -53,9 +53,9 @@
     $cx1->bind_class(name => "Baz", package => "Foo");
 
     my $o = $cx1->eval("new Foo();");
-    isa_ok($o, "Foo");
+    isa_ok($o, "Foo", "new Foo() returns instanceof Foo");
     $o = $cx1->eval("new Baz();");
-    isa_ok($o, "Foo");
+    isa_ok($o, "Foo", "new Baz() returns instanceof Foo");
 
 }
 
@@ -64,16 +64,16 @@
     my $Foo_object_method = 0;
     sub object_method {
         my $self = shift;
-        isa_ok($self, "Foo");
-        is($_[0], scalar @_);
+        isa_ok($self, "Foo", "self is Foo in object_method");
+        is($_[0], scalar @_, "1 arg in object_method");
         $Foo_object_method++;
     }
     
     my $Foo_class_method = 0;
     sub class_method {
         my $self = shift;
-        is($self, "Foo");
-        is($_[0], scalar @_);
+        is($self, "Foo", "self is Foo in class_method");
+        is($_[0], scalar @_, "1 arg in class_method");
         $Foo_class_method++;
     }
 
@@ -87,26 +87,26 @@
     $cx1->eval("o = new Foo(); o.object_method(1)");
 
     if ($@ || $Foo_object_method == 0) {
-        ok(0, "calling object_method failed");
-        ok(0, "calling object_method failed");
+        ok(0, "self is Foo in object_method");
+        ok(0, "1 arg in object_method");
     }
 
     $cx1->eval("Foo.class_method(1);");
 
     if ($@ || $Foo_class_method == 0) {
-        ok(0, "calling class_method failed");
-        ok(0, "calling class_method failed");
+        ok(0, "self is Foo in class_method");
+        ok(0, "1 arg in class_method");
     }
 }
 
 # Check multiple instance methods
 {
     sub fone {
-        is($_[1], 1);
+        is($_[1], 1, "called fone");
     }
 
     sub ftwo {
-        is($_[1], 2);
+        is($_[1], 2, "called ftwo");
     }
     
     my $cx1 = $rt1->create_context();
@@ -115,6 +115,10 @@
                      fs => [qw(fone ftwo)],
                  );
     $cx1->eval("o = new Foo(); o.fone(1); o.ftwo(2)");
+    if ($@) {
+	ok(0, "called fone");
+	ok(0, "called ftwo");
+    }
 }
 
 # Check ps
@@ -122,19 +126,19 @@
     my $x = 5;
     sub get_x {
         my $self = shift;
-        isa_ok($self, "Foo");
+        isa_ok($self, "Foo", "self is Foo in get_x");
         return $x;
     }
 
     sub set_x {
         my $self = shift;
-        isa_ok($self, "Foo");
+        isa_ok($self, "Foo", "self is Foo in set_x");
         $x = shift;
     }
 
     sub get_y {
         my $self = shift;
-        isa_ok($self, "Foo");
+        isa_ok($self, "Foo", "self is Foo in get_y");
         return 10;
     }
 
@@ -159,13 +163,13 @@
     my $z = 10;
     sub get_z {
         my $self = shift;
-        is($self, "Foo");
+        is($self, "Foo", "self is Foo in get_z");
         return $z;
     }
 
     sub set_z {
         my $self = shift;
-        is($self, "Foo");
+        is($self, "Foo", "self is Foo in set_z");
         $z = shift;
     }
 
@@ -176,9 +180,11 @@
                                },
                  );
     my $r = $cx1->eval("Foo.z;");
-    is($r, 10);
+    diag($@) if $@;
+    is($r, 10, "Foo.z is 10");
     $cx1->eval("Foo.z = 11;");
-    is($z, 11);
+    diag($@) if $@;
+    is($z, 11, "Foo.z is 11 after assignment");
 }
 
 {
@@ -189,8 +195,10 @@
                      ps => { x => { getter => sub { return "x"; } } },
                      static_ps => { y => { getter => sub { return "y"; } } }
                      );
-    is($cx1->eval("(new Foo()).x"), "x");
-    is($cx1->eval("Foo.y"), "y");
-       
-                             
-}
+    is($cx1->eval("(new Foo()).x"), "x", "(new Foo()).x return x");
+    diag($@) if $@;
+    is($cx1->eval("Foo.y"), "y", "Foo.y returns y");
+    diag($@) if $@;
+}
+
+#  LocalWords:  STDERR

Modified: trunk/libjavascript-perl/t/23-unicode.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/t/23-unicode.t?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/t/23-unicode.t (original)
+++ trunk/libjavascript-perl/t/23-unicode.t Tue Aug 12 19:54:41 2008
@@ -37,7 +37,10 @@
 $context->bind_value( uhash => { "\x{e9}" => 1 } );
 is( $context->eval("uhash[ ucopy ]" ), 1, "unicode hash keys from perl" );
 
+$context->unbind_value("uhash");
+$context->unbind_value("ucopy");
+$context->bind_value( ucopy => "\x{2668}" );
 $context->bind_value( uhash => { "\x{2668}" => 1 } );
-is( $context->eval("uhash[ ucopy ]" ), 1, "unicode hash keys from perl" );
+is( $context->eval(q{uhash[ucopy]}), 1, "unicode hash keys from perl" );
 
 

Modified: trunk/libjavascript-perl/t/30-refcount.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/t/30-refcount.t?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/t/30-refcount.t (original)
+++ trunk/libjavascript-perl/t/30-refcount.t Tue Aug 12 19:54:41 2008
@@ -31,5 +31,5 @@
         is($sv->REFCNT, 2);
     }
     
-    is($sv->REFCNT, 1);
+    is($sv->REFCNT, 0);
 }

Modified: trunk/libjavascript-perl/typemap
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjavascript-perl/typemap?rev=24218&op=diff
==============================================================================
--- trunk/libjavascript-perl/typemap (original)
+++ trunk/libjavascript-perl/typemap Tue Aug 12 19:54:41 2008
@@ -1,10 +1,15 @@
 TYPEMAP
-PJS_Runtime *           T_PTRREF
-PJS_Context *           T_PTRREF
-PJS_Script *            T_PTRREF
-JSFunction *            T_PTROBJ
-PJS_TrapHandler *  T_PTRREF
-jsval                   jsval
+
+PJS_Runtime *               T_PTRREF
+PJS_Context *               T_PTRREF
+PJS_Script *                T_PTRREF
+JavaScript::PerlArray       T_PTROBJ
+JavaScript::PerlHash        T_PTROBJ
+JavaScript::PerlClass       T_PTROBJ
+JavaScript::PerlFunction    T_PTROBJ
+JSFunction *                T_PTROBJ
+PJS_TrapHandler *           T_PTRREF
+jsval                       jsval
 
 OUTPUT
 




More information about the Pkg-perl-cvs-commits mailing list