Author: chromatic
Date: Mon Apr 23 09:38:02 2007
New Revision: 18305
Modified:
trunk/src/pmc/smop_attribute.pmc
trunk/t/pmc/smop_attribute.t
Log:
[PMC] Removed a GC hint from SMOP_Attribute that caused occasional segfaults.
Added a test that exposes those segfaults without this patch.
Miscellaneous tidying of the PMC and the test.
Fixed a couple of doc bugs in the PMC.
Modified: trunk/src/pmc/smop_attribute.pmc
==============================================================================
--- trunk/src/pmc/smop_attribute.pmc (original)
+++ trunk/src/pmc/smop_attribute.pmc Mon Apr 23 09:38:02 2007
@@ -1,17 +1,17 @@
/*
-Copyright (C) 2001-2005, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
-src/pmc/smop_class.pmc - SMOP Class
+src/pmc/smop_attribute.pmc - SMOP Attribute
=head1 DESCRIPTION
-This class, smop_class, implements the class class of the simple meta
+This class, SMOP_Attribute, implements the attribute class of the simple meta
object protocol.
-=head2 Functions
+=head2 Methods
=over 4
@@ -30,13 +30,13 @@
static void smop_init(Interp *interp, PMC *self) {
SMOP_Attribute *smop = NULL;
- /* turn on marking of the class_data array */
- PObj_data_is_PMC_array_SET(self);
- /* turn on custom destruction since our PMC* array is dynamically
allocated */
+
+ /* turn on custom destruction since our PMC* array is dynamically allocated
+ */
PObj_active_destroy_SET(self);
- PMC_data(self) = mem_sys_allocate_zeroed(sizeof(SMOP_Attribute));
- smop = SMOP_attr(self);
+ PMC_data(self) = mem_allocate_zeroed_typed(SMOP_Attribute);
+ smop = SMOP_attr(self);
}
@@ -75,7 +75,10 @@
*/
void destroy() {
+ if (PMC_data(SELF)) {
mem_sys_free(PMC_data(SELF));
+ PMC_data(SELF) = NULL;
+ }
}
Modified: trunk/t/pmc/smop_attribute.t
==============================================================================
--- trunk/t/pmc/smop_attribute.t (original)
+++ trunk/t/pmc/smop_attribute.t Mon Apr 23 09:38:02 2007
@@ -6,7 +6,6 @@
t/pmc/smop_attribute.t - test the new SMOP Attribute PMC
-
=head1 SYNOPSIS
% prove t/pmc/smop_attribute.t
@@ -32,47 +31,51 @@
$P0 = new 'SMOP_Attribute'
isa_ok ($P0, 'SMOP_Attribute')
+ # SMOP_Attribute used to cause segfaults when GC ran (RT #42408)
+ $P1 = getinterp
+ $P1.'run_gc'()
+
+ $P0 = new 'SMOP_Attribute'
+ $S0 = $P0.'name'("TestClass1")
+ is ($S0, 'TestClass1', 'test the SMOP_Attribute name method')
+
+ $S1 = $P0.'name'()
+ is ($S1, 'TestClass1', 'test the SMOP_Attribute name method')
+
+ $P0 = new 'SMOP_Attribute'
+ $S0 = $P0.'type'("TestTypeClass1")
+ is ($S0, 'TestTypeClass1', 'test the SMOP_Attribute name method')
+ $S1 = $P0.'type'()
+ is ($S1, 'TestTypeClass1', 'test the SMOP_Attribute name method')
+
+ $P1 = new 'ResizableIntegerArray'
+ push $P1, 1
+ push $P1, 2
+ push $P1, 3
- $P0 = new 'SMOP_Attribute'
- $S0 = $P0.'name'("TestClass1")
- is ($S0, 'TestClass1', 'test the SMOP_Attribute name method')
-
- $S1 = $P0.'name'()
- is ($S1, 'TestClass1', 'test the SMOP_Attribute name method')
-
- $P0 = new 'SMOP_Attribute'
- $S0 = $P0.'type'("TestTypeClass1")
- is ($S0, 'TestTypeClass1', 'test the SMOP_Attribute name method')
- $S1 = $P0.'type'()
- is ($S1, 'TestTypeClass1', 'test the SMOP_Attribute name method')
-
- $P1 = new 'ResizableIntegerArray'
- push $P1, 1
- push $P1, 2
- push $P1, 3
-
- $P0 = new 'SMOP_Attribute'
- $P2 = $P0.'class'($P1)
- get_repr $S0, $P2
- is ($S0, '[ 1, 2, 3 ]', 'test the SMOP_Attribute type method with a
ResizableIntegerArray' )
- $P3 = $P0.'class'()
- get_repr $S1, $P3
- is ($S1, '[ 1, 2, 3 ]', 'test the SMOP_Attribute type method with a
ResizableIntegerArray' )
-
-
- $P1 = new 'FixedIntegerArray'
- set $P1, 3
- $P1[0]= 1
- $P1[1]= 2
- $P1[2]= 3
-
- $P0 = new 'SMOP_Attribute'
- $P2 = $P0.'class'($P1)
- get_repr $S0, $P2
- is( $S0, '[ 1, 2, 3 ]', 'test the SMOP_Attribute class method with a
FixedIntegerArray' )
- $P3 = $P0.'class'()
- get_repr $S1, $P3
- is( $S1, '[ 1, 2, 3 ]', 'test the SMOP_Attribute class method with a
FixedIntegerArray' )
+ $P0 = new 'SMOP_Attribute'
+ $P2 = $P0.'class'($P1)
+ get_repr $S0, $P2
+ is ($S0, '[ 1, 2, 3 ]', 'test the SMOP_Attribute type method with a
ResizableIntegerArray' )
+ $P3 = $P0.'class'()
+ get_repr $S1, $P3
+ is ($S1, '[ 1, 2, 3 ]', 'test the SMOP_Attribute type method with a
ResizableIntegerArray' )
+
+
+ $P1 = new 'FixedIntegerArray'
+ set $P1, 3
+ $P1[0]= 1
+ $P1[1]= 2
+ $P1[2]= 3
+
+ $P0 = new 'SMOP_Attribute'
+ $P2 = $P0.'class'($P1)
+ get_repr $S0, $P2
+ is( $S0, '[ 1, 2, 3 ]', 'test the SMOP_Attribute class method with a
FixedIntegerArray' )
+
+ $P3 = $P0.'class'()
+ get_repr $S1, $P3
+ is( $S1, '[ 1, 2, 3 ]', 'test the SMOP_Attribute class method with a
FixedIntegerArray' )
.end
