Test Perl argument and return value conversion
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/508c6ab9 Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/508c6ab9 Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/508c6ab9 Branch: refs/heads/master Commit: 508c6ab93d21a63e2235002e291a15b5934bbdf8 Parents: 7ad8fd8 Author: Nick Wellnhofer <[email protected]> Authored: Tue Dec 1 14:19:14 2015 +0100 Committer: Nick Wellnhofer <[email protected]> Committed: Tue Dec 1 16:06:03 2015 +0100 ---------------------------------------------------------------------- runtime/core/Clownfish/Test/TestHost.c | 107 +++++++++++++++++++ runtime/core/Clownfish/Test/TestHost.cfh | 65 +++++++++++ .../perl/buildlib/Clownfish/Build/Binding.pm | 9 ++ runtime/perl/t/binding/018-host.t | 87 ++++++++++++++- 4 files changed, 267 insertions(+), 1 deletion(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/508c6ab9/runtime/core/Clownfish/Test/TestHost.c ---------------------------------------------------------------------- diff --git a/runtime/core/Clownfish/Test/TestHost.c b/runtime/core/Clownfish/Test/TestHost.c new file mode 100644 index 0000000..9172c99 --- /dev/null +++ b/runtime/core/Clownfish/Test/TestHost.c @@ -0,0 +1,107 @@ +/* Licensed to the Apache Software Foundation (ASF) under one or more + * contributor license agreements. See the NOTICE file distributed with + * this work for additional information regarding copyright ownership. + * The ASF licenses this file to You 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. + */ + +#define CFISH_USE_SHORT_NAMES +#define TESTCFISH_USE_SHORT_NAMES + +#include "Clownfish/Test/TestHost.h" +#include "Clownfish/Class.h" + +TestHost* +TestHost_new() { + return (TestHost*)Class_Make_Obj(TESTHOST); +} + +Obj* +TestHost_Test_Obj_Pos_Arg_IMP(TestHost *self, Obj *arg) { + UNUSED_VAR(self); + return arg; +} + +Obj* +TestHost_Test_Obj_Pos_Arg_Def_IMP(TestHost *self, Obj *arg) { + UNUSED_VAR(self); + return arg; +} + +Obj* +TestHost_Test_Obj_Label_Arg_IMP(TestHost *self, Obj *arg, bool unused) { + UNUSED_VAR(self); + UNUSED_VAR(unused); + return arg; +} + +Obj* +TestHost_Test_Obj_Label_Arg_Def_IMP(TestHost *self, Obj *arg, bool unused) { + UNUSED_VAR(self); + UNUSED_VAR(unused); + return arg; +} + +int32_t +TestHost_Test_Int32_Pos_Arg_IMP(TestHost *self, int32_t arg) { + UNUSED_VAR(self); + return arg; +} + +int32_t +TestHost_Test_Int32_Pos_Arg_Def_IMP(TestHost *self, int32_t arg) { + UNUSED_VAR(self); + return arg; +} + +int32_t +TestHost_Test_Int32_Label_Arg_IMP(TestHost *self, int32_t arg, bool unused) { + UNUSED_VAR(self); + UNUSED_VAR(unused); + return arg; +} + +int32_t +TestHost_Test_Int32_Label_Arg_Def_IMP(TestHost *self, int32_t arg, + bool unused) { + UNUSED_VAR(self); + UNUSED_VAR(unused); + return arg; +} + +bool +TestHost_Test_Bool_Pos_Arg_IMP(TestHost *self, bool arg) { + UNUSED_VAR(self); + return arg; +} + +bool +TestHost_Test_Bool_Pos_Arg_Def_IMP(TestHost *self, bool arg) { + UNUSED_VAR(self); + return arg; +} + +bool +TestHost_Test_Bool_Label_Arg_IMP(TestHost *self, bool arg, bool unused) { + UNUSED_VAR(self); + UNUSED_VAR(unused); + return arg; +} + +bool +TestHost_Test_Bool_Label_Arg_Def_IMP(TestHost *self, bool arg, bool unused) { + UNUSED_VAR(self); + UNUSED_VAR(unused); + return arg; +} + + http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/508c6ab9/runtime/core/Clownfish/Test/TestHost.cfh ---------------------------------------------------------------------- diff --git a/runtime/core/Clownfish/Test/TestHost.cfh b/runtime/core/Clownfish/Test/TestHost.cfh new file mode 100644 index 0000000..497c93d --- /dev/null +++ b/runtime/core/Clownfish/Test/TestHost.cfh @@ -0,0 +1,65 @@ +/* Licensed to the Apache Software Foundation (ASF) under one or more + * contributor license agreements. See the NOTICE file distributed with + * this work for additional information regarding copyright ownership. + * The ASF licenses this file to You 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. + */ + +parcel TestClownfish; + +/** Clownfish test suite. + */ +class Clownfish::Test::TestHost { + inert incremented TestHost* + new(); + + Obj* + Test_Obj_Pos_Arg(TestHost *self, Obj *arg); + + Obj* + Test_Obj_Pos_Arg_Def(TestHost *self, nullable Obj *arg = NULL); + + Obj* + Test_Obj_Label_Arg(TestHost *self, Obj *arg, bool unused = false); + + Obj* + Test_Obj_Label_Arg_Def(TestHost *self, nullable Obj *arg = NULL, + bool unused = false); + + int32_t + Test_Int32_Pos_Arg(TestHost *self, int32_t arg); + + int32_t + Test_Int32_Pos_Arg_Def(TestHost *self, int32_t arg = 101); + + int32_t + Test_Int32_Label_Arg(TestHost *self, int32_t arg, bool unused = false); + + int32_t + Test_Int32_Label_Arg_Def(TestHost *self, int32_t arg = 101, + bool unused = false); + + bool + Test_Bool_Pos_Arg(TestHost *self, bool arg); + + bool + Test_Bool_Pos_Arg_Def(TestHost *self, bool arg = true); + + bool + Test_Bool_Label_Arg(TestHost *self, bool arg, bool unused = false); + + bool + Test_Bool_Label_Arg_Def(TestHost *self, bool arg = true, + bool unused = false); +} + + http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/508c6ab9/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 2452b79..d678ade 100644 --- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm +++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm @@ -23,6 +23,7 @@ sub bind_all { my $class = shift; $class->bind_clownfish; $class->bind_test; + $class->bind_test_host; $class->bind_test_alias_obj; $class->bind_blob; $class->bind_boolean; @@ -105,6 +106,14 @@ END_XS_CODE Clownfish::CFC::Binding::Perl::Class->register($binding); } +sub bind_test_host { + my $binding = Clownfish::CFC::Binding::Perl::Class->new( + parcel => "TestClownfish", + class_name => "Clownfish::Test::TestHost", + ); + Clownfish::CFC::Binding::Perl::Class->register($binding); +} + sub bind_test_alias_obj { my $binding = Clownfish::CFC::Binding::Perl::Class->new( parcel => "TestClownfish", http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/508c6ab9/runtime/perl/t/binding/018-host.t ---------------------------------------------------------------------- diff --git a/runtime/perl/t/binding/018-host.t b/runtime/perl/t/binding/018-host.t index 310d487..32d7fdf 100644 --- a/runtime/perl/t/binding/018-host.t +++ b/runtime/perl/t/binding/018-host.t @@ -16,8 +16,9 @@ use strict; use warnings; -use Test::More tests => 5; +use Test::More tests => 39; use Clownfish qw( to_clownfish ); +use Clownfish::Test; my %complex_data_structure = ( a => [ 1, 2, 3, { ooga => 'booga' } ], @@ -48,3 +49,87 @@ like( $@, qr/Invalid parameter/, "Die on invalid parameter" ); eval { $string->length(undef) }; like( $@, qr/Usage: length/, "Die on extra parameter" ); +my $th = Clownfish::Test::TestHost->new; +$string = Clownfish::String->new("string"); +my $retval; + +$retval = $th->test_obj_pos_arg($string); +is( $retval, 'string', "positional object arg" ); +eval { $th->test_obj_pos_arg(undef) }; +like( $@, qr/undef/, "die on undef positional object arg" ); + +$retval = $th->test_obj_pos_arg_def($string); +is( $retval, 'string', "positional object arg w/default" ); +$retval = $th->test_obj_pos_arg_def(undef); +ok( !defined($retval), "undef positional object arg w/default" ); +$retval = $th->test_obj_pos_arg_def(); +ok( !defined($retval), "empty positional object arg w/default" ); + +$retval = $th->test_obj_label_arg(arg => $string); +is( $retval, 'string', "labeled object arg" ); +eval { $th->test_obj_label_arg(arg => undef) }; +like( $@, qr/undef/, "die on undef labeled object arg" ); + +$retval = $th->test_obj_label_arg_def(arg => $string); +is( $retval, 'string', "labeled object arg w/default" ); +$retval = $th->test_obj_label_arg_def(arg => undef); +ok( !defined($retval), "undef labeled object arg w/default" ); +$retval = $th->test_obj_label_arg_def(); +ok( !defined($retval), "empty labeled object arg w/default" ); + +$retval = $th->test_int32_pos_arg(102); +is( $retval, 102, "positional int32 arg" ); +eval { $th->test_int32_pos_arg(undef) }; +like( $@, qr/undef/, "die on undef positional int32 arg" ); + +$retval = $th->test_int32_pos_arg_def(102); +is( $retval, 102, "positional int32 arg w/default" ); +$retval = $th->test_int32_pos_arg_def(undef); +is( $retval, 101, "undef positional int32 arg w/default" ); +$retval = $th->test_int32_pos_arg_def(); +is( $retval, 101, "empty positional int32 arg w/default" ); + +$retval = $th->test_int32_label_arg(arg => 102); +is( $retval, 102, "labeled int32 arg" ); +eval { $th->test_int32_label_arg(arg => undef) }; +like( $@, qr/undef/, "die on undef labeled int32 arg" ); + +$retval = $th->test_int32_label_arg_def(arg => 102); +is( $retval, 102, "labeled int32 arg w/default" ); +$retval = $th->test_int32_label_arg_def(arg => undef); +is( $retval, 101, "undef labeled int32 arg w/default" ); +$retval = $th->test_int32_label_arg_def(); +is( $retval, 101, "empty labeled int32 arg w/default" ); + +$retval = $th->test_bool_pos_arg(1); +ok( $retval, "true positional bool arg" ); +$retval = $th->test_bool_pos_arg(0); +ok( !$retval, "false positional bool arg" ); +eval { $th->test_bool_pos_arg(undef) }; +like( $@, qr/undef/, "die on undef positional bool arg" ); + +$retval = $th->test_bool_pos_arg_def(1); +ok( $retval, "true positional bool arg w/default" ); +$retval = $th->test_bool_pos_arg_def(0); +ok( !$retval, "false positional bool arg w/default" ); +$retval = $th->test_bool_pos_arg_def(undef); +ok( $retval, "undef positional bool arg w/default" ); +$retval = $th->test_bool_pos_arg_def(); +ok( $retval, "empty positional bool arg w/default" ); + +$retval = $th->test_bool_label_arg(arg => 1); +ok( $retval, "true labeled bool arg" ); +$retval = $th->test_bool_label_arg(arg => 0); +ok( !$retval, "false labeled bool arg" ); +eval { $th->test_bool_label_arg(arg => undef) }; +like( $@, qr/undef/, "die on undef labeled bool arg" ); + +$retval = $th->test_bool_label_arg_def(arg => 1); +ok( $retval, "true labeled bool arg w/default" ); +$retval = $th->test_bool_label_arg_def(arg => 0); +ok( !$retval, "false labeled bool arg w/default" ); +$retval = $th->test_bool_label_arg_def(arg => undef); +ok( $retval, "undef labeled bool arg w/default" ); +$retval = $th->test_bool_label_arg_def(); +ok( $retval, "empty labeled bool arg w/default" ); +
