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);