Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Checking in changes prior to tagging of version 0.53. Changelog diff is:

diff --git a/Changes b/Changes
index ef4a066..00cc2ef 100755
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Data-Util

+0.53 Mon Oct 19 19:08:19 2009
+    - fix an issue which broke method modifiers in some cases
+
 0.52 Mon Jul 13 12:20:03 2009
     - fix t/06_subroutine.t for bleadperl
     - add repository information
  • Loading branch information...
commit 03b31f874411fb8716ca9b15c700e271c52a3219 1 parent 9fad2e7
@gfx authored
Showing with 212 additions and 209 deletions.
  1. +3 −0  Changes
  2. +2 −2 lib/Data/Util.pm
  3. +1 −1  lib/Data/Util/JA.pod
  4. +187 −187 subs.c
  5. +19 −19 typemap
View
3  Changes
@@ -1,5 +1,8 @@
Revision history for Data-Util
+0.53 Mon Oct 19 19:08:19 2009
+ - fix an issue which broke method modifiers in some cases
+
0.52 Mon Jul 13 12:20:03 2009
- fix t/06_subroutine.t for bleadperl
- add repository information
View
4 lib/Data/Util.pm 100755 → 100644
@@ -4,7 +4,7 @@ use 5.008_001;
use strict;
#use warnings;
-our $VERSION = '0.52';
+our $VERSION = '0.53';
use Exporter;
our @ISA = qw(Exporter);
@@ -79,7 +79,7 @@ Data::Util - A selection of utilities for data and data types
=head1 VERSION
-This document describes Data::Util version 0.52
+This document describes Data::Util version 0.53
=head1 SYNOPSIS
View
2  lib/Data/Util/JA.pod 100755 → 100644
@@ -7,7 +7,7 @@ Data::Util::JA - データとデータ型のためのユーティリティ集
=head1 VERSION
-This document describes Data::Util version 0.52
+This document describes Data::Util version 0.53
=for test_synopsis no warnings 'redefine';
View
374 subs.c
@@ -1,7 +1,7 @@
/*
- Data-Util/subs.c
+ Data-Util/subs.c
- XS code templates for curry() and modify_subroutine()
+ XS code templates for curry() and modify_subroutine()
*/
#include "data-util.h"
@@ -10,203 +10,203 @@ MGVTBL modified_vtbl;
MAGIC*
my_mg_find_by_vtbl(pTHX_ SV* const sv, const MGVTBL* const vtbl){
- MAGIC* mg;
- for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
- if(mg->mg_virtual == vtbl){
- break;
- }
- }
- return mg;
+ MAGIC* mg;
+ for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
+ if(mg->mg_virtual == vtbl){
+ break;
+ }
+ }
+ return mg;
}
XS(XS_Data__Util_curried){
- dVAR; dXSARGS;
- MAGIC* const mg = mg_find_by_vtbl((SV*)cv, &curried_vtbl);
- assert(mg);
-
- SP -= items;
- /*
- NOTE:
- Curried subroutines have two properties, "params" and "phs"(placeholders).
- Geven a curried subr created by "curry(\&f, $x, *_, $y, \0)":
- params: [ $x, undef, $y, undef]
- phs: [undef, *_, undef, 0]
-
- Here the curried subr is called with arguments.
- Firstly, the arguments are set to params, expanding subscriptive placeholders,
- but the placeholder "*_" is set to the end of params.
- params: [ $x, undef, $y, $_[0], @_ ]
- Then, params are pushed into SP, expanding "*_".
- SP: [ $x, @_[1..$#_], $y, $_[0] ]
- Finally, params are cleand up.
- params: [ $x, undef, $y, undef ]
- */
- {
- AV* const params = (AV*)mg->mg_obj;
- SV** params_ary = AvARRAY(params);
- I32 const len = AvFILLp(params) + 1;
-
- AV* const phs = (AV*)mg->mg_ptr; /* placeholders */
- SV**const phs_ary = AvARRAY(phs);
-
- I32 max_ph = -1; /* max placeholder index */
- I32 min_ph = items; /* min placeholder index */
-
- SV** sph = NULL; // indicates *_
-
- I32 const is_method = XSANY.any_i32;
- I32 push_size = len - 1; /* -1: proc */
- register I32 i;
- SV* proc;
-
- /* fill in params */
- for(i = 0; i < len; i++){
- SV* const ph = phs_ary[i];
-
- if(isGV(ph)){ /* symbolic placeholder *_ */
- if(!sph){
- I32 j;
-
- if(AvMAX(params) < (len + items)){
- av_extend(params, len + items);
- params_ary = AvARRAY(params); /* maybe realloc()-ed */
- }
-
- /*
- All the arguments @_ is pushed into the end of params,
- not calling SvREFCNT_inc().
- */
-
- sph = &params_ary[len];
- for(j = 0; j < items; j++){
- /* NOTE: no need to SvREFCNT_inc(ST(j)),
- * bacause AvFILLp(params) remains len-1.
- * That's okey.
- */
- sph[j] = ST(j);
- }
- }
- push_size += items;
- }
- else if(SvIOKp(ph)){ /* subscriptive placeholders */
- IV p = SvIVX(ph);
-
- if(p >= 0){
- if(p > max_ph) max_ph = p;
- }
- else{ /* negative index */
- p += items;
-
- if(p < 0){
- Perl_croak(aTHX_ PL_no_aelem, (int)p);
- }
-
- if(p < min_ph) min_ph = p;
- }
-
-
- if(p <= items){
- /* NOTE: no need to SvREFCNT_inc(params_ary[i]),
- * because it removed from params_ary before call_sv()
- */
- params_ary[i] = ST(p);
- }
- }
- }
-
- PUSHMARK(SP);
- EXTEND(SP, push_size);
-
- if(is_method){
- PUSHs( params_ary[0] ); /* invocant */
- proc = params_ary[1]; /* method */
- i = 2;
- }
- else{
- proc = params_ary[0]; /* code ref */
- i = 1;
- }
-
- for(/* i is initialized above */; i < len; i++){
- if(isGV(phs_ary[i])){
- /* warn("#sph %d - %d", (int)max_ph+1, (int)min_ph); //*/
- PUSHary(sph, max_ph + 1, min_ph);
- }
- else{
- PUSHs(params_ary[i]);
- }
- }
- PUTBACK;
-
- /* NOTE: need to clean up params before call_sv(), because call_sv() might die */
- for(i = 0; i < len; i++){
- if(SvIOKp(phs_ary[i])){
- /* NOTE: no need to SvREFCNT_dec(params_ary[i]) */
- params_ary[i] = &PL_sv_undef;
- }
- }
-
- call_sv(proc, GIMME_V | is_method);
- }
+ dVAR; dXSARGS;
+ MAGIC* const mg = mg_find_by_vtbl((SV*)cv, &curried_vtbl);
+ assert(mg);
+
+ SP -= items;
+ /*
+ NOTE:
+ Curried subroutines have two properties, "params" and "phs"(placeholders).
+ Geven a curried subr created by "curry(\&f, $x, *_, $y, \0)":
+ params: [ $x, undef, $y, undef]
+ phs: [undef, *_, undef, 0]
+
+ Here the curried subr is called with arguments.
+ Firstly, the arguments are set to params, expanding subscriptive placeholders,
+ but the placeholder "*_" is set to the end of params.
+ params: [ $x, undef, $y, $_[0], @_ ]
+ Then, params are pushed into SP, expanding "*_".
+ SP: [ $x, @_[1..$#_], $y, $_[0] ]
+ Finally, params are cleand up.
+ params: [ $x, undef, $y, undef ]
+ */
+ {
+ AV* const params = (AV*)mg->mg_obj;
+ SV** params_ary = AvARRAY(params);
+ I32 const len = AvFILLp(params) + 1;
+
+ AV* const phs = (AV*)mg->mg_ptr; /* placeholders */
+ SV**const phs_ary = AvARRAY(phs);
+
+ I32 max_ph = -1; /* max placeholder index */
+ I32 min_ph = items; /* min placeholder index */
+
+ SV** sph = NULL; // indicates *_
+
+ I32 const is_method = XSANY.any_i32;
+ I32 push_size = len - 1; /* -1: proc */
+ register I32 i;
+ SV* proc;
+
+ /* fill in params */
+ for(i = 0; i < len; i++){
+ SV* const ph = phs_ary[i];
+
+ if(isGV(ph)){ /* symbolic placeholder *_ */
+ if(!sph){
+ I32 j;
+
+ if(AvMAX(params) < (len + items)){
+ av_extend(params, len + items);
+ params_ary = AvARRAY(params); /* maybe realloc()-ed */
+ }
+
+ /*
+ All the arguments @_ is pushed into the end of params,
+ not calling SvREFCNT_inc().
+ */
+
+ sph = &params_ary[len];
+ for(j = 0; j < items; j++){
+ /* NOTE: no need to SvREFCNT_inc(ST(j)),
+ * bacause AvFILLp(params) remains len-1.
+ * That's okey.
+ */
+ sph[j] = ST(j);
+ }
+ }
+ push_size += items;
+ }
+ else if(SvIOKp(ph)){ /* subscriptive placeholders */
+ IV p = SvIVX(ph);
+
+ if(p >= 0){
+ if(p > max_ph) max_ph = p;
+ }
+ else{ /* negative index */
+ p += items;
+
+ if(p < 0){
+ Perl_croak(aTHX_ PL_no_aelem, (int)p);
+ }
+
+ if(p < min_ph) min_ph = p;
+ }
+
+
+ if(p <= items){
+ /* NOTE: no need to SvREFCNT_inc(params_ary[i]),
+ * because it removed from params_ary before call_sv()
+ */
+ params_ary[i] = ST(p);
+ }
+ }
+ }
+
+ PUSHMARK(SP);
+ EXTEND(SP, push_size);
+
+ if(is_method){
+ PUSHs( params_ary[0] ); /* invocant */
+ proc = params_ary[1]; /* method */
+ i = 2;
+ }
+ else{
+ proc = params_ary[0]; /* code ref */
+ i = 1;
+ }
+
+ for(/* i is initialized above */; i < len; i++){
+ if(isGV(phs_ary[i])){
+ /* warn("#sph %d - %d", (int)max_ph+1, (int)min_ph); //*/
+ PUSHary(sph, max_ph + 1, min_ph);
+ }
+ else{
+ PUSHs(params_ary[i]);
+ }
+ }
+ PUTBACK;
+
+ /* NOTE: need to clean up params before call_sv(), because call_sv() might die */
+ for(i = 0; i < len; i++){
+ if(SvIOKp(phs_ary[i])){
+ /* NOTE: no need to SvREFCNT_dec(params_ary[i]) */
+ params_ary[i] = &PL_sv_undef;
+ }
+ }
+
+ call_sv(proc, GIMME_V | is_method);
+ }
}
/* call an av of cv with args_ary */
static void
my_call_av(pTHX_ AV* const subs, SV** const args_ary, I32 const args_len){
- I32 const subs_len = AvFILLp(subs) + 1;
- I32 i;
+ I32 const subs_len = AvFILLp(subs) + 1;
+ I32 i;
- for(i = 0; i < subs_len; i++){
- dSP;
+ for(i = 0; i < subs_len; i++){
+ dSP;
- PUSHMARK(SP);
- XPUSHary(args_ary, 0, args_len);
- PUTBACK;
+ PUSHMARK(SP);
+ XPUSHary(args_ary, 0, args_len);
+ PUTBACK;
- call_sv(AvARRAY(subs)[i], G_VOID | G_DISCARD | G_EVAL);
- if(SvTRUE(ERRSV)){
- croak(NULL);
- }
- }
+ call_sv(AvARRAY(subs)[i], G_VOID | G_DISCARD | G_EVAL);
+ if(SvTRUE(ERRSV)){
+ croak(NULL);
+ }
+ }
}
XS(XS_Data__Util_modified){
- dVAR; dXSARGS;
- MAGIC* const mg = mg_find_by_vtbl((SV*)cv, &modified_vtbl);
- assert(mg);
-
- SP -= items;
- {
- AV* const subs_av = (AV*)mg->mg_obj;
- AV* const before = (AV*)AvARRAY(subs_av)[M_BEFORE];
- SV* const current = (SV*)AvARRAY(subs_av)[M_CURRENT];
- AV* const after = (AV*)AvARRAY(subs_av)[M_AFTER];
- I32 i;
-
- dXSTARG;
- AV* const args = (AV*)TARG;
- SV** args_ary;
- SvUPGRADE(TARG, SVt_PVAV);
-
- if(AvMAX(args) < items){
- av_extend(args, items);
- }
- args_ary = AvARRAY(args);
-
- for(i = 0; i < items; i++){
- args_ary[i] = ST(i); /* no need to SvREFCNT_inc() */
- }
-
- PUTBACK;
- my_call_av(aTHX_ before, args_ary, items);
- SPAGAIN;
-
- PUSHMARK(SP);
- XPUSHary(args_ary, 0, items);
- PUTBACK;
- call_sv(current, GIMME_V);
-
- my_call_av(aTHX_ after, args_ary, items);
- }
- /* no need to XSRETURN(n) */
+ dVAR; dXSARGS;
+ MAGIC* const mg = mg_find_by_vtbl((SV*)cv, &modified_vtbl);
+ assert(mg);
+
+ SP -= items;
+ {
+ AV* const subs_av = (AV*)mg->mg_obj;
+ AV* const before = (AV*)AvARRAY(subs_av)[M_BEFORE];
+ SV* const current = (SV*)AvARRAY(subs_av)[M_CURRENT];
+ AV* const after = (AV*)AvARRAY(subs_av)[M_AFTER];
+ I32 i;
+
+ dXSTARG;
+ AV* const args = (AV*)TARG;
+ SV** args_ary;
+ SvUPGRADE(TARG, SVt_PVAV);
+
+ if(AvMAX(args) < items){
+ av_extend(args, items);
+ }
+ args_ary = AvARRAY(args);
+
+ for(i = 0; i < items; i++){
+ args_ary[i] = ST(i); /* no need to SvREFCNT_inc() */
+ }
+
+ PUTBACK;
+ my_call_av(aTHX_ before, args_ary, items);
+ SPAGAIN;
+
+ PUSHMARK(SP);
+ XPUSHary(args_ary, 0, items);
+ PUTBACK;
+ call_sv(current, GIMME_V);
+
+ my_call_av(aTHX_ after, args_ary, items);
+ }
+ /* no need to XSRETURN(n) */
}
View
38 typemap
@@ -1,19 +1,19 @@
-###
-
-AV* T_AVREF
-HV* T_HVREF
-CV* T_CVREF
-
-###
-INPUT
-
-T_AVREF
- $var = deref_av($arg);
-
-T_HVREF
- $var = deref_hv($arg);
-
-T_CVREF
- $var = deref_cv($arg);
-
-
+###
+
+AV* T_AVREF
+HV* T_HVREF
+CV* T_CVREF
+
+###
+INPUT
+
+T_AVREF
+ $var = deref_av($arg);
+
+T_HVREF
+ $var = deref_hv($arg);
+
+T_CVREF
+ $var = deref_cv($arg);
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.