httpd-apreq-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From j...@apache.org
Subject cvs commit: httpd-apreq-2/glue/perl/xsbuilder apreq_xs_postperl.h apreq_xs_tables.h
Date Tue, 13 Jul 2004 01:00:07 GMT
joes        2004/07/12 18:00:07

  Modified:    glue/perl/t/response/TestApReq request.pm
               glue/perl/xsbuilder apreq_xs_postperl.h apreq_xs_tables.h
  Log:
  Ignore KEY_MAGIC for now - testing safer MGVTBL approach (which is requires tiehash API,
so some non-tiehash request.pm tests are commented out.)
  
  Revision  Changes    Path
  1.29      +8 -8      httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm
  
  Index: request.pm
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm,v
  retrieving revision 1.28
  retrieving revision 1.29
  diff -u -r1.28 -r1.29
  --- request.pm	11 Jul 2004 20:26:43 -0000	1.28
  +++ request.pm	13 Jul 2004 01:00:07 -0000	1.29
  @@ -154,15 +154,15 @@
               die "values test failed: '$test_string'" unless
                   $test_string eq "disable_uploads:bar1:bar2";
   
  -            $test_string = "";
  -            $test_string .= "$_=" . $args->get($_) . ";" for $args->get;
  -            die "get test failed: '$test_string'" unless
  -                $test_string eq "test=disable_uploads;foo=bar1;foo=bar2;";
  +#            $test_string = "";
  +#            $test_string .= "$_=" . $args->get($_) . ";" for $args->get;
  +#            die "get test failed: '$test_string'" unless
  +#                $test_string eq "test=disable_uploads;foo=bar1;foo=bar2;";
   
  -            $test_string = "";
  -            $test_string .= "$_=" . $args->get($_) . ";" for @_ = $args->get;
  -            die "get test2 failed: '$test_string'" unless
  -                $test_string eq "test=disable_uploads;foo=bar1;foo=bar2;";
  +#            $test_string = "";
  +#            $test_string .= "$_=" . $args->get($_) . ";" for @_ = $args->get;
  +#            die "get test2 failed: '$test_string'" unless
  +#                $test_string eq "test=disable_uploads;foo=bar1;foo=bar2;";
   
               $test_string = join ":", %$args;
               die "list deref test failed: '$test_string'" unless
  
  
  
  1.41      +0 -34     httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h
  
  Index: apreq_xs_postperl.h
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h,v
  retrieving revision 1.40
  retrieving revision 1.41
  diff -u -r1.40 -r1.41
  --- apreq_xs_postperl.h	11 Jul 2004 06:31:44 -0000	1.40
  +++ apreq_xs_postperl.h	13 Jul 2004 01:00:07 -0000	1.41
  @@ -129,40 +129,6 @@
       return rv;
   }
   
  -/**
  - * Converts a C object, with environment, to a TIEHASH object.
  - * @param obj C object.
  - * @param env C environment.
  - * @param class Class perl object will be blessed and tied to.
  - * @return Reference to a new TIEHASH object in class.
  - */
  -APR_INLINE
  -static SV *apreq_xs_table_c2perl(pTHX_ void *obj, void *env, 
  -                                 const char *class, SV *parent)
  -{
  -    SV *sv = (SV *)newHV();
  -    /*upgrade ensures CUR and LEN are both 0 */
  -    SV *rv = sv_setref_pv(newSV(0), class, obj);
  -    if (env) {
  -        /* We use the old idiom for sv_magic() below,
  -         * because perl 5.6 mangles the env pointer on
  -         * the recommended 5.8.x invocation
  -         *
  -         *   sv_magic(SvRV(rv), Nullsv, PERL_MAGIC_ext, env, 0);
  -         *
  -         * 5.8.x is OK with the old way as well, but in the future
  -         * we may have to use "#if PERL_VERSION < 8" ...
  -         */
  -        sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, Nullch, -1);
  -        SvMAGIC(SvRV(rv))->mg_ptr = env;
  -    }
  -
  -    sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
  -    SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
  -
  -    return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
  -}
  -
   #define apreq_xs_2sv(t,class,parent)                    \
                apreq_xs_c2perl(aTHX_ t, env, class, parent)
   
  
  
  
  1.11      +63 -2     httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_tables.h
  
  Index: apreq_xs_tables.h
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_tables.h,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- apreq_xs_tables.h	12 Jul 2004 14:27:49 -0000	1.10
  +++ apreq_xs_tables.h	13 Jul 2004 01:00:07 -0000	1.11
  @@ -20,6 +20,67 @@
   /* backward compatibility macros support */
   #include "ppport.h"
   
  +static int apreq_xs_table_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, 
  +                                  const char *name, int namelen)
  +{
  +    /* clone the object */
  +    MAGIC *tie_magic = mg_find(nsv, PERL_MAGIC_tiedelem);
  +    SV *rv = tie_magic->mg_obj;
  +    SV *obj = SvRV(rv);
  +    SV *parent = SvMAGIC(obj)->mg_obj;
  +    void *env  = (void *)SvMAGIC(obj)->mg_ptr;        
  +    SV *new_rv = sv_setref_iv(newSV(0), HvNAME(SvSTASH(obj)), SvIVX(obj));
  +    SV *new_obj = SvRV(new_rv);
  +    sv_magic(new_obj, parent, PERL_MAGIC_ext, Nullch, -1);
  +    SvMAGIC(new_obj)->mg_ptr = env;
  +    SvCUR(new_obj) = SvCUR(obj);
  +    SvREFCNT_dec(rv);
  +    tie_magic->mg_obj = new_rv;
  +    return 0;
  +}
  +
  +
  +static const MGVTBL apreq_xs_table_magic = {0, 0, 0, 0, 0, 
  +                                            apreq_xs_table_magic_copy};
  +
  +
  +/**
  + * Converts a C object, with environment, to a TIEHASH object.
  + * @param obj C object.
  + * @param env C environment.
  + * @param class Class perl object will be blessed and tied to.
  + * @return Reference to a new TIEHASH object in class.
  + */
  +APR_INLINE
  +static SV *apreq_xs_table_c2perl(pTHX_ void *obj, void *env, 
  +                                 const char *class, SV *parent)
  +{
  +    SV *sv = (SV *)newHV();
  +    /*upgrade ensures CUR and LEN are both 0 */
  +    SV *rv = sv_setref_pv(newSV(0), class, obj);
  +    if (env) {
  +        /* We use the old idiom for sv_magic() below,
  +         * because perl 5.6 mangles the env pointer on
  +         * the recommended 5.8.x invocation
  +         *
  +         *   sv_magic(SvRV(rv), Nullsv, PERL_MAGIC_ext, env, 0);
  +         *
  +         * 5.8.x is OK with the old way as well, but in the future
  +         * we may have to use "#if PERL_VERSION < 8" ...
  +         */
  +        sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, Nullch, -1);
  +        SvMAGIC(SvRV(rv))->mg_ptr = env;
  +    }
  +    sv_magic(sv, NULL, PERL_MAGIC_ext, Nullch, -1);
  +    SvMAGIC(sv)->mg_virtual = (MGVTBL *)&apreq_xs_table_magic;
  +    SvMAGIC(sv)->mg_flags |= MGf_COPY;
  +    sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
  +    SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
  +
  +    return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
  +}
  +
  +
   #define apreq_xs_sv2table(sv)      ((apr_table_t *) SvIVX(SvRV(sv)))
   #define apreq_xs_table2sv(t,class,parent)                               \
                     apreq_xs_table_c2perl(aTHX_ t, env, class, parent)
  @@ -94,12 +155,12 @@
       const char *val;
   };
   
  -/*
  +/* Ignore KEY_MAGIC for now - testing safer MGVTBL approach.
   ** Comment the define of APREQ_XS_TABLE_USE_KEY_MAGIC out
   ** if perl still chokes on key magic
   ** Need 5.8.1 or higher for PERL_MAGIC_vstring
   */
  -#if PERL_REVISION == 5 && PERL_VERSION == 8 && PERL_SUBVERSION >= 1
  +#if 0 && PERL_REVISION == 5 && PERL_VERSION == 8 && PERL_SUBVERSION
>= 1
   #define APREQ_XS_TABLE_USE_KEY_MAGIC
   #endif
   
  
  
  

Mime
View raw message