Mailing List Archive

Author: creamyg
Date: 2008-09-07 08:35:32 -0700 (Sun, 07 Sep 2008)
New Revision: 3837

Modified:
trunk/c_src/KinoSearch/Obj/VTable.c
trunk/perl/lib/KinoSearch.pm
Log:
Fix a memory leak for subclasses created from C -- their DESTROY methods were
not being called in Perl-space.


Modified: trunk/c_src/KinoSearch/Obj/VTable.c
===================================================================
--- trunk/c_src/KinoSearch/Obj/VTable.c 2008-09-07 15:31:47 UTC (rev 3836)
+++ trunk/c_src/KinoSearch/Obj/VTable.c 2008-09-07 15:35:32 UTC (rev 3837)
@@ -147,6 +147,16 @@

/* Store the virtual table in the registry. */
Hash_Store(VTable_registry, subclass_name, (Obj*)singleton);
+
+ /* Register class with host. */
+ Native_callback(&VTABLE, "_register", 2,
+ ARG_OBJ("singleton", singleton), ARG_OBJ("parent", parent));
+
+ /* Decrement the refcount so that the only count is one owned by the
+ * registry. This is a little tricky because it means that the caller
+ * has to use the vtable right away. If the vtable has its refcount
+ * incremented then decremented, the custom Dec_RefCount() method will
+ * trigger destruction. */
singleton->ref.count--;

/* Track globals to help hunt memory leaks. */

Modified: trunk/perl/lib/KinoSearch.pm
===================================================================
--- trunk/perl/lib/KinoSearch.pm 2008-09-07 15:31:47 UTC (rev 3836)
+++ trunk/perl/lib/KinoSearch.pm 2008-09-07 15:35:32 UTC (rev 3837)
@@ -223,6 +223,16 @@
}
return $methods;
}
+
+ sub _register {
+ my ( undef, %args ) = @_;
+ my $singleton_class = $args{singleton}->get_name;
+ my $parent_class = $args{parent}->get_name;
+ if ( !$singleton_class->isa($parent_class) ) {
+ no strict 'refs';
+ push @{"$singleton_class\::ISA"}, $parent_class;
+ }
+ }
}

{


_______________________________________________
kinosearch-commits mailing list
kinosearch-commits@rectangular.com
http://www.rectangular.com/mailman/listinfo/kinosearch-commits