Custom XS wrapper for Obj_Clone Clone should always return a Clownfish object.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/51866b61 Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/51866b61 Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/51866b61 Branch: refs/heads/master Commit: 51866b61531fa92aa1f711d69289ea2b42f2dd48 Parents: cf29eb7 Author: Nick Wellnhofer <[email protected]> Authored: Sun Nov 15 15:17:22 2015 +0100 Committer: Nick Wellnhofer <[email protected]> Committed: Tue Nov 17 18:27:56 2015 +0100 ---------------------------------------------------------------------- .../perl/buildlib/Clownfish/Build/Binding.pm | 27 ++++++++++---------- runtime/perl/lib/Clownfish.pm | 23 ----------------- runtime/perl/t/binding/016-varray.t | 2 +- 3 files changed, 14 insertions(+), 38 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/51866b61/runtime/perl/buildlib/Clownfish/Build/Binding.pm ---------------------------------------------------------------------- diff --git a/runtime/perl/buildlib/Clownfish/Build/Binding.pm b/runtime/perl/buildlib/Clownfish/Build/Binding.pm index 417e966..c4e7939 100644 --- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm +++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm @@ -219,13 +219,6 @@ CODE: RETVAL = CFISH_OBJ_TO_SV_NOINC(self); } OUTPUT: RETVAL - -SV* -_clone(self) - cfish_String *self; -CODE: - RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_Str_Clone_IMP(self)); -OUTPUT: RETVAL END_XS_CODE my $binding = Clownfish::CFC::Binding::Perl::Class->new( @@ -439,11 +432,16 @@ END_POD $pod_spec->set_synopsis($synopsis); $pod_spec->set_description($description); $pod_spec->add_method( + method => 'Clone', + alias => 'clone', + ); + $pod_spec->add_method( method => 'Destroy', alias => 'DESTROY', pod => $destroy_pod, ); + my @hand_rolled = qw( Clone ); my $xs_code = <<'END_XS_CODE'; MODULE = Clownfish PACKAGE = Clownfish::Obj @@ -473,6 +471,13 @@ CODE: RETVAL = cfish_Obj_is_a(self, target); } OUTPUT: RETVAL + +SV* +clone(self) + cfish_Obj *self; +CODE: + RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_Obj_Clone(self)); +OUTPUT: RETVAL END_XS_CODE my $binding = Clownfish::CFC::Binding::Perl::Class->new( @@ -483,6 +488,7 @@ END_XS_CODE alias => 'DESTROY', method => 'Destroy', ); + $binding->exclude_method($_) for @hand_rolled; $binding->append_xs($xs_code); $binding->set_pod_spec($pod_spec); @@ -501,13 +507,6 @@ sub bind_varray { MODULE = Clownfish PACKAGE = Clownfish::Vector SV* -_clone(self) - cfish_Vector *self; -CODE: - RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_Vec_Clone(self)); -OUTPUT: RETVAL - -SV* pop(self) cfish_Vector *self; CODE: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/51866b61/runtime/perl/lib/Clownfish.pm ---------------------------------------------------------------------- diff --git a/runtime/perl/lib/Clownfish.pm b/runtime/perl/lib/Clownfish.pm index 8ac8530..546eda6 100644 --- a/runtime/perl/lib/Clownfish.pm +++ b/runtime/perl/lib/Clownfish.pm @@ -134,21 +134,6 @@ sub error {$Clownfish::Err::error} } { - package Clownfish::String; - our $VERSION = '0.004000'; - $VERSION = eval $VERSION; - - { - # Defeat obscure bugs in the XS auto-generation by redefining clone(). - # (Because of how the typemap works for String*, - # the auto-generated methods return UTF-8 Perl scalars rather than - # actual String objects.) - no warnings 'redefine'; - sub clone { shift->_clone(@_) } - } -} - -{ package Clownfish::Err; our $VERSION = '0.004000'; $VERSION = eval $VERSION; @@ -187,14 +172,6 @@ sub error {$Clownfish::Err::error} sub get_error {$error} } -{ - package Clownfish::Vector; - our $VERSION = '0.004000'; - $VERSION = eval $VERSION; - no warnings 'redefine'; - sub clone { CORE::shift->_clone } -} - 1; __END__ http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/51866b61/runtime/perl/t/binding/016-varray.t ---------------------------------------------------------------------- diff --git a/runtime/perl/t/binding/016-varray.t b/runtime/perl/t/binding/016-varray.t index 6640310..a48589d 100644 --- a/runtime/perl/t/binding/016-varray.t +++ b/runtime/perl/t/binding/016-varray.t @@ -29,6 +29,6 @@ $varray->insert( tick => 0, element => 'elem', ); -$twin = $varray->_clone; +$twin = $varray->clone; is_deeply( $twin->to_perl, $varray->to_perl, "clone" );
