marvin at rectangular
Jul 8, 2008, 7:01 PM
Post #1 of 1
(195 views)
Permalink
|
|
r3584 - in trunk/boilerplater/lib/Boilerplater/Binding/Perl: . XSub
|
|
Author: creamyg
Date: 2008-07-08 19:01:06 -0700 (Tue, 08 Jul 2008)
New Revision: 3584
Modified:
trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub.pm
trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub/Method.pm
Log:
Be more strict about the way auto-generated XS bindings extract $self from the
Perl stack -- i.e. don't allow a plain string SV to be converted to a
ZombieCharBuf and invoke methods.
Modified: trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub/Method.pm
===================================================================
--- trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub/Method.pm 2008-07-09 01:55:39 UTC (rev 3583)
+++ trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub/Method.pm 2008-07-09 02:01:06 UTC (rev 3584)
@@ -108,10 +108,18 @@
my $var_declarations = $self->var_declarations;
my @var_assignments;
for ( my $i = 0; $i < @$arg_vars; $i++ ) {
- my $var = $arg_vars->[$i];
- my $val = $arg_inits->[$i];
- my $var_name = $var->get_name;
- my $statement = from_perl( $var->get_type, $var_name, "ST($i)" );
+ my $var = $arg_vars->[$i];
+ my $val = $arg_inits->[$i];
+ my $var_name = $var->get_name;
+ my $var_type = $var->get_type;
+ my $statement;
+ if ( $i == 0 ) { # $self
+ $statement = _self_assign_statement( $var_type,
+ $method->get_micro_name );
+ }
+ else {
+ $statement = from_perl( $var_type, $var_name, "ST($i)" );
+ }
if ( defined $val ) {
$statement = qq| if ( SvOK(ST($i)) && items >= $i ) {
$statement
@@ -166,8 +174,10 @@
my $self_var = $arg_vars->[0];
my $self_type = $self_var->get_type;
my $params_hash_name = $self->perl_name . "_PARAMS";
- my @var_assignments = (
- from_perl( $self_type, 'self', 'ST(0)' ),
+ my $self_assignment = _self_assign_statement( $self_type,
+ $self->{method}->get_micro_name );
+ my @var_assignments = (
+ $self_assignment,
qq|args_hash = build_args_hash( &(ST(0)), 1, items, "$params_hash_name");|,
);
@@ -226,4 +236,20 @@
END_STUFF
}
+# Create an assignment statement for extracting $self from the Perl stack.
+sub _self_assign_statement {
+ my ( $type, $method_name ) = @_;
+ my $type_c = $type->to_c;
+ $type_c =~ /(\w+)\*$/ or die "Not an object type: $type_c";
+ my $vtable = uc($1);
+
+ # Make an exception for deserialize -- allow self to be NULL if called as
+ # a class method.
+ my $macro
+ = $method_name =~ /^deserialize$/
+ ? 'MAYBE_SV_TO_KOBJ'
+ : 'SV_TO_KOBJ';
+ return "self = ($type_c)$macro(ST(0), &$vtable);";
+}
+
1;
Modified: trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub.pm
===================================================================
--- trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub.pm 2008-07-09 01:55:39 UTC (rev 3583)
+++ trunk/boilerplater/lib/Boilerplater/Binding/Perl/XSub.pm 2008-07-09 02:01:06 UTC (rev 3584)
@@ -99,8 +99,10 @@
my $self = shift;
my $arg_vars = $self->{param_list}->get_variables;
my @var_declarations;
- for my $arg_var (@$arg_vars) {
+ for my $i ( 0 .. $#$arg_vars ) {
+ my $arg_var = $arg_vars->[$i];
push @var_declarations, $arg_var->c_declaration;
+ next if $i == 0; # no ZombieCharBuf for $self.
next
unless $arg_var->get_type->get_specifier
=~ /^kino_(Obj|ByteBuf|CharBuf)$/;
_______________________________________________
kinosearch-commits mailing list
kinosearch-commits [at] rectangular
http://www.rectangular.com/mailman/listinfo/kinosearch-commits
|
