Merge pull request #29 from jezwhite/memory-leaks

Memory leaks
gonzus · Dec 3, 2021 · 4466828 · 4466828
2 parents a318f23 + 04b6a65
commit 4466828
Show file tree

Hide file tree

Showing 12 changed files with 196 additions and 72 deletions.
diff --git a/Changes b/Changes
@@ -1,3 +1,7 @@
+0.000080    2021-09-27
+            * Fix minor memory leaks in statistics, get/set messages and main object destruction
+            * Fix memory leak when using closures and perl callbacks in Set
+
 0.000079    2021-09-16
             * Teach XS to translate ArrayBuffer & TypedArray to Perl.
             * Fix character-encoding oddities, add documentation.

diff --git a/duk.xs b/duk.xs
@@ -81,6 +81,22 @@ static void tear_down(Duk* duk)
     duk_destroy_heap(duk->ctx);
 }
 
+static void destroy_duktape_object(pTHX_ Duk* duk)
+ {   
+  if (duk) {   
+    //Free perl objects 
+    SvREFCNT_dec((SV *) duk->stats);
+    SvREFCNT_dec((SV *) duk->msgs);
+    if( duk->version) {
+      SvREFCNT_dec((SV *) duk->version);
+    }
+    //
+    hv_clear(duk->funcref);  
+    SvREFCNT_dec((SV *) duk->funcref);
+    free(duk);
+  }
+}
+
 static Duk* create_duktape_object(pTHX_ HV* opt)
 {
     Duk* duk = (Duk*) malloc(sizeof(Duk));
@@ -90,6 +106,7 @@ static Duk* create_duktape_object(pTHX_ HV* opt)
 
     duk->stats = newHV();
     duk->msgs = newHV();
+    duk->funcref = newHV();
 
     if (opt) {
         hv_iterinit(opt);
@@ -140,6 +157,7 @@ static int session_dtor(pTHX_ SV* sv, MAGIC* mg)
     Duk* duk = (Duk*) mg->mg_ptr;
     UNUSED_ARG(sv);
     tear_down(duk);
+    destroy_duktape_object(aTHX_ duk);
     return 0;
 }
 
@@ -172,7 +190,7 @@ get_stats(Duk* duk)
 void
 reset_stats(Duk* duk)
   PPCODE:
-    duk->stats = newHV();
+    hv_clear(duk->stats);
 
 HV*
 get_msgs(Duk* duk)
@@ -183,7 +201,7 @@ get_msgs(Duk* duk)
 void
 reset_msgs(Duk* duk)
   PPCODE:
-    duk->msgs = newHV();
+    hv_clear(duk->msgs);
 
 SV*
 get(Duk* duk, const char* name)
@@ -236,30 +254,26 @@ instanceof(Duk* duk, const char* object, const char* class)
     RETVAL = pl_instanceof_global_or_property(aTHX_ ctx, object, class);
     pl_stats_stop(aTHX_ duk, &stats, "instanceof");
   OUTPUT: RETVAL
-
+  
 int
 set(Duk* duk, const char* name, SV* value)
   PREINIT:
-    duk_context* ctx = 0;
     Stats stats;
   CODE:
     TIMEOUT_RESET(duk);
-    ctx = duk->ctx;
     pl_stats_start(aTHX_ duk, &stats);
-    RETVAL = pl_set_global_or_property(aTHX_ ctx, name, value);
+    RETVAL = pl_set_global_or_property(aTHX_ duk, name, value);
     pl_stats_stop(aTHX_ duk, &stats, "set");
   OUTPUT: RETVAL
 
 int
 remove(Duk* duk, const char* name)
   PREINIT:
-    duk_context* ctx = 0;
     Stats stats;
   CODE:
     TIMEOUT_RESET(duk);
-    ctx = duk->ctx;
     pl_stats_start(aTHX_ duk, &stats);
-    RETVAL = pl_del_global_or_property(aTHX_ ctx, name);
+    RETVAL = pl_del_global_or_property(aTHX_ duk, name);
     pl_stats_stop(aTHX_ duk, &stats, "remove");
   OUTPUT: RETVAL
 

diff --git a/duk_console.c b/duk_console.c
@@ -19,31 +19,26 @@
 
 /* XXX: Init console object using duk_def_prop() when that call is available. */
 
-typedef struct ConsoleConfig {
-    ConsoleHandler* handler;
-    void* data;
-} ConsoleConfig;
-
-static ConsoleConfig console_config;
-
-int duk_console_log(duk_uint_t flags, const char* fmt, ...)
+int duk_console_log(duk_context *ctx,duk_uint_t flags, const char* fmt, ...)
 {
     int ret = 0;
-    if (console_config.handler) {
-        va_list ap;
-        va_start(ap, fmt);
-        ret = console_config.handler(flags, console_config.data, fmt, ap);
-        va_end(ap);
-    }
+	void* ourData;
+    va_list ap;
+    va_start(ap, fmt);
+
+	/* Get our duk pointer for this ctx*/
+	duk_push_thread_stash(ctx,ctx);
+    duk_get_prop_string(ctx, -1, PL_NAME_CONSOLE_GENERIC_CALLBACK); 
+    ourData = duk_get_pointer(ctx, -1);
+	duk_pop(ctx);
+
+	if (ourData) {
+		ret = pl_console_callback(ourData,flags,fmt, ap);
+	}
+    va_end(ap);
     return ret;
 }
 
-void duk_console_register_handler(ConsoleHandler* handler, void* data)
-{
-    console_config.handler = handler;
-    console_config.data = data;
-}
-
 static duk_ret_t duk__console_log_helper(duk_context *ctx, const char *error_name) {
     duk_uint_t flags = (duk_uint_t) duk_get_current_magic(ctx);
     duk_idx_t n = duk_get_top(ctx);
@@ -76,7 +71,7 @@ static duk_ret_t duk__console_log_helper(duk_context *ctx, const char *error_nam
 		duk_get_prop_string(ctx, -1, "stack");
 	}
 
-    duk_console_log(flags, "%s\n", duk_to_string(ctx, -1));
+    duk_console_log(ctx, flags, "%s\n", duk_to_string(ctx, -1));
 	return 0;
 }
 

diff --git a/duk_console.h b/duk_console.h
@@ -20,18 +20,13 @@ extern "C" {
 /* Send output to stderr. */
 #define DUK_CONSOLE_TO_STDERR      (1 << 3)
 
-/* The console handler prototype */
-typedef int (ConsoleHandler)(duk_uint_t flags, void* data,
-                             const char* fmt, va_list ap);
+#define PL_NAME_CONSOLE_GENERIC_CALLBACK  "__perl__duk__"
 
 /* Initialize the console system */
 extern void duk_console_init(duk_context *ctx, duk_uint_t flags);
 
-/* Register a console handler */
-extern void duk_console_register_handler(ConsoleHandler* handler, void* data);
-
 /* Public function to log messages, callable from C */
-extern int duk_console_log(duk_uint_t flags, const char* fmt, ...);
+extern int duk_console_log(duk_context *ctx,duk_uint_t flags, const char* fmt, ...);
 
 #if defined(__cplusplus)
 }

diff --git a/lib/JavaScript/Duktape/XS.pm b/lib/JavaScript/Duktape/XS.pm
@@ -6,7 +6,7 @@ use parent 'Exporter';
 use JSON::PP;  # required to properly handle booleans
 use XSLoader;
 
-our $VERSION = '0.000079';
+our $VERSION = '0.000080';
 XSLoader::load( __PACKAGE__, $VERSION );
 
 our @EXPORT_OK = qw[];
@@ -25,7 +25,7 @@ engine
 
 =head1 VERSION
 
-Version 0.000079
+Version 0.000080
 
 =head1 SYNOPSIS
 

diff --git a/pl_console.c b/pl_console.c
@@ -10,21 +10,20 @@
 #define va_copy(dest, src)  __va_copy(dest, src)
 #endif
 
-static int print_console_messages(duk_uint_t flags, void* data,
+static int print_console_messages(pTHX_ duk_uint_t flags,
                                   const char* fmt, va_list ap)
 {
-    dTHX;
     PerlIO* fp = (flags & DUK_CONSOLE_TO_STDERR) ? PerlIO_stderr() : PerlIO_stdout();
     int ret = PerlIO_vprintf(fp, fmt, ap);
 
-    UNUSED_ARG(data);
     if (flags & DUK_CONSOLE_FLUSH) {
         PerlIO_flush(fp);
     }
     return ret;
 }
 
 
+
 static void save_msg(pTHX_ Duk* duk, const char* target, SV* message)
 {
     STRLEN tlen = strlen(target);
@@ -59,11 +58,10 @@ static void save_msg(pTHX_ Duk* duk, const char* target, SV* message)
     }
 }
 
-static int save_console_messages(duk_uint_t flags, void* data,
+
+static int save_console_messages(pTHX_ Duk* duk,duk_uint_t flags,
                                  const char* fmt, va_list ap)
 {
-    dTHX;
-    Duk* duk = (Duk*) data;
     const char* target = (flags & DUK_CONSOLE_TO_STDERR) ? "stderr" : "stdout";
     SV* message = newSVpvs("");
     va_list args_copy;
@@ -73,17 +71,29 @@ static int save_console_messages(duk_uint_t flags, void* data,
     return SvCUR(message);
 }
 
-int pl_console_init(Duk* duk)
+int pl_console_callback(void* data, duk_uint_t flags,const char* fmt, va_list ap)
 {
-    /* initialize console object */
-    duk_console_init(duk->ctx, DUK_CONSOLE_PROXY_WRAPPER | DUK_CONSOLE_FLUSH);
+    dTHX;
+    Duk* duk = (Duk*) data;
 
     if (duk->flags & DUK_OPT_FLAG_SAVE_MESSAGES) {
-        duk_console_register_handler(save_console_messages, duk);
+        return save_console_messages(aTHX_ duk,flags,fmt,ap);
     }
     else {
-        duk_console_register_handler(print_console_messages, duk);
+        return print_console_messages(aTHX_ flags,fmt,ap);
     }
+}
+
+int pl_console_init(Duk* duk)
+{
+    /* initialize console object */
+    duk_console_init(duk->ctx, DUK_CONSOLE_PROXY_WRAPPER | DUK_CONSOLE_FLUSH);
+
+    /* save our duk pointer to the ctx so it can get it back later when we do callbacks */
+    duk_push_thread_stash(duk->ctx,duk->ctx);
+    duk_push_pointer(duk->ctx, duk);
+    duk_put_prop_string(duk->ctx, -2, PL_NAME_CONSOLE_GENERIC_CALLBACK); 
+    duk_pop(duk->ctx);
 
     return 0;
 }
diff --git a/pl_duk.c b/pl_duk.c
@@ -17,6 +17,7 @@
 static duk_ret_t perl_caller(duk_context* ctx);
 
 static HV* seen;
+static int skip_func_create = 0; //A flag, when set we skip the creation of a perl function
 
 static inline SV* _cstr_to_svpv(pTHX_ const char* cstr, STRLEN clen) {
     SV* ret = newSVpv(cstr, clen);
@@ -59,7 +60,7 @@ static SV* pl_duk_to_perl_impl(pTHX_ duk_context* ctx, int pos, HV* seen)
                 /* if the JS function has a slot with the Perl callback, */
                 /* then we know we created it, so we return that */
                 if (duk_get_prop_lstring(ctx, pos, PL_SLOT_GENERIC_CALLBACK, sizeof(PL_SLOT_GENERIC_CALLBACK) - 1)) {
-                    ret = (SV*) duk_get_pointer(ctx, pos);
+                    ret = newSVsv((SV*) duk_get_pointer(ctx, pos));
                 }
                 duk_pop(ctx); /* pop function / null pointer */
             } else if (duk_is_array(ctx, pos)) {
@@ -273,15 +274,23 @@ static int pl_perl_to_duk_impl(pTHX_ SV* value, duk_context* ctx, HV* seen, int
         } else if (type == SVt_PVCV) {
             /* use perl_caller as generic handler, but store the real callback */
             /* in a slot, from where we can later retrieve it */
-            SV* func = newSVsv(value);
-            duk_push_c_function(ctx, perl_caller, DUK_VARARGS);
-            if (!func) {
-                croak("Could not create copy of Perl callback\n");
-            }
-            duk_push_pointer(ctx, func);
-            if (! duk_put_prop_lstring(ctx, -2, PL_SLOT_GENERIC_CALLBACK, sizeof(PL_SLOT_GENERIC_CALLBACK) - 1)) {
-                croak("Could not associate C dispatcher and Perl callback\n");
-            }
+
+            /* if the flag is set, it means we have already created the function and we don't need to do anything */
+            if (skip_func_create==1) {
+				skip_func_create = 0;
+			}
+			else {
+				/* In cases where we have a function references as part of the object - not sure of the use case here?*/
+				SV* func = newSVsv(value);
+				duk_push_c_function(ctx, perl_caller, DUK_VARARGS);
+				if (!func) {
+				   croak("Could not create copy of Perl callback\n");
+				}
+				duk_push_pointer(ctx, func);
+				if (! duk_put_prop_lstring(ctx, -2, PL_SLOT_GENERIC_CALLBACK, sizeof(PL_SLOT_GENERIC_CALLBACK) - 1)) {
+				   croak("Could not associate C dispatcher and Perl callback\n");
+				}
+			}
         } else {
             croak("Don't know how to deal with an undetermined Perl reference (type: %d)\n", type);
             ret = 0;
@@ -515,19 +524,37 @@ SV* pl_get_global_or_property(pTHX_ duk_context* ctx, const char* name)
     return ret;
 }
 
-int pl_set_global_or_property(pTHX_ duk_context* ctx, const char* name, SV* value)
+int pl_set_global_or_property(pTHX_ Duk* duk, const char* name, SV* value)
 {
     int len = 0;
     int last_dot = 0;
+	duk_context* ctx = duk->ctx;
+
+    last_dot = find_last_dot(name, &len);
 
-    /* fprintf(stderr, "STACK: %ld\n", (long) duk_get_top(ctx)); */
+    /* Treat perl functions differently as we need to keep track of them so we don't create memory leaks when using closures*/
+    if (SvROK(value)) {
+		SV* ref = SvRV(value);
+		if (SvTYPE(ref) == SVt_PVCV) {
+            /*We have a coderef, inc the ref count to keep it alive, and save the name in out struct to we can drop it again later */
+            SvREFCNT_inc(value);
+            hv_store(duk->funcref, name, len, value, 0);
+			duk_push_c_function(ctx, perl_caller, DUK_VARARGS);
+			duk_push_pointer(ctx, value);
+			if (! duk_put_prop_lstring(ctx, -2, PL_SLOT_GENERIC_CALLBACK, sizeof(PL_SLOT_GENERIC_CALLBACK) - 1)) {
+			    croak("Could not associate C dispatcher and Perl callback\n");
+			}
+            //Set the flag so we know not to create this function later. 
+			skip_func_create = 1;
+		}
+	}
 
     if (pl_perl_to_duk(aTHX_ value, ctx)) {
         /* that put value in stack */
     } else {
         return 0;
     }
-    last_dot = find_last_dot(name, &len);
+
     if (last_dot < 0) {
         if (duk_put_global_lstring(ctx, name, len)) {
             /* that consumed value that was in stack */
@@ -554,10 +581,15 @@ int pl_set_global_or_property(pTHX_ duk_context* ctx, const char* name, SV* valu
     return 1;
 }
 
-int pl_del_global_or_property(pTHX_ duk_context* ctx, const char* name)
+int pl_del_global_or_property(pTHX_ Duk* duk, const char* name)
 {
+	duk_context* ctx = duk->ctx;
     int len = 0;
     int last_dot = find_last_dot(name, &len);
+
+    /* treat perl functions differently, if the name exists in the hash, it'll drop reference count */
+	hv_delete(duk->funcref,name,len,0);
+
     if (last_dot < 0) {
         duk_push_global_object(ctx);
         duk_del_prop_lstring(ctx, -1, name, len);
@@ -586,7 +618,7 @@ SV* pl_eval(pTHX_ Duk* duk, const char* js, const char* file)
         duk_uint_t flags = 0;
 
         /* flags |= DUK_COMPILE_STRICT; */
-
+        
         pl_stats_start(aTHX_ duk, &stats);
         if (!file) {
             /* Compile the requested code without a reference to the file where it lives */
@@ -600,7 +632,7 @@ SV* pl_eval(pTHX_ Duk* duk, const char* js, const char* file)
         pl_stats_stop(aTHX_ duk, &stats, "compile");
         if (rc != DUK_EXEC_SUCCESS) {
             /* Only for an error this early we print something out and bail out */
-            duk_console_log(DUK_CONSOLE_FLUSH | DUK_CONSOLE_TO_STDERR,
+            duk_console_log(ctx,DUK_CONSOLE_FLUSH | DUK_CONSOLE_TO_STDERR,
                             "JS could not compile code: %s\n",
                             duk_safe_to_string(ctx, -1));
             break;