You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2005/04/29 00:22:25 UTC
svn commit: r165214 - in /perl/modperl/branches/clone-skip-unstable:
lib/ModPerl/ src/modules/perl/ t/apr-ext/ t/conf/ t/lib/TestAPRlib/
t/lib/TestCommon/ t/perl/ t/response/TestPerl/ todo/ xs/ xs/APR/Bucket/
xs/APR/Pool/ xs/APR/Table/ xs/maps/
Author: stas
Date: Thu Apr 28 15:22:22 2005
New Revision: 165214
URL: http://svn.apache.org/viewcvs?rev=165214&view=rev
Log:
revert: wrong branch :(
Modified:
perl/modperl/branches/clone-skip-unstable/lib/ModPerl/TypeMap.pm
perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.c
perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.h
perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_util.c
perl/modperl/branches/clone-skip-unstable/t/apr-ext/pool.t
perl/modperl/branches/clone-skip-unstable/t/apr-ext/table.t
perl/modperl/branches/clone-skip-unstable/t/conf/modperl_extra.pl
perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/pool.pm
perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/table.pm
perl/modperl/branches/clone-skip-unstable/t/lib/TestCommon/Utils.pm
perl/modperl/branches/clone-skip-unstable/t/perl/ithreads.t
perl/modperl/branches/clone-skip-unstable/t/perl/ithreads_cloning.t
perl/modperl/branches/clone-skip-unstable/t/response/TestPerl/ithreads_cloning.pm
perl/modperl/branches/clone-skip-unstable/todo/release
perl/modperl/branches/clone-skip-unstable/xs/APR/Bucket/APR__Bucket.h
perl/modperl/branches/clone-skip-unstable/xs/APR/Pool/APR__Pool.h
perl/modperl/branches/clone-skip-unstable/xs/APR/Table/APR__Table.h
perl/modperl/branches/clone-skip-unstable/xs/maps/apr_functions.map
perl/modperl/branches/clone-skip-unstable/xs/typemap
Modified: perl/modperl/branches/clone-skip-unstable/lib/ModPerl/TypeMap.pm
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/lib/ModPerl/TypeMap.pm?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/lib/ModPerl/TypeMap.pm (original)
+++ perl/modperl/branches/clone-skip-unstable/lib/ModPerl/TypeMap.pm Thu Apr 28 15:22:22 2005
@@ -499,15 +499,8 @@
$define = "mp_xs_${ptype}_2obj";
$code .= <<EOF;
-MP_INLINE SV *$define(pTHX_ void *ptr);
-MP_INLINE SV *$define(pTHX_ void *ptr)
-{
- SV *rv = sv_setref_pv(sv_newmortal(), "$class", ptr);
- if (ptr) {
- MP_CLONE_INSERT_OBJ("$class", rv);
- }
- return rv;
-}
+#define $define(ptr) \\
+sv_setref_pv(sv_newmortal(), "$class", (void*)ptr)
EOF
Modified: perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.c
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.c?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.c (original)
+++ perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.c Thu Apr 28 15:22:22 2005
@@ -64,9 +64,8 @@
SV *hv = (SV*)newHV();
SV *rsv = sv_newmortal();
- SV *rv = sv_setref_pv(rsv, classname, p);
- MP_CLONE_INSERT_OBJ("APR::Table", rv);
-
+ sv_setref_pv(rsv, classname, p);
+
/* Prefetch magic requires perl 5.8 */
#if ((PERL_REVISION == 5) && (PERL_VERSION >= 8))
Modified: perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.h
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.h?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.h (original)
+++ perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_common_util.h Thu Apr 28 15:22:22 2005
@@ -97,128 +97,5 @@
SV *modperl_perl_gensym(pTHX_ char *pack);
-/*** ithreads enabled perl CLONE support ***/
-#define MP_CLONE_DEBUG 1
-
-#define MP_CLONE_HASH_NAME "::CLONE_objects"
-#define MP_CLONE_HASH_NAME1 "CLONE_objects"
-#define MP_CLONE_HASH_LEN1 13
-
-/* some classes like APR::Table get the key in a different way and
- * therefore should redefine this define */
-#define MP_CLONE_KEY_COMMON(obj) SvIVX(SvRV(obj))
-
-#define MP_CLONE_GET_HV(namespace) \
- get_hv(Perl_form(aTHX_ "%s::%s", namespace, MP_CLONE_HASH_NAME), TRUE);
-
-#if MP_CLONE_DEBUG
-
-#define MP_CLONE_DEBUG_INSERT_KEY(namespace, obj) \
- Perl_warn(aTHX_ "%s %p: insert %s, %p => %p", \
- namespace, aTHX_ SvPV_nolen(sv_key), obj, SvRV(obj));
-
-#define MP_CLONE_DEBUG_HOLLOW_KEY(namespace) \
- Perl_warn(aTHX_ "%s %p: hollow %s", namespace, \
- aTHX_ SvPVX(hv_iterkeysv(he)));
-
-#define MP_CLONE_DEBUG_DELETE_KEY(namespace) \
- Perl_warn(aTHX_ "%s %p: delete %s", namespace, aTHX_ SvPVX(sv_key));
-
-#define MP_CLONE_DEBUG_CLONE(namespace) \
- Perl_warn(aTHX_ "%s %p: CLONE called", namespace, aTHX);
-
-#define MP_CLONE_DUMP_OBJECTS_HASH(namespace) \
- { \
- HE *he; \
- HV *hv = MP_CLONE_GET_HV(namespace); \
- Perl_warn(aTHX_ "%s %p: DUMP", namespace, aTHX); \
- hv_iterinit(hv); \
- while ((he = hv_iternext(hv))) { \
- SV *key = hv_iterkeysv(he); \
- SV *val = hv_iterval(hv, he); \
- Perl_warn(aTHX_ "\t%s => %p => %p\n", SvPVX(key), \
- val, SvRV(val)); \
- } \
- }
-
-#else /* if MP_CLONE_DEBUG */
-
-#define MP_CLONE_DEBUG_INSERT_KEY(namespace, obj)
-#define MP_CLONE_DEBUG_HOLLOW_KEY(namespace)
-#define MP_CLONE_DEBUG_DELETE_KEY(namespace)
-#define MP_CLONE_DEBUG_CLONE(namespace)
-#define MP_CLONE_DUMP_OBJECTS_HASH(namespace)
-
-#endif /* if MP_CLONE_DEBUG */
-
-#ifdef SvWEAKREF
-#define WEAKEN(sv) sv_rvweaken(sv)
-#else
-#error "weak references are not implemented in this release of perl");
-#endif
-
-#define MP_CLONE_INSERT_OBJ(namespace, obj) \
- { \
- SV *weak_rv, *sv_key; \
- /* $objects{"$$self"} = $self; \
- Scalar::Util::weaken($objects{"$$self"}) \
- */ \
- HV *hv = MP_CLONE_GET_HV(namespace); \
-/* use the real object pointer as a unique key */ \
- sv_key = newSVpvf("%p", MP_CLONE_KEY_COMMON((obj))); \
- MP_CLONE_DEBUG_INSERT_KEY("a", (obj)); \
- weak_rv = newRV(SvRV((obj))); \
- WEAKEN(weak_rv); /* à la Scalar::Util::weaken */ \
- { \
- HE *ok = hv_store_ent(hv, sv_key, weak_rv, FALSE); \
- sv_free(sv_key); \
- if (ok == NULL) { \
- SvREFCNT_dec(weak_rv); \
- Perl_croak(aTHX_ "failed to insert into %%%s::%s", \
- namespace, MP_CLONE_HASH_NAME); \
- } \
- MP_CLONE_DUMP_OBJECTS_HASH(namespace); \
- } \
- }
-
-#define MP_CLONE_DO_CLONE(namespace, class) \
- { \
- HE *he; \
- HV *hv = MP_CLONE_GET_HV(namespace); \
- MP_CLONE_DEBUG_CLONE(namespace); \
- MP_CLONE_DUMP_OBJECTS_HASH(namespace); \
- hv_iterinit(hv); \
- while ((he = hv_iternext(hv))) { \
- SV *rv = hv_iterval(hv, he); \
- SV *sv = SvRV(rv); \
- /* sv_dump(rv); */ \
- MP_CLONE_DEBUG_HOLLOW_KEY(namespace); \
- if (sv) { \
- /* detach from the C struct and invalidate */ \
- mg_free(sv); /* remove any magic */ \
- SvFLAGS(sv) = 0; /* invalidate the sv */ \
- /* sv_free(sv); */ \
- } \
- /* sv_dump(sv); */ \
- /* sv_dump(rv); */ \
- SV *sv_key = hv_iterkeysv(he); \
- hv_delete_ent(hv, sv_key, G_DISCARD, FALSE); \
- } \
- MP_CLONE_DUMP_OBJECTS_HASH(namespace); \
- class = class; /* unused */ \
- }
-
-/* obj: SvRV'd object */
-#define MP_CLONE_DELETE_OBJ(namespace, obj) \
- { \
- HV *hv = MP_CLONE_GET_HV(namespace); \
- SV *sv_key = newSVpvf("%p", MP_CLONE_KEY_COMMON(obj)); \
- /* delete $CLONE_objects{"$$self"}; */ \
- MP_CLONE_DEBUG_DELETE_KEY(namespace); \
- hv_delete_ent(hv, sv_key, G_DISCARD, FALSE); \
- sv_free(sv_key); \
- MP_CLONE_DUMP_OBJECTS_HASH(namespace); \
- }
-
#endif /* MODPERL_COMMON_UTIL_H */
Modified: perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_util.c
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_util.c?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_util.c (original)
+++ perl/modperl/branches/clone-skip-unstable/src/modules/perl/modperl_util.c Thu Apr 28 15:22:22 2005
@@ -192,15 +192,11 @@
MP_INLINE SV *modperl_ptr2obj(pTHX_ char *classname, void *ptr)
{
SV *sv = newSV(0);
- SV *rv;
-
+
MP_TRACE_h(MP_FUNC, "sv_setref_pv(%s, 0x%lx)\n",
classname, (unsigned long)ptr);
- rv = sv_setref_pv(sv, classname, ptr);
- if (ptr) {
- MP_CLONE_INSERT_OBJ(classname, rv);
- }
-
+ sv_setref_pv(sv, classname, ptr);
+
return sv;
}
Modified: perl/modperl/branches/clone-skip-unstable/t/apr-ext/pool.t
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/apr-ext/pool.t?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/apr-ext/pool.t (original)
+++ perl/modperl/branches/clone-skip-unstable/t/apr-ext/pool.t Thu Apr 28 15:22:22 2005
@@ -2,14 +2,10 @@
use strict;
use warnings FATAL => 'all';
-
-use threads;
+use Apache::Test;
use TestAPRlib::pool;
-use Apache::Test;
-
plan tests => TestAPRlib::pool::num_of_tests();
TestAPRlib::pool::test();
-
Modified: perl/modperl/branches/clone-skip-unstable/t/apr-ext/table.t
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/apr-ext/table.t?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/apr-ext/table.t (original)
+++ perl/modperl/branches/clone-skip-unstable/t/apr-ext/table.t Thu Apr 28 15:22:22 2005
@@ -2,7 +2,6 @@
use strict;
use warnings FATAL => 'all';
-use Test::More ();
use Apache::Test;
use TestAPRlib::table;
Modified: perl/modperl/branches/clone-skip-unstable/t/conf/modperl_extra.pl
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/conf/modperl_extra.pl?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/conf/modperl_extra.pl (original)
+++ perl/modperl/branches/clone-skip-unstable/t/conf/modperl_extra.pl Thu Apr 28 15:22:22 2005
@@ -29,12 +29,6 @@
use Apache2::Process ();
use Apache2::Log ();
-use TestCommon::Utils;
-# XXX: must be loaded before Test::Builder gets loaded (via A-T or
-# Test::More) so it'll get the threads right.
-require threads if TestCommon::Utils::THREADS_OK;
-# XXX: need to do the same for t/TEST for apr-ext tests
-
use Apache2::Const -compile => ':common';
reorg_INC();
Modified: perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/pool.pm
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/pool.pm?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/pool.pm (original)
+++ perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/pool.pm Thu Apr 28 15:22:22 2005
@@ -3,9 +3,7 @@
use strict;
use warnings FATAL => 'all';
-use TestCommon::Utils;
-
-use Apache::Test; # for a shared test counter under ithreads
+use Apache::Test;
use Apache::TestUtil;
use Apache::TestTrace;
@@ -13,28 +11,11 @@
use APR::Table ();
sub num_of_tests {
- my $runs = 1;
- $runs += 3 if TestCommon::Utils::THREADS_OK;
-
- return $runs * 75;
+ return 75;
}
sub test {
- test_set();
-
- return unless TestCommon::Utils::THREADS_OK;
-
- require threads;
- our $p = APR::Pool->new;
- my $threads = 2;
- threads->new(\&test_set)->join for 1..$threads;
- test_set(); # parent again
-
- #$_->join() for threads->list();
-}
-
-sub test_set {
my $pool = APR::Pool->new();
my $table = APR::Table::make($pool, 2);
@@ -426,8 +407,6 @@
#ok $num_bytes;
}
-
- return undef; # a must for thread callback
}
# returns how many ancestor generations the pool has (parent,
Modified: perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/table.pm
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/table.pm?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/table.pm (original)
+++ perl/modperl/branches/clone-skip-unstable/t/lib/TestAPRlib/table.pm Thu Apr 28 15:22:22 2005
@@ -5,51 +5,29 @@
use strict;
use warnings FATAL => 'all';
-use Test::More ();
use Apache::Test;
use Apache::TestUtil;
use APR::Table ();
use APR::Pool ();
-use TestCommon::Utils;
-
use APR::Const -compile => ':table';
use constant TABLE_SIZE => 20;
our $filter_count;
sub num_of_tests {
- my $runs = 1;
- $runs += 3 if TestCommon::Utils::THREADS_OK;
-
my $tests = 56;
+
# tied hash values() for a table w/ multiple values for the same
# key
$tests += 2 if $] >= 5.008;
- return $tests * $runs;
+ return $tests;
}
sub test {
- test_set();
-
- return unless TestCommon::Utils::THREADS_OK;
-
- require threads;
- our $p = APR::Pool->new;
- my $threads = 2;
-
- threads->new(\&test_set)->join for 1..$threads;
- test_set(); # parent again
-
- # XXX: at the moment serializing each run, since ok's gets
- # interleaved with other otput when multple threads run at the
- # same time
- #$_->join() for threads->list();
-}
-sub test_set {
$filter_count = 0;
my $pool = APR::Pool->new();
my $table = APR::Table::make($pool, TABLE_SIZE);
Modified: perl/modperl/branches/clone-skip-unstable/t/lib/TestCommon/Utils.pm
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/lib/TestCommon/Utils.pm?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/lib/TestCommon/Utils.pm (original)
+++ perl/modperl/branches/clone-skip-unstable/t/lib/TestCommon/Utils.pm Thu Apr 28 15:22:22 2005
@@ -11,9 +11,6 @@
use Apache2::Const -compile => qw(MODE_READBYTES);
use APR::Const -compile => qw(SUCCESS BLOCK_READ);
-use Config;
-use constant THREADS_OK => $] >= 5.008 && $Config{useithreads};
-
use constant IOBUFSIZE => 8192;
# perl 5.6.x only triggers taint protection on strings which are at
Modified: perl/modperl/branches/clone-skip-unstable/t/perl/ithreads.t
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/perl/ithreads.t?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/perl/ithreads.t (original)
+++ perl/modperl/branches/clone-skip-unstable/t/perl/ithreads.t Thu Apr 28 15:22:22 2005
@@ -8,11 +8,9 @@
# perl < 5.6.0 fails to compile code with 'shared' attributes, so we must skip
# it here.
-#unless ($] >= 5.008001 && $Config{useithreads}) {
-# plan tests => 1, need
-# {"perl 5.8.1 or higher w/ithreads enabled is required" => 0};
-#}
-
-plan tests => 1, under_construction;
+unless ($] >= 5.008001 && $Config{useithreads}) {
+ plan tests => 1, need
+ {"perl 5.8.1 or higher w/ithreads enabled is required" => 0};
+}
print GET_BODY_ASSERT "/TestPerl__ithreads";
Modified: perl/modperl/branches/clone-skip-unstable/t/perl/ithreads_cloning.t
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/perl/ithreads_cloning.t?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/perl/ithreads_cloning.t (original)
+++ perl/modperl/branches/clone-skip-unstable/t/perl/ithreads_cloning.t Thu Apr 28 15:22:22 2005
@@ -1,16 +0,0 @@
-# WARNING: this file is generated, do not edit
-# 01: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestConfig.pm:927
-# 02: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestConfig.pm:945
-# 03: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestConfigPerl.pm:135
-# 04: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestConfigPerl.pm:550
-# 05: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestConfig.pm:613
-# 06: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestConfig.pm:628
-# 07: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestConfig.pm:1562
-# 08: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestRun.pm:506
-# 09: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestRunPerl.pm:84
-# 10: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestRun.pm:725
-# 11: /home/stas/apache.org/mp2-svn/Apache-Test/lib/Apache/TestRun.pm:725
-# 12: t/TEST:21
-
-use Apache::TestRequest 'GET_BODY_ASSERT';
-print GET_BODY_ASSERT "/TestPerl__ithreads_cloning";
Modified: perl/modperl/branches/clone-skip-unstable/t/response/TestPerl/ithreads_cloning.pm
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/t/response/TestPerl/ithreads_cloning.pm?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/t/response/TestPerl/ithreads_cloning.pm (original)
+++ perl/modperl/branches/clone-skip-unstable/t/response/TestPerl/ithreads_cloning.pm Thu Apr 28 15:22:22 2005
@@ -1,135 +0,0 @@
-package TestPerl::ithreads_cloning;
-
-# a few basic tests on how mp2 objects deal with cloning (used
-# APR::Table and APR::Pool for the tests)
-#
-
-use strict;
-use warnings FATAL => 'all';
-
-use APR::Table ();
-use APR::Pool ();
-
-use Apache::Test;
-use Apache::TestUtil;
-
-use TestCommon::Utils;
-
-use Devel::Peek;
-
-use Apache2::Const -compile => 'OK';
-
-my $pool_ext = APR::Pool->new;
-my $table_ext1 = APR::Table::make($pool_ext, 10);
-my $table_ext2 = APR::Table::make($pool_ext, 10);
-
-my $threads = 2;
-
-sub handler {
- my $r = shift;
-
- my $tests = 10 * (2 + $threads);
- plan $r, tests => $tests, need
- need_threads,
- {"perl >= 5.8.1 is required (this is $])" => ($] >= 5.008001)};
-
- require threads;
- threads->import();
-
- read_test();
- #Dump $pool_ext;
- #Dump $table_ext1;
- threads->new(\&read_test)->join() for 1..$threads;
- #Dump $pool_ext;
- #Dump $table_ext1;
- read_test();
-
- Apache2::Const::OK;
-}
-
-# 10 subtests
-sub read_test {
- my $tid = threads->self()->tid();
- t_debug "tid: $tid";
-
- {
- # use of invalidated cloned object
- my $error_msg = q[Can't call method "set" on unblessed reference];
- eval { $table_ext1->set(1 => 2); };
- if ($tid > 0) { # child thread
- # set must fail, since $table_ext1 must have been invalidated
- ok t_cmp $@, qr/\Q$error_msg/,
- '$table_ext1 must have been invalidated';
- }
- else {
- # should work just fine for the parent "thread", which
- # created this variable
- ok !$@;
- }
- }
-
- {
- # use of invalidated cloned object as an argument
- my $error_msg = 'argument is not a blessed reference ' .
- '(expecting an APR::Pool derived object)';
- eval { my $table = APR::Table::make($pool_ext, 10) };
- if ($tid > 0) { # child thread
- # make() must fail, since $pool_ext must have been invalidated
- ok t_cmp $@, qr/\Q$error_msg/,
- '$pool_ext must have been invalidated';
- }
- else {
- # should work just fine for the parent "thread", which
- # created this variable
- ok !$@;
- }
- }
-
- {
- # this is an important test, since the thread assigns a new
- # value to the cloned $table_ext1 (since it existed before the
- # thread was started)
-
- my $save = $table_ext1;
-
- $table_ext1 = APR::Table::make(APR::Pool->new, 10);
-
- validate($table_ext1);
-
- $table_ext1 = $save;
- }
-
- {
- # here $table_ext2 is a private variable, so the cloned
- # variable $table_ext2 is not touched
- my $table_ext2 = APR::Table::make(APR::Pool->new, 10);
-
- validate($table_ext2);
- }
-
- return undef;
-}
-
-# 4 subtests
-sub validate {
- my $t = shift;
- my $tid = threads->self()->tid();
-
- $t->set($_ => $_) for 1..20;
- for my $count (1..2) {
- my $expected = 20;
- my $received = $t->get(20);
- is $received, $expected, "tid: $tid: pass 1:";
- $t->set(20 => 40);
- $received = $t->get(20);
- $expected = 40;
- is $received, $expected, "tid: $tid: pass 2:";
- # reset
- $t->set(20 => 20);
- }
-}
-
-1;
-
-__END__
-
Modified: perl/modperl/branches/clone-skip-unstable/todo/release
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/todo/release?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/todo/release (original)
+++ perl/modperl/branches/clone-skip-unstable/todo/release Thu Apr 28 15:22:22 2005
@@ -44,91 +44,3 @@
happy). Not sure what's the best solution here.
---------------
-
-Making mp2 API perl-thread-safe
-owner: stas
-
-Status:
-
-V = done
-N = creates no objects
-- = not started
-+ = in progress
-
-1)
-
--- APR::Bucket
--- APR::BucketType
-V- APR::Pool
--- APR::SockAddr
--- APR::Socket
-V- APR::Table
--- APR::UUID
-
-2)
-
--- APR::Brigade xs/APR/Brigade/APR__Brigade.h: SV *bb_sv = sv_setref_pv(NEWSV(0, 0), "APR::Brigade", (void*)bb);
--- APR::BucketAlloc xs/APR/BucketAlloc/APR__BucketAlloc.h: SV *ba_sv = sv_setref_pv(NEWSV(0, 0), "APR::BucketAlloc", (void*)ba);
--- APR::Error (not sure about this one, should probably handle as well)
--- APR::Finfo xs/APR/Finfo/APR__Finfo.h: finfo_sv = sv_setref_pv(NEWSV(0, 0), "APR::Finfo", (void*)finfo);
--- APR::IpSubnet xs/APR/IpSubnet/APR__IpSubnet.h: ipsub_sv = sv_setref_pv(NEWSV(0, 0), "APR::IpSubnet", (void*)ipsub);
--- APR::ThreadMutex xs/APR/ThreadMutex/APR__ThreadMutex.h: mutex_sv = sv_setref_pv(NEWSV(0, 0), "APR::ThreadMutex", (void*)mutex);
--- APR::URI xs/APR/URI/APR__URI.h: uri_sv = sv_setref_pv(NEWSV(0, 0), "APR::URI", (void*)uri);
-
-3)
-
--- Apache::CmdParms
--- Apache::Command
--- Apache::Connection
--- Apache::Directive
--- Apache::Filter
--- Apache::FilterRec
--- Apache::ServerRec
--- Apache::SubRequest
--- Apache::Module
--- Apache::Process
-
-4)
--- Apache::Log xs/Apache/Log/Apache__Log.h: sv_setref_pv(svretval, pclass, (void*)retval);
--- Apache::RequestRec
- src/modules/perl/modperl_io.c: sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
- src/modules/perl/modperl_io.c: sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
- src/modules/perl/modperl_io_apache.c: sv_setref_pv(sv, "Apache::RequestRec", (void*)(st->r));
- xs/Apache/RequestUtil/Apache__RequestUtil.h: r_sv = sv_setref_pv(NEWSV(0, 0), "Apache::RequestRec", (void*)r);
-
-
-4) The following too (needs more detailed lookthrough):
-
-V- src/modules/perl/modperl_util.c: sv_setref_pv(sv, classname, ptr);
-V- src/modules/perl/modperl_common_util.c: sv_setref_pv(rsv, classname, p);
-V- xs/typemap: sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-V- xs/typemap: sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-
-XXX: also grep for sv_bless
-
-+ need to add DESTROY and CLONE methods to all the classes that we
-have the objects blessed into
-
-None of the following classes is used to bless object and therefore
-they require no special CLONE handling:
-
-N- Apache::Access
-N- Apache::HookRun
-N- Apache::MPM
-N- Apache::RequestIO
-N- Apache::RequestUtil
-N- Apache::Response
-N- Apache::ServerUtil
-N- Apache::SubProcess
-N- Apache::URI
-N- Apache::Util
-N- APR::Base64
-N- APR::Date
-N- APR::OS
-N- APR::String
-N- APR::Util
-N- ModPerl::Global
-N- ModPerl::Util
-
-
-
Modified: perl/modperl/branches/clone-skip-unstable/xs/APR/Bucket/APR__Bucket.h
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/xs/APR/Bucket/APR__Bucket.h?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/xs/APR/Bucket/APR__Bucket.h (original)
+++ perl/modperl/branches/clone-skip-unstable/xs/APR/Bucket/APR__Bucket.h Thu Apr 28 15:22:22 2005
@@ -78,11 +78,6 @@
return APR_BUCKET_IS_EOS(bucket);
}
-static MP_INLINE int mpxs_APR__Bucket_is_eoc(apr_bucket *bucket)
-{
- return APR_BUCKET_IS_EOC(bucket);
-}
-
static MP_INLINE int mpxs_APR__Bucket_is_flush(apr_bucket *bucket)
{
return APR_BUCKET_IS_FLUSH(bucket);
Modified: perl/modperl/branches/clone-skip-unstable/xs/APR/Pool/APR__Pool.h
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/xs/APR/Pool/APR__Pool.h?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/xs/APR/Pool/APR__Pool.h (original)
+++ perl/modperl/branches/clone-skip-unstable/xs/APR/Pool/APR__Pool.h Thu Apr 28 15:22:22 2005
@@ -23,6 +23,20 @@
#endif
} mpxs_pool_account_t;
+/* XXX: this implementation has a problem with perl ithreads. if a
+ * custom pool is allocated, and then a thread is spawned we now have
+ * two copies of the pool object, each living in a different perl
+ * interpreter, both pointing to the same memory address of the apr
+ * pool.
+ *
+ * need to write a CLONE class method could properly clone the
+ * thread's copied object, but it's tricky:
+ * - it needs to call parent_get() on the copied object and allocate a
+ * new pool from that parent's pool
+ * - it needs to reinstall any registered cleanup callbacks (can we do
+ * that?) may be we can skip those?
+ */
+
#ifndef MP_SOURCE_SCAN
#include "apr_optional.h"
static
@@ -202,8 +216,6 @@
if (parent_pool) {
mpxs_add_pool_magic(rv, parent_pool_obj);
}
-
- MP_CLONE_INSERT_OBJ("APR::Pool", rv);
return rv;
}
@@ -339,7 +351,7 @@
apr_pool_t *parent_pool = apr_pool_parent_get(child_pool);
if (parent_pool) {
- return SvREFCNT_inc(mp_xs_APR__Pool_2obj(aTHX_ parent_pool));
+ return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
}
else {
MP_POOL_TRACE(MP_FUNC, "pool (0x%lx) has no parents",
@@ -356,20 +368,9 @@
{
SV *sv = SvRV(obj);
- MP_CLONE_DELETE_OBJ("APR::Pool", obj);
-
if (MP_APR_POOL_SV_HAS_OWNERSHIP(sv)) {
- //Perl_warn(aTHX_ "APR::Pool %p: DESTROY %p => %p", aTHX_ obj, sv);
apr_pool_t *p = mpxs_sv_object_deref(obj, apr_pool_t);
apr_pool_destroy(p);
-
}
-
- if (MP_APR_POOL_SV_HAS_OWNERSHIP(sv)) {
- /* do *not* merge this with the next conditional */
-
- }
-
}
-#define mpxs_APR__Pool_CLONE(class) MP_CLONE_DO_CLONE("APR::Pool", class)
Modified: perl/modperl/branches/clone-skip-unstable/xs/APR/Table/APR__Table.h
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/xs/APR/Table/APR__Table.h?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/xs/APR/Table/APR__Table.h (original)
+++ perl/modperl/branches/clone-skip-unstable/xs/APR/Table/APR__Table.h Thu Apr 28 15:22:22 2005
@@ -17,17 +17,11 @@
#define mpxs_APR__Table_DELETE apr_table_unset
#define mpxs_APR__Table_CLEAR apr_table_clear
-/* redefine the key method */
-#undef MP_CLONE_KEY_COMMON
-#define MP_CLONE_KEY_COMMON(obj) \
- modperl_hash_tied_object(aTHX_ "APR::Table", obj)
-
#define MPXS_DO_TABLE_N_MAGIC_RETURN(call) \
apr_pool_t *p = mp_xs_sv2_APR__Pool(p_sv); \
apr_table_t *t = call; \
SV *t_sv = modperl_hash_tie(aTHX_ "APR::Table", Nullsv, t); \
mpxs_add_pool_magic(t_sv, p_sv); \
- MP_CLONE_INSERT_OBJ("APR::Table", t_sv); \
return t_sv;
static MP_INLINE SV *mpxs_APR__Table_make(pTHX_ SV *p_sv, int nelts)
@@ -35,6 +29,7 @@
MPXS_DO_TABLE_N_MAGIC_RETURN(apr_table_make(p, nelts));
}
+
static MP_INLINE SV *mpxs_APR__Table_copy(pTHX_ apr_table_t *base, SV *p_sv)
{
MPXS_DO_TABLE_N_MAGIC_RETURN(apr_table_copy(p, base));
@@ -197,6 +192,7 @@
}
}
+
MP_STATIC XS(MPXS_apr_table_get)
{
dXSARGS;
@@ -235,8 +231,3 @@
});
}
-
-#define mpxs_APR__Table_CLONE(class) MP_CLONE_DO_CLONE("APR::Table", class)
-
-#define mpxs_APR__Table_DESTROY(obj) MP_CLONE_DELETE_OBJ("APR::Table", obj);
-
Modified: perl/modperl/branches/clone-skip-unstable/xs/maps/apr_functions.map
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/xs/maps/apr_functions.map?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/xs/maps/apr_functions.map (original)
+++ perl/modperl/branches/clone-skip-unstable/xs/maps/apr_functions.map Thu Apr 28 15:22:22 2005
@@ -174,7 +174,6 @@
~apr_pool_destroy
DEFINE_destroy | mpxs_apr_pool_DESTROY | SV *:obj
DEFINE_DESTROY | mpxs_apr_pool_DESTROY | SV *:obj
- DEFINE_CLONE | | SV *:class
>apr_pool_destroy_debug
SV *:DEFINE_new | mpxs_apr_pool_create | SV *:parent_pool_obj
-apr_pool_create_ex
@@ -247,8 +246,6 @@
apr_proc_mutex_unlock
MODULE=APR::Table
- DEFINE_CLONE | | SV *:class
- DEFINE_DESTROY | | SV *:obj
apr_table_clear
~apr_table_copy
mpxs_APR__Table_copy
Modified: perl/modperl/branches/clone-skip-unstable/xs/typemap
URL: http://svn.apache.org/viewcvs/perl/modperl/branches/clone-skip-unstable/xs/typemap?rev=165214&r1=165213&r2=165214&view=diff
==============================================================================
--- perl/modperl/branches/clone-skip-unstable/xs/typemap (original)
+++ perl/modperl/branches/clone-skip-unstable/xs/typemap Thu Apr 28 15:22:22 2005
@@ -6,20 +6,10 @@
######################################################################
OUTPUT
T_POOLOBJ
- {
- SV *rv = sv_setref_pv($arg, \"${ntype}\", (void*)$var);
- if ($var) {
- MP_CLONE_INSERT_OBJ("APR::Pool", rv);
- }
- }
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
T_APACHEOBJ
- {
- SV *rv = sv_setref_pv($arg, \"${ntype}\", (void*)$var);
- if ($var) {
- MP_CLONE_INSERT_OBJ("APR::Pool", rv);
- }
- }
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
T_HASHOBJ
$arg = modperl_hash_tie(aTHX_ \"${ntype}\", $arg, $var);