svn commit: r123369 - /perl/modperl/trunk/Changes /perl/modperl/trunk/xs/APR/Pool/APR__Pool.h /perl/modperl/trunk/xs/modperl_xs_util.h

2004-12-26 Thread stas
Author: stas
Date: Sun Dec 26 15:05:39 2004
New Revision: 123369

URL: http://svn.apache.org/viewcvs?view=rev&rev=123369
Log:
make sure that we add the pools dependency only for non-native pools

Modified:
   perl/modperl/trunk/Changes
   perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
   perl/modperl/trunk/xs/modperl_xs_util.h

Modified: perl/modperl/trunk/Changes
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=123369&p1=perl/modperl/trunk/Changes&r1=123368&p2=perl/modperl/trunk/Changes&r2=123369
==
--- perl/modperl/trunk/Changes  (original)
+++ perl/modperl/trunk/Changes  Sun Dec 26 15:05:39 2004
@@ -17,7 +17,8 @@
 used it corrupted. the solution is to make the newly created objects
 refer to the underlying object via magic attachment. only objects
 using objects that have DESTROY are effected. This concerns some of
-the methods accepting the APR::Pool object. [Stas]
+the methods accepting the custom APR::Pool object (not native pools
+like $r->pool). [Stas]
 Adjusted: 
 - APR::Brigade: new
 - APR::Finfo: stat

Modified: perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/APR/Pool/APR__Pool.h?view=diff&rev=123369&p1=perl/modperl/trunk/xs/APR/Pool/APR__Pool.h&r1=123368&p2=perl/modperl/trunk/xs/APR/Pool/APR__Pool.h&r2=123369
==
--- perl/modperl/trunk/xs/APR/Pool/APR__Pool.h  (original)
+++ perl/modperl/trunk/xs/APR/Pool/APR__Pool.h  Sun Dec 26 15:05:39 2004
@@ -43,7 +43,7 @@
 APR_OPTIONAL_FN_TYPE(modperl_interp_unselect) *modperl_opt_interp_unselect;
 #endif
 
-#define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) (mg_find(sv, PERL_MAGIC_ext) != NULL)
+#define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) mpxs_pool_is_custom(sv)
 
 #ifdef USE_ITHREADS
 

Modified: perl/modperl/trunk/xs/modperl_xs_util.h
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/modperl_xs_util.h?view=diff&rev=123369&p1=perl/modperl/trunk/xs/modperl_xs_util.h&r1=123368&p2=perl/modperl/trunk/xs/modperl_xs_util.h&r2=123369
==
--- perl/modperl/trunk/xs/modperl_xs_util.h (original)
+++ perl/modperl/trunk/xs/modperl_xs_util.h Sun Dec 26 15:05:39 2004
@@ -104,20 +104,32 @@
 MARK++; \
 }
 
+/* custom pool objects created by modperl users (not internal like
+ * r->pool) are marked by magic in SvRV(obj)
+ */
+#define mpxs_pool_is_custom(pool) (mg_find(pool, PERL_MAGIC_ext) != NULL)
+
 /* several methods need to ensure that the pool that they take as an
  * object doesn't go out of scope before the object that they return,
  * since if this happens, the data contained in the later object
  * becomes corrupted. this macro is used in various xs files where
  * it's needed */
 #if ((PERL_REVISION == 5) && (PERL_VERSION >= 8))
-/* modperl_hash_tie already attached another _ext magic under
- * 5.8+, so must use sv_magicext to have two magics with the
- * type  */
-#define mpxs_add_pool_magic(obj, pool_obj)  \
+ /* sometimes the added magic is the second one (e.g. in case when
+  * the object is generated by modperl_hash_tie, so under 5.8+
+  * need to use sv_magicext, since sv_magicext does only one magic
+  * of the same type at 5.8+ */
+#define mpxs_add_pool_magic_doit(obj, pool_obj) \
 sv_magicext(SvRV(obj), pool_obj, PERL_MAGIC_ext, NULL, Nullch, -1)
 #else
-#define mpxs_add_pool_magic(obj, pool_obj)  \
+#define mpxs_add_pool_magic_doit(obj, pool_obj) \
 sv_magic(SvRV(obj), pool_obj, PERL_MAGIC_ext, Nullch, -1)
 #endif
+
+/* add dependency magic only for custom pools */
+#define mpxs_add_pool_magic(obj, pool_obj)  \
+if (mpxs_pool_is_custom(SvRV(pool_obj))) {  \
+mpxs_add_pool_magic_doit(obj, pool_obj);\
+}
 
 #endif /* MODPERL_XS_H */


svn commit: r123372 - /perl/modperl/trunk/src/modules/perl/modperl_filter.c /perl/modperl/trunk/src/modules/perl/modperl_io.c /perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h

2004-12-26 Thread stas
Author: stas
Date: Sun Dec 26 15:45:59 2004
New Revision: 123372

URL: http://svn.apache.org/viewcvs?view=rev&rev=123372
Log:
consistently use PERL_MAGIC_* macros everywhere (makes it easier to grep 
for certain kinds of magic)

Modified:
   perl/modperl/trunk/src/modules/perl/modperl_filter.c
   perl/modperl/trunk/src/modules/perl/modperl_io.c
   perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h

Modified: perl/modperl/trunk/src/modules/perl/modperl_filter.c
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_filter.c?view=diff&rev=123372&p1=perl/modperl/trunk/src/modules/perl/modperl_filter.c&r1=123371&p2=perl/modperl/trunk/src/modules/perl/modperl_filter.c&r2=123372
==
--- perl/modperl/trunk/src/modules/perl/modperl_filter.c(original)
+++ perl/modperl/trunk/src/modules/perl/modperl_filter.cSun Dec 26 
15:45:59 2004
@@ -354,13 +354,13 @@
 
 static void modperl_filter_mg_set(pTHX_ SV *obj, modperl_filter_t *filter)
 {
-sv_magic(SvRV(obj), Nullsv, '~', NULL, -1);
+sv_magic(SvRV(obj), Nullsv, PERL_MAGIC_ext, NULL, -1);
 SvMAGIC(SvRV(obj))->mg_ptr = (char *)filter;
 }
 
 modperl_filter_t *modperl_filter_mg_get(pTHX_ SV *obj)
 {
-MAGIC *mg = mg_find(SvRV(obj), '~');
+MAGIC *mg = mg_find(SvRV(obj), PERL_MAGIC_ext);
 return mg ? (modperl_filter_t *)mg->mg_ptr : NULL;
 }
 
@@ -375,7 +375,7 @@
 if (gv) {
 CV *cv = modperl_mgv_cv(gv);
 if (cv && SvMAGICAL(cv)) {
-MAGIC *mg = mg_find((SV*)(cv), '~');
+MAGIC *mg = mg_find((SV*)(cv), PERL_MAGIC_ext);
 init_handler_pv_code = mg ? mg->mg_ptr : NULL;
 }
 else {

Modified: perl/modperl/trunk/src/modules/perl/modperl_io.c
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_io.c?view=diff&rev=123372&p1=perl/modperl/trunk/src/modules/perl/modperl_io.c&r1=123371&p2=perl/modperl/trunk/src/modules/perl/modperl_io.c&r2=123372
==
--- perl/modperl/trunk/src/modules/perl/modperl_io.c(original)
+++ perl/modperl/trunk/src/modules/perl/modperl_io.cSun Dec 26 15:45:59 2004
@@ -28,7 +28,7 @@
 
 modperl_io_handle_untie(aTHX_ handle);
 
-sv_magic(TIEHANDLE_SV(handle), obj, 'q', Nullch, 0);
+sv_magic(TIEHANDLE_SV(handle), obj, PERL_MAGIC_tiedscalar, Nullch, 0);
 
 SvREFCNT_dec(obj); /* since sv_magic did SvREFCNT_inc */
 
@@ -78,7 +78,7 @@
 MAGIC *mg;
 SV *sv = TIEHANDLE_SV(handle);
 
-if (SvMAGICAL(sv) && (mg = mg_find(sv, 'q'))) {
+if (SvMAGICAL(sv) && (mg = mg_find(sv, PERL_MAGIC_tiedscalar))) {
char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
 
if (!strEQ(package, classname)) {
@@ -93,14 +93,14 @@
 MP_INLINE void modperl_io_handle_untie(pTHX_ GV *handle)
 {
 #ifdef MP_TRACE
-if (mg_find(TIEHANDLE_SV(handle), 'q')) {
+if (mg_find(TIEHANDLE_SV(handle), PERL_MAGIC_tiedscalar)) {
 MP_TRACE_r(MP_FUNC, "untie *%s(0x%lx), REFCNT=%d\n",
GvNAME(handle), (unsigned long)handle,
SvREFCNT(TIEHANDLE_SV(handle)));
 }
 #endif
 
-sv_unmagic(TIEHANDLE_SV(handle), 'q');
+sv_unmagic(TIEHANDLE_SV(handle), PERL_MAGIC_tiedscalar);
 }
 
 MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)

Modified: perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h?view=diff&rev=123372&p1=perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h&r1=123371&p2=perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h&r2=123372
==
--- perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h (original)
+++ perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h Sun Dec 26 
15:45:59 2004
@@ -103,6 +103,10 @@
 #   define PERL_MAGIC_tied 'P'
 #endif
 
+#ifndef PERL_MAGIC_tiedscalar
+#   define PERL_MAGIC_tiedscalar 'p'
+#endif
+
 #ifndef PERL_MAGIC_ext
 #   define PERL_MAGIC_ext '~'
 #endif


svn commit: r123373 - /perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h

2004-12-26 Thread stas
Author: stas
Date: Sun Dec 26 15:52:10 2004
New Revision: 123373

URL: http://svn.apache.org/viewcvs?view=rev&rev=123373
Log:
PERL_MAGIC_tiedscalar is 'q' not 'p'

Modified:
   perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h

Modified: perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h?view=diff&rev=123373&p1=perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h&r1=123372&p2=perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h&r2=123373
==
--- perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h (original)
+++ perl/modperl/trunk/src/modules/perl/modperl_perl_includes.h Sun Dec 26 
15:52:10 2004
@@ -104,7 +104,7 @@
 #endif
 
 #ifndef PERL_MAGIC_tiedscalar
-#   define PERL_MAGIC_tiedscalar 'p'
+#   define PERL_MAGIC_tiedscalar 'q'
 #endif
 
 #ifndef PERL_MAGIC_ext


svn commit: r123375 - in perl/modperl/trunk: . src/modules/perl t/response/TestAPI todo xs/Apache/RequestUtil xs/maps xs/tables/current/ModPerl

2004-12-26 Thread stas
Author: stas
Date: Sun Dec 26 17:06:31 2004
New Revision: 123375

URL: http://svn.apache.org/viewcvs?view=rev&rev=123375
Log:
- Apache::RequestUtil: new: create the pool dependency 
- adjust modperl_xs_sv2request_rec not to assume that there is only one 
magic: check that mg->mg_ptr is set (i.e. created by modperl and not 
Apache::RequestUtil::new) before returning it

Modified:
   perl/modperl/trunk/Changes
   perl/modperl/trunk/src/modules/perl/modperl_util.c
   perl/modperl/trunk/t/response/TestAPI/request_rec.pm
   perl/modperl/trunk/todo/release
   perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h
   perl/modperl/trunk/xs/maps/modperl_functions.map
   perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm

Modified: perl/modperl/trunk/Changes
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=123375&p1=perl/modperl/trunk/Changes&r1=123374&p2=perl/modperl/trunk/Changes&r2=123375
==
--- perl/modperl/trunk/Changes  (original)
+++ perl/modperl/trunk/Changes  Sun Dec 26 17:06:31 2004
@@ -26,6 +26,7 @@
 - APR::Table: copy, overlay, make
 - APR::ThreadMutex: new
 - APR::URI: parse
+- Apache::RequestUtil: new
 
 speed up the 'perl Makefile.PL' stage [Randy Kobes]:
  - reduce the number of calls to build_config() of

Modified: perl/modperl/trunk/src/modules/perl/modperl_util.c
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_util.c?view=diff&rev=123375&p1=perl/modperl/trunk/src/modules/perl/modperl_util.c&r1=123374&p2=perl/modperl/trunk/src/modules/perl/modperl_util.c&r2=123375
==
--- perl/modperl/trunk/src/modules/perl/modperl_util.c  (original)
+++ perl/modperl/trunk/src/modules/perl/modperl_util.c  Sun Dec 26 17:06:31 2004
@@ -154,7 +154,9 @@
 return r;
 }
 
-if ((mg = mg_find(sv, PERL_MAGIC_ext))) {
+/* there could be pool magic attached to custom $r object, so make
+ * sure that mg->mg_ptr is set */
+if ((mg = mg_find(sv, PERL_MAGIC_ext)) && mg->mg_ptr) {
 return (request_rec *)mg->mg_ptr;
 }
 else {

Modified: perl/modperl/trunk/t/response/TestAPI/request_rec.pm
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestAPI/request_rec.pm?view=diff&rev=123375&p1=perl/modperl/trunk/t/response/TestAPI/request_rec.pm&r1=123374&p2=perl/modperl/trunk/t/response/TestAPI/request_rec.pm&r2=123375
==
--- perl/modperl/trunk/t/response/TestAPI/request_rec.pm(original)
+++ perl/modperl/trunk/t/response/TestAPI/request_rec.pmSun Dec 26 
17:06:31 2004
@@ -11,6 +11,7 @@
 use Apache::RequestUtil ();
 
 use APR::Finfo ();
+use APR::Pool ();
 
 use Apache::Const -compile => qw(OK M_GET M_PUT);
 use APR::Const-compile => qw(FINFO_NORM);
@@ -23,7 +24,7 @@
 sub handler {
 my $r = shift;
 
-plan $r, tests => 53;
+plan $r, tests => 54;
 
 #Apache->request($r); #PerlOptions +GlobalRequest takes care
 my $gr = Apache->request;
@@ -207,6 +208,18 @@
 ok t_cmp $@, qr/$err/, "invalid $r object";
 }
 
+# out-of-scope pools
+{
+my $newr = Apache::RequestRec->new($r->connection, APR::Pool->new);
+{
+require APR::Table;
+# try to overwrite the pool
+my $table = APR::Table::make(APR::Pool->new, 50);
+$table->set($_ => $_) for 'aa'..'za';
+}
+# check if $newr is still OK
+ok $newr->connection->isa('Apache::Connection');
+}
 
 # tested in other tests
 # - input_filters:TestAPI::in_out_filters

Modified: perl/modperl/trunk/todo/release
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/todo/release?view=diff&rev=123375&p1=perl/modperl/trunk/todo/release&r1=123374&p2=perl/modperl/trunk/todo/release&r2=123375
==
--- perl/modperl/trunk/todo/release (original)
+++ perl/modperl/trunk/todo/release Sun Dec 26 17:06:31 2004
@@ -45,7 +45,4 @@
   
   APR::Pool:
   ? mpxs_apr_pool_create (having problems): APR__Pool.patch
-  
-  Apache::RequestUtil:
-  ? mpxs_Apache__RequestRec_new (having problems): Apache__RequestUtil.patch
 

Modified: perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h?view=diff&rev=123375&p1=perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h&r1=123374&p2=perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h&r2=123375
==
--- perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h  
(original)
+++ perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h  Sun Dec 
26 17:06:31 2004
@@ -54,17 +54,21 @@
  */
 
 

svn commit: r123387 - /perl/modperl/trunk/Changes /perl/modperl/trunk/t/lib/TestAPRlib/pool.pm /perl/modperl/trunk/todo/release /perl/modperl/trunk/xs/APR/Pool/APR__Pool.h /perl/modperl/trunk/xs/modperl_xs_util.h

2004-12-26 Thread stas
Author: stas
Date: Sun Dec 26 20:57:35 2004
New Revision: 123387

URL: http://svn.apache.org/viewcvs?view=rev&rev=123387
Log:
- APR::Pool: new: create dependency on the parent pool
- adjust MP_APR_POOL_SV_DROPS_OWNERSHIP_RUN to carefuly unwind that 
dependency to avoid too early destruction of the parent pool, which 
otherwise would nuke the child pool.

Modified:
   perl/modperl/trunk/Changes
   perl/modperl/trunk/t/lib/TestAPRlib/pool.pm
   perl/modperl/trunk/todo/release
   perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
   perl/modperl/trunk/xs/modperl_xs_util.h

Modified: perl/modperl/trunk/Changes
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=123387&p1=perl/modperl/trunk/Changes&r1=123386&p2=perl/modperl/trunk/Changes&r2=123387
==
--- perl/modperl/trunk/Changes  (original)
+++ perl/modperl/trunk/Changes  Sun Dec 26 20:57:35 2004
@@ -27,6 +27,7 @@
 - APR::ThreadMutex: new
 - APR::URI: parse
 - Apache::RequestUtil: new
+- APR::Pool: new
 
 speed up the 'perl Makefile.PL' stage [Randy Kobes]:
  - reduce the number of calls to build_config() of

Modified: perl/modperl/trunk/t/lib/TestAPRlib/pool.pm
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/TestAPRlib/pool.pm?view=diff&rev=123387&p1=perl/modperl/trunk/t/lib/TestAPRlib/pool.pm&r1=123386&p2=perl/modperl/trunk/t/lib/TestAPRlib/pool.pm&r2=123387
==
--- perl/modperl/trunk/t/lib/TestAPRlib/pool.pm (original)
+++ perl/modperl/trunk/t/lib/TestAPRlib/pool.pm Sun Dec 26 20:57:35 2004
@@ -11,7 +11,7 @@
 use APR::Table ();
 
 sub num_of_tests {
-return 74;
+return 75;
 }
 
 sub test {
@@ -387,8 +387,13 @@
 ok 1;
 }
 
-
-
+# out-of-scope pools
+{
+my $sp = APR::Pool->new->new;
+# the parent temp pool must stick around
+ok t_cmp(2, ancestry_count($sp),
+ "parent pool is still alive + global pool");
+}
 
 # other stuff
 {

Modified: perl/modperl/trunk/todo/release
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/todo/release?view=diff&rev=123387&p1=perl/modperl/trunk/todo/release&r1=123386&p2=perl/modperl/trunk/todo/release&r2=123387
==
--- perl/modperl/trunk/todo/release (original)
+++ perl/modperl/trunk/todo/release Sun Dec 26 20:57:35 2004
@@ -42,7 +42,3 @@
 problem, but this seems to be a problem in
 modperl_bucket_sv_setaside which loses the newly seta-aside
 bucket)
-  
-  APR::Pool:
-  ? mpxs_apr_pool_create (having problems): APR__Pool.patch
-

Modified: perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/APR/Pool/APR__Pool.h?view=diff&rev=123387&p1=perl/modperl/trunk/xs/APR/Pool/APR__Pool.h&r1=123386&p2=perl/modperl/trunk/xs/APR/Pool/APR__Pool.h&r2=123387
==
--- perl/modperl/trunk/xs/APR/Pool/APR__Pool.h  (original)
+++ perl/modperl/trunk/xs/APR/Pool/APR__Pool.h  Sun Dec 26 20:57:35 2004
@@ -45,12 +45,30 @@
 
 #define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) mpxs_pool_is_custom(sv)
 
+/* before the magic is freed, one needs to carefully detach the
+ * dependant pool magic added by mpxs_add_pool_magic (most of the time
+ * it'd be a parent pool), and postpone its destruction, until after
+ * the child pool is destroyed. Since if we don't do that the
+ * destruction of the parent pool will destroy the child pool C guts
+ * and when perl unware of that the rug was pulled under the feet will
+ * continue destructing the child pool, things will crash
+ */
+#define MP_APR_POOL_SV_DROPS_OWNERSHIP_RUN(acct) STMT_START {   \
+MAGIC *mg = mg_find(acct->sv, PERL_MAGIC_ext);  \
+if (mg && mg->mg_obj) { \
+sv_2mortal(mg->mg_obj); \
+mg->mg_obj = Nullsv;\
+mg->mg_flags &= ~MGf_REFCOUNTED;\
+}   \
+mg_free(acct->sv);  \
+SvIVX(acct->sv) = 0;\
+} STMT_END
+
 #ifdef USE_ITHREADS
 
 #define MP_APR_POOL_SV_DROPS_OWNERSHIP(acct) STMT_START {   \
 dTHXa(acct->perl);  \
-mg_free(acct->sv);  \
-SvIVX(acct->sv) = 0;\
+MP_APR_POOL_SV_DROPS_OWNERSHIP_RUN(acct);   \
 if (modperl_opt_interp_unselect && acct->interp) {  \
 /* this will decrement the interp refcnt until  \
  * there are no more r