jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #1375 from tlby/issue-1374

Browse source 
repair uses of EXTEND() in Perl typemaps
This commit is contained in:
William S Fulton 2018-12-16 15:01:42 +00:00 • committed by GitHub
commit e523556be3
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
4 changed files with 98 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

3
CHANGES.current
View file

@ -7,6 +7,9 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
Version 4.0.0 (in progress)
===========================
2018-12-11: tlby
[Perl] #1374 repair EXTEND() handling in typemaps
2018-12-06: vadz
#1359 #1364 Add missing nested class destructor wrapper when the nested class is
inside a template. Removes associated bogus 'Illegal destructor name' warning. Only

88
Examples/test-suite/perl5/scilab_multivalue_runme.pl Normal file
View file

@ -0,0 +1,88 @@
use strict;
use warnings;
use Test::More tests => 44;
BEGIN { use_ok('scilab_multivalue') }
require_ok('scilab_multivalue');
my($a, $b, $c, $d, $ret);
# OUTPUT
($a, $b) = scilab_multivalue::output2();
is($a, 1, "[a, b] = output2(): a");
is($b, 2, "[a, b] = output2(): b");
($ret, $a, $b) = scilab_multivalue::output2Ret();
is($ret, 3, "[a, b] = output2Ret(): b");
is($a, 1, "[a, b] = output2Ret(): a");
is($b, 2, "[a, b] = output2Ret(): b");
($c, $d) = scilab_multivalue::output2Input2(1, 2);
is($c, 2, "[c, d] = output2Input2(1, 2): c");
is($d, 4, "[c, d] = output2Input2(1, 2): d");
($ret, $c, $d) = scilab_multivalue::output2Input2Ret(1, 2);
is($ret, 6, "[ret, c, d] = output2Input2Ret(1, 2): ret");
is($c, 2, "[ret, c, d] = output2Input2Ret(1, 2): c");
is($d, 4, "[ret, c, d = output2Input2Ret(1, 2): d");
($ret, $a, $b, $c) = scilab_multivalue::output3Input1Ret(10);
is($ret, 10, "[ret, a, b, c] = output3Input1Ret(10): ret");
is($a, 11, "[ret, a, b, c] = output3Input1Ret(10): a");
is($b, 12, "[ret, a, b, c] = output3Input1Ret(10): b");
is($c, 13, "[ret, a, b, c] = output3Input1Ret(10): c");
($ret, $a, $b, $c) = scilab_multivalue::output3Input3Ret(10, 20, 30);
is($ret, 66, "[ret, a, b, c] = output3Input1Ret(10, 20, 30): ret");
is($a, 11, "[ret, a, b, c] = output3Input1Ret(10, 20, 30): a");
is($b, 22, "[ret, a, b, c] = output3Input1Ret(10, 20, 30): b");
is($c, 33, "[ret, a, b, c] = output3Input1Ret(10, 20, 30): c");
# INOUT
($a, $b) = scilab_multivalue::inout2(1, 2);
is($a, 2, "[a, b] = output2(1, 2): a");
is($b, 4, "[a, b] = output2(1, 2): b");
($ret, $a, $b) = scilab_multivalue::inout2Ret(1, 2);
is($ret, 6, "[a, b] = inout2Ret(1, 2): b");
is($a, 2, "[a, b] = inout2Ret(1, 2): a");
is($b, 4, "[a, b] = inout2Ret(1, 2): b");
($c, $d) = scilab_multivalue::inout2Input2(1, 2, 1, 1);
is($c, 2, "[c, d] = inout2Input2(1, 2): c");
is($d, 3, "[c, d] = inout2Input2(1, 2): d");
($ret, $c, $d) = scilab_multivalue::inout2Input2Ret(1, 2, 1, 1);
is($ret, 5, "[c, d] = inout2Input2Ret(1, 2): ret");
is($c, 2, "[c, d] = inout2Input2Ret(1, 2): c");
is($d, 3, "[c, d] = inout2Input2Ret(1, 4): d");
($ret, $a, $b, $c) = scilab_multivalue::inout3Input1Ret(10, 1, 2, 3);
is($ret, 10, "[ret, a, b, c] = output3Input1Ret(ret, 1, 2, 3): ret");
is($a, 11, "[ret, a, b, c] = output3Input1Ret(ret, 1, 2, 3): a");
is($b, 12, "[ret, a, b, c] = output3Input1Ret(ret, 1, 2, 3): b");
is($c, 13, "[ret, a, b, c] = output3Input1Ret(ret, 1, 2, 3): c");
($ret, $a, $b, $c) = scilab_multivalue::inout3Input3Ret(10, 1, 20, 2, 30, 3);
is($ret, 66, "[ret, a, b, c] = output3Input1Ret(10, 20, 30): ret");
is($a, 11, "[ret, a, b, c] = inout3Input1Ret(10, 1, 20, 2, 30, 3): a");
is($b, 22, "[ret, a, b, c] = inout3Input1Ret(10, 1, 20, 2, 30, 3): b");
is($c, 33, "[ret, a, b, c] = inout3Input1Ret(10, 1, 20, 2, 30, 3): c");
# CLASS
$a = scilab_multivalue::ClassA->new();
($ret, $c, $d) = $a->output2Input2Ret(1, 2);
is($ret, 6, "[ret, c, d] = ClassA_output2Input2Ret(a, 1, 2): ret");
is($c, 2, "[c, d] = ClassA_output2Input2Ret(a, 1, 2): c");
is($d, 4, "[c, d] = ClassA_output2Input2Ret(a, 1, 2): d");
($ret, $c, $d) = $a->inout2Input2Ret(1, 2, 1, 1);
is($ret, 5, "[ret, c, d] = ClassA_inout2Input2Ret(a, 1, 2): ret");
is($c, 2, "[c, d] = ClassA_inout2Input2(a, 1, 2): c");
is($d, 3, "[c, d] = ClassA_inout2Input2(a, 1, 2): d");

4
Lib/perl5/perltypemaps.swg
View file

@ -43,7 +43,7 @@
/* Perl types */
#define SWIG_Object SV *
#define VOID_Object sv_newmortal()
#define VOID_Object &PL_sv_undef
/* Perl $shadow flag */
#define %newpointer_flags $shadow
@ -56,7 +56,7 @@
%define %set_output(obj) $result = obj; argvi++ %enddef
/* append output */
%define %append_output(obj) if (argvi >= items) EXTEND(sp,1); %set_output(obj) %enddef
%define %append_output(obj) if (argvi >= items) EXTEND(sp, argvi+1); %set_output(obj) %enddef
/* variable output */
%define %set_varoutput(obj) sv_setsv($result,obj) %enddef

10
Lib/perl5/typemaps.i
View file

@ -168,7 +168,7 @@ output values.
bool *OUTPUT, bool &OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
EXTEND(sp, argvi+1);
}
$result = sv_newmortal();
sv_setiv($result,(IV) *($1));
@ -181,7 +181,7 @@ output values.
unsigned char *OUTPUT, unsigned char &OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
EXTEND(sp, argvi+1);
}
$result = sv_newmortal();
sv_setuv($result,(UV) *($1));
@ -194,7 +194,7 @@ output values.
double *OUTPUT, double &OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
EXTEND(sp, argvi+1);
}
$result = sv_newmortal();
sv_setnv($result,(double) *($1));
@ -204,7 +204,7 @@ output values.
%typemap(argout) long long *OUTPUT, long long &OUTPUT {
char temp[256];
if (argvi >= items) {
EXTEND(sp,1);
EXTEND(sp, argvi+1);
}
sprintf(temp,"%lld", (long long)*($1));
$result = sv_newmortal();
@ -215,7 +215,7 @@ output values.
%typemap(argout) unsigned long long *OUTPUT, unsigned long long &OUTPUT {
char temp[256];
if (argvi >= items) {
EXTEND(sp,1);
EXTEND(sp, argvi+1);
}
sprintf(temp,"%llu", (unsigned long long)*($1));
$result = sv_newmortal();