[svn:mod_parrot] r531 - in mod_parrot/trunk: . lib lib/ModParrot/APR lib/ModParrot/Apache lib/ModParrot/HLL src t/response/TestAPI

[email protected] Sun, 7 Dec 2008 14:31:05 -0800 (PST)
Newsgroups perl.cvs.mod_parrot
Message-ID <[email protected]>
Author: jhorwitz
Date: Sun Dec  7 14:31:04 2008
New Revision: 531

Added:
   mod_parrot/trunk/lib/ModParrot/APR/Pool.pir
   mod_parrot/trunk/t/response/TestAPI/apr_pool.pir
Modified:
   mod_parrot/trunk/Makefile.in
   mod_parrot/trunk/call_list.txt
   mod_parrot/trunk/lib/ModParrot/Apache/RequestRec.pir
   mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir
   mod_parrot/trunk/lib/mod_parrot.pir
   mod_parrot/trunk/src/nci.c
   mod_parrot/trunk/t/response/TestAPI/request_rec.pir

Log:
initial support for APR pools


Modified: mod_parrot/trunk/Makefile.in
==============================================================================
--- mod_parrot/trunk/Makefile.in	(original)
+++ mod_parrot/trunk/Makefile.in	Sun Dec  7 14:31:04 2008
@@ -44,6 +44,7 @@
 MPLIBS=	lib/ModParrot/Apache/RequestRec \
 	lib/ModParrot/Apache/Constants \
 	lib/ModParrot/Apache/Module \
+	lib/ModParrot/APR/Pool \
 	lib/ModParrot/APR/Table \
 	lib/mod_parrot \
 	lib/ModParrot/Constants \

Modified: mod_parrot/trunk/call_list.txt
==============================================================================
--- mod_parrot/trunk/call_list.txt	(original)
+++ mod_parrot/trunk/call_list.txt	Sun Dec  7 14:31:04 2008
@@ -20,3 +20,4 @@
 v       Jtiiipt
 p       JttPP
 P       Jtpi
+i       Vppp

Added: mod_parrot/trunk/lib/ModParrot/APR/Pool.pir
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/lib/ModParrot/APR/Pool.pir	Sun Dec  7 14:31:04 2008
@@ -0,0 +1,97 @@
+# $Id$
+
+# Copyright (c) 2008 Jeff Horwitz
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+=head1 NAME
+
+ModParrot/APR/Pool.pir
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This code implements the ModParrot;APR;Pool class.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+.namespace [ 'ModParrot'; 'APR'; 'Pool' ]
+
+.sub _initialize :load
+    .local pmc pool_class
+    .local pmc func
+    .local pmc nul
+
+    null nul
+
+    newclass pool_class, [ 'ModParrot'; 'APR'; 'Pool' ]
+    addattribute pool_class, 'apr_pool'
+    addattribute pool_class, 'parent'
+
+    dlfunc func, nul, "apr_pool_create_ex", "iVppp"
+    set_root_global [ 'APR'; 'NCI' ], "apr_pool_create_ex", func
+.end
+
+.sub init :vtable :method
+    .local pmc pool
+    .local pmc apr_pool_create, null_ptr, nul
+
+    apr_pool_create = get_root_global [ 'APR'; 'NCI' ], "apr_pool_create_ex"
+    null_ptr = get_root_global [ 'ModParrot'; 'NCI' ], "null"
+    nul = null_ptr()
+    $I0 = apr_pool_create(pool, nul, nul, nul)
+    setattribute self, 'apr_pool', pool
+.end
+
+.sub init_pmc :vtable :method
+    .param pmc attrs
+    .local pmc pool, parent
+    .local pmc pool_attr, parent_attr
+    .local pmc apr_pool_create, null_ptr, nul
+
+    pool_attr = getattribute self, 'apr_pool'
+    parent_attr = getattribute self, 'parent'
+
+    apr_pool_create = get_root_global [ 'APR'; 'NCI' ], "apr_pool_create_ex"
+    null_ptr = get_root_global [ 'ModParrot'; 'NCI' ], "null"
+    nul = null_ptr()
+
+    if null parent_attr goto end_attr_check
+    $S0 = typeof parent_attr
+    if $S0 == 'ModParrot;APR;Pool' goto end_attr_check
+    # XXX error out here!
+  end_attr_check:
+    unless null pool_attr goto done
+    unless null parent_attr goto have_parent
+    # XXX should never get here, else we'd be in init()
+    goto done
+  have_parent:
+    null pool
+    $P0 = getattribute parent_attr, 'apr_pool'
+    $I0 = apr_pool_create(pool, $P0, nul, nul)
+    setattribute self, 'apr_pool', pool
+  done:
+    .return()
+.end
+
+=head1 AUTHOR
+
+Jeff Horwitz
+
+=cut
+

Modified: mod_parrot/trunk/lib/ModParrot/Apache/RequestRec.pir
==============================================================================
--- mod_parrot/trunk/lib/ModParrot/Apache/RequestRec.pir	(original)
+++ mod_parrot/trunk/lib/ModParrot/Apache/RequestRec.pir	Sun Dec  7 14:31:04 2008
@@ -616,6 +616,31 @@
     .return(table)
 .end
 
+=item C<ModParrot;APR;Pool pool()>
+
+=over 4
+
+Returns the request pool as a ModParrot;APR;Pool object.
+
+=back
+
+=cut
+
+.sub pool :method
+    .local pmc p, pool, func, r
+
+    func = get_root_global ['ModParrot'; 'NCI'], 'request_rec_pool'
+    getattribute r, self, 'r'
+    p = func(r)
+
+    $P0 = get_class [ 'ModParrot'; 'APR'; 'Pool' ]
+    $P1 = new 'Hash'
+    $P1['apr_pool'] = p
+    pool = new $P0, $P1
+
+    .return(pool)
+.end
+
 =back
 
 =head1 AUTHOR

Modified: mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir
==============================================================================
--- mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir	(original)
+++ mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir	Sun Dec  7 14:31:04 2008
@@ -31,6 +31,8 @@
     $P0 = get_hll_global 'P6metaclass'
     $P1 = get_class ['ModParrot'; 'Apache'; 'RequestRec']
     $P0.'register'($P1, 'name' => 'Apache;RequestRec')
+    $P1 = get_class ['ModParrot';'APR'; 'Pool']
+    $P0.'register'($P1, 'name' => 'APR;Pool')
     $P1 = get_class ['ModParrot';'APR'; 'Table']
     $P0.'register'($P1, 'name' => 'APR;Table')
     $P1 = get_class ['ModParrot'; 'Interpreter']

Modified: mod_parrot/trunk/lib/mod_parrot.pir
==============================================================================
--- mod_parrot/trunk/lib/mod_parrot.pir	(original)
+++ mod_parrot/trunk/lib/mod_parrot.pir	Sun Dec  7 14:31:04 2008
@@ -27,6 +27,9 @@
 
     .include "build/src/pir/request_rec_dlfunc.pir"
 
+    dlfunc func, nul, "mpnci_null", "p"
+    set_root_global [ 'ModParrot'; 'NCI' ], "null", func
+
     dlfunc func, nul, "mpnci_backtrace", "tJ"
     set_root_global [ 'ModParrot'; 'NCI' ], "backtrace", func
 
@@ -63,6 +66,9 @@
     dlfunc func, nul, "mpnci_request_rec_err_headers_out", "pJp"
     set_root_global [ 'ModParrot'; 'NCI' ], "request_rec_err_headers_out", func
 
+    dlfunc func, nul, "mpnci_request_rec_pool", "pJp"
+    set_root_global [ 'ModParrot'; 'NCI' ], "request_rec_pool", func
+
     dlfunc func, nul, "mpnci_rwrite", "iJPip"
     set_root_global [ 'ModParrot'; 'NCI' ], "rwrite", func
 
@@ -99,6 +105,7 @@
     load_bytecode 'ModParrot/Context.pbc'
     load_bytecode 'ModParrot/Apache/Constants.pbc'
     load_bytecode 'ModParrot/Apache/RequestRec.pbc'
+    load_bytecode 'ModParrot/APR/Pool.pbc'
     load_bytecode 'ModParrot/APR/Table.pbc'
 .end
 

Modified: mod_parrot/trunk/src/nci.c
==============================================================================
--- mod_parrot/trunk/src/nci.c	(original)
+++ mod_parrot/trunk/src/nci.c	Sun Dec  7 14:31:04 2008
@@ -36,6 +36,12 @@
 
 extern module AP_MODULE_DECLARE_DATA parrot_module;
 
+/* used from PIR to pass C-style NULLs to NCI functions */
+void *mpnci_null(void)
+{
+    return (void *)NULL;
+}
+
 request_rec *mpnci_request_rec(Parrot_Interp interp)
 {
     modparrot_context *ctxp;
@@ -386,3 +392,8 @@
     return(handler);
 }
 #endif
+
+apr_pool_t *mpnci_request_rec_pool(Parrot_Interp interp, request_rec *r)
+{
+    return(r->pool);
+}

Added: mod_parrot/trunk/t/response/TestAPI/apr_pool.pir
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/t/response/TestAPI/apr_pool.pir	Sun Dec  7 14:31:04 2008
@@ -0,0 +1,39 @@
+.namespace [ 'TestAPI::apr_pool' ]
+
+.sub handler
+    .param pmc r
+    .local pmc ap_const
+    .local string results
+
+    ap_const = get_root_global [ 'ModParrot'; 'Apache'; 'Constants' ], 'table'
+
+    r.'puts'("1..2\n")
+
+  START_1:
+    push_eh NOT_OK_1
+    $P0 = new ['ModParrot'; 'APR'; 'Pool']
+    pop_eh
+    $S0 = typeof $P0
+    if $S0 == 'ModParrot;APR;Pool' goto OK_1
+  NOT_OK_1:
+    r.'puts'("not ")
+  OK_1:
+    r.'puts'("ok 1 - create pool (no parent)\n")
+
+  START_2:
+    push_eh NOT_OK_2
+    $P1 = r.'pool'()
+    $P2 = new 'Hash'
+    $P2['parent'] = $P1
+    $P0 = new ['ModParrot'; 'APR'; 'Pool'], $P2
+    pop_eh
+    $S0 = typeof $P0
+    if $S0 == 'ModParrot;APR;Pool' goto OK_2
+  NOT_OK_2:
+    r.'puts'("not ")
+  OK_2:
+    r.'puts'("ok 2 - create pool (with request pool parent)\n")
+
+    $I0 = ap_const['OK']
+    .return($I0)
+.end

Modified: mod_parrot/trunk/t/response/TestAPI/request_rec.pir
==============================================================================
--- mod_parrot/trunk/t/response/TestAPI/request_rec.pir	(original)
+++ mod_parrot/trunk/t/response/TestAPI/request_rec.pir	Sun Dec  7 14:31:04 2008
@@ -9,7 +9,7 @@
 
     ap_const = get_root_global [ 'ModParrot'; 'Apache'; 'Constants' ], 'table'
 
-    r.'puts'("1..37\n")
+    r.'puts'("1..38\n")
 
   # XXX this should be fatal on failure
   START_1:
@@ -421,6 +421,17 @@
   OK_37:
     r.'puts'("ok 37 - headers_in()\n")
 
+  START_38:
+    push_eh NOT_OK_38
+    $P0 = r.'pool'()
+    pop_eh
+    $S0 = typeof $P0
+    if $S0 == 'ModParrot;APR;Pool' goto OK_38
+  NOT_OK_38:
+    r.'puts'("not ")
+  OK_38:
+    r.'puts'("ok 38 - pool()\n")
+
     # STILL TODO (not tested in original client-side tests)
     # assbackwards
     # proxyreq