File: ffi_platypus_lang.t

package info (click to toggle)
libffi-platypus-perl 2.10-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,860 kB
  • sloc: perl: 7,388; ansic: 6,862; cpp: 53; sh: 19; makefile: 14
file content (96 lines) | stat: -rw-r--r-- 2,051 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
use Test2::V0 -no_srand => 1;
use FFI::Platypus::Lang;
use FFI::CheckLib;
use FFI::Platypus;

my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';

subtest 'Foo constructor' => sub {
  my $ffi = FFI::Platypus->new(lang => 'Foo');
  $ffi->lib($libtest);

  eval { $ffi->type('int') };
  isnt $@, '', 'int is not an okay type';
  note $@;
  eval { $ffi->type('foo_t') };
  is $@, '', 'foo_t is an okay type';
  eval { $ffi->type('sint16') };
  is $@, '', 'sint16 is an okay type';

  is $ffi->sizeof('foo_t'), 2, 'sizeof foo_t = 2';
  is $ffi->sizeof('bar_t'), 4, 'sizeof foo_t = 4';

  is $ffi->function('UnMangled::Name(int i)' => ['bmyint'] => 'bmyint')->call(22), 22;
};

subtest 'Foo attribute' => sub {
  my $ffi = FFI::Platypus->new;
  $ffi->lib($libtest);
  $ffi->lang('Foo');

  eval { $ffi->type('int') };
  isnt $@, '', 'int is not an okay type';
  note $@;
  eval { $ffi->type('foo_t') };
  is $@, '', 'foo_t is an okay type';
  eval { $ffi->type('sint16') };
  is $@, '', 'sint16 is an okay type';

  is $ffi->sizeof('foo_t'), 2, 'sizeof foo_t = 2';
  is $ffi->sizeof('bar_t'), 4, 'sizeof foo_t = 4';

  is $ffi->function('UnMangled::Name(int i)' => ['bmyint'] => 'bmyint')->call(22), 22;
};

subtest 'MyLang::Roger' => sub {
  my $ffi = FFI::Platypus->new;
  $ffi->lang('=MyLang::Roger');

  eval { $ffi->type('int') };
  isnt $@, '', 'int is not an okay type';
  note $@;

  is $ffi->sizeof('foo_t'), 4, 'sizeof foo_t = 4';
};

done_testing;

package
  MyLang::Roger;

sub native_type_map
{
  {
    foo_t => 'sint32',
  }
}

package
  FFI::Platypus::Lang::Foo;

sub native_type_map
{
  {
    foo_t  => 'sint16',
    bar_t  => 'uint32',
    myint  => 'sint32',
    bmyint => 'uint8',
  }
}

sub mangler
{
  die "not a class method of FFI::Platypus::Lang::Foo"
    unless $_[0] eq 'FFI::Platypus::Lang::Foo';
  die "libtest not passed in as second argument"
    unless $_[1] eq $libtest;

  my %mangle = (
    'UnMangled::Name(int i)' => 'f0',
  );

  sub {
    defined $mangle{$_[0]} ? $mangle{$_[0]} : $_[0];
  };
}