FFI-Platypus-2.12/ 000755 000000 000000 00000000000 15251066120 013635 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/CONTRIBUTING 000644 000000 000000 00000012472 15251066120 015475 0 ustar 00root root 000000 000000 CONTRIBUTING
If you have implemented a new feature or fixed a bug then you may make
a pull request on this project's GitHub repository:
https://github.com/PerlFFI/FFI-Platypus/pulls
This project is developed using Dist::Zilla. The project's git
repository also comes with the Makefile.PL file necessary for building,
testing (and even installing if necessary) without Dist::Zilla. Please
keep in mind though that these files are generated so if changes need
to be made to those files they should be done through the project's
dist.ini file. If you do use Dist::Zilla and already have the necessary
plugins installed, then I encourage you to run dzil test before making
any pull requests. This is not a requirement, however, I am happy to
integrate especially smaller patches that need tweaking to fit the
project standards. I may push back and ask you to write a test case or
alter the formatting of a patch depending on the amount of time I have
and the amount of code that your patch touches.
This project's GitHub issue tracker listed above is not Write-Only. If
you want to contribute then feel free to browse through the existing
issues and see if there is something you feel you might be good at and
take a whack at the problem. I frequently open issues myself that I
hope will be accomplished by someone in the future but do not have time
to immediately implement myself.
Another good area to help out in is documentation. I try to make sure
that there is good document coverage, that is there should be
documentation describing all the public features and warnings about
common pitfalls, but an outsider's or alternate view point on such
things would be welcome; if you see something confusing or lacks
sufficient detail I encourage documentation only pull requests to
improve things.
The Platypus distribution comes with a test library named libtest that
is normally automatically built by ./Build test. If you prefer to use
prove or run tests directly, you can use the ./Build libtest command to
build it. Example:
% perl Makefile.PL
% make
% make ffi-test
% prove -bv t
# or an individual test
% perl -Mblib t/ffi_platypus_memory.t
The build process also respects these environment variables:
FFI_PLATYPUS_DEBUG_FAKE32
When building Platypus on 32 bit Perls, it will use the Math::Int64 C
API and make Math::Int64 a prerequisite. Setting this environment
variable will force Platypus to build with both of those options on a
64 bit Perl as well.
% env FFI_PLATYPUS_DEBUG_FAKE32=1 perl Makefile.PL
DEBUG_FAKE32:
+ making Math::Int64 a prereq
+ Using Math::Int64's C API to manipulate 64 bit values
Generating a Unix-style Makefile
Writing Makefile for FFI::Platypus
Writing MYMETA.yml and MYMETA.json
%
FFI_PLATYPUS_NO_ALLOCA
Platypus uses the non-standard and somewhat controversial C function
alloca by default on platforms that support it. I believe that
Platypus uses it responsibly to allocate small amounts of memory for
argument type parameters, and does not use it to allocate large
structures like arrays or buffers. If you prefer not to use alloca
despite these precautions, then you can turn its use off by setting
this environment variable when you run Makefile.PL:
helix% env FFI_PLATYPUS_NO_ALLOCA=1 perl Makefile.PL
NO_ALLOCA:
+ alloca() will not be used, even if your platform supports it.
Generating a Unix-style Makefile
Writing Makefile for FFI::Platypus
Writing MYMETA.yml and MYMETA.json
V
When building platypus may hide some of the excessive output when
probing and building, unless you set V to a true value.
% env V=1 perl Makefile.PL
% make V=1
...
Coding Guidelines
* Do not hesitate to make code contribution. Making useful
contributions is more important than following byzantine bureaucratic
coding regulations. We can always tweak things later.
* Please make an effort to follow existing coding style when making
pull requests.
* The intent of the FFI-Platypus team is to support the same versions
of Perl that are supported by the Perl toolchain. As of this writing
that means 5.16 and better. As such, please do not include any code
that requires a newer version of Perl.
Performance Testing
As Mark Twain was fond of saying there are four types of lies: lies,
damn lies, statistics and benchmarks. That being said, it can sometimes
be helpful to compare the runtime performance of Platypus if you are
making significant changes to the Platypus Core. For that I use
`FFI-Performance`, which can be found in my GitHub repository here:
https://github.com/Perl5-FFI/FFI-Performance
System integrators
This distribution uses Alien::FFI in fallback mode, meaning if the
system doesn't provide pkg-config and libffi it will attempt to
download libffi and build it from source. If you are including Platypus
in a larger system (for example a Linux distribution) you only need to
make sure to declare pkg-config or pkgconf and the development package
for libffi as prereqs for this module.
FFI-Platypus-2.12/Changes 000644 000000 000000 00000111714 15251066120 015135 0 ustar 00root root 000000 000000 Revision history for FFI-Platypus
2.12 2026-09-11 15:02:01 -0600
- Added FFI::Platypus::Buffer::raw_scalar which allocates an
uninitialized scalar of a fixed size for use as a buffer
(gh#411)
- Fixed intermittent segfault in the bundle-bzip2 example caused
by an uninitialized bz_stream struct (gh#411)
- FFI::Platypus::Closure sticky and unstick methods now return
$self so that they can be chained (gh#411, gh#405 JBARRETT++)
- Added a SECURITY policy document (gh#406, gh#411)
- Fixed regression from 0.94 that broke the identity cast used
internally by attach_cast on hppa-linux (gh#394, gh#411)
2.11 2026-01-12 03:30:38 -0700
- Documentation updates only
2.10 2024-12-18 11:11:31 -0700
- Detect V modules according to v.mod files (gh#402)
2.09 2024-08-18 20:33:42 -0600
- Fix bug in complex type detection (gh#396, mauke++)
2.08 2023-05-05 15:48:53 -0600
- Updated non-binding support for Perls to match the policy
of the Perl toolchain (Perls older than 10 years old are
unsupported, with a one-time exception of Perl 5.16). The
intent is not to suddenly drop support for older Perls, but
the FFI-Platypus team may take advantage of features in
supported Perls that will effectively remove compatability
with unsupported Perls.
- Documentation improvements (gh#392)
2.07 2023-03-14 06:59:09 -0600
- Production release identical to 2.06_01
2.06_01 2023-02-27 10:13:25 -0700
- Refactor Alien::FFI fallback mode to delete it as a prereq when it is not
needed instead of adding it when it is. This way the CPAN river rating
for Alien::FFI more closely reflects reality (gh#391)
2.05 2022-11-15 16:59:05 -0700
- Documentation improvements (gh#387, gh#388)
2.04 2022-11-05 07:14:35 -0600
- Documentation improvements (gh#372, gh#378, gh#380, gh#381, gh#382, gh#383,
gh#384, gh#386)
2.03 2022-10-27 21:19:06 -0600
- Add hook for detecting bundled Zig project. You will need to install
FFI::Build::File::Zig to use it. (gh#379)
2.02 2022-10-24 10:43:09 -0600
- The closure method now accepts undef as an argument. It just returns undef
which should be accepted by any function that takes a closure. (gh#376, gh#377)
2.01 2022-08-30 15:37:22 -0600
- Documentation fixes (gh#373)
2.00 2022-08-12 13:58:51 -0600
- Production release identical to 1.91_01
1.91_01 2022-07-05 07:41:07 -0400
- Setting the env environment V variable to a true value now will override the
verbose option on FFI::Build. This allows modules that use it to display verbose
output without having to change the .fbx files. This mirrors the behavior of
how FFI-Platypus itself works. (gh#369)
1.90_02 2022-06-27 08:33:31 -0600
- Documentation updates for API = 2 (gh#340, gh#368)
1.90_01 2022-06-24 11:03:35 -0500
- api = 2 is no longer experimental (gh#365)
1.61_01 2022-06-23 16:16:43 -0500
- Added experimental modules FFI::Build::Plugin and FFI::Build::PluginData (gh#351)
1.60_01 2022-06-23 15:49:42 -0500
- Updated installer
1.59_01 2022-06-19 07:47:49 -0600
- Internal refactor (gh#361)
1.58 2022-06-19 06:19:42 -0600
- TypeParser version 2 accept string(10) as alias for string(10)* (gh#346, gh#359)
1.57 2022-06-15 18:30:29 -0600
- Documentation improvements
1.56 2021-10-27 19:44:37 -0600
- Fixes for very old versions of Mac OS X / Xcode (gh#350)
- Added cxxld method to FFI::Build::Platform (gh#350)
1.55 2021-07-29 10:41:02 -0600
- Production release identical to 1.54_01
1.54_01 2021-07-12 17:05:37 -0600
- FFI::Temp will retry up to 10 times to avoid a race (gh#344, gh#348)
1.53 2021-07-12 12:18:27 -0600
- Documentation improvements (gh#307, gh#347)
1.52 2021-07-01 07:33:44 -0600
- Probe for intmax_t uintmax_t types (gh#341)
1.51 2021-07-01 07:25:38 -0600
- Fix testing bug that was failing on systems with libffi that does
not support variadic functions (ppisar++ gh#323, gh#343, gh#345)
1.50 2021-06-30 08:34:17 -0600
- Production release identical to 1.49_01
1.49_01 2021-06-22 17:07:44 -0600
- float gets promoted to double when used as a varadic argument
(gh#323, gh#338)
1.48_01 2021-06-22 00:32:02 -0600
- Test forks in CI (gh#333, #334, #335)
- Internal refactor of pointer and array input arguments to reduce
duplication (gh#336)
1.47_01 2021-06-21 22:24:40 -0600
- Restore experimental code from 1.45_01
1.46 2021-06-21 22:20:12 -0600
- Hotfix due to testing bug in 1.44 (gh#333)
- This version does not include experimental code from 1.45_01.
1.45_01 2021-06-21 18:23:17 -0600
- Experimental: with api => 2, you can now pass an array reference to
a pointer argument, which is roughly equivalent to an array type with
no size, example: sint[] (gh#227, gh#332)
1.44 2021-06-20 06:50:03 -0600
- Migrate test suite to Test::V0 (gh#327)
- Use parent instead of base in documentation and in code (gh#239 jjatria++)
- Improved consistency of examples and documentation (gh#328, gh#330, jjatria++)
1.43 2021-03-17 09:46:40 -0600
- Fix test hang on cygwin (gh#320, gh#321)
1.42 2021-03-15 05:42:23 -0600
- Production release identical to 1.41_01
1.41_01 2021-03-14 12:49:38 -0600
- Adjusted test introduced in 1.40_01 to not rely on returning
a record-value for platforms that do not support that. (gh#318, gh#319)
1.40_01 2021-03-12 13:08:41 -0700
- Add support for closures returning records pass-by-value
if they do not include string pointers (gh#313, gh#315)
1.39_01 2021-03-09 17:38:37 -0700
- Fix bug where closure ABI wasn't being used for non-default
ABIs (gh#313, gh#314)
- Add support for closures taking records pass-by-value (gh#312)
1.38 2021-03-08 17:13:15 -0700
- Production release identical to 1.37_01
1.37_01 2021-03-06 14:03:35 -0700
- Document the .fbx interface for specifying compiler / linker flags or
using Aliens with bundled C code in FFI::Platypus::Bundle
(gh#221, gh#306)
1.36_01 2021-03-02 17:32:03 -0700
- Improved the reliability of ABI detection on some platforms
(gh#285, gh#301, gh#302)
1.35_01 2021-03-01 16:02:07 -0700
- Favor the Microsoft strdup over the bundled copy if found as _strdup
which is what it is called now (gh#299).
- Added FFI::Platypus::Type::WideString type plugin
(IKEGAMI++ gh#291, gh#292, gh#299)
1.34 2020-10-23 09:04:46 -0600
- Fixed bug in in record meta object which expressed itself on at least
some platforms (gh#287, gh#288)
1.33 2020-09-28 10:47:26 -0600
- FFI::Platypus::Declare is no longer part of this distribution. It is
now available from FFI-Platypus-Declare instead. It has already
been discouraged for quite some time. (gh#285)
- Fix bug where bundled .so name could incorrectly get double colons (::)
in the name in development mode only. This is probably only a problem
on Windows. (gh#284)
1.32 2020-09-21 04:25:13 -0600
- Fix unsupported Perl tests.
Fixes code that refuse to install on 5.10.0t (threads) (gh#275, gh#280)
1.31 2020-07-01 05:28:10 -0600
- Refuse to install on very old versions of Perl 5.8.1, 5.8.2, 5.8.3 and
5.10.0t (threads) (Gh#275)
- Move to new GH org PerlFFI (old org was Perl5-FFI, and will remain to
keep URL redirection). The new URL is
https://github.com/PerlFFI/FFI-Platypus
1.30 2020-06-16 06:51:53 -0600
- Dropping support for Perl 5.8.1, 5.8.2 and 5.8.3, and the threaded version
of 5.10.0. For now Platypus will install on these versions of Perl, but a
warning will be issued, along with a 45s sleep at configure time and a 180s
sleep at test time. Please upgrade to 5.8.4 (or preferrably 5.32).
Starting July 1st, Platypus will refuse to install on these elderly Perls.
(gh#271, gh#272)
1.29 2020-06-06 08:40:10 -0600
- For window (from FFI::Platypus::Buffer), if $size is omitted then
it will assumed to be a C string and computed using strlen (gh#270)
1.28 2020-05-20 01:43:09 -0600
- Production release identical to 1.27_01
1.27_01 2020-05-17 18:01:37 -0600
- Add strcpy to FFI::Platypus::Memory (gh#265)
- Add window to FFI::Platypus::Buffer (gh#266, gh#267)
1.26 2020-05-07 04:59:17 -0600
- The return type for the function method can now be omitted and
defaults to 'void' (gh#262, gh#263)
- The attach_cast method can now take a wrapper function (gh#261, gh#264)
1.25 2020-05-05 19:40:02 -0600
- Fixed bug where return type uint64* was being returned as
sint64* (gh#258, gh#259)
1.24 2020-05-02 16:59:34 -0600
- Add kindof method (gh#243, gh#254)
- Add countof method (gh#243, gh#254)
- Add unitof method (gh#245, gh#254)
- Add def method (gh#244, gh#248, gh#254)
- Add hook load_custom_types to the language plugins that allows
them to define custom types (gh#253)
1.23_01 2020-05-01 11:13:59 -0600
- Custom record arguments are kept around for the lifetime of the
function call, meaning they don't have to be explicitly kept by
the custom code wrapper as long as they aren't used after the
function returns (gh#236, gh#247).
- This completes support for custom record types. This is a
release candidate.
1.22_01 2020-05-01 08:16:25 -0600
- Fix test on MSWin32 + older libffi where returning record values
doesn't work (introduced in 1.20_01, gh#250)
1.21_01 2020-04-29 19:10:59 -0600
- Diagnostic release.
1.20_01 2020-04-29 06:45:11 -0600
- Return record custom record value (gh#214, gh#215, gh#235, gh#238, gh#245)
1.19_01 2020-04-27 12:38:43 -0600
- Diagnostic release.
1.18_01 2020-04-19 10:17:52 -0600
- Return pointer to custom record (gh#214, gh#215, gh#235, gh#238)
1.17_01 2020-04-18 09:04:02 -0600
- Silence (probably harmless) clang warning introduced in 1.12_01
(gh#237, gh#239)
1.16_01 2020-04-18 10:10:37 -0400
- Initial support for custom records. Returning custom records
(either via pointer or by reference) is excluded, but should
be added soon (gh#214, gh#215, gh#235)
1.15_01 2020-04-17 10:34:13 -0600
- Internal refactor (gh#214)
1.14_01 2020-04-17 09:14:25 -0600
- Experimental: with api => 2, a return value of NULL is
translated to undef instead of empty list (gh#234, gh#231)
1.12_01 2020-04-17 10:35:51 -0400
- Added grow and set_used_length functions to
FFI::Platypus::Buffer (djerius++ gh#225)
1.11 2020-04-16 04:07:34 -0600
- Add api method (gh#233)
- On Visual C++ Perl detect libffi using Win32::Vcpkg, if
available (gh#229)
- Simplified internal handling of 64 bit integers for
32 and 64 bit arch (gh#228)
1.10 2020-02-05 16:39:51 -0700
- On OS X, check if homebrew + libffi is installed and use
that instead of falling back on Alien::FFI (libffi isn't
installed by homebrew in a way that it can be found by
without specifically looking for it).
- Die with an appropriate diagnostic if there is a syntax or
runtime error in an .fbx file (FFI::Build).
(djerius++ gh#223)
1.09 2020-01-18 13:41:56 -0700
- Production release identical to 1.08_01
1.08_01 2020-01-17 19:39:21 -0700
- Fix warning on some versions of windows (gh#217, gh#218)
1.07 2019-12-28 08:44:36 -0700
- Fix bug in variadic argument count (gh#210, gh#211)
1.06 2019-12-14 07:49:54 -0700
- Visual C++ Perl build probe for ssize_t (gh#208, gh#209)
1.05 2019-12-13 09:27:50 -0700
- ffi_platypus_bundle.h provides an EXPORT macro which allows
you to decorate functions/data for export under Visual C++ Perl (gh#207)
- ffi_pl_bundle_init, ffi_pl_bundle_constant and ffi_pl_bundle_fini
are now properly marked as EXPORT. No code changes needed as long
as you are using the header file (gh#207)
1.04_01 2019-12-12 19:05:54 -0700
- Some additional testing fixes for Visual C++ Perl build (gh#206)
1.03_01 2019-12-11 20:53:40 -0700
- Restore support for Visual C++ Perl build (gh#202)
- C++ support on Visual C++ Perl is not supported at this time (gh#203)
1.02 2019-12-09 03:07:41 -0700
- FFI::Build is no longer described as "alpha"
- Documentation fixes.
1.01 2019-11-16 07:16:20 -0700
- Documentation fixes only (gh#198, gh#199, gh#200)
1.00 2019-11-15 13:46:15 -0500
- Production release identical to 0.99_06
0.99_06 2019-11-12 21:08:23 -0500
- Detect Rust or Go modules according to Cargo.toml or go.mod files (gh#197)
0.99_05 2019-10-30 19:25:02 -0600
- Add FFI::Build support for build_all method (gh#195)
0.99_03 2019-10-24 10:46:02 -0700
- Documentation
0.99_02 2019-10-14 16:16:16 -0600
- api = 1 is no longer experimental (gh#193)
0.99_01 2019-10-14 14:39:18 -0600
- Convert documentation from api => 0 (implicit) to api => 1 (explicit)
- Improved documentation (gh#181, gh#184)
0.98 2019-10-14 13:18:02 -0600
- Production release identical to 0.97_05
0.97_05 2019-10-12 13:09:12 -0600
- Fixed several memory leaks on some return types and complex type
arguments (gh#190, gh#191)
0.97_04 2019-10-05 12:31:32 -0600
- pointer is no longer an alias for opaque with api => 1 (gh#189)
- Added several reserved words for the type parser when api => 1 (gh#189)
0.97_03 2019-09-25 18:03:13 -0600
- FFI::Platypus::Record has a record_layout_1 function which
uses api => 1 by default. (gh#187)
0.97_02 2019-09-20 04:03:59 -0600
- FFI::Platypus::Record record_layout may now take FFI::Platypus
constructor arguments as a array reference as the first argument
(gh#185)
0.97_01 2019-09-18 20:56:59 -0600
- Pre-compute cast functions when they are created to save time each time
they are called (gh#178, #179)
- sizeof and alignof can now be used as class methods (gh#183)
0.96 2019-08-19 18:33:58 -0400
- Production release identical to 0.95_11
0.95_11 2019-08-19 09:41:56 -0400
- Documentation fixes (hakonhagland++ gh#173)
- Increased Perl::Critic criticism and associated fixes (gh#172)
0.95_10 2019-08-16 16:14:54 -0400
- Detect bad forks.pm (gh#170)
0.95_09 2019-08-15 10:37:41 -0400
- Daignostic release
0.95_08 2019-08-14 09:18:10 -0400
- Document constant interface (see FFI::Platypus::Constant) (gh#169)
0.95_07 2019-08-13 13:38:30 -0400
- Minor tweak to bundle interface: do not create fbx.json file when
running on-demand (gh#167)
- Document bundle interface (see FFI::Platypus::Bundle) (gh#160, gh#168)
0.95_06 2019-08-03 08:51:46 -0400
- Platypus now passes the api version (if > 0) into language plugins
class native_type_map method (gh#165, gh#166)
0.95_05 2019-08-01 16:18:41 -0400
- Under api = 1, a warning will be issued when Platypus tries to load
a file that is not a dnyamic library. Previously, and under api = 0
this warning was only issued if the environment variable
FFI_PLATYPUS_DLERROR is set to a true value (gh#161, gh#163)
0.95_04 2019-07-31 21:18:30 -0400
- New interface for bundling code with dist (see bundle method)
experimental, requires api = 1 (gh#160, gh#162)
- Bundle API provides a way to define Perl constants from C
(gh#138)
0.95_03 2019-07-29 19:21:24 -0400
- Remove build dependent strings from deployment
(gh#104, gh#110, gh#157, gh#159)
0.95_02 2019-07-25 17:15:09 -0400
- Fix memory leak related to array in the case of bad type error (gh#154)
- Fix compiler warnings in record meta module (gh#153, gh155)
- More consistent use of temp directories to work around noexec on /tmp
(gh#156, gh#158)
0.95_01 2019-07-23 22:19:14 -0400
- Add support for "object" types. (gh#49, gh#89, gh#151)
- Fixed bug where 64 bit integer types could be truncated in a
cast on 32 bit platform (gh#151)
- You can now decorate record value types with * to get
a record type using type parse 1 (gh#150)
- Add support for complex arrays on platforms where
complex types are supported (gh#89, gh#152)
0.94 2019-07-23 09:53:46 -0400
- Production release identical to 0.93_03
0.93_03 2019-07-22 15:02:05 -0400
- Reclaim some memory waste introduced in 0.93_01 (gh#149)
0.93_02 2019-07-18 10:03:01 -0400
- Fix complex test on 32bit
0.93_01 2019-07-17 20:21:47 -0400
- Add support for returning records pass-by-value (gh#89, gh#147)
- Add enum and senum (signed enum) types (gh#146)
0.92 2019-07-17 18:16:40 -0400
- Production release identical to 0.91_02
0.91_02 2019-07-16 19:31:40 -0400
- Documentation improvements. (gh#139, gh#145, et. al)
- Fixed minor testing error introduced in 0.91_01 (gh#143, gh#144)
0.91_01 2019-07-14 09:32:13 -0400
- Add support for variadic functions (gh#136, gh#141)
- Include Type Parser version 1. This can be activated using
the api => 1 when creating a FFI::Platypus instance (gh#135)
- Usage of Type Parser version 1 is experimental and will
issue a warning until FFI::Platypus 1.00 is released (gh#135)
- Added support for pass-by-value records (gh#57,gh#92,gh#135)
this requires Type Parser version 1
- Allow decoration of aliases of basic types (gh#135, gh#135)
this requires Type Parser version 1
- Fix bug where Math::LongDouble and Math::Complex detection
wasn't being made for array and pointers of longdouble,
complex_float and complex_double types. (gh#135)
- For functions: allow a single 'void' argument type to indicate
an empty list of arguments (a la old C style). The 'void'
type is otherwise now illegal as an argument type (ie when
there is more than one argument) and will throw an exception
when the function is created. Previously a warning would
be issued when the funtion was called. (gh#140, gh#142)
0.90 2019-07-01 09:47:31 -0400
- Documentation improvements (gh#137, et. al.)
0.89_01 2019-06-24 08:33:05 -0400
- Fixed bug where prototypes to attach were sometimes being
ignored.
- Add sub_ref method to FFI::Platypus::Function (gh#133)
- Better file/line number diagnostics for croak inside a
wrapper (gh#129, gh#132)
0.88 2019-06-19 06:56:57 -0400
- Add mangler attribute for FFI::Platypus (gh#128)
0.87 2019-04-23 08:25:35 -0400
- Add probe for intptr_t and uintptr_t types (gh#123)
- You may now use the ALIEN_INSTALL_TYPE environment
to force using Alien::FFI (gh#121)
- Documentation improvements (gh#122 manwar++ gh#120 ppisar++)
0.86 2019-03-02 16:42:12 -0500
- Production release identical to 0.85_01
0.85_01 2019-03-01 20:38:22 -0500
- Fix configure bug that misconfigured Perls with 32bit IVs
resulting in truncated 64bit values. (gh#117, gh#118).
This was a regression, probably introduced around 0.72
or so. The test t/gh117.t has been added to avoid a
recurrence of this regression.
0.84 2019-02-15 15:26:23 -0500
- FFI::Build sets @rpath on libraries that it builds
on OS X.
0.83 2019-02-12 14:05:04 -0500
- Fix warning in FFI::Build when verbose off
- Allow arry file spec for FFI::Buuild source method
- Added scalar_to_pointer to FFI::Platypus::Buffer
0.82 2019-02-10 10:34:57 -0500
- Production release identical to 0.81_04
0.81_04 2019-02-08 14:49:20 -0500
- Diagnostic release
0.81_02 2019-02-05 12:19:50 -0500
- Diagnostic release
0.81_01 2019-02-04 11:51:52 -0500
- Diagnostic release
0.80 2019-02-01 15:36:50 -0500
- Fix incompatibility with parallel bsd make
0.79 2019-01-31 20:58:07 -0500
- Fix probe runner builder bug (gh#112, gh#113)
0.78 2019-01-30 10:28:22 -0500
- Production release identical to 0.77_03
0.77_03 2019-01-29 21:44:29 -0500
- Remove Java gcj examples. The gcj compiler has been deprecated,
unmaintained, and removed from the gcc collection for quite a while
now.
- Fix problem diagnostic window on Windows during probe
0.77_02 2019-01-29 11:30:56 -0500
- Fix regressions in 0.77_01
0.77_01 2019-01-28 15:47:07 -0500
- Honor compiler and linker flag overrides provided on the command-line
for FFI::Probe::Runner::Builder, make ffi and make ffi-test (gh#104)
0.76_01 2019-01-20 20:14:45 -0500
- function method can now take a wrapper code reference as its last
argument in the same way as attach.
0.75_01 2019-01-19 04:45:19 -0500
- Add strndup to FFI::Platypus::Memory
0.74 2019-01-19 04:42:22 -0500
- Production release identical to 0.73_01
0.73_01 2019-01-13 18:31:33 -0500
- Remove dependency on Win32::ErrorMode on Windows
0.72_01 2019-01-11 22:17:11 -0500
- Remove dependency on Config::AutoConf
0.71_01 2019-01-10 23:29:06 -0500
- Merge FFI-Build into this distribution
- Add FFI::Probe
0.70_01 2019-01-10 15:34:57 -0500
- prereq fix: IPC::Cmd as a configure requires
since it doesn't come with Perl 5.8.x
0.69_01 2019-01-09 15:59:43 -0500
- require Alien::FFI in fallback mode
0.68_01 2019-01-05 21:12:47 -0500
- Improve platform probing of complex type
- Allow override of platform probing using FFI_PLATYPUS_PROBE_OVERRIDE
0.67_01 2019-01-05 09:16:22 -0500
- Better support for complex types: pointers to complex types and complex
type and pointers to complex as return value
0.66_01 2019-01-04 20:16:59 -0500
- EXPERIMENTAL ExtUtils::MakeMaker fixes for dynamic prereqs on windows
- restore FFI_PLATYPUS_DEBUG_FAKE32
- restore FFI_PLATYPUS_NO_ALLOCA
0.65_01 2019-01-04 13:38:58 -0500
- EXPERIMENTAL ExtUtils::MakeMaker fixes for parallel and freebsd build
0.64_01 2019-01-03 03:16:57 -0500
- EXPERIMENTAL ExtUtils::MakeMaker fixes for MSWin32 / cygwin
0.63_01 2019-01-02 11:23:48 -0500
- EXPERIMENTAL ExtUtils::MakeMaker release
0.62_01 2019-01-01 04:23:23 -0500
- New type: array of string "string [x]" and "string []" are supported
- NULL terminated arrays are supported as return types for string and opaque
arrays "opaque []" and "string []"
0.61_01 2018-12-31 19:56:20 -0500
- New type: pointers to string "string *" are supported.
- FFI::Platypus::Type::StringPointer is now deprecated.
0.60_01 2018-12-30 14:55:15 -0500
- sticky/unstick functions can safely be called multiple times
- Removed some extra lookups from closure calls, should be faster now.
0.59 2018-12-16 16:33:37 -0700
- Workaround for possibly buggy pack/unpack on Perl 5.8.8 gh#91
Fixes FFI::Platypus::Type::StringArray
0.58 2018-11-20 14:31:10 -0500
- Add unstick method to FFI::Platypus::Closure
0.57_01 2018-11-04 15:36:33 -0500
- Major refactor of the internals of the type system. The API is
the same but some type meta-data (which was never guaranteed
to stay the same) may have changed.
* The internal representation of types is much smaller (4 bytes
for simple types), which can save a lot of memory if you have
lots of types.
* Fixed width strings example: `string(32)` are now internally
treated the same as a record with no class `record(32)`.
Previously these were separate types but worked identically,
this removes duplicate code.
* Fixed width string arguments to a closure are now read-only,
Usually you should be copying these arguments anyway.
* Removed the internal type "exotic float" which includes
`long double`, `complex float` and `complex double`. These are
now grouped internally with other scalar types.
- Merge FFI::Platypus::Type::StringArray into this distribution
0.56 2018-09-03 09:17:42 -0400
- lib method accepts code reference which will be called immediately
and results added to lib list
0.55 2018-08-29 10:37:36 -0400
- Production release identical to 0.54_03
0.54_03 2018-08-28 10:46:04 -0400
- Additional test diagnostics.
0.54_02 2018-08-28 05:30:04 -0400
- record as closure argument is now read-only. This makes
sense since such records are actually copies. For when
you need a non-copy use an opaque type instead. This allows
records with rw strings (although they will be ro in the
closure).
0.54_01 2018-08-16 03:27:31 -0400
- Experimental: allow record as closure argument
Records with string_rw are not supported, and
will likely crash your script if you try to use
them. Support for such records is probably not in
the cards, but a future version may disallow them
to avoid crashes.
- Closure objects now have a sticky method, similar to what
is already available in the discouraged FFI::Platypus::Declare
interface
0.53 2018-08-15 20:38:29 -0400
- Production release identical to 0.52_04
0.52_04 2018-08-15 05:52:15 -0400
- Work-around for Strawberry Perl 5.14.4 unicode bug (see gh#85)
0.52_03 2018-08-14 15:28:19 -0400
- Major refactoring of test suite
0.52_02 2018-08-14 08:05:07 -0400
- Added standard RTLD_ constants to FFI::Platypus::DL
- Fixed long standing but till now unused bug on Windows where dlopen was
returning a handle for libraries that weren't actually being loaded.
0.52_01 2018-08-13 20:39:32 -0400
- Testing: moved libtest to t/ffi, using the same convention as FFI::Build
- Added FFI::Platypus::DL. Previously this had been (under a different
name) a private interface to libdl used by FFI::Platypus under the covers.
On Windows it is an emulation layer over the native equivalents.
0.51 2018-08-09 03:14:15 -0400
- update the package method to work with FFI-Build
0.50 2018-06-01 07:58:33 -0400
- Additional diagnostics
0.49_05 2018-05-29 12:44:45 -0400
- Require Alien::FFI 0.20 for bugfixes
0.49_04 2018-05-27 07:36:58 -0400
- Additional diagnostics
- Added a FAQ section. Some other minor documentation enhancements.
0.49_03 2018-05-19 10:09:15 -0400
- The previous version contained build files that would break the install
unless you were building on my machine. This is what the previous
version should have been.
0.49_02 2018-05-18 22:08:43 -0400
- Fix version mismatch error with XS
0.49_01 2018-05-18 16:16:13 -0400
- Move the source repository for this project into the GitHub org Perl5-FFI
The new URL is https://github.org/Perl5-FFI/FFI-Platypus
- Remove dependency on JSON::PP, use Data::Dumper for build configuration.
This may improve startup performance.
0.48 2018-02-20 09:37:32 -0500
- setting lib => undef is now the same as setting it to [undef] in the
constructor (previously lib => undef was ignored)
0.47 2017-03-23 18:26:01 -0400
- Fix installer bug where My::ShareConfig was accidentally declared as a
prereq
0.46 2017-03-23 15:47:29 -0400
- Remove some internal use of Module::Build with the intent of one day
migrating to EUMM or some other installer
- Remove Module::Build::FFI. It now has its own distribution.
- Prefix the lang attribute with an equal '=' sign to indicate a fully
qualified class name instead of one under FFI::Platypus::Lang
0.45 2016-10-24 07:59:57 -0400
- Remove check for Threaded Perl / OpenBSD, as the issue there has been
reported fixed
0.44 2016-10-20 14:31:23 -0400
- You can now control which implementation of strdup FFI::Platypus::Memory
uses via the FFI_PLATYPUS_MEMORY_STRDUP_IMPL environment variable.
0.43 2016-07-08 03:28:57 -0400
- Numerous fixes for systems with 64bit big-endian arch
(previously only 32bit big-endian had been tested)
- Officially discourage the use of FFI::Platypus::Declare
0.42 2016-05-06 16:31:01 -0400
- Support for MSYS2
0.41 2016-04-09 16:03:07 -0400
- For the return value undef can be passed in to mean 'void'.
- Fixed installer bug where ABI probe would silently fail if /tmp
was mounted noexec
- Avoid unnecessary downgrade on when Perl is compiled to use longdouble
0.40 2015-08-29 08:45:19 -0400
- Closure declarations ignore white space between () and ->
0.39 2015-08-24 03:23:10 -0400
- Fixed spurious warning: auto loading of record class (via
FFI::Platypus::Record) was ALWAYS warning, when it should have only been
warning on load failure.
0.38 2015-08-13 17:13:07 -0400
- closure method now comes with a more useful diagnostic thinks to
Carp::croak
- Added a check for standard C headers. This seems to help the configure
stage find ptrdiff_t, which was frequently not detected correctly
(at least on Linux).
- Improved thread safety by using MY_CXT for some very infrequently used
global variables.
- Added IRC meta data information for metacpan.org. Please join us at
#native on irc.perl.org!
- Many minor documentation corrections and tweaks. Most significant is
that Convert::Binary::C can now be recommended as it is once again
properly maintained.
- Added tests for threads and forks. If these tests fail in your environment
please let me know!
0.37 2015-05-29 14:28:21 -0400
- Added compatibility back in for older version of constant
(newer one is not available on CPAN yet)
0.36 2015-05-29 13:40:32 -0400
- Explicitly require constant pragma version 1.32
0.35 2015-05-29 12:06:39 -0400
- FFI::Platypus::Record uses constant to create size of alignment constants
instead of creating them with a sub reference (this usage was deprecated
in Perl 5.22)
0.34 2015-05-07 09:27:04 -0400
- Require Alien::FFI which is more reliable at configure time on some
platforms
0.33 2015-03-23 21:55:02 -0400
- Additional fix for Microsoft Visual C++ that didn't get folded into
the previous release.
- Fixed segfault during global destruction (gh#53)
0.32 2015-03-18 13:02:53 -0400
- Make sure -L flags from Alien::FFI come before those in perl Config
For more reliable builds
- Support for Microsoft Visual C++ (you will probably also need
Alien::FFI 0.09 or beter)
0.31 2015-02-26 13:41:23 -0500
- Fix bug involving wide custom arguments
"wide" meaning where a single Perl argument is translated
into multiple machine code arguments. (pipcet++ gh#43)
0.30 2015-02-25 17:50:54 -0500
- You can now pass an opaque in place of a closure type (pipcet++ gh#40,gh#41)
- FFI closures are now cached and can be reused if the same closure is passed
repeatedly (pipcet++ gh#40,gh#42)
- Passing non-reference to scalar as a pointer argument will now issue a
warning (gh#5)
0.29 2015-02-24 08:50:34 -0500
- Delayed loading of Win32::ErrorMode to avoid build prereq failure on Windows
0.28 2015-02-23 14:01:54 -0500
- Fix Win32 probe prereq on non-Strawberry 5.20.x+
- Fix for Solaris cc
0.27 2015-02-22 11:17:05 -0500
- Interface to alternate ABIs / calling conventions
- Added abi method
- Added abis class method
- Simplify Win32 probe
- Added FFI::Platypus::Lang::Win32 which provides data types used by
the Windows API. Takes care of subtle differences between
Win32 and Win64.
- Fixed bugs specific to 5.8.x
- Language plugins can now specify an ABI with abi class method
- Default ABI for FFI::Platypus::Lang::Win32 is stdcall on 32bit windows
0.26 2015-02-18 17:47:43 -0500
- Added support for pointers to longdouble (in C "long double *") type
- Added support for array of longdouble (in C "long double []") type
- Added tied array interface for record array members (see
FFI::Platypus::Record::TieArray) Marked as EXPERIMENTAL
- Array members of records can now be accessed (set/get) by element
- Array members of records types are now documented (see
FFI::Platypus::Record)
- Bugfix: array wasn't being updated on return for variable length
array types
- Should now build with an Alien::FFI that was built with ALIEN_FORCE=1
0.25 2015-02-16 20:18:41 -0500
- Probe for proper long double support instead of trusting ffi.h
- This disables long double support on cygwin, which does not seem to
work, at least in so far as it seems to work on other platforms
patches to prove otherwise are welcome.
0.24 2015-02-16 15:38:58 -0500
- Fixed Windows / Strawberry configuration issues
0.23 2015-02-16 05:44:39 -0500
- Support for longdouble (in C "long double") type.
- Support for complex_float (in C "float complex") type
- Support for complex_double (in C "double complex") type
- Fixes for Big Endian architectures (tested on Linux PowerPC)
0.22 2015-02-12 07:47:32 -0500
- Variable length arrays
- More recent version of Config::AutoConf required in the configure step
(gh#33 zmughal)
- Documentation improvements and additional examples, including a
crazy Java one
0.21 2015-02-09 06:23:03 -0500
- Added FFI::Platypus#alignof method
- Added FFI::Platypus::Record module
- Added fixed length strings example: string(10)
- Added ro and rw trait for strings
0.20 2015-02-05 14:06:11 -0500
- Added optional wrapper argument to FFI::Platypus#attach
and FFI::Platypus::Declare#attach
- Added FFI::Platypus#find_lib method
- FFI::CheckLib is now a runtime requirement for Platypus
- Bumped Alien::FFI requirement to 0.06
0.19 2015-02-03 13:34:53 -0500
- Accept additional extensions, in addition to dlext
Example: on OS X both .bundle and .dylib can be used
Example: although arguably wrong, on cygwin sometimes .so is used
- Added Module::Build::FFI->ffi_dlext class method
0.18 2015-01-30 15:22:07 -0500
- Improved support for C++ in Module::Build::FFI
- Module::Build::FFI can now be subclassed to support foreign
languages other than C and C++. See Module::Build::FFI::Rust as an
example.
- Added a hook to allow different names for native types. See
FFI::Platypus::Lang::Rust for an example.
- Added a hook to allow mangling of symbol (function) names. See
FFI::Platypus::Lang::CPP for an example with C++
- Module::Build::FFI#ffi_include_dir can now be an array reference
- Module::Build::FFI#ffi_source_dir can now be an array reference
- Module::Build::FFI#ffi_libtest_dir can now be an array reference
- Module::Build::FFI will build assembly source files (with .s
extensions) in the libtest and ffi directories
0.17 2015-01-28 11:11:02 -0500
- Allow integer and floating point type default to 0 when not provided
without warning
- You can now take the sizeof a custom type (it will be the size of
the native type that is actually passed on the C argument stack).
- Sizeof should be faster now as it doesn't look up the other meta
information or create a hash to contain it
- Added record type see FFI::Platypus::Type#Records
- Added bool as a primitive type.
0.16 2015-01-23 17:31:00 -0500
- Bumping Alien::FFI version requirement up to 0.04
Thus indirectly Alien::Base to 0.07
Believe this may fix a cpan testers failure that I am seeing
0.15 2015-01-23 16:46:27 -0500
- add FFI::Platypus#ignore_not_found attribute
- add FFI::Platypus#package method
- Module::Build::FFI was moved into this distribution
(formerly distributed as part of FFI-Util)
- added aliases: uchar, ushort, uint and ulong
0.14 2015-01-22 08:19:42 -0500
- Fixed some broken links in the documentation
0.12 2015-01-21 23:22:16 -0500
- First CPAN release
- Improved documentation
- Functionally identically to 0.11
0.11 2015-01-21 16:33:58 -0500
- Release candidate 2
- arguments are available during custom return type even when
platform does not support alloca
- More documentation and examples
- FFI::Platypus::API now use prototypes so you can skip the ()
0.10 2015-01-20 04:06:17 -0500
- Release candidate 1
- Added custom Types API (see FFI::Platypus::API)
- Added String Pointer custom type (FFI::Platypus::Type::StringPointer)
- Added Pointer / Size Buffer custom type
(FFI::Platypus::Type::PointerSizeBuffer)
0.09 2015-01-19 03:01:48 -0500
- Third beta
- moved cast and sizeof from FFI::Platypus::Memory
into FFI::Platypus methods.
- cast and size of functions for FFI::Platypus::Declare
- attach_cast for faster casting
- renamed FFI::Platypus::Declare#function to
FFI::Platypus::Declare#attach to more closely match
the OO interface
- adjusted custom type interface
- renamed ffi_to_perl native_to_perl
- renamed perl_to_ffi perl_to_native
- type argument is now part of the hash and is called
native_type
0.08 2015-01-16 10:55:14 -0500
- Second beta
- add FFI::Platypus::Buffer
stole the buffer functions from FFI::Util
can do this with cast, but cast is slow
- Fixed bug where cast didn't work with closures.
- closure data now free'd when it the closure
goes out of scope (GH#4)
0.07 2015-01-15 18:53:45 -0500
- First (mostly complete) beta
- workaround some issues with closures
- much more comprehensive documentation
0.06 2015-01-14 17:13:57 -0500
- fix typo in last version that broke 32 bit Perls. oops.
0.05 2015-01-14 17:04:25 -0500
- Forth (and mostly complete) alpha
- custom types written in Perl are supported.
- bug fixes for 32 bit Perls (with compilers that support int64_t)
0.04 2015-01-13 11:14:54 -0500
- Third (and incomplete) alpha
- all basic types supported everywhere
- closures do not support non basic types or returning strings from a closure
0.03 2015-01-09 15:40:14 -0500
- Second (and incomplete) alpha
- closure support added (only integer arguments implmented).
- memory leak related to closures will be fixed in the next alpha.
0.02 2015-01-07 17:40:35 -0500
- Early (and incomplete) alpha
0.01 2015-01-07 17:21:27 -0500
- Original (and incompatible) prototype
FFI-Platypus-2.12/Changes.FFI-Build 000644 000000 000000 00000002244 15251066120 016572 0 ustar 00root root 000000 000000 Revision history for {{$dist->name}}
After 0.12 FFI-Build was merged with FFI-Platypus
0.12 2019-01-06 10:23:17 -0500
- Make FFI::Platypus an optional testing dependency
(previously it was a required dependency for testing
only).
0.11 2018-12-20 21:55:50 -0700
- Require EUMM 7.24 for fixes in testing
0.10 2018-12-20 17:51:17 -0700
- Fix bug where build aliens were used
for test only build
0.09 2018-08-28 10:50:27 -0400
- Additional test diagnostics
0.08 2018-08-28 09:58:19 -0400
- Same workaroudn for linkers with space
0.07 2018-08-20 10:52:27 -0400
- Workaround for compilers with space
0.06 2018-08-20 08:57:30 -0400
- Fix test
0.05 2018-08-20 05:17:36 -0400
- Removed FFI::Build::File::Fortran, which is now part of the
FFI-Platypus-Lang-Fortran dist
0.04 2018-08-19 12:56:54 -0400
- When `cc -MM` or `c++ -MM` fails for computing dependencies, fall back
on just the .c file being the dependency.
0.03 2018-08-16 04:03:09 -0400
- Fix for test failure on cygwin + MSWin32
- Additional diagnostics for Fortran build test
0.02 2018-08-09 04:54:30 -0400
- initial version
FFI-Platypus-2.12/Changes.FFI-Platypus-Type-StringArray 000644 000000 000000 00000000372 15251066120 022536 0 ustar 00root root 000000 000000 Revision history for FFI-Platypus-Type-StringArray
After 0.02 FFI-Platypus-Type-StringArray was merged with FFI-Platypus
0.02 2018-07-28 21:34:16 -0400
- Add support as a return type.
0.01 2015-01-23 16:50:47 -0500
- initial version
FFI-Platypus-2.12/INSTALL 000644 000000 000000 00000004553 15251066120 014675 0 ustar 00root root 000000 000000 This is the Perl distribution FFI-Platypus.
Installing FFI-Platypus is straightforward.
## Installation with cpanm
If you have cpanm, you only need one line:
% cpanm FFI::Platypus
If it does not have permission to install modules to the current perl, cpanm
will automatically set up and install to a local::lib in your home directory.
See the local::lib documentation (https://metacpan.org/pod/local::lib) for
details on enabling it in your environment.
## Installing with the CPAN shell
Alternatively, if your CPAN shell is set up, you should just be able to do:
% cpan FFI::Platypus
## Manual installation
As a last resort, you can manually install it. If you have not already
downloaded the release tarball, you can find the download link on the module's
MetaCPAN page: https://metacpan.org/pod/FFI::Platypus
Untar the tarball, install configure prerequisites (see below), then build it:
% perl Makefile.PL
% make && make test
Then install it:
% make install
On Windows platforms, you should use `dmake` or `nmake`, instead of `make`.
If your perl is system-managed, you can create a local::lib in your home
directory to install modules to. For details, see the local::lib documentation:
https://metacpan.org/pod/local::lib
The prerequisites of this distribution will also have to be installed manually. The
prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated
by running the manual build process described above.
## Configure Prerequisites
This distribution requires other modules to be installed before this
distribution's installer can be run. They can be found under the
"configure_requires" key of META.yml or the
"{prereqs}{configure}{requires}" key of META.json.
## Other Prerequisites
This distribution may require additional modules to be installed after running
Makefile.PL.
Look for prerequisites in the following phases:
* to run make, PHASE = build
* to use the module code itself, PHASE = runtime
* to run tests, PHASE = test
They can all be found in the "PHASE_requires" key of MYMETA.yml or the
"{prereqs}{PHASE}{requires}" key of MYMETA.json.
## Documentation
FFI-Platypus documentation is available as POD.
You can run `perldoc` from a shell to read the documentation:
% perldoc FFI::Platypus
For more information on installing Perl modules via CPAN, please see:
https://www.cpan.org/modules/INSTALL.html
FFI-Platypus-2.12/LICENSE 000644 000000 000000 00000046320 15251066120 014647 0 ustar 00root root 000000 000000 This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
Terms of the Perl programming language system itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2015-2022 by Graham Ollis.
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
Copyright (C) 19yy
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, see .
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
, 1 April 1989
Moe Ghoul, President of Vice
That's all there is to it!
--- The Perl Artistic License 1.0 ---
This software is Copyright (c) 2015-2022 by Graham Ollis.
This is free software, licensed under:
The Perl Artistic License 1.0
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
FFI-Platypus-2.12/MANIFEST 000644 000000 000000 00000020622 15251066120 014770 0 ustar 00root root 000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.037
CONTRIBUTING
Changes
Changes.FFI-Build
Changes.FFI-Platypus-Type-StringArray
INSTALL
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
SECURITY
SUPPORT
author.yml
corpus/ffi_build/project-cxx/foo1.cxx
corpus/ffi_build/project-cxx/foo2.cpp
corpus/ffi_build/project1/foo1.c
corpus/ffi_build/project1/foo2.c
corpus/ffi_build/project2/bar.c
corpus/ffi_build/source/foo.c
corpus/ffi_build_file_base/basic.foo
corpus/ffi_build_file_c/basic.c
corpus/ffi_build_file_c/foo1.c
corpus/ffi_build_file_c/foo2.c
corpus/ffi_build_file_c/include/myfoo.h
corpus/ffi_build_file_cxx/basic.cxx
corpus/ffi_build_file_cxx/foo1.cxx
corpus/ffi_build_file_cxx/foo2.cpp
corpus/ffi_build_file_cxx/include/myfoo.h
corpus/ffi_build_mm/lb1/hello.fbx
corpus/ffi_build_mm/lb1/hello1.c
corpus/ffi_build_mm/lb1/hello2.c
corpus/ffi_build_mm/lb1bad/hello.fbx
corpus/ffi_build_mm/lb1bad/hello1.c
corpus/ffi_build_mm/lb1bad/hello2.c
corpus/ffi_build_mm/lb2/hello1.c
corpus/ffi_build_mm/lb2/hello2.c
corpus/ffi_build_mm/project1/ffi/x.c
corpus/ffi_build_mm/project1/ffi/y.c
corpus/ffi_build_mm/project1/ffi/z.c
corpus/ffi_build_mm/project1/t/ffi/a.c
corpus/ffi_build_mm/project1/t/ffi/b.c
corpus/ffi_build_mm/project1/t/ffi/c.c
corpus/ffi_build_plugin/lib1/FFI/Build/Plugin/blank.txt
corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/Foo1.pm
corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/Foo2.pm
corpus/ffi_probe_runner/bar.c
corpus/ffi_probe_runner/foo.c
corpus/memory/arg_array.pl
corpus/memory/arg_custom.pl
corpus/memory/arg_object.pl
corpus/memory/arg_pointer.pl
corpus/memory/arg_scalar.pl
corpus/memory/attach.pl
corpus/memory/empty.pl
corpus/memory/function.pl
corpus/memory/return_array.pl
corpus/memory/return_custom.pl
corpus/memory/return_object.pl
corpus/memory/return_pointer.pl
corpus/memory/return_scalar.pl
corpus/memory/supp/basic_type_cache.supp
dist.ini
examples/add.c
examples/add.pl
examples/archive.pl
examples/archive.tar
examples/archive_object.pl
examples/array_reverse.c
examples/array_reverse.pl
examples/array_sum.c
examples/array_sum.pl
examples/bundle-answer/ffi/answer.c
examples/bundle-answer/ffi/answer.fbx
examples/bundle-answer/include/answer.h
examples/bundle-answer/lib/Answer.pm
examples/bundle-answer/t/answer.t
examples/bundle-bzip2/ffi/bz2.fbx
examples/bundle-bzip2/ffi/compress.c
examples/bundle-bzip2/lib/Bzip2.pm
examples/bundle-bzip2/t/bzip2.t
examples/bundle-const/ffi/const.c
examples/bundle-const/ffi/myheader.h
examples/bundle-const/lib/Const.pm
examples/bundle-const/t/const.t
examples/bundle-foo/Makefile.PL
examples/bundle-foo/ffi/foo.c
examples/bundle-foo/lib/Foo.pm
examples/bundle-foo/t/foo.t
examples/bundle-init/ffi/init.c
examples/bundle-init/lib/Init.pm
examples/bundle-init/t/init.t
examples/char.pl
examples/closure-opaque.pl
examples/closure.c
examples/closure.pl
examples/color.c
examples/color.pl
examples/curl.pl
examples/curl_callback.pl
examples/file_handle.pl
examples/file_handle.txt
examples/list_integer_types.pl
examples/malloc.pl
examples/math.pl
examples/notify.pl
examples/notify.png
examples/person.c
examples/person.pl
examples/pipe.pl
examples/puts.pl
examples/string_reverse.c
examples/string_reverse.pl
examples/swap.c
examples/swap.pl
examples/tcod.pl
examples/time.pl
examples/time_record.pl
examples/time_struct.pl
examples/var_array.c
examples/var_array.pl
examples/win32_beep.pl
examples/win32_getSystemTime.pl
examples/win32_messagebox.pl
examples/win32_messagebox.png
examples/xor_cipher.c
examples/xor_cipher.pl
examples/zmq3.pl
ffi/constant.c
ffi/memory.c
ffi/record_meta.c
inc/Alien/Base/Wrapper.pm
inc/Alien/FFI/PkgConfigPP.pm
inc/Alien/FFI/Vcpkg.pm
inc/Alien/FFI/pkgconfig.pm
inc/Alien/psapi.pm
inc/My/BuildConfig.pm
inc/My/Config.pm
inc/My/ConfigH.pm
inc/My/ConfigPl.pm
inc/My/ShareConfig.pm
inc/abi/abis-all.json
inc/abi/compute-all.pl
inc/bad-5100t.pl
inc/bad-forks.pl
inc/bad-oldperl.pl
inc/mm-build.pl
inc/mm-clean.pl
inc/mm-config-pb.pl
inc/mm-config-set.pl
inc/mm-config.pl
inc/mm-test.pl
inc/mymm.pl
inc/pdb
inc/probe/abi.c
inc/probe/alloca.c
inc/probe/bigendian.c
inc/probe/bigendian64.c
inc/probe/complex.c
inc/probe/longdouble.c
inc/probe/recordvalue.c
inc/probe/strnlen.c
inc/probe/variadic.c
include/ffi_platypus.h
include/ffi_platypus_bundle.h
include/ffi_platypus_call.h
include/ffi_platypus_guts.h
include/libtest.h
include/perl_math_int64.h
include/ppport.h
lib/FFI/Build.pm
lib/FFI/Build/File/Base.pm
lib/FFI/Build/File/C.pm
lib/FFI/Build/File/CXX.pm
lib/FFI/Build/File/Library.pm
lib/FFI/Build/File/Object.pm
lib/FFI/Build/MM.pm
lib/FFI/Build/Platform.pm
lib/FFI/Build/Plugin.pm
lib/FFI/Build/PluginData.pm
lib/FFI/Platypus.pm
lib/FFI/Platypus.xs
lib/FFI/Platypus/API.pm
lib/FFI/Platypus/Buffer.pm
lib/FFI/Platypus/Bundle.pm
lib/FFI/Platypus/Closure.pm
lib/FFI/Platypus/Constant.pm
lib/FFI/Platypus/DL.pm
lib/FFI/Platypus/Function.pm
lib/FFI/Platypus/Internal.pm
lib/FFI/Platypus/Lang.pm
lib/FFI/Platypus/Lang/ASM.pm
lib/FFI/Platypus/Lang/C.pm
lib/FFI/Platypus/Lang/Win32.pm
lib/FFI/Platypus/Legacy.pm
lib/FFI/Platypus/Memory.pm
lib/FFI/Platypus/Record.pm
lib/FFI/Platypus/Record/Meta.pm
lib/FFI/Platypus/Record/TieArray.pm
lib/FFI/Platypus/ShareConfig.pm
lib/FFI/Platypus/Type.pm
lib/FFI/Platypus/Type/PointerSizeBuffer.pm
lib/FFI/Platypus/Type/StringArray.pm
lib/FFI/Platypus/Type/StringPointer.pm
lib/FFI/Platypus/Type/WideString.pm
lib/FFI/Platypus/TypeParser.pm
lib/FFI/Platypus/TypeParser/Version0.pm
lib/FFI/Platypus/TypeParser/Version1.pm
lib/FFI/Platypus/TypeParser/Version2.pm
lib/FFI/Probe.pm
lib/FFI/Probe/Runner.pm
lib/FFI/Probe/Runner/Builder.pm
lib/FFI/Probe/Runner/Result.pm
lib/FFI/Temp.pm
lib/FFI/typemap
maint/cip-before-install
maint/cip-test-examples
maint/generate-abw
maint/generate-readme
maint/generate-record-accessor
maint/run-after_build.pl
maint/run-before_build.pl
maint/tt/accessor.tt
maint/tt/accessor_wrapper.tt
perlcriticrc
t/00_diag.t
t/ffi/align.c
t/ffi/align_array.c
t/ffi/align_fixed.c
t/ffi/align_string.c
t/ffi/basic.c
t/ffi/closure.c
t/ffi/color.c
t/ffi/complex_double.c
t/ffi/complex_float.c
t/ffi/double.c
t/ffi/float.c
t/ffi/gh117.c
t/ffi/gh174.c
t/ffi/longdouble.c
t/ffi/memcmp4.c
t/ffi/meta.c
t/ffi/pointer.c
t/ffi/record.c
t/ffi/sint16.c
t/ffi/sint32.c
t/ffi/sint64.c
t/ffi/sint8.c
t/ffi/string.c
t/ffi/string_array.c
t/ffi/uint16.c
t/ffi/uint32.c
t/ffi/uint64.c
t/ffi/uint8.c
t/ffi/variadic.c
t/ffi_build.t
t/ffi_build_file_base.t
t/ffi_build_file_c.t
t/ffi_build_file_cxx.t
t/ffi_build_file_library.t
t/ffi_build_file_object.t
t/ffi_build_mm.t
t/ffi_build_platform.t
t/ffi_build_plugin.t
t/ffi_build_plugindata.t
t/ffi_platypus.t
t/ffi_platypus_api.t
t/ffi_platypus_buffer.t
t/ffi_platypus_bundle.t
t/ffi_platypus_closure.t
t/ffi_platypus_constant.t
t/ffi_platypus_dl.t
t/ffi_platypus_function.t
t/ffi_platypus_function_wrapper.t
t/ffi_platypus_internal.t
t/ffi_platypus_lang.t
t/ffi_platypus_lang_asm.t
t/ffi_platypus_lang_c.t
t/ffi_platypus_lang_win32.t
t/ffi_platypus_legacy.t
t/ffi_platypus_memory.t
t/ffi_platypus_record.t
t/ffi_platypus_record_meta.t
t/ffi_platypus_record_tiearray.t
t/ffi_platypus_shareconfig.t
t/ffi_platypus_type.t
t/ffi_platypus_type_pointersizebuffer.t
t/ffi_platypus_type_stringarray.t
t/ffi_platypus_type_stringpointer.t
t/ffi_platypus_type_widestring.t
t/ffi_platypus_typeparser.t
t/ffi_platypus_typeparser_version0.t
t/ffi_platypus_typeparser_version1.t
t/ffi_platypus_typeparser_version2.t
t/ffi_probe.t
t/ffi_probe_runner.t
t/ffi_probe_runner_builder.t
t/ffi_probe_runner_result.t
t/ffi_temp.t
t/forks.t
t/gh117.t
t/gh129.t
t/gh260.t
t/gh323.t
t/lib/Test/Cleanup.pm
t/lib/Test/FauxAttach.pm
t/lib/Test/Platypus.pm
t/memory.t
t/threads.t
t/type_complex_double.t
t/type_complex_float.t
t/type_custom.t
t/type_double.t
t/type_float.t
t/type_longdouble.t
t/type_longdouble__array.t
t/type_longdouble__hide.t
t/type_longdouble__ptr.t
t/type_opaque.t
t/type_record.t
t/type_record_value.t
t/type_sint16.t
t/type_sint32.t
t/type_sint64.t
t/type_sint8.t
t/type_string.t
t/type_uint16.t
t/type_uint32.t
t/type_uint64.t
t/type_uint8.t
xs/ABI.xs
xs/API.xs
xs/Buffer.xs
xs/Closure.xs
xs/ClosureData.xs
xs/DL.xs
xs/Function.xs
xs/Internal.xs
xs/Record.xs
xs/Type.xs
xs/TypeParser.xs
xs/cast.c
xs/closure.c
xs/complex.c
xs/custom.c
xs/meta.c
xs/names.c
xs/perl_math_int64.c
xs/record_opaque.c
xs/record_simple.c
xs/record_string.c
xs/windl.c
xt/author/critic.t
xt/author/eol.t
xt/author/example.t
xt/author/no_tabs.t
xt/author/pod.t
xt/author/pod_coverage.t
xt/author/pod_link.t
xt/author/pod_spelling_system.t
xt/author/version.t
xt/release/changes.t
xt/release/fixme.t
FFI-Platypus-2.12/META.json 000644 000000 000000 00000021213 15251066120 015255 0 ustar 00root root 000000 000000 {
"abstract" : "Write Perl bindings to non-Perl libraries with FFI. No XS required.",
"author" : [
"Graham Ollis "
],
"dynamic_config" : 1,
"generated_by" : "Dist::Zilla version 6.037, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "FFI-Platypus",
"no_index" : {
"directory" : [
"examples"
]
},
"prereqs" : {
"build" : {
"requires" : {
"Alien::FFI" : "0.20",
"ExtUtils::CBuilder" : "0"
}
},
"configure" : {
"requires" : {
"Capture::Tiny" : "0",
"ExtUtils::MakeMaker" : "7.12",
"ExtUtils::ParseXS" : "3.30",
"IPC::Cmd" : "0",
"JSON::PP" : "0",
"parent" : "0",
"perl" : "5.006"
}
},
"develop" : {
"recommends" : {
"Dist::Zilla::Plugin::AlienBase::Wrapper::Bundle" : "0.26",
"Dist::Zilla::Plugin::Author::Plicease::Thanks" : "0",
"Dist::Zilla::Plugin::Author::Plicease::Upload" : "0",
"Dist::Zilla::Plugin::CopyFilesFromBuild" : "0",
"Dist::Zilla::Plugin::InsertExample" : "0.10",
"Dist::Zilla::Plugin::Meta::Dynamic::Config" : "0",
"Dist::Zilla::Plugin::MetaNoIndex" : "0",
"Dist::Zilla::Plugin::PPPort" : "0",
"Dist::Zilla::Plugin::Prereqs" : "0",
"Dist::Zilla::Plugin::PruneFiles" : "0",
"Dist::Zilla::Plugin::RemovePrereqs" : "0",
"Dist::Zilla::PluginBundle::Author::Plicease" : "2.69",
"ExtUtils::MakeMaker" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitHardTabs" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace" : "0",
"Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines" : "0",
"Perl::Critic::Policy::Community::ArrayAssignAref" : "0",
"Perl::Critic::Policy::Community::BarewordFilehandles" : "0",
"Perl::Critic::Policy::Community::ConditionalDeclarations" : "0",
"Perl::Critic::Policy::Community::ConditionalImplicitReturn" : "0",
"Perl::Critic::Policy::Community::DeprecatedFeatures" : "0",
"Perl::Critic::Policy::Community::DiscouragedModules" : "0",
"Perl::Critic::Policy::Community::DollarAB" : "0",
"Perl::Critic::Policy::Community::Each" : "0",
"Perl::Critic::Policy::Community::IndirectObjectNotation" : "0",
"Perl::Critic::Policy::Community::LexicalForeachIterator" : "0",
"Perl::Critic::Policy::Community::LoopOnHash" : "0",
"Perl::Critic::Policy::Community::ModPerl" : "0",
"Perl::Critic::Policy::Community::OpenArgs" : "0",
"Perl::Critic::Policy::Community::OverloadOptions" : "0",
"Perl::Critic::Policy::Community::POSIXImports" : "0",
"Perl::Critic::Policy::Community::PackageMatchesFilename" : "0",
"Perl::Critic::Policy::Community::PreferredAlternatives" : "0",
"Perl::Critic::Policy::Community::StrictWarnings" : "0",
"Perl::Critic::Policy::Community::Threads" : "0",
"Perl::Critic::Policy::Community::Wantarray" : "0",
"Perl::Critic::Policy::Community::WarningsSwitch" : "0",
"Perl::Critic::Policy::Community::WhileDiamondDefaultAssignment" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitFormats" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic" : "0",
"Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements" : "0",
"Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish" : "0",
"Perl::Critic::Policy::Objects::ProhibitIndirectSyntax" : "0",
"Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic" : "0",
"Perl::Critic::Policy::Subroutines::ProhibitNestedSubs" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator" : "0",
"Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames" : "0",
"Perl::Critic::Policy::Variables::ProhibitUnusedVariables" : "0",
"Software::License::Perl_5" : "0"
},
"requires" : {
"Alien::Libbz2" : "0",
"CHI" : "0",
"Convert::Binary::C" : "0",
"Devel::Hide" : "0",
"Devel::PPPort" : "3.28",
"FFI::C" : "0",
"File::chdir" : "0",
"FindBin" : "0",
"HTTP::Tiny::Mech" : "0",
"Path::Tiny" : "0.130",
"Perl::Critic" : "0",
"Test2::Require::EnvVar" : "0.000121",
"Test2::Require::Module" : "0.000121",
"Test2::Tools::PerlCritic" : "0",
"Test2::V0" : "0.000121",
"Test::CPAN::Changes" : "0",
"Test::EOL" : "0",
"Test::Fixme" : "0.07",
"Test::More" : "0.98",
"Test::NoTabs" : "0",
"Test::Pod" : "0",
"Test::Pod::Coverage" : "0",
"Test::Pod::LinkCheck::Lite" : "0",
"Test::Script" : "0",
"Test::Spelling" : "0",
"WWW::Mechanize::Cached" : "0",
"YAML" : "0"
}
},
"runtime" : {
"requires" : {
"Capture::Tiny" : "0",
"ExtUtils::MakeMaker" : "7.12",
"FFI::CheckLib" : "0.05",
"File::Spec::Functions" : "0",
"IPC::Cmd" : "0",
"JSON::PP" : "0",
"List::Util" : "1.45",
"autodie" : "0",
"constant" : "1.32",
"parent" : "0",
"perl" : "5.008004"
}
},
"test" : {
"requires" : {
"Capture::Tiny" : "0",
"Test2::API" : "1.302015",
"Test2::V0" : "0.000121",
"perl" : "5.008004"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/PerlFFI/FFI-Platypus/issues"
},
"homepage" : "https://pl.atypus.org",
"repository" : {
"type" : "git",
"url" : "git://github.com/PerlFFI/FFI-Platypus.git",
"web" : "https://github.com/PerlFFI/FFI-Platypus"
},
"x_IRC" : "irc://irc.perl.org/#native",
"x_twitter" : "https://fosstodon.org/@PerlFFI"
},
"version" : "2.12",
"x_contributors" : [
"Graham Ollis ",
"Bakkiaraj Murugesan (bakkiaraj)",
"Dylan Cali (calid)",
"pipcet",
"Zaki Mughal (zmughal)",
"Fitz Elliott (felliott)",
"Vickenty Fesunov (vyf)",
"Gregor Herrmann (gregoa)",
"Shlomi Fish (shlomif)",
"Damyan Ivanov",
"Ilya Pavlov (Ilya33)",
"Petr P\u00edsa\u0159 (ppisar)",
"Mohammad S Anwar (MANWAR)",
"H\u00e5kon H\u00e6gland (hakonhagland, HAKONH)",
"Meredith (merrilymeredith, MHOWARD)",
"Diab Jerius (DJERIUS)",
"Eric Brine (IKEGAMI)",
"szTheory",
"Jos\u00e9 Joaqu\u00edn Atria (JJATRIA)",
"Pete Houston (openstrike, HOUSTON)",
"Lukas Mai (MAUKE)"
],
"x_generated_by_perl" : "v5.42.3",
"x_serialization_backend" : "Cpanel::JSON::XS version 4.43",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later",
"x_use_unsafe_inc" : 0
}
FFI-Platypus-2.12/META.yml 000644 000000 000000 00000003710 15251066120 015107 0 ustar 00root root 000000 000000 ---
abstract: 'Write Perl bindings to non-Perl libraries with FFI. No XS required.'
author:
- 'Graham Ollis '
build_requires:
Alien::FFI: '0.20'
Capture::Tiny: '0'
ExtUtils::CBuilder: '0'
Test2::API: '1.302015'
Test2::V0: '0.000121'
perl: '5.008004'
configure_requires:
Capture::Tiny: '0'
ExtUtils::MakeMaker: '7.12'
ExtUtils::ParseXS: '3.30'
IPC::Cmd: '0'
JSON::PP: '0'
parent: '0'
perl: '5.006'
dynamic_config: 1
generated_by: 'Dist::Zilla version 6.037, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: FFI-Platypus
no_index:
directory:
- examples
requires:
Capture::Tiny: '0'
ExtUtils::MakeMaker: '7.12'
FFI::CheckLib: '0.05'
File::Spec::Functions: '0'
IPC::Cmd: '0'
JSON::PP: '0'
List::Util: '1.45'
autodie: '0'
constant: '1.32'
parent: '0'
perl: '5.008004'
resources:
IRC: irc://irc.perl.org/#native
Twitter: https://fosstodon.org/@PerlFFI
bugtracker: https://github.com/PerlFFI/FFI-Platypus/issues
homepage: https://pl.atypus.org
repository: git://github.com/PerlFFI/FFI-Platypus.git
version: '2.12'
x_contributors:
- 'Graham Ollis '
- 'Bakkiaraj Murugesan (bakkiaraj)'
- 'Dylan Cali (calid)'
- pipcet
- 'Zaki Mughal (zmughal)'
- 'Fitz Elliott (felliott)'
- 'Vickenty Fesunov (vyf)'
- 'Gregor Herrmann (gregoa)'
- 'Shlomi Fish (shlomif)'
- 'Damyan Ivanov'
- 'Ilya Pavlov (Ilya33)'
- 'Petr PÃsaÅ™ (ppisar)'
- 'Mohammad S Anwar (MANWAR)'
- 'Håkon Hægland (hakonhagland, HAKONH)'
- 'Meredith (merrilymeredith, MHOWARD)'
- 'Diab Jerius (DJERIUS)'
- 'Eric Brine (IKEGAMI)'
- szTheory
- 'José JoaquÃn Atria (JJATRIA)'
- 'Pete Houston (openstrike, HOUSTON)'
- 'Lukas Mai (MAUKE)'
x_generated_by_perl: v5.42.3
x_serialization_backend: 'YAML::Tiny version 1.76'
x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later'
x_use_unsafe_inc: 0
FFI-Platypus-2.12/Makefile.PL 000644 000000 000000 00000012763 15251066120 015620 0 ustar 00root root 000000 000000 BEGIN {
use strict; use warnings;
unless(eval q{ use 5.008004; 1}) {
print "Perl 5.008004 or better required\n";
exit;
}
}
# This file was automatically generated by Dist::Zilla::Plugin::Author::Plicease::MakeMaker v2.80
use strict;
use warnings;
use 5.008004;
use ExtUtils::MakeMaker 6.64;
require "./inc/mymm.pl";
my %WriteMakefileArgs = (
"ABSTRACT" => "Write Perl bindings to non-Perl libraries with FFI. No XS required.",
"AUTHOR" => "Graham Ollis ",
"BUILD_REQUIRES" => {
"Alien::FFI" => "0.20",
"ExtUtils::CBuilder" => 0
},
"CONFIGURE_REQUIRES" => {
"Capture::Tiny" => 0,
"ExtUtils::MakeMaker" => "7.12",
"ExtUtils::ParseXS" => "3.30",
"IPC::Cmd" => 0,
"JSON::PP" => 0,
"parent" => 0
},
"DISTNAME" => "FFI-Platypus",
"LICENSE" => "perl",
"MIN_PERL_VERSION" => "5.008004",
"NAME" => "FFI::Platypus",
"PM" => {
"lib/FFI/Build.pm" => "\$(INST_LIB)/FFI/Build.pm",
"lib/FFI/Build/File/Base.pm" => "\$(INST_LIB)/FFI/Build/File/Base.pm",
"lib/FFI/Build/File/C.pm" => "\$(INST_LIB)/FFI/Build/File/C.pm",
"lib/FFI/Build/File/CXX.pm" => "\$(INST_LIB)/FFI/Build/File/CXX.pm",
"lib/FFI/Build/File/Library.pm" => "\$(INST_LIB)/FFI/Build/File/Library.pm",
"lib/FFI/Build/File/Object.pm" => "\$(INST_LIB)/FFI/Build/File/Object.pm",
"lib/FFI/Build/MM.pm" => "\$(INST_LIB)/FFI/Build/MM.pm",
"lib/FFI/Build/Platform.pm" => "\$(INST_LIB)/FFI/Build/Platform.pm",
"lib/FFI/Build/Plugin.pm" => "\$(INST_LIB)/FFI/Build/Plugin.pm",
"lib/FFI/Build/PluginData.pm" => "\$(INST_LIB)/FFI/Build/PluginData.pm",
"lib/FFI/Platypus.pm" => "\$(INST_LIB)/FFI/Platypus.pm",
"lib/FFI/Platypus/API.pm" => "\$(INST_LIB)/FFI/Platypus/API.pm",
"lib/FFI/Platypus/Buffer.pm" => "\$(INST_LIB)/FFI/Platypus/Buffer.pm",
"lib/FFI/Platypus/Bundle.pm" => "\$(INST_LIB)/FFI/Platypus/Bundle.pm",
"lib/FFI/Platypus/Closure.pm" => "\$(INST_LIB)/FFI/Platypus/Closure.pm",
"lib/FFI/Platypus/Constant.pm" => "\$(INST_LIB)/FFI/Platypus/Constant.pm",
"lib/FFI/Platypus/DL.pm" => "\$(INST_LIB)/FFI/Platypus/DL.pm",
"lib/FFI/Platypus/Function.pm" => "\$(INST_LIB)/FFI/Platypus/Function.pm",
"lib/FFI/Platypus/Internal.pm" => "\$(INST_LIB)/FFI/Platypus/Internal.pm",
"lib/FFI/Platypus/Lang.pm" => "\$(INST_LIB)/FFI/Platypus/Lang.pm",
"lib/FFI/Platypus/Lang/ASM.pm" => "\$(INST_LIB)/FFI/Platypus/Lang/ASM.pm",
"lib/FFI/Platypus/Lang/C.pm" => "\$(INST_LIB)/FFI/Platypus/Lang/C.pm",
"lib/FFI/Platypus/Lang/Win32.pm" => "\$(INST_LIB)/FFI/Platypus/Lang/Win32.pm",
"lib/FFI/Platypus/Legacy.pm" => "\$(INST_LIB)/FFI/Platypus/Legacy.pm",
"lib/FFI/Platypus/Memory.pm" => "\$(INST_LIB)/FFI/Platypus/Memory.pm",
"lib/FFI/Platypus/Record.pm" => "\$(INST_LIB)/FFI/Platypus/Record.pm",
"lib/FFI/Platypus/Record/Meta.pm" => "\$(INST_LIB)/FFI/Platypus/Record/Meta.pm",
"lib/FFI/Platypus/Record/TieArray.pm" => "\$(INST_LIB)/FFI/Platypus/Record/TieArray.pm",
"lib/FFI/Platypus/ShareConfig.pm" => "\$(INST_LIB)/FFI/Platypus/ShareConfig.pm",
"lib/FFI/Platypus/Type.pm" => "\$(INST_LIB)/FFI/Platypus/Type.pm",
"lib/FFI/Platypus/Type/PointerSizeBuffer.pm" => "\$(INST_LIB)/FFI/Platypus/Type/PointerSizeBuffer.pm",
"lib/FFI/Platypus/Type/StringArray.pm" => "\$(INST_LIB)/FFI/Platypus/Type/StringArray.pm",
"lib/FFI/Platypus/Type/StringPointer.pm" => "\$(INST_LIB)/FFI/Platypus/Type/StringPointer.pm",
"lib/FFI/Platypus/Type/WideString.pm" => "\$(INST_LIB)/FFI/Platypus/Type/WideString.pm",
"lib/FFI/Platypus/TypeParser.pm" => "\$(INST_LIB)/FFI/Platypus/TypeParser.pm",
"lib/FFI/Platypus/TypeParser/Version0.pm" => "\$(INST_LIB)/FFI/Platypus/TypeParser/Version0.pm",
"lib/FFI/Platypus/TypeParser/Version1.pm" => "\$(INST_LIB)/FFI/Platypus/TypeParser/Version1.pm",
"lib/FFI/Platypus/TypeParser/Version2.pm" => "\$(INST_LIB)/FFI/Platypus/TypeParser/Version2.pm",
"lib/FFI/Probe.pm" => "\$(INST_LIB)/FFI/Probe.pm",
"lib/FFI/Probe/Runner.pm" => "\$(INST_LIB)/FFI/Probe/Runner.pm",
"lib/FFI/Probe/Runner/Builder.pm" => "\$(INST_LIB)/FFI/Probe/Runner/Builder.pm",
"lib/FFI/Probe/Runner/Result.pm" => "\$(INST_LIB)/FFI/Probe/Runner/Result.pm",
"lib/FFI/Temp.pm" => "\$(INST_LIB)/FFI/Temp.pm"
},
"PREREQ_PM" => {
"Capture::Tiny" => 0,
"ExtUtils::MakeMaker" => "7.12",
"FFI::CheckLib" => "0.05",
"File::Spec::Functions" => 0,
"IPC::Cmd" => 0,
"JSON::PP" => 0,
"List::Util" => "1.45",
"autodie" => 0,
"constant" => "1.32",
"parent" => 0
},
"TEST_REQUIRES" => {
"Capture::Tiny" => 0,
"Test2::API" => "1.302015",
"Test2::V0" => "0.000121"
},
"VERSION" => "2.12",
"test" => {
"TESTS" => "t/*.t"
}
);
mymm::myWriteMakefile(%WriteMakefileArgs); FFI-Platypus-2.12/README 000644 000000 000000 00000250252 15251066120 014523 0 ustar 00root root 000000 000000 NAME
FFI::Platypus - Write Perl bindings to non-Perl libraries with FFI. No
XS required.
VERSION
version 2.12
SYNOPSIS
use FFI::Platypus 2.00;
# for all new code you should use api => 2
my $ffi = FFI::Platypus->new(
api => 2,
lib => undef, # search libc
);
# call dynamically
$ffi->function( puts => ['string'] => 'int' )->call("hello world");
# attach as a xsub and call (much faster)
$ffi->attach( puts => ['string'] => 'int' );
puts("hello world");
DESCRIPTION
Platypus is a library for creating interfaces to machine code libraries
written in languages like C, C++, Go, Fortran, Rust, Pascal.
Essentially anything that gets compiled into machine code. This
implementation uses libffi to
accomplish this task. libffi is battle tested by a number of other
scripting and virtual machine languages, such as Python and Ruby to
serve a similar role. There are a number of reasons why you might want
to write an extension with Platypus instead of XS:
FFI / Platypus does not require messing with the guts of Perl
XS is less of an API and more of the guts of perl splayed out to do
whatever you want. That may at times be very powerful, but it can
also be a frustrating exercise in hair pulling.
FFI / Platypus is portable
Lots of languages have FFI interfaces, and it is subjectively easier
to port an extension written in FFI in Perl or another language to
FFI in another language or Perl. One goal of the Platypus Project is
to reduce common interface specifications to a common format like
JSON that could be shared between different languages.
FFI / Platypus could be a bridge to Raku
One of those "other" languages could be Raku and Raku already has an
FFI interface I am told.
FFI / Platypus can be reimplemented
In a bright future with multiple implementations of Perl 5, each
interpreter will have its own implementation of Platypus, allowing
extensions to be written once and used on multiple platforms, in much
the same way that Ruby-FFI extensions can be use in Ruby, JRuby and
Rubinius.
FFI / Platypus is pure perl (sorta)
One Platypus script or module works on any platform where the
libraries it uses are available. That means you can deploy your
Platypus script in a shared filesystem where they may be run on
different platforms. It also means that Platypus modules do not need
to be installed in the platform specific Perl library path.
FFI / Platypus is not C or C++ centric
XS is implemented primarily as a bunch of C macros, which requires at
least some understanding of C, the C pre-processor, and some C++
caveats (since on some platforms Perl is compiled and linked with a
C++ compiler). Platypus on the other hand could be used to call other
compiled languages, like Fortran, Go, Rust, Pascal, C++, or even
assembly, allowing you to focus on your strengths.
FFI / Platypus does not require a parser
Inline isolates the extension developer from XS to some extent, but
it also requires a parser. The various Inline language bindings are a
great technical achievement, but I think writing a parser for every
language that you want to interface with is a bit of an anti-pattern.
This document consists of an API reference, a set of examples, some
support and development (for contributors) information. If you are new
to Platypus or FFI, you may want to skip down to the EXAMPLES to get a
taste of what you can do with Platypus.
Platypus has extensive documentation of types at FFI::Platypus::Type
and its custom types API at FFI::Platypus::API.
You are strongly encouraged to use API level 2 for all new code. There
are a number of improvements and design fixes that you get for free.
You should even consider updating existing modules to use API level 2
where feasible. How do I do that you might ask? Simply pass in the API
level to the platypus constructor.
my $ffi = FFI::Platypus->new( api => 2 );
The Platypus documentation has already been updated to assume API level
1.
CONSTRUCTORS
new
my $ffi = FFI::Platypus->new( api => 2, %options);
Create a new instance of FFI::Platypus.
Any types defined with this instance will be valid for this instance
only, so you do not need to worry about stepping on the toes of other
CPAN FFI / Platypus Authors.
Any functions found will be out of the list of libraries specified with
the lib attribute.
options
api
[version 0.91]
Sets the API level. The recommended value for all new code is 2. The
Platypus documentation assumes API level 2 except for a few places
that specifically document older versions. You should only use a
lower value for a legacy code base that cannot be migrated to a newer
API level. Legal values are:
0
Original API level. See FFI::Platypus::TypeParser::Version0 for
details on the differences.
1
Enable version 1 API type parser which allows pass-by-value records
and type decoration on basic types.
2
Enable version 2 API. The Platypus documentation assumes this api
level is set.
API version 2 is identical to version 1, except:
Pointer functions that return NULL will return undef instead of
empty list
This fixes a long standing design bug in Platypus.
Array references may be passed to pointer argument types
This replicates the behavior of array argument types with no
size. So the types sint8* and sint8[] behave identically when an
array reference is passed in. They differ in that, as before, you
can pass a scalar reference into type sint8*.
The fixed string type can be specified without pointer modifier
That is you can use string(10) instead of string(10)* as you were
previously able to in API 0.
lib
Either a pathname (string) or a list of pathnames (array ref of
strings) to pre-populate the lib attribute. Use [undef] to search the
current process for symbols.
0.48
undef (without the array reference) can be used to search the current
process for symbols.
ignore_not_found
[version 0.15]
Set the ignore_not_found attribute.
lang
[version 0.18]
Set the lang attribute.
ATTRIBUTES
lib
$ffi->lib($path1, $path2, ...);
my @paths = $ffi->lib;
The list of libraries to search for symbols in.
The most portable and reliable way to find dynamic libraries is by
using FFI::CheckLib, like this:
use FFI::CheckLib 0.06;
$ffi->lib(find_lib_or_die lib => 'archive');
# finds libarchive.so on Linux
# libarchive.bundle on OS X
# libarchive.dll (or archive.dll) on Windows
# cygarchive-13.dll on Cygwin
# ...
# and will die if it isn't found
FFI::CheckLib has a number of options, such as checking for specific
symbols, etc. You should consult the documentation for that module.
As a special case, if you add undef as a "library" to be searched,
Platypus will also search the current process for symbols. This is
mostly useful for finding functions in the standard C library, without
having to know the name of the standard c library for your platform (as
it turns out it is different just about everywhere!).
You may also use the "find_lib" method as a shortcut:
$ffi->find_lib( lib => 'archive' );
ignore_not_found
[version 0.15]
$ffi->ignore_not_found(1);
my $ignore_not_found = $ffi->ignore_not_found;
Normally the attach and function methods will throw an exception if it
cannot find the name of the function you provide it. This will change
the behavior such that function will return undef when the function is
not found and attach will ignore functions that are not found. This is
useful when you are writing bindings to a library and have many
optional functions and you do not wish to wrap every call to function
or attach in an eval.
lang
[version 0.18]
$ffi->lang($language);
Specifies the foreign language that you will be interfacing with. The
default is C. The foreign language specified with this attribute
changes the default native types (for example, if you specify Rust, you
will get i32 as an alias for sint32 instead of int as you do with C).
If the foreign language plugin supports it, this will also enable
Platypus to find symbols using the demangled names (for example, if you
specify CPP for C++ you can use method names like Foo::get_bar() with
"attach" or "function".
api
[version 1.11]
my $level = $ffi->api;
Returns the API level of the Platypus instance.
METHODS
type
$ffi->type($typename);
$ffi->type($typename => $alias);
Define a type. The first argument is the native or C name of the type.
The second argument (optional) is an alias name that you can use to
refer to this new type. See FFI::Platypus::Type for legal type
definitions.
Examples:
$ffi->type('sint32'); # only checks to see that sint32 is a valid type
$ffi->type('sint32' => 'myint'); # creates an alias myint for sint32
$ffi->type('bogus'); # dies with appropriate diagnostic
custom_type
$ffi->custom_type($alias => {
native_type => $native_type,
native_to_perl => $coderef,
perl_to_native => $coderef,
perl_to_native_post => $coderef,
});
Define a custom type. See FFI::Platypus::Type#Custom-Types for details.
load_custom_type
$ffi->load_custom_type($name => $alias, @type_args);
Load the custom type defined in the module $name, and make an alias
$alias. If the custom type requires any arguments, they may be passed
in as @type_args. See FFI::Platypus::Type#Custom-Types for details.
If $name contains :: then it will be assumed to be a fully qualified
package name. If not, then FFI::Platypus::Type:: will be prepended to
it.
types
my @types = $ffi->types;
my @types = FFI::Platypus->types;
Returns the list of types that FFI knows about. This will include the
native libffi types (example: sint32, opaque and double) and the normal
C types (example: unsigned int, uint32_t), any types that you have
defined using the type method, and custom types.
The list of types that Platypus knows about varies somewhat from
platform to platform, FFI::Platypus::Type includes a list of the core
types that you can always count on having access to.
It can also be called as a class method, in which case, no user defined
or custom types will be included in the list.
type_meta
my $meta = $ffi->type_meta($type_name);
my $meta = FFI::Platypus->type_meta($type_name);
Returns a hash reference with the meta information for the given type.
It can also be called as a class method, in which case, you won't be
able to get meta data on user defined types.
The format of the meta data is implementation dependent and subject to
change. It may be useful for display or debugging.
Examples:
my $meta = $ffi->type_meta('int'); # standard int type
my $meta = $ffi->type_meta('int[64]'); # array of 64 ints
$ffi->type('int[128]' => 'myintarray');
my $meta = $ffi->type_meta('myintarray'); # array of 128 ints
mangler
$ffi->mangler(\&mangler);
Specify a customer mangler to be used for symbol lookup. This is
usually useful when you are writing bindings for a library where all of
the functions have the same prefix. Example:
$ffi->mangler(sub {
my($symbol) = @_;
return "foo_$symbol";
});
$ffi->function( get_bar => [] => 'int' ); # attaches foo_get_bar
my $f = $ffi->function( set_baz => ['int'] => 'void' );
$f->call(22); # calls foo_set_baz
function
my $function = $ffi->function($name => \@argument_types => $return_type);
my $function = $ffi->function($address => \@argument_types => $return_type);
my $function = $ffi->function($name => \@argument_types => $return_type, \&wrapper);
my $function = $ffi->function($address => \@argument_types => $return_type, \&wrapper);
Returns an object that is similar to a code reference in that it can be
called like one.
Caveat: many situations require a real code reference, so at the price
of a performance penalty you can get one like this:
my $function = $ffi->function(...);
my $coderef = sub { $function->(@_) };
It may be better, and faster to create a real Perl function using the
attach method.
In addition to looking up a function by name you can provide the
address of the symbol yourself:
my $address = $ffi->find_symbol('my_function');
my $function = $ffi->function($address => ...);
Under the covers, function uses find_symbol when you provide it with a
name, but it is useful to keep this in mind as there are alternative
ways of obtaining a functions address. Example: a C function could
return the address of another C function that you might want to call.
[version 0.76]
If the last argument is a code reference, then it will be used as a
wrapper around the function when called. The first argument to the
wrapper will be the inner function, or if it is later attached an xsub.
This can be used if you need to verify/modify input/output data.
Examples:
my $function = $ffi->function('my_function_name', ['int', 'string'] => 'string');
my $return_string = $function->(1, "hi there");
[version 0.91]
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types => $return_type);
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types => $return_type, \&wrapper);
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types);
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types => \&wrapper);
Version 0.91 and later allows you to creat functions for c variadic
functions (such as printf, scanf, etc) which can take a variable number
of arguments. The first set of arguments are the fixed set, the second
set are the variable arguments to bind with. The variable argument
types must be specified in order to create a function object, so if you
need to call variadic function with different set of arguments then you
will need to create a new function object each time:
# int printf(const char *fmt, ...);
$ffi->function( printf => ['string'] => ['int'] => 'int' )
->call("print integer %d\n", 42);
$ffi->function( printf => ['string'] => ['string'] => 'int' )
->call("print string %s\n", 'platypus');
Some older versions of libffi and possibly some platforms may not
support variadic functions. If you try to create a one, then an
exception will be thrown.
[version 1.26]
If the return type is omitted then void will be the assumed return
type.
attach
$ffi->attach($name => \@argument_types => $return_type);
$ffi->attach([$c_name => $perl_name] => \@argument_types => $return_type);
$ffi->attach([$address => $perl_name] => \@argument_types => $return_type);
$ffi->attach($name => \@argument_types => $return_type, \&wrapper);
$ffi->attach([$c_name => $perl_name] => \@argument_types => $return_type, \&wrapper);
$ffi->attach([$address => $perl_name] => \@argument_types => $return_type, \&wrapper);
Find and attach a C function as a real live Perl xsub. The advantage of
attaching a function over using the function method is that it is much
much much faster since no object resolution needs to be done. The
disadvantage is that it locks the function and the FFI::Platypus
instance into memory permanently, since there is no way to deallocate
an xsub.
If just one $name is given, then the function will be attached in Perl
with the same name as it has in C. The second form allows you to give
the Perl function a different name. You can also provide an address
(the third form), just like with the function method.
Examples:
$ffi->attach('my_function_name', ['int', 'string'] => 'string');
$ffi->attach(['my_c_function_name' => 'my_perl_function_name'], ['int', 'string'] => 'string');
my $string1 = my_function_name($int);
my $string2 = my_perl_function_name($int);
[version 0.20]
If the last argument is a code reference, then it will be used as a
wrapper around the attached xsub. The first argument to the wrapper
will be the inner xsub. This can be used if you need to verify/modify
input/output data.
Examples:
$ffi->attach('my_function', ['int', 'string'] => 'string', sub {
my($my_function_xsub, $integer, $string) = @_;
$integer++;
$string .= " and another thing";
my $return_string = $my_function_xsub->($integer, $string);
$return_string =~ s/Belgium//; # HHGG remove profanity
$return_string;
});
[version 0.91]
$ffi->attach($name => \@fixed_argument_types => \@var_argument_types, $return_type);
$ffi->attach($name => \@fixed_argument_types => \@var_argument_types, $return_type, \&wrapper);
As of version 0.91 you can attach a variadic functions, if it is
supported by the platform / libffi that you are using. For details see
the function documentation. If not supported by the implementation then
an exception will be thrown.
closure
my $closure = $ffi->closure($coderef);
my $closure = FFI::Platypus->closure($coderef);
Prepares a code reference so that it can be used as a FFI closure (a
Perl subroutine that can be called from C code). For details on
closures, see FFI::Platypus::Type#Closures and FFI::Platypus::Closure.
cast
my $converted_value = $ffi->cast($original_type, $converted_type, $original_value);
The cast function converts an existing $original_value of type
$original_type into one of type $converted_type. Not all types are
supported, so care must be taken. For example, to get the address of a
string, you can do this:
my $address = $ffi->cast('string' => 'opaque', $string_value);
Something that won't work is trying to cast an array to anything:
my $address = $ffi->cast('int[10]' => 'opaque', \@list); # WRONG
attach_cast
$ffi->attach_cast("cast_name", $original_type, $converted_type);
$ffi->attach_cast("cast_name", $original_type, $converted_type, \&wrapper);
my $converted_value = cast_name($original_value);
This function attaches a cast as a permanent xsub. This will make it
faster and may be useful if you are calling a particular cast a lot.
[version 1.26]
A wrapper may be added as the last argument to attach_cast and works
just like the wrapper for attach and function methods.
sizeof
my $size = $ffi->sizeof($type);
my $size = FFI::Platypus->sizeof($type);
Returns the total size of the given type in bytes. For example to get
the size of an integer:
my $intsize = $ffi->sizeof('int'); # usually 4
my $longsize = $ffi->sizeof('long'); # usually 4 or 8 depending on platform
You can also get the size of arrays
my $intarraysize = $ffi->sizeof('int[64]'); # usually 4*64
my $intarraysize = $ffi->sizeof('long[64]'); # usually 4*64 or 8*64
# depending on platform
Keep in mind that "pointer" types will always be the pointer / word
size for the platform that you are using. This includes strings, opaque
and pointers to other types.
This function is not very fast, so you might want to save this value as
a constant, particularly if you need the size in a loop with many
iterations.
alignof
[version 0.21]
my $align = $ffi->alignof($type);
Returns the alignment of the given type in bytes.
kindof
[version 1.24]
my $kind = $ffi->kindof($type);
Returns the kind of a type. This is a string with a value of one of
void
scalar
string
closure
record
record-value
pointer
array
object
countof
[version 1.24]
my $count = $ffi->countof($type);
For array types returns the number of elements in the array (returns 0
for variable length array). For the void type returns 0. Returns 1 for
all other types.
def
[version 1.24]
$ffi->def($package, $type, $value);
my $value = $ff->def($package, $type);
This method allows you to store data for types. If the $package is not
provided, then the caller's package will be used. $type must be a legal
Platypus type for the FFI::Platypus instance.
unitof
[version 1.24]
my $unittype = $ffi->unitof($type);
For array and pointer types, returns the basic type without the array
or pointer part. In other words, for sin16[] or sint16* it will return
sint16.
find_lib
[version 0.20]
$ffi->find_lib( lib => $libname );
This is just a shortcut for calling FFI::CheckLib#find_lib and updating
the "lib" attribute appropriately. Care should be taken though, as this
method simply passes its arguments to FFI::CheckLib#find_lib, so if
your module or script is depending on a specific feature in
FFI::CheckLib then make sure that you update your prerequisites
appropriately.
find_symbol
my $address = $ffi->find_symbol($name);
Return the address of the given symbol (usually function).
bundle
[version 0.96 api = 1+]
$ffi->bundle($package, \@args);
$ffi->bundle(\@args);
$ffi->bundle($package);
$ffi->bundle;
This is an interface for bundling compiled code with your distribution
intended to eventually replace the package method documented above. See
FFI::Platypus::Bundle for details on how this works.
package
[version 0.15 api = 0]
$ffi->package($package, $file); # usually __PACKAGE__ and __FILE__ can be used
$ffi->package; # autodetect
Note: This method is officially discouraged in favor of bundle
described above.
If you use FFI::Build (or the older deprecated Module::Build::FFI to
bundle C code with your distribution, you can use this method to tell
the FFI::Platypus instance to look for symbols that came with the
dynamic library that was built when your distribution was installed.
abis
my $href = $ffi->abis;
my $href = FFI::Platypus->abis;
Get the legal ABIs supported by your platform and underlying
implementation. What is supported can vary a lot by CPU and by
platform, or even between 32 and 64 bit on the same CPU and platform.
They keys are the "ABI" names, also known as "calling conventions". The
values are integers used internally by the implementation to represent
those ABIs.
abi
$ffi->abi($name);
Set the ABI or calling convention for use in subsequent calls to
"function" or "attach". May be either a string name or integer value
from the "abis" method above.
EXAMPLES
Here are some examples. These examples are provided in full with the
Platypus distribution in the "examples" directory. There are also some
more examples in FFI::Platypus::Type that are related to types.
Passing and Returning Integers
C Source
int add(int a, int b) {
return a+b;
}
Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use File::Basename qw( dirname );
my $ffi = FFI::Platypus->new( api => 2, lib => './add.so' );
$ffi->attach( add => ['int', 'int'] => 'int' );
print add(1,2), "\n"; # prints 3
Execute
$ cc -shared -o add.so add.c
$ perl add.pl
3
Discussion
Basic types like integers and floating points are the easiest to pass
across the FFI boundary. Because they are values that are passed on the
stack (or through registers) you don't need to worry about memory
allocations or ownership.
Here we are building our own C dynamic library using the native C
compiler on a Unix like platform. The exact incantation that you will
use to do this would unfortunately depend on your platform and C
compiler.
By default, Platypus uses the Platypus C language plugin, which gives
you easy access to many of the basic types used by C APIs. (for example
int, unsigned long, double, size_t and others).
If you are working with another language like Fortran, Go, Rust or Zig,
you will find similar examples where you can use the Platypus language
plugin for that language and use the native types.
String Arguments (with puts)
C API
cppreference - puts
Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2, lib => undef );
$ffi->attach( puts => ['string'] => 'int' );
puts("hello world");
Execute
$ perl puts.pl
hello world
Discussion
Passing strings into a C function as an argument is also pretty easy
using Platypus. Just use the string type, which is equivalent to the C
or const char * types.
In this example we are using the C Standard Library's puts function, so
we don't need to build our own C code. We do still need to tell
Platypus where to look for the puts symbol though, which is why we set
lib to undef. This is a special value which tells Platypus to search
the Perl runtime executable itself (including any dynamic libraries)
for symbols. That helpfully includes the C Standard Library.
Returning Strings
C Source
#include
#include
const char *
string_reverse(const char *input)
{
static char *output = NULL;
int i, len;
if(output != NULL)
free(output);
if(input == NULL)
return NULL;
len = strlen(input);
output = malloc(len+1);
for(i=0; input[i]; i++)
output[len-i-1] = input[i];
output[len] = '\0';
return output;
}
Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './string_reverse.so',
);
$ffi->attach( string_reverse => ['string'] => 'string' );
print string_reverse("\nHello world");
string_reverse(undef);
Execute
$ cc -shared -o string_reverse.so string_reverse.c
$ perl string_reverse.pl
dlrow olleH
Discussion
The C code here takes an input ASCII string and reverses it, returning
the result. Note that it retains ownership of the string, the caller is
expected to use it before the next call to reverse_string, or copy it.
The Perl code simply declares the return value as string and is very
simple. This does bring up an inconsistency though, strings passed in
to a function as arguments are passed by reference, whereas the return
value is copied! This is usually what you want because C APIs usually
follow this pattern where you are expected to make your own copy of the
string.
At the end of the program we call reverse_string with undef, which gets
translated to C as NULL. This allows it to free the output buffer so
that the memory will not leak.
Returning and Freeing Strings with Embedded NULLs
C Source
#include
#include
char *
string_crypt(const char *input, int len, const char *key)
{
char *output;
int i, n;
if(input == NULL)
return NULL;
output = malloc(len+1);
output[len] = '\0';
for(i=0, n=0; inew(
api => 2,
lib => './xor_cipher.so',
);
$ffi->attach( string_crypt_free => ['opaque'] );
$ffi->attach( string_crypt => ['string','int','string'] => 'opaque' => sub{
my($xsub, $input, $key) = @_;
my $ptr = $xsub->($input, length($input), $key);
my $output = buffer_to_scalar $ptr, length($input);
string_crypt_free($ptr);
return $output;
});
my $orig = "hello world";
my $key = "foobar";
print YAML::Dump($orig);
my $encrypted = string_crypt($orig, $key);
print YAML::Dump($encrypted);
my $decrypted = string_crypt($encrypted, $key);
print YAML::Dump($decrypted);
Execute
$ cc -shared -o xor_cipher.so xor_cipher.c
$ perl xor_cipher.pl
--- hello world
--- "\x0e\n\x03\x0e\x0eR\x11\0\x1d\x0e\x05"
--- hello world
Discussion
The C code here also returns a string, but it has some different
expectations, so we can't just use the string type like we did in the
previous example and copy the string.
This C code implements a simple XOR cipher. Given an input string and a
key it returns an encrypted or decrypted output string where the
characters are XORd with the key. There are some challenges here
though. First the input and output strings can have embedded NULLs in
them. For the string passed in, we can provide the length of the input
string. For the output, the string type expects a NULL terminated
string, so we can't use that. So instead we get a pointer to the output
using the opaque type. Because we know that the output string is the
same length as the input string we can convert the pointer to a regular
Perl string using the buffer_to_scalar function. (For more details
about working with buffers and strings see FFI::Platypus::Buffer).
Next, the C code here does not keep the pointer to the output string,
as in the previous example. We are expected to call string_encrypt_free
when we are done. Since we are getting the pointer back from the C code
instead of copying the string that is easy to do.
Finally, we are using a wrapper to hide a lot of this complexity from
our caller. The last argument to the attach call is a code reference
which will wrap around the C function, which is passed in as the first
argument of the wrapper. This is a good practice when writing modules,
to hide the complexity of C.
Pointers
C Source
void
swap(int *a, int *b)
{
int tmp = *b;
*b = *a;
*a = tmp;
}
Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './swap.so',
);
$ffi->attach( swap => ['int*','int*'] );
my $a = 1;
my $b = 2;
print "[a,b] = [$a,$b]\n";
swap( \$a, \$b );
print "[a,b] = [$a,$b]\n";
Execute
$ cc -shared -o swap.so swap.c
$ perl swap.pl
[a,b] = [1,2]
[a,b] = [2,1]
Discussion
Pointers are often use in C APIs to return simple values like this.
Platypus provides access to pointers to primitive types by appending *
to the primitive type. Here for example we are using int* to create a
function that takes two pointers to integers and swaps their values.
When calling the function from Perl we pass in a reference to a scalar.
Strictly speaking Perl allows modifying the argument values to
subroutines, so we could have allowed just passing in a scalar, but in
the design of Platypus we decided that forcing the use of a reference
here emphasizes that you are passing a reference to the variable, not
just the value.
Not pictured in this example, but you can also pass in undef for a
pointer value and that will be translated into NULL on the C side. You
can also return a pointer to a primitive type from a function, again
this will be returned to Perl as a reference to a scalar. Platypus also
supports string pointers (string*). (Though the C equivalent to a
string* is a double pointer to char char**).
Opaque Pointers (objects)
C Source
#include
#include
typedef struct person_t {
char *name;
unsigned int age;
} person_t;
person_t *
person_new(const char *name, unsigned int age) {
person_t *self = malloc(sizeof(person_t));
self->name = strdup(name);
self->age = age;
}
const char *
person_name(person_t *self) {
return self->name;
}
unsigned int
person_age(person_t *self) {
return self->age;
}
void
person_free(person_t *self) {
free(self->name);
free(self);
}
Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './person.so',
);
$ffi->type( 'opaque' => 'person_t' );
$ffi->attach( person_new => ['string','unsigned int'] => 'person_t' );
$ffi->attach( person_name => ['person_t'] => 'string' );
$ffi->attach( person_age => ['person_t'] => 'unsigned int' );
$ffi->attach( person_free => ['person_t'] );
my $person = person_new( 'Roger Frooble Bits', 35 );
print "name = ", person_name($person), "\n";
print "age = ", person_age($person), "\n";
person_free($person);
Execute
$ cc -shared -o person.so person.c
$ perl person.pl
name = Roger Frooble Bits
age = 35
Discussion
An opaque pointer is a pointer (memory address) that is pointing to
something but you do not know the structure of that something. In C
this is usually a void*, but it could also be a pointer to a struct
without a defined body.
This is often used to as an abstraction around objects in C. Here in
the C code we have a person_t struct with functions to create (a
constructor), free (a destructor) and query it (methods).
The Perl code can then use the constructor, methods and destructors
without having to understand the internals. The person_t internals can
also be changed without having to modify the calling code.
We use the Platypus type method to create an alias of opaque called
person_t. While this is not necessary, it does make the Perl code
easier to understand.
In later examples we will see how to hide the use of opaque types
further using the object type, but for some code direct use of opaque
is appropriate.
Opaque Pointers (buffers and strings)
C API
cppreference - free
cppreference - malloc
cppreference - memcpy
cppreference - strdup
Perl Source
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( malloc free memcpy strdup );
my $ffi = FFI::Platypus->new( api => 2 );
my $buffer = malloc 14;
my $ptr_string = strdup("hello there!!\n");
memcpy $buffer, $ptr_string, 15;
print $ffi->cast('opaque' => 'string', $buffer);
free $ptr_string;
free $buffer;
Execute
$ perl malloc.pl
hello there!!
Discussion
Another useful application of the opaque type is for dealing with
buffers, and C strings that you do not immediately need to convert into
Perl strings. This example is completely contrived, but we are using
malloc to create a buffer of 14 bytes. We create a C string using
strdup, and then copy it into the buffer using memcpy. When we are done
with the opaque pointers we can free them using free since they. (This
is generally only okay when freeing memory that was allocated by
malloc, which is the case for strdup).
These memory tools, along with others are provided by the
FFI::Platypus::Memory module, which is worth reviewing when you need to
manipulate memory from Perl when writing your FFI code.
Just to verify that the memcpy did the right thing we convert the
buffer into a Perl string and print it out using the Platypus cast
method.
Arrays
C Source
void
array_reverse(int a[], int len) {
int tmp, i;
for(i=0; i < len/2; i++) {
tmp = a[i];
a[i] = a[len-i-1];
a[len-i-1] = tmp;
}
}
void
array_reverse10(int a[10]) {
array_reverse(a, 10);
}
Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './array_reverse.so',
);
$ffi->attach( array_reverse => ['int[]','int'] );
$ffi->attach( array_reverse10 => ['int[10]'] );
my @a = (1..10);
array_reverse10( \@a );
print "$_ " for @a;
print "\n";
@a = (1..20);
array_reverse( \@a, 20 );
print "$_ " for @a;
print "\n";
Execute
$ cc -shared -o array_reverse.so array_reverse.c
$ perl array_reverse.pl
10 9 8 7 6 5 4 3 2 1
20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
Discussion
Arrays in C are passed as pointers, so the C code here reverses the
array in place, rather than returning it. Arrays can also be fixed or
variable length. If the array is variable length the length of the
array must be provided in some way. In this case we explicitly pass in
a length. Another way might be to end the array with 0, if you don't
otherwise expect any 0 to appear in your data. For this reason,
Platypus adds a zero (or NULL in the case of pointers) element at the
end of the array when passing it into a variable length array type,
although we do not use it here.
With Platypus you can declare an array type as being either fixed or
variable length. Because Perl stores arrays in completely differently
than C, a temporary array is created by Platypus, passed into the C
function as a pointer. When the function returns the array is re-read
by Platypus and the Perl array is updated with the new values. The
temporary array is then freed.
You can use any primitive type for arrays, even string. You can also
return an array from a function. As in our discussion about strings,
when you return an array the value is copied, which is usually what you
want.
Pointers as Arrays
C Source
#include
int
array_sum(const int *a) {
int i, sum;
if(a == NULL)
return -1;
for(i=0, sum=0; a[i] != 0; i++)
sum += a[i];
return sum;
}
Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './array_sum.so',
);
$ffi->attach( array_sum => ['int*'] => 'int' );
print array_sum(undef), "\n"; # -1
print array_sum([0]), "\n"; # 0
print array_sum([1,2,3,0]), "\n"; # 6
Execute
$ cc -shared -o array_sum.so array_sum.c
$ perl array_sum.pl
-1
0
6
Discussion
Starting with the Platypus version 2 API, you can also pass an array
reference in to a pointer argument.
In C pointer and array arguments are often used somewhat
interchangeably. In this example we have an array_sum function that
takes a zero terminated array of integers and computes the sum. If the
pointer to the array is zero (0) then we return -1 to indicate an
error.
This is the main advantage from Perl for using pointer argument rather
than an array one: the array argument will not let you pass in undef /
NULL.
Sending Strings to GUI on Unix with libnotify
C API
Libnotify Reference Manual
Perl Source
use FFI::CheckLib;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'notify'),
);
$ffi->attach( notify_init => ['string'] );
$ffi->attach( notify_uninit => [] );
$ffi->attach( notify_notification_new => ['string', 'string', 'string'] => 'opaque' );
$ffi->attach( notify_notification_show => ['opaque', 'opaque'] );
my $message = join "\n",
"Hello from Platypus!",
"Welcome to the fun",
"world of FFI";
notify_init('Platypus Hello');
my $n = notify_notification_new('Platypus Hello World', $message, 'dialog-information');
notify_notification_show($n, undef);
notify_uninit();
Execute
$ perl notify.pl
Discussion
The GNOME project provides an API to send notifications to its desktop
environment. Nothing here is particularly new: all of the types and
techniques are ones that we have seen before, except we are using a
third party library, instead of using our own C code or the standard C
library functions.
When using a third party library you have to know the name or location
of it, which is not typically portable, so here we use FFI::CheckLib's
find_lib_or_die function. If the library is not found the script will
die with a useful diagnostic. FFI::CheckLib has a number of useful
features and will integrate nicely with Alien::Build based Aliens.
The Win32 API with MessageBoxW
Win32 API
MessageBoxW function (winuser.h)
Perl Source
use utf8;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => [undef],
);
# see FFI::Platypus::Lang::Win32
$ffi->lang('Win32');
# Send a Unicode string to the Windows API MessageBoxW function.
use constant MB_OK => 0x00000000;
use constant MB_DEFAULT_DESKTOP_ONLY => 0x00020000;
$ffi->attach( [MessageBoxW => 'MessageBox'] => [ 'HWND', 'LPCWSTR', 'LPCWSTR', 'UINT'] => 'int' );
MessageBox(undef, "I â¤ï¸ Platypus", "Confession", MB_OK|MB_DEFAULT_DESKTOP_ONLY);
Execute
$ perl win32_messagebox.pl
Discussion
The API used by Microsoft Windows presents some unique challenges. On
32 bit systems a different ABI is used than what is used by the
standard C library. It also provides a rats nest of type aliases.
Finally if you want to talk Unicode to any of the Windows API you will
need to use UTF-16LE instead of UTF-8 which is native to Perl. (The
Win32 API refers to these as LPWSTR and LPCWSTR types). As much as
possible the Win32 "language" plugin attempts to handle these
challenges transparently. For more details see
FFI::Platypus::Lang::Win32.
Discussion
The libnotify library is a desktop GUI notification system for the
GNOME Desktop environment. This script sends a notification event that
should show up as a balloon, for me it did so in the upper right hand
corner of my screen.
Structured Data Records (by pointer or by reference)
C API
cppreference - localtime
Perl Source
use FFI::Platypus 2.00;
use FFI::C;
my $ffi = FFI::Platypus->new(
api => 2,
lib => [undef],
);
FFI::C->ffi($ffi);
package Unix::TimeStruct {
FFI::C->struct(tm => [
tm_sec => 'int',
tm_min => 'int',
tm_hour => 'int',
tm_mday => 'int',
tm_mon => 'int',
tm_year => 'int',
tm_wday => 'int',
tm_yday => 'int',
tm_isdst => 'int',
tm_gmtoff => 'long',
_tm_zone => 'opaque',
]);
# For now 'string' is unsupported by FFI::C, but we
# can cast the time zone from an opaque pointer to
# string.
sub tm_zone {
my $self = shift;
$ffi->cast('opaque', 'string', $self->_tm_zone);
}
# attach the C localtime function
$ffi->attach( localtime => ['time_t*'] => 'tm', sub {
my($inner, $class, $time) = @_;
$time = time unless defined $time;
$inner->(\$time);
});
}
# now we can actually use our Unix::TimeStruct class
my $time = Unix::TimeStruct->localtime;
printf "time is %d:%d:%d %s\n",
$time->tm_hour,
$time->tm_min,
$time->tm_sec,
$time->tm_zone;
Execute
$ perl time_struct.pl
time is 3:48:19 MDT
Discussion
C and other machine code languages frequently provide interfaces that
include structured data records (defined using the struct keyword in
C). Some libraries will provide an API which you are expected to read
or write before and/or after passing them along to the library.
For C pointers to strict, union, nested struct and nested union
structures, the easiest interface to use is via FFI::C. If you are
working with a struct that must be passed by value (not pointers), then
you will want to use FFI::Platypus::Record class instead. We will
discuss an example of that next.
The C localtime function takes a pointer to a C struct. We simply
define the members of the struct using the FFI::C struct method.
Because we used the ffi method to tell FFI::C to use our local instance
of FFI::Platypus it registers the tm type for us, and we can just start
using it as a return type!
Structured Data Records (on stack or by value)
C Source
#include
#include
typedef struct color_t {
char name[8];
uint8_t red;
uint8_t green;
uint8_t blue;
} color_t;
color_t
color_increase_red(color_t color, uint8_t amount)
{
strcpy(color.name, "reddish");
color.red += amount;
return color;
}
Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './color.so'
);
package Color {
use FFI::Platypus::Record;
use overload
'""' => sub { shift->as_string },
bool => sub { 1 }, fallback => 1;
record_layout_1($ffi,
'string(8)' => 'name', qw(
uint8 red
uint8 green
uint8 blue
));
sub as_string {
my($self) = @_;
sprintf "%s: [red:%02x green:%02x blue:%02x]",
$self->name, $self->red, $self->green, $self->blue;
}
}
$ffi->type('record(Color)' => 'color_t');
$ffi->attach( color_increase_red => ['color_t','uint8'] => 'color_t' );
my $gray = Color->new(
name => 'gray',
red => 0xDC,
green => 0xDC,
blue => 0xDC,
);
my $slightly_red = color_increase_red($gray, 20);
print "$gray\n";
print "$slightly_red\n";
Execute
$ cc -shared -o color.so color.c
$ perl color.pl
gray: [red:dc green:dc blue:dc]
reddish: [red:f0 green:dc blue:dc]
Discussion
In the C source of this example, we pass a C struct by value by copying
it onto the stack. On the Perl side we create a Color class using
FFI::Platypus::Record, which allows us to pass the structure the way
the C source wants us to.
Generally you should only reach for FFI::Platypus::Record if you need
to pass small records on the stack like this. For more complicated
(including nested) data you want to use FFI::C using pointers.
Avoiding Copy Using Memory Windows (with libzmq3)
C API
ØMQ/3.2.6 API Reference
Perl Source
use constant ZMQ_IO_THREADS => 1;
use constant ZMQ_MAX_SOCKETS => 2;
use constant ZMQ_REQ => 3;
use constant ZMQ_REP => 4;
use FFI::CheckLib qw( find_lib_or_die );
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( malloc );
use FFI::Platypus::Buffer qw( scalar_to_buffer window );
my $endpoint = "ipc://zmq-ffi-$$";
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die lib => 'zmq',
);
$ffi->attach(zmq_version => ['int*', 'int*', 'int*'] => 'void');
my($major,$minor,$patch);
zmq_version(\$major, \$minor, \$patch);
print "libzmq version $major.$minor.$patch\n";
die "this script only works with libzmq 3 or better" unless $major >= 3;
$ffi->type('opaque' => 'zmq_context');
$ffi->type('opaque' => 'zmq_socket');
$ffi->type('opaque' => 'zmq_msg_t');
$ffi->attach(zmq_ctx_new => [] => 'zmq_context');
$ffi->attach(zmq_ctx_set => ['zmq_context', 'int', 'int'] => 'int');
$ffi->attach(zmq_socket => ['zmq_context', 'int'] => 'zmq_socket');
$ffi->attach(zmq_connect => ['opaque', 'string'] => 'int');
$ffi->attach(zmq_bind => ['zmq_socket', 'string'] => 'int');
$ffi->attach(zmq_send => ['zmq_socket', 'opaque', 'size_t', 'int'] => 'int');
$ffi->attach(zmq_msg_init => ['zmq_msg_t'] => 'int');
$ffi->attach(zmq_msg_recv => ['zmq_msg_t', 'zmq_socket', 'int'] => 'int');
$ffi->attach(zmq_msg_data => ['zmq_msg_t'] => 'opaque');
$ffi->attach(zmq_errno => [] => 'int');
$ffi->attach(zmq_strerror => ['int'] => 'string');
my $context = zmq_ctx_new();
zmq_ctx_set($context, ZMQ_IO_THREADS, 1);
my $socket1 = zmq_socket($context, ZMQ_REQ);
zmq_connect($socket1, $endpoint);
my $socket2 = zmq_socket($context, ZMQ_REP);
zmq_bind($socket2, $endpoint);
{ # send
our $sent_message = "hello there";
my($pointer, $size) = scalar_to_buffer $sent_message;
my $r = zmq_send($socket1, $pointer, $size, 0);
die zmq_strerror(zmq_errno()) if $r == -1;
}
{ # recv
my $msg_ptr = malloc 100;
zmq_msg_init($msg_ptr);
my $size = zmq_msg_recv($msg_ptr, $socket2, 0);
die zmq_strerror(zmq_errno()) if $size == -1;
my $data_ptr = zmq_msg_data($msg_ptr);
window(my $recv_message, $data_ptr, $size);
print "recv_message = $recv_message\n";
}
Execute
$ perl zmq3.pl
libzmq version 4.3.4
recv_message = hello there
Discussion
ØMQ is a high-performance asynchronous messaging library. There are a
few things to note here.
Firstly, sometimes there may be multiple versions of a library in the
wild and you may need to verify that the library on a system meets your
needs (alternatively you could support multiple versions and configure
your bindings dynamically). Here we use zmq_version to ask libzmq which
version it is.
zmq_version returns the version number via three integer pointer
arguments, so we use the pointer to integer type: int *. In order to
pass pointer types, we pass a reference. In this case it is a reference
to an undefined value, because zmq_version will write into the pointers
the output values, but you can also pass in references to integers,
floating point values and opaque pointer types. When the function
returns the $major variable (and the others) has been updated and we
can use it to verify that it supports the API that we require.
Finally we attach the necessary functions, send and receive a message.
When we receive we use the FFI::Platypus::Buffer function window
instead of buffer_to_scalar. They have a similar effect in that the
provide a scalar from a region of memory, but window doesn't have to
copy any data, so it is cheaper to call. The only downside is that a
windowed scalar like this is read-only.
libarchive
C Documentation
https://www.libarchive.org/
Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
# This example uses FreeBSD's libarchive to list the contents of any
# archive format that it suppors. We've also filled out a part of
# the ArchiveWrite class that could be used for writing archive formats
# supported by libarchive
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'archive'),
);
$ffi->type('object(Archive)' => 'archive_t');
$ffi->type('object(ArchiveRead)' => 'archive_read_t');
$ffi->type('object(ArchiveWrite)' => 'archive_write_t');
$ffi->type('object(ArchiveEntry)' => 'archive_entry_t');
package Archive {
# base class is "abstract" having no constructor or destructor
$ffi->mangler(sub {
my($name) = @_;
"archive_$name";
});
$ffi->attach( error_string => ['archive_t'] => 'string' );
}
package ArchiveRead {
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_read_$name";
});
$ffi->attach( new => ['string'] => 'archive_read_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_t'] );
$ffi->attach( support_filter_all => ['archive_t'] => 'int' );
$ffi->attach( support_format_all => ['archive_t'] => 'int' );
$ffi->attach( open_filename => ['archive_t','string','size_t'] => 'int' );
$ffi->attach( next_header2 => ['archive_t', 'archive_entry_t' ] => 'int' );
$ffi->attach( data_skip => ['archive_t'] => 'int' );
# ... define additional read methods
}
package ArchiveWrite {
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_write_$name";
});
$ffi->attach( new => ['string'] => 'archive_write_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_write_t'] );
# ... define additional write methods
}
package ArchiveEntry {
$ffi->mangler(sub {
my($name) = @_;
"archive_entry_$name";
});
$ffi->attach( new => ['string'] => 'archive_entry_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_entry_t'] );
$ffi->attach( pathname => ['archive_entry_t'] => 'string' );
# ... define additional entry methods
}
use constant ARCHIVE_OK => 0;
# this is a Perl version of the C code here:
# https://github.com/libarchive/libarchive/wiki/Examples#List_contents_of_Archive_stored_in_File
my $archive_filename = shift @ARGV;
unless(defined $archive_filename)
{
print "usage: $0 archive.tar\n";
exit;
}
my $archive = ArchiveRead->new;
$archive->support_filter_all;
$archive->support_format_all;
my $r = $archive->open_filename($archive_filename, 1024);
die "error opening $archive_filename: ", $archive->error_string
unless $r == ARCHIVE_OK;
my $entry = ArchiveEntry->new;
while($archive->next_header2($entry) == ARCHIVE_OK)
{
print $entry->pathname, "\n";
$archive->data_skip;
}
Execute
$ perl archive_object.pl archive.tar
archive.pl
archive_object.pl
Discussion
libarchive is the implementation of tar for FreeBSD provided as a
library and available on a number of platforms.
One interesting thing about libarchive is that it provides a kind of
object oriented interface via opaque pointers. This example creates an
abstract class Archive, and concrete classes ArchiveWrite, ArchiveRead
and ArchiveEntry. The concrete classes can even be inherited from and
extended just like any Perl classes because of the way the custom types
are implemented. We use Platypus's object type for this implementation,
which is a wrapper around an opaque (can also be an integer) type that
is blessed into a particular class.
Another advanced feature of this example is that we define a mangler to
modify the symbol resolution for each class. This means we can do this
when we define a method for Archive:
$ffi->attach( support_filter_all => ['archive_t'] => 'int' );
Rather than this:
$ffi->attach(
[ archive_read_support_filter_all => 'support_read_filter_all' ] =>
['archive_t'] => 'int' );
);
As nice as libarchive is, note that we have to shoehorn then
archive_free function name into the Perl convention of using DESTROY as
the destructor. We can easily do that for just this one function with:
$ffi->attach( [ free => 'DESTROY' ] => ['archive_t'] );
The libarchive is a large library with hundreds of methods. For
comprehensive FFI bindings for libarchive see Archive::Libarchive.
unix open
C API
Input-output system calls in C
Perl Source
use FFI::Platypus 2.00;
{
package FD;
use constant O_RDONLY => 0;
use constant O_WRONLY => 1;
use constant O_RDWR => 2;
use constant IN => bless \do { my $in=0 }, __PACKAGE__;
use constant OUT => bless \do { my $out=1 }, __PACKAGE__;
use constant ERR => bless \do { my $err=2 }, __PACKAGE__;
my $ffi = FFI::Platypus->new( api => 2, lib => [undef]);
$ffi->type('object(FD,int)' => 'fd');
$ffi->attach( [ 'open' => 'new' ] => [ 'string', 'int', 'mode_t' ] => 'fd' => sub {
my($xsub, $class, $fn, @rest) = @_;
my $fd = $xsub->($fn, @rest);
die "error opening $fn $!" if $$fd == -1;
$fd;
});
$ffi->attach( write => ['fd', 'string', 'size_t' ] => 'ssize_t' );
$ffi->attach( read => ['fd', 'string', 'size_t' ] => 'ssize_t' );
$ffi->attach( close => ['fd'] => 'int' );
}
my $fd = FD->new("file_handle.txt", FD::O_RDONLY);
my $buffer = "\0" x 10;
while(my $br = $fd->read($buffer, 10))
{
FD::OUT->write($buffer, $br);
}
$fd->close;
Execute
$ perl file_handle.pl
Hello World
Discussion
The Unix file system calls use an integer handle for each open file. We
can use the same object type that we used for libarchive above, except
we let platypus know that the underlying type is int instead of opaque
(the latter being the default for the object type). Mainly just for
demonstration since Perl has much better IO libraries, but now we have
an OO interface to the Unix IO functions.
Varadic Functions (with libcurl)
C API
curl_easy_init
curl_easy_setopt
curl_easy_perform
curl_easy_cleanup
CURLOPT_URL
Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use constant CURLOPT_URL => 10002;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'curl'),
);
my $curl_handle = $ffi->function( 'curl_easy_init' => [] => 'opaque' )
->call;
$ffi->function( 'curl_easy_setopt' => ['opaque', 'enum' ] => ['string'] )
->call($curl_handle, CURLOPT_URL, "https://pl.atypus.org" );
$ffi->function( 'curl_easy_perform' => ['opaque' ] => 'enum' )
->call($curl_handle);
$ffi->function( 'curl_easy_cleanup' => ['opaque' ] )
->call($curl_handle);
Execute
$ perl curl.pl
pl.atypus.org - Home for the Perl Platypus Project
...
Discussion
The libcurl library makes extensive use of "varadic"
functions.
The C programming language and ABI have the concept of "varadic"
functions that can take a variable number and variable type of
arguments. Assuming you have a libffi that supports it (and most modern
systems should), then you can create bindings to a varadic function by
providing two sets of array references, one for the fixed arguments
(for reasons, C varadic functions must have at least one) and one for
variable arguments. In this example we call curl_easy_setopt as a
varadic function.
For functions that have a large or infinite number of possible
signatures it may be impracticable or impossible to attach them all.
You can instead do as we did in this example, create a function object
using the function method and call it immediately. This is not as
performant either when you create or call as using the attach method,
but in some cases the performance penalty may be worth it or
unavoidable.
Callbacks (with libcurl)
C API
curl_easy_init
curl_easy_setopt
curl_easy_perform
curl_easy_cleanup
CURLOPT_URL
CURLOPT_WRITEFUNCTION
Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use FFI::Platypus::Buffer qw( window );
use constant CURLOPT_URL => 10002;
use constant CURLOPT_WRITEFUNCTION => 20011;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'curl'),
);
my $curl_handle = $ffi->function( 'curl_easy_init' => [] => 'opaque' )
->call;
$ffi->function( 'curl_easy_setopt' => [ 'opaque', 'enum' ] => ['string'] )
->call($curl_handle, CURLOPT_URL, "https://pl.atypus.org" );
my $html;
my $closure = $ffi->closure(sub {
my($ptr, $len, $num, $user) = @_;
window(my $buf, $ptr, $len*$num);
$html .= $buf;
return $len*$num;
});
$ffi->function( 'curl_easy_setopt' => [ 'opaque', 'enum' ] => ['(opaque,size_t,size_t,opaque)->size_t'] => 'enum' )
->call($curl_handle, CURLOPT_WRITEFUNCTION, $closure);
$ffi->function( 'curl_easy_perform' => [ 'opaque' ] => 'enum' )
->call($curl_handle);
$ffi->function( 'curl_easy_cleanup' => [ 'opaque' ] )
->call($curl_handle);
if($html =~ /(.*?)<\/title>/) {
print "$1\n";
}
Execute
$ perl curl_callback.pl
pl.atypus.org - Home for the Perl Platypus Project
Discussion
This example is similar to the previous one, except instead of letting
libcurl <https://curl.se> write the content body to STDOUT, we give it
a callback to send the data to instead. The closure method can be used
to create a callback function pointer that can be called from C. The
type for the callback is in the form
(arg_type,arg_type,etc)->return_type where the argument types are in
parentheticals with an arrow between the argument types and the return
type.
Inside the closure or callback we use the window function from
FFI::Platypus::Buffer again to avoid an extra copy. We still have to
copy the buffer to append it to $hmtl but it is at least one less copy.
bundle your own code
C Source
ffi/foo.c:
#include <ffi_platypus_bundle.h>
#include <string.h>
typedef struct {
char *name;
int value;
} foo_t;
foo_t*
foo__new(const char *class_name, const char *name, int value) {
(void)class_name;
foo_t *self = malloc( sizeof( foo_t ) );
self->name = strdup(name);
self->value = value;
return self;
}
const char *
foo__name(foo_t *self) {
return self->name;
}
int
foo__value(foo_t *self) {
return self->value;
}
void
foo__DESTROY(foo_t *self) {
free(self->name);
free(self);
}
Perl Source
lib/Foo.pm:
package Foo;
use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('object(Foo)' => 'foo_t');
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/foo__/;
$name;
});
$ffi->bundle;
$ffi->attach( new => [ 'string', 'string', 'int' ] => 'foo_t' );
$ffi->attach( name => [ 'foo_t' ] => 'string' );
$ffi->attach( value => [ 'foo_t' ] => 'int' );
$ffi->attach( DESTROY => [ 'foo_t' ] => 'void' );
1;
t/foo.t:
use Test2::V0;
use Foo;
my $foo = Foo->new("platypus", 10);
isa_ok $foo, 'Foo';
is $foo->name, "platypus";
is $foo->value, 10;
done_testing;
Makefile.PL:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile(
$fbmm->mm_args(
NAME => 'Foo',
DISTNAME => 'Foo',
VERSION => '1.00',
# ...
)
);
sub MY::postamble
{
$fbmm->mm_postamble;
}
Execute
With prove:
$ prove -lvm
t/foo.t ..
# Seeded srand with seed '20221105' from local date.
ok 1 - Foo=SCALAR->isa('Foo')
ok 2
ok 3
1..3
ok
All tests successful.
Files=1, Tests=3, 0 wallclock secs ( 0.00 usr 0.00 sys + 0.10 cusr 0.00 csys = 0.10 CPU)
Result: PASS
With ExtUtils::MakeMaker:
$ perl Makefile.PL
Generating a Unix-style Makefile
Writing Makefile for Foo
Writing MYMETA.yml and MYMETA.json
$ make
cp lib/Foo.pm blib/lib/Foo.pm
"/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" -MFFI::Build::MM=cmd -e fbx_build
CC ffi/foo.c
LD blib/lib/auto/share/dist/Foo/lib/libFoo.so
$ make test
"/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" -MFFI::Build::MM=cmd -e fbx_build
"/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" -MFFI::Build::MM=cmd -e fbx_test
PERL_DL_NONLAZY=1 "/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/foo.t .. ok
All tests successful.
Files=1, Tests=3, 1 wallclock secs ( 0.00 usr 0.00 sys + 0.03 cusr 0.00 csys = 0.03 CPU)
Result: PASS
Discussion
You can bundle your own C code with your Perl extension. There are a
number of reasons you might want to do this Sometimes you need to
optimize a tight loop for speed. Or you might need a little bit of glue
code for your bindings to a library that isn't inherently FFI friendly.
Either way what you want is the FFI::Build system on the install step
and the FFI::Platypus::Bundle interface on the runtime step. If you are
using Dist::Zilla for your distribution, you will also want to check
out the Dist::Zilla::Plugin::FFI::Build plugin to make this as painless
as possible.
One of the nice things about the bundle interface is that it is smart
enough to work with either App::Prove or ExtUtils::MakeMaker. This
means, unlike XS, you do not need to explicitly compile your C code in
development mode, that will be done for you when you call $ffi->bundle
FAQ
How do I get constants defined as macros in C header files
This turns out to be a challenge for any language calling into C, which
frequently uses #define macros to define constants like so:
#define FOO_STATIC 1
#define FOO_DYNAMIC 2
#define FOO_OTHER 3
As macros are expanded and their definitions are thrown away by the C
pre-processor there isn't any way to get the name/value mappings from
the compiled dynamic library.
You can manually create equivalent constants in your Perl source:
use constant FOO_STATIC => 1;
use constant FOO_DYNAMIC => 2;
use constant FOO_OTHER => 3;
If there are a lot of these types of constants you might want to
consider using a tool (Convert::Binary::C can do this) that can extract
the constants for you.
See also the "Integer constants" example in FFI::Platypus::Type.
You can also use the new Platypus bundle interface to define Perl
constants from C space. This is more reliable, but does require a
compiler at install time. It is recommended mainly for writing bindings
against libraries that have constants that can vary widely from
platform to platform. See FFI::Platypus::Constant for details.
What about enums?
The C enum types are integers. The underlying type is up to the
platform, so Platypus provides enum and senum types for unsigned and
singed enums respectively. At least some compilers treat signed and
unsigned enums as different types. The enum values are essentially the
same as macro constants described above from an FFI perspective. Thus
the process of defining enum values is identical to the process of
defining macro constants in Perl.
For more details on enumerated types see "Enum types" in
FFI::Platypus::Type.
There is also a type plugin (FFI::Platypus::Type::Enum) that can be
helpful in writing interfaces that use enums.
Memory leaks
There are a couple places where memory is allocated, but never
deallocated that may look like memory leaks by tools designed to find
memory leaks like valgrind. This memory is intended to be used for the
lifetime of the perl process so there normally this isn't a problem
unless you are embedding a Perl interpreter which doesn't closely match
the lifetime of your overall application.
Specifically:
type cache
some types are cached and not freed. These are needed as long as
there are FFI functions that could be called.
attached functions
Attaching a function as an xsub will definitely allocate memory that
won't be freed because the xsub could be called at any time,
including in END blocks.
The Platypus team plans on adding a hook to free some of this "leaked"
memory for use cases where Perl and Platypus are embedded in a larger
application where the lifetime of the Perl process is significantly
smaller than the overall lifetime of the whole process.
I get seg faults on some platforms but not others with a library using
pthreads.
On some platforms, Perl isn't linked with libpthreads if Perl threads
are not enabled. On some platforms this doesn't seem to matter,
libpthreads can be loaded at runtime without much ill-effect. (Linux
from my experience doesn't seem to mind one way or the other). Some
platforms are not happy about this, and about the only thing that you
can do about it is to build Perl such that it links with libpthreads
even if it isn't a threaded Perl.
This is not really an FFI issue, but a Perl issue, as you will have the
same problem writing XS code for the such libraries.
Doesn't work on Perl 5.10.0.
The first point release of Perl 5.10 was buggy, and is not supported by
Platypus. Please upgrade to a newer Perl.
CAVEATS
Platypus and Native Interfaces like libffi rely on the availability of
dynamic libraries. Things not supported include:
Systems that lack dynamic library support
Like MS-DOS
Systems that are not supported by libffi
Like OpenVMS
Languages that do not support using dynamic libraries from other
languages
This used to be the case with Google's Go, but is no longer the case.
This is a problem for C / XS code as well.
Languages that do not compile to machine code
Like .NET based languages and Java.
The documentation has a bias toward using FFI / Platypus with C. This
is my fault, as my background mainly in C/C++ programmer (when I am not
writing Perl). In many places I use "C" as a short form for "any
language that can generate machine code and is callable from C". I
welcome pull requests to the Platypus core to address this issue. In an
attempt to ease usage of Platypus by non C programmers, I have written
a number of foreign language plugins for various popular languages (see
the SEE ALSO below). These plugins come with examples specific to those
languages, and documentation on common issues related to using those
languages with FFI. In most cases these are available for easy adoption
for those with the know-how or the willingness to learn. If your
language doesn't have a plugin YET, that is just because you haven't
written it yet.
SUPPORT
The intent of the FFI-Platypus team is to support the same versions of
Perl that are supported by the Perl toolchain. As of this writing that
means 5.16 and better.
IRC: #native on irc.perl.org
(click for instant chat room login)
<http://chat.mibbit.com/#native@irc.perl.org>
If something does not work the way you think it should, or if you have
a feature request, please open an issue on this project's GitHub Issue
tracker:
https://github.com/perlFFI/FFI-Platypus/issues
SECURITY
If you have identified a security vulnerability in the code, or the
possibility of one, please report it right away using GitHub's private
vulnerability reporting feature at
https://github.com/PerlFFI/FFI-Platypus/security/advisories/new, rather
than this project's public GitHub issue tracker, so that a fix can be
prepared before any public disclosure.
The maintainer will try to respond promptly, and will release a fix as
soon as reasonably possible. Please keep in mind, though, that
FFI-Platypus is maintained by volunteers in their spare time, and a
rapid response cannot be guaranteed.
Security fixes will normally only be made for the most recent
production release.
You may also report the issue to CPANSec
<https://security.metacpan.org/>, particularly if the issue is urgent
or you do not get a response from the maintainer in a reasonable amount
of time.
CONTRIBUTING
If you have implemented a new feature or fixed a bug then you may make
a pull request on this project's GitHub repository:
https://github.com/PerlFFI/FFI-Platypus/pulls
This project is developed using Dist::Zilla. The project's git
repository also comes with the Makefile.PL file necessary for building,
testing (and even installing if necessary) without Dist::Zilla. Please
keep in mind though that these files are generated so if changes need
to be made to those files they should be done through the project's
dist.ini file. If you do use Dist::Zilla and already have the necessary
plugins installed, then I encourage you to run dzil test before making
any pull requests. This is not a requirement, however, I am happy to
integrate especially smaller patches that need tweaking to fit the
project standards. I may push back and ask you to write a test case or
alter the formatting of a patch depending on the amount of time I have
and the amount of code that your patch touches.
This project's GitHub issue tracker listed above is not Write-Only. If
you want to contribute then feel free to browse through the existing
issues and see if there is something you feel you might be good at and
take a whack at the problem. I frequently open issues myself that I
hope will be accomplished by someone in the future but do not have time
to immediately implement myself.
Another good area to help out in is documentation. I try to make sure
that there is good document coverage, that is there should be
documentation describing all the public features and warnings about
common pitfalls, but an outsider's or alternate view point on such
things would be welcome; if you see something confusing or lacks
sufficient detail I encourage documentation only pull requests to
improve things.
The Platypus distribution comes with a test library named libtest that
is normally automatically built by ./Build test. If you prefer to use
prove or run tests directly, you can use the ./Build libtest command to
build it. Example:
% perl Makefile.PL
% make
% make ffi-test
% prove -bv t
# or an individual test
% perl -Mblib t/ffi_platypus_memory.t
The build process also respects these environment variables:
FFI_PLATYPUS_DEBUG_FAKE32
When building Platypus on 32 bit Perls, it will use the Math::Int64 C
API and make Math::Int64 a prerequisite. Setting this environment
variable will force Platypus to build with both of those options on a
64 bit Perl as well.
% env FFI_PLATYPUS_DEBUG_FAKE32=1 perl Makefile.PL
DEBUG_FAKE32:
+ making Math::Int64 a prereq
+ Using Math::Int64's C API to manipulate 64 bit values
Generating a Unix-style Makefile
Writing Makefile for FFI::Platypus
Writing MYMETA.yml and MYMETA.json
%
FFI_PLATYPUS_NO_ALLOCA
Platypus uses the non-standard and somewhat controversial C function
alloca by default on platforms that support it. I believe that
Platypus uses it responsibly to allocate small amounts of memory for
argument type parameters, and does not use it to allocate large
structures like arrays or buffers. If you prefer not to use alloca
despite these precautions, then you can turn its use off by setting
this environment variable when you run Makefile.PL:
helix% env FFI_PLATYPUS_NO_ALLOCA=1 perl Makefile.PL
NO_ALLOCA:
+ alloca() will not be used, even if your platform supports it.
Generating a Unix-style Makefile
Writing Makefile for FFI::Platypus
Writing MYMETA.yml and MYMETA.json
V
When building platypus may hide some of the excessive output when
probing and building, unless you set V to a true value.
% env V=1 perl Makefile.PL
% make V=1
...
Coding Guidelines
* Do not hesitate to make code contribution. Making useful
contributions is more important than following byzantine bureaucratic
coding regulations. We can always tweak things later.
* Please make an effort to follow existing coding style when making
pull requests.
* The intent of the FFI-Platypus team is to support the same versions
of Perl that are supported by the Perl toolchain. As of this writing
that means 5.16 and better. As such, please do not include any code
that requires a newer version of Perl.
Performance Testing
As Mark Twain was fond of saying there are four types of lies: lies,
damn lies, statistics and benchmarks. That being said, it can sometimes
be helpful to compare the runtime performance of Platypus if you are
making significant changes to the Platypus Core. For that I use
`FFI-Performance`, which can be found in my GitHub repository here:
https://github.com/Perl5-FFI/FFI-Performance
System integrators
This distribution uses Alien::FFI in fallback mode, meaning if the
system doesn't provide pkg-config and libffi it will attempt to
download libffi and build it from source. If you are including Platypus
in a larger system (for example a Linux distribution) you only need to
make sure to declare pkg-config or pkgconf and the development package
for libffi as prereqs for this module.
SEE ALSO
Extending Platypus
FFI::Platypus::Type
Type definitions for Platypus.
FFI::C
Interface for defining structured data records for use with Platypus.
It supports C struct, union, nested structures and arrays of all of
those. It only supports passing these types by reference or pointer,
so if you need to pass structured data by value see
FFI::Platypus::Record below.
FFI::Platypus::Record
Interface for defining structured data records for use with Platypus.
Included in the Platypus core. Supports pass by value which is
uncommon in C, but frequently used in languages like Rust and Go.
Consider using FFI::C instead if you don't need to pass by value.
FFI::Platypus::API
The custom types API for Platypus.
FFI::Platypus::Memory
Memory functions for FFI.
Languages
FFI::Platypus::Lang::C
Documentation and tools for using Platypus with the C programming
language
FFI::Platypus::Lang::CPP
Documentation and tools for using Platypus with the C++ programming
language
FFI::Platypus::Lang::Fortran
Documentation and tools for using Platypus with Fortran
FFI::Platypus::Lang::Go
Documentation and tools for using Platypus with Go
FFI::Platypus::Lang::Pascal
Documentation and tools for using Platypus with Free Pascal
FFI::Platypus::Lang::Rust
Documentation and tools for using Platypus with the Rust programming
language
FFI::Platypus::Lang::ASM
Documentation and tools for using Platypus with the Assembly
FFI::Platypus::Lang::Win32
Documentation and tools for using Platypus with the Win32 API.
FFI::Platypus::Lang::Zig
Documentation and tools for using Platypus with the Zig programming
language
Wasm and Wasm::Wasmtime
Modules for writing WebAssembly bindings in Perl. This allows you to
call functions written in any language supported by WebAssembly.
These modules are also implemented using Platypus.
Other Tools Related Tools Useful for FFI
FFI::CheckLib
Find dynamic libraries in a portable way.
Convert::Binary::C
A great interface for decoding C data structures, including structs,
enums, #defines and more.
pack and unpack
Native to Perl functions that can be used to decode C struct types.
C::Scan
This module can extract constants and other useful objects from C
header files that may be relevant to an FFI application. One downside
is that its use may require development packages to be installed.
Other Foreign Function Interfaces
Affix
A wrapper around infix <https://github.com/sanko/infix>, an
FFI-focused just-in-time (JIT) compiler.
NativeCall
Promising interface to Platypus inspired by Raku.
Win32::API
Microsoft Windows specific FFI style interface.
FFI
Older, simpler, less featureful FFI. It used to be implemented using
FSF's ffcall. Because ffcall has been unsupported for some time, I
reimplemented this module using FFI::Platypus.
C::DynaLib
Another FFI for Perl that doesn't appear to have worked for a long
time.
C::Blocks
Embed a tiny C compiler into your Perl scripts.
P5NCI
Yet another FFI like interface that does not appear to be supported
or under development anymore.
Other
Alien::FFI
Provides libffi for Platypus during its configuration and build
stages.
ACKNOWLEDGMENTS
In addition to the contributors mentioned below, I would like to
acknowledge Brock Wilcox (AWWAIID) and Meredith Howard (MHOWARD) whose
work on FFI::Sweet not only helped me get started with FFI but
significantly influenced the design of Platypus.
Dan Book, who goes by Grinnz on IRC for answering user questions about
FFI and Platypus.
In addition I'd like to thank Alessandro Ghedini (ALEXBIO) whose work
on another Perl FFI library helped drive some of the development ideas
for FFI::Platypus.
AUTHOR
Author: Graham Ollis <plicease@cpan.org>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
FFI-Platypus-2.12/SECURITY 000644 000000 000000 00000001662 15251066120 015034 0 ustar 00root root 000000 000000 SECURITY
If you have identified a security vulnerability in the code, or the
possibility of one, please report it right away using GitHub's private
vulnerability reporting feature at
https://github.com/PerlFFI/FFI-Platypus/security/advisories/new, rather
than this project's public GitHub issue tracker, so that a fix can be
prepared before any public disclosure.
The maintainer will try to respond promptly, and will release a fix as
soon as reasonably possible. Please keep in mind, though, that
FFI-Platypus is maintained by volunteers in their spare time, and a
rapid response cannot be guaranteed.
Security fixes will normally only be made for the most recent
production release.
You may also report the issue to CPANSec
<https://security.metacpan.org/>, particularly if the issue is urgent
or you do not get a response from the maintainer in a reasonable amount
of time.
FFI-Platypus-2.12/SUPPORT 000644 000000 000000 00000001020 15251066120 014725 0 ustar 00root root 000000 000000 SUPPORT
The intent of the FFI-Platypus team is to support the same versions of
Perl that are supported by the Perl toolchain. As of this writing that
means 5.16 and better.
IRC: #native on irc.perl.org
(click for instant chat room login)
<http://chat.mibbit.com/#native@irc.perl.org>
If something does not work the way you think it should, or if you have
a feature request, please open an issue on this project's GitHub Issue
tracker:
https://github.com/perlFFI/FFI-Platypus/issues
FFI-Platypus-2.12/author.yml 000644 000000 000000 00000006775 15251066120 015701 0 ustar 00root root 000000 000000 ---
pod_spelling_system:
skip: 0
# list of words that are spelled correctly
# (regardless of what spell check thinks)
stopwords:
- valgrind
- merrilymeredith
- longdouble
- sint
- uint
- parentheticals
- ffi
- xsub
- JIT
- xsubs
- libffi
- strdup
- libc
- libarchive
- free'd
- free'ing
- SIGSEGV
- Ctypes
- libm
- libnotify
- libuuid
- libzmq
- deparsed
- tcc
- fsprogs
- DLLs
- libtest
- bzip
- Fortran
- smushes
- Bakkiaraj
- Murugesan
- bakkiaraj
- demangling
- lang
- demangled
- alignof
- ALEXBIO
- AWWAIID
- Alessandro
- Ghedini
- MHOWARD
- JRuby
- Rubinius
- reimplemented
- Mughal
- Zaki
- zmughal
- Scala
- JVM
- integrators
- ABIs
- abis
- abi
- ABI
- pipcet
- FSF
- bzip2
- e2fsprogs
- g3
- sint8
- sint16
- sint32
- sint64
- uint8
- uint16
- uint32
- uint64
- x86
- calid
- Fitz
- felliott
- Fesunov
- Vickenty
- vyf
- Gregor
- Herrmann
- gregoa
- Damyan
- Ivanov
- Shlomi
- shlomif
- seg
- pthreads
- UNIXen
- dlclose
- dlerror
- dlopen
- dlsym
- libdl
- or'd
- customizations
- unmark
- unstick
- dlrun
- exe
- rv
- decl
- stmt
- dirname
- osname
- diag
- cflags
- fPIC
- ld
- ldflags
- buildname
- libs
- cxx
- shellwords
- fbx
- strndup
- Petr
- PÃsaÅ™
- ppisar
- Anwar
- MANWAR
- api
- deallocating
- deinitialization
- HAKONH
- hakonhagland
- kon
- merrilymeredith
- Grinnz
- DJERIUS
- Diab
- Jerius
- featureful
- countof
- kindof
- thet
- unitof
- const
- IKEGAMI
- BMP
- WebAssembly
- sensical
- eXtensions
- szTheory
- JJATRIA
- Joaqu
- Jos
- openstrike
- Raku
- cxxld
- dyncall
# for tl;dr
- tl
- winuser
- MessageBoxW
- Zig
- cppreference
- NULLs
- XORd
- decrypted
- varadic
- libcurl
- performant
- Lukas
- MAUKE
- HÃ¥kon
- Hægland
- José
- JoaquÃn
- CPANSec
pod_coverage:
skip: 0
# format is "Class#method" or "Class", regex allowed
# for either Class or method.
private:
- FFI::Platypus::Type::.*
- FFI::Platypus::Record::Meta
- FFI::Platypus::ShareConfig
- FFI::Platypus::Internal
- FFI::Platypus::Type
- FFI::Platypus::TypeParser
- FFI::Platypus::TypeParser::Version0
- FFI::Platypus::TypeParser::Version1
- FFI::Platypus::Closure#get_data
- FFI::Platypus::Closure#add_data
- FFI::Probe
- FFI::Platypus::Bundle
- FFI::Platypus::Constant
- App::fbx#main
- FFI::Build::File::Object#default_suffix
- FFI::Build::File::Library#default_suffix
- FFI::Build::File::C#cc
- FFI::Build::File::C#ld
- FFI::Build::File::C#accept_suffix
- FFI::Build::File::C#build_item_cpp
- FFI::Build::File::CXX#cc
- FFI::Build::File::CXX#ld
- FFI::Build::File::CXX#accept_suffix
- FFI::Build::File::Fortran#cc
- FFI::Build::File::Fortran#ld
- FFI::Build::File::Fortran#accept_suffix
- FFI::Build::File::C#build_item
- FFI::Build::File::Object#build_item
- FFI::Build::MM
- FFI::Build::Plugin
- FFI::Build::PluginData
- FFI::Platypus::Function#new
- FFI::Temp
FFI-Platypus-2.12/corpus/ 000755 000000 000000 00000000000 15251066120 015150 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build/ 000755 000000 000000 00000000000 15251066120 017073 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build/project-cxx/ 000755 000000 000000 00000000000 15251066120 021341 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build/project-cxx/foo1.cxx 000644 000000 000000 00000000167 15251066120 022735 0 ustar 00root root 000000 000000 class Foo {
public:
int answer() { return 42; };
};
extern "C" int
foo1()
{
Foo foo;
return foo.answer();
}
FFI-Platypus-2.12/corpus/ffi_build/project-cxx/foo2.cpp 000644 000000 000000 00000000523 15251066120 022712 0 ustar 00root root 000000 000000 // This requires C++11 (I believe)
// TODO: support older c++ compilers.
#include <iostream>
class Foo2 {
public:
const char *answer() { return "42"; };
};
extern "C" const char *
foo2()
{
Foo2 foo;
return foo.answer();
}
extern "C" void
not_to_call_just_to_pull_in_the_stdcpp()
{
std::cout << "Hello There" << std::endl;
}
FFI-Platypus-2.12/corpus/ffi_build/project1/ 000755 000000 000000 00000000000 15251066120 020622 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build/project1/foo1.c 000644 000000 000000 00000000165 15251066120 021634 0 ustar 00root root 000000 000000 #ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
EXPORT
int
foo1()
{
return 42;
}
FFI-Platypus-2.12/corpus/ffi_build/project1/foo2.c 000644 000000 000000 00000000200 15251066120 021623 0 ustar 00root root 000000 000000 #ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
EXPORT
const char *
foo2()
{
return "42";
}
FFI-Platypus-2.12/corpus/ffi_build/project2/ 000755 000000 000000 00000000000 15251066120 020623 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build/project2/bar.c 000644 000000 000000 00000000101 15251066120 021523 0 ustar 00root root 000000 000000 #include <libdontpanic.h>
int myanswer()
{
return answer();
}
FFI-Platypus-2.12/corpus/ffi_build/source/ 000755 000000 000000 00000000000 15251066120 020373 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build/source/foo.c 000644 000000 000000 00000000000 15251066120 021310 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_file_base/ 000755 000000 000000 00000000000 15251066120 021064 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_file_base/basic.foo 000644 000000 000000 00000000025 15251066120 022647 0 ustar 00root root 000000 000000 This is a basic foo.
FFI-Platypus-2.12/corpus/ffi_build_file_c/ 000755 000000 000000 00000000000 15251066120 020374 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_file_c/basic.c 000644 000000 000000 00000000105 15251066120 021615 0 ustar 00root root 000000 000000 #include <stdio.h>
int
main(int argc, char *argv[])
{
return 0;
}
FFI-Platypus-2.12/corpus/ffi_build_file_c/foo1.c 000644 000000 000000 00000000034 15251066120 021401 0 ustar 00root root 000000 000000 int
foo1()
{
return 42;
}
FFI-Platypus-2.12/corpus/ffi_build_file_c/foo2.c 000644 000000 000000 00000000057 15251066120 021407 0 ustar 00root root 000000 000000 #include <myfoo.h>
int
foo1()
{
return 42;
}
FFI-Platypus-2.12/corpus/ffi_build_file_c/include/ 000755 000000 000000 00000000000 15251066120 022017 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_file_c/include/myfoo.h 000644 000000 000000 00000000123 15251066120 023315 0 ustar 00root root 000000 000000 #ifndef MYFOO_H
#define MYFOO_H
/* this doesn't do anything apparently */
#endif
FFI-Platypus-2.12/corpus/ffi_build_file_cxx/ 000755 000000 000000 00000000000 15251066120 020754 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_file_cxx/basic.cxx 000644 000000 000000 00000000151 15251066120 022556 0 ustar 00root root 000000 000000 #include <iostream.h>
int
main(int argc, char *argv[])
{
cout << "hello world" << endl;
return 0;
}
FFI-Platypus-2.12/corpus/ffi_build_file_cxx/foo1.cxx 000644 000000 000000 00000000171 15251066120 022343 0 ustar 00root root 000000 000000 class Foo {
public:
int answer() { return 42; };
};
int
foo1()
{
// comment
Foo foo;
return foo.answer();
}
FFI-Platypus-2.12/corpus/ffi_build_file_cxx/foo2.cpp 000644 000000 000000 00000000170 15251066120 022323 0 ustar 00root root 000000 000000 #include <myfoo.h>
class Foo {
public:
int answer() { return 42; };
};
int
foo1()
{
// comment
return 42;
}
FFI-Platypus-2.12/corpus/ffi_build_file_cxx/include/ 000755 000000 000000 00000000000 15251066120 022377 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_file_cxx/include/myfoo.h 000644 000000 000000 00000000123 15251066120 023675 0 ustar 00root root 000000 000000 #ifndef MYFOO_H
#define MYFOO_H
/* this doesn't do anything apparently */
#endif
FFI-Platypus-2.12/corpus/ffi_build_mm/ 000755 000000 000000 00000000000 15251066120 017564 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb1/ 000755 000000 000000 00000000000 15251066120 020242 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb1/hello.fbx 000644 000000 000000 00000000206 15251066120 022044 0 ustar 00root root 000000 000000 use strict;
use warnings;
our $DIR;
our $PLATFORM;
die unless $PLATFORM->isa('FFI::Build::Platform');
{ source => [ "$DIR/*.c" ] };
FFI-Platypus-2.12/corpus/ffi_build_mm/lb1/hello1.c 000644 000000 000000 00000000000 15251066120 021560 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb1/hello2.c 000644 000000 000000 00000000000 15251066120 021561 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb1bad/ 000755 000000 000000 00000000000 15251066120 020711 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb1bad/hello.fbx 000644 000000 000000 00000000226 15251066120 022515 0 ustar 00root root 000000 000000 use strict;
use warnings;
skootch skootch;
our $DIR;
our $PLATFORM;
die unless $PLATFORM->isa('FFI::Build::Platform');
{ source => [ "$DIR/*.c" ] };
FFI-Platypus-2.12/corpus/ffi_build_mm/lb1bad/hello1.c 000644 000000 000000 00000000000 15251066120 022227 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb1bad/hello2.c 000644 000000 000000 00000000000 15251066120 022230 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb2/ 000755 000000 000000 00000000000 15251066120 020243 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb2/hello1.c 000644 000000 000000 00000000000 15251066120 021561 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/lb2/hello2.c 000644 000000 000000 00000000000 15251066120 021562 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/ 000755 000000 000000 00000000000 15251066120 021313 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/ffi/ 000755 000000 000000 00000000000 15251066120 022057 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/ffi/x.c 000644 000000 000000 00000000200 15251066120 022462 0 ustar 00root root 000000 000000 #ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
EXPORT
int
frooble_runtime()
{
return 47;
}
FFI-Platypus-2.12/corpus/ffi_build_mm/project1/ffi/y.c 000644 000000 000000 00000000000 15251066120 022461 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/ffi/z.c 000644 000000 000000 00000000000 15251066120 022462 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/t/ 000755 000000 000000 00000000000 15251066120 021556 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/t/ffi/ 000755 000000 000000 00000000000 15251066120 022322 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/t/ffi/a.c 000644 000000 000000 00000000175 15251066120 022711 0 ustar 00root root 000000 000000 #ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
EXPORT
int
frooble_test()
{
return 50;
}
FFI-Platypus-2.12/corpus/ffi_build_mm/project1/t/ffi/b.c 000644 000000 000000 00000000000 15251066120 022675 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_mm/project1/t/ffi/c.c 000644 000000 000000 00000000000 15251066120 022676 0 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/ 000755 000000 000000 00000000000 15251066120 020451 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib1/ 000755 000000 000000 00000000000 15251066120 021300 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib1/FFI/ 000755 000000 000000 00000000000 15251066120 021704 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib1/FFI/Build/ 000755 000000 000000 00000000000 15251066120 022743 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib1/FFI/Build/Plugin/ 000755 000000 000000 00000000000 15251066120 024201 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib1/FFI/Build/Plugin/blank.txt 000644 000000 000000 00000000001 15251066120 026020 0 ustar 00root root 000000 000000
FFI-Platypus-2.12/corpus/ffi_build_plugin/lib2/ 000755 000000 000000 00000000000 15251066120 021301 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib2/FFI/ 000755 000000 000000 00000000000 15251066120 021705 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib2/FFI/Build/ 000755 000000 000000 00000000000 15251066120 022744 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/ 000755 000000 000000 00000000000 15251066120 024202 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/Foo1.pm 000644 000000 000000 00000000323 15251066120 025342 0 ustar 00root root 000000 000000 package FFI::Build::Plugin::Foo1;
use strict;
use warnings;
use constant api_version => 0;
sub new
{
my($class) = @_;
bless {}, $class;
}
sub bar
{
my($self, @args) = @_;
$self->{bar} = \@args;
}
1;
FFI-Platypus-2.12/corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/Foo2.pm 000644 000000 000000 00000000224 15251066120 025343 0 ustar 00root root 000000 000000 package FFI::Build::Plugin::Foo2;
use strict;
use warnings;
use constant api_version => 0;
sub new
{
my($class) = @_;
bless {}, $class;
}
1;
FFI-Platypus-2.12/corpus/ffi_probe_runner/ 000755 000000 000000 00000000000 15251066120 020474 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/ffi_probe_runner/bar.c 000644 000000 000000 00000000333 15251066120 021403 0 ustar 00root root 000000 000000 #include <stdio.h>
int
dlmain(int argc, char *argv[])
{
int i;
printf("argc=%d\n", argc);
for(i=0;i<argc;i++)
printf("argv[%d]=%s\n", i, argv[i]);
fprintf(stderr, "something to std error\n");
return 0;
}
FFI-Platypus-2.12/corpus/ffi_probe_runner/foo.c 000644 000000 000000 00000000334 15251066120 021423 0 ustar 00root root 000000 000000 #include <stdio.h>
int
dlmain(int argc, char *argv[])
{
int i;
printf("argc=%d\n", argc);
for(i=0;i<argc;i++)
printf("argv[%d]=%s\n", i, argv[i]);
fprintf(stderr, "something to std error\n");
return 12;
}
FFI-Platypus-2.12/corpus/memory/ 000755 000000 000000 00000000000 15251066120 016460 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/memory/arg_array.pl 000644 000000 000000 00000002761 15251066120 020772 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
my @types = map { "${_}[2]" } ( 'float', 'double', 'longdouble',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ $type ] => 'void' );
no_leaks_ok {
my @a = (1,2);
$f->call(\@a)
};
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
my $f = $ffi->function(0 => [ 'opaque[2]' ] => 'void' );
my @a = ($ptr, undef);
no_leaks_ok { $f->call(\@a) };
$free->call($ptr);
};
subtest 'string' => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'string[2]' ] => 'void' );
my @a = ("hello world", undef);
no_leaks_ok { $f->call(\@a) };
};
subtest 'complex' => sub {
foreach my $type (qw( complex_float[2] complex_double[2] ))
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ $type ] => 'void' );
{
my @c = ([1.0,2.0],[3.0,4.0]);
no_leaks_ok { $f->call(\@c) };
}
{
my @c = (Math::Complex->make(1.0,2.0),Math::Complex->make(3.0,4.0));
no_leaks_ok { $f->call(\@c) };
}
};
}
};
done_testing;
FFI-Platypus-2.12/corpus/memory/arg_custom.pl 000644 000000 000000 00000002336 15251066120 021164 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
my @types = map { "$_" } ( 'float', 'double',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
$ffi->custom_type( foo_t => {
native_type => $type,
native_to_perl => sub { $_[0] },
perl_to_native => sub { $_[0] },
perl_to_native_post => sub { $_[0] },
});
my $f = $ffi->function(0 => [ "foo_t" ] => 'void' );
no_leaks_ok { $f->call(129) };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
$ffi->custom_type( foo_t => {
native_type => 'opaque',
native_to_perl => sub { $_[0] },
perl_to_native => sub { $_[0] },
perl_to_native_post => sub { $_[0] },
});
my $f = $ffi->function(0 => [ 'foo_t' ] => 'void' );
no_leaks_ok { $f->call($ptr) };
$free->call($ptr);
no_leaks_ok { $f->call(undef) };
};
done_testing;
FFI-Platypus-2.12/corpus/memory/arg_object.pl 000644 000000 000000 00000001761 15251066120 021121 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
my @types = map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 );
{
package Foo;
sub new
{
my($class, $arg) = @_;
bless \$arg, $class;
}
}
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new( api => 1 );
my $f = $ffi->function(0 => [ "object(Foo,$type)" ] => 'void' );
my $foo = Foo->new(129);
no_leaks_ok { $f->call($foo) };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( api => 1, lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
my $f = $ffi->function(0 => [ 'object(Foo)' ] => 'void' );
my $foo1 = Foo->new($ptr);
no_leaks_ok { $f->call($foo1) };
$free->call($ptr);
my $foo2 = Foo->new(undef);
no_leaks_ok { $f->call($foo2) };
};
done_testing;
FFI-Platypus-2.12/corpus/memory/arg_pointer.pl 000644 000000 000000 00000003135 15251066120 021330 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
my @types = map { "$_*" } ( 'float', 'double', 'longdouble',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ $type ] => 'void' );
no_leaks_ok {
my $val = 129;
$f->call(\$val)
};
no_leaks_ok { $f->call(undef) };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
my $f = $ffi->function(0 => [ 'opaque*' ] => 'void' );
no_leaks_ok { $f->call(\$ptr) };
$free->call($ptr);
no_leaks_ok { $f->call(undef) };
};
subtest 'string' => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'string*' ] => 'void' );
no_leaks_ok { $f->call(\"hello world") };
my $str = "hello world";
no_leaks_ok { $f->call(\$str) };
no_leaks_ok { $f->call(undef) };
};
subtest 'complex' => sub {
foreach my $type (qw( complex_float* complex_double* ))
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ $type ] => 'void' );
{
my $c = [1.0,2.0];
no_leaks_ok { $f->call(\$c) };
}
{
my $c = Math::Complex->make(1.0,2.0);
no_leaks_ok { $f->call(\$c) };
}
no_leaks_ok { $f->call(undef) };
};
}
};
done_testing;
FFI-Platypus-2.12/corpus/memory/arg_scalar.pl 000644 000000 000000 00000005125 15251066120 021116 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use lib 't/lib';
use Test::FauxAttach;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
use FFI::Platypus::Record::Meta;
my @types = ( 'float', 'double', 'longdouble',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ $type ] => 'void' );
no_leaks_ok { $f->call(129) };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
my $f = $ffi->function(0 => [ 'opaque' ] => 'void' );
no_leaks_ok { $f->call($ptr) };
$free->call($ptr);
no_leaks_ok { $f->call(undef) };
};
subtest 'string' => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'string' ] => 'void' );
no_leaks_ok { $f->call("hello world") };
no_leaks_ok { $f->call(undef) };
};
subtest 'complex' => sub {
foreach my $type (qw( complex_float complex_double ))
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ $type ] => 'void' );
{
my $c = [1.0,2.0];
no_leaks_ok { $f->call($c) };
}
{
my $c = Math::Complex->make(1.0,2.0);
no_leaks_ok { $f->call($c) };
}
};
}
};
subtest 'record' => sub {
my $ffi = FFI::Platypus->new( api => 1 );
our $meta = FFI::Platypus::Record::Meta->new(['sint32']);
{
package Foo;
sub new
{
my $value = "\0" x 4;
return bless \$value, 'Foo';
}
sub _ffi_record_size { 4 }
sub _ffi_meta { $meta }
}
$ffi->type('record(Foo)' => 'foo_t');
my $foo = Foo->new;
foreach my $type (qw( foo_t foo_t* ))
{
subtest $type => sub {
my $f = $ffi->function(0 => [ $type ] => 'void' );
no_leaks_ok { $f->call($foo) };
}
}
subtest 'record(4)*' => sub {
my $f = $ffi->function(0 => [ 'record(4)*' ] => 'void' );
my $str = "\0" x 4;
no_leaks_ok { $f->call($str) };
};
undef $meta;
};
subtest 'closure' => sub {
my $ffi = FFI::Platypus->new;
$ffi->type('()->void' => 'closure_t');
my $f = $ffi->function(0 => [ 'closure_t' ] => 'void' );
no_leaks_ok { $f->call(undef) };
no_leaks_ok {
my $closure = $ffi->closure(sub {});
$f->call($closure);
};
{
my $closure = $ffi->closure(sub {});
$f->call($closure);
no_leaks_ok {
$f->call($closure);
}
};
};
done_testing;
FFI-Platypus-2.12/corpus/memory/attach.pl 000644 000000 000000 00000000626 15251066120 020265 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus;
use FFI::CheckLib qw( find_lib );
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
my $ffi = FFI::Platypus->new();
$ffi->lib( $libtest );
$ffi->type('()->void' => 'callback_t');
$ffi->attach( gh174_func1 => [ 'callback_t' ] => 'void' );
my $callback = $ffi->closure(
sub { print "Perl callback()\n" }
);
gh174_func1( $callback );
FFI-Platypus-2.12/corpus/memory/empty.pl 000644 000000 000000 00000000053 15251066120 020151 0 ustar 00root root 000000 000000 use strict;
use warnings;
print "nada\n";
FFI-Platypus-2.12/corpus/memory/function.pl 000644 000000 000000 00000000706 15251066120 020645 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus;
use FFI::CheckLib qw( find_lib );
{
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
my $ffi = FFI::Platypus->new();
$ffi->lib( $libtest );
$ffi->type('()->void' => 'callback_t');
my $gh174_func1 = $ffi->function( gh174_func1 => [ 'callback_t' ] => 'void' );
my $callback = $ffi->closure(
sub { print "Perl callback()\n" }
);
$gh174_func1->call( $callback );
}
FFI-Platypus-2.12/corpus/memory/return_array.pl 000644 000000 000000 00000005334 15251066120 021537 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
my @types = map { $_ . '[2]' }
( 'float', 'double', 'longdouble',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( 'malloc' => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( 'free' => [ 'opaque' ] => 'void' );
my $memcpy = $ffi->function( 'memcpy' => [ 'opaque', $type, 'size_t' ] => 'opaque' );
my $size = $ffi->sizeof($type);
my $ptr = $malloc->call($size);
$memcpy->call($ptr, [1,2], $size);
no_leaks_ok {
$ffi->cast( 'opaque' => $type, $ptr );
};
if($type =~ /^longdouble/)
{
my @o = @{ $ffi->cast( 'opaque' => $type, $ptr ) };
cmp_ok $o[0], '==', 1;
cmp_ok $o[1], '==', 2;
}
else
{
is $ffi->cast( 'opaque' => $type, $ptr ), [1,2];
}
$free->call($ptr);
}
}
subtest 'string/opaque' => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( 'malloc' => [ 'size_t' ] => 'opaque' );
my $strdup = $ffi->function( 'strdup' => [ 'string' ] => 'opaque' );
my $free = $ffi->function( 'free' => [ 'opaque' ] => 'void' );
my $memcpy = $ffi->function( 'memcpy' => [ 'opaque', 'opaque[2]', 'size_t' ] => 'opaque' );
my $size = $ffi->sizeof('string[2]');
my $ptr = $malloc->call($size);
my $frooble = $strdup->call("frooble");
$memcpy->call($ptr, [$frooble,undef], $size);
no_leaks_ok {
$ffi->cast( 'opaque' => 'string[2]', $ptr );
};
is $ffi->cast( 'opaque' => 'string[2]', $ptr ), ["frooble",undef];
no_leaks_ok {
$ffi->cast( 'opaque' => 'opaque[2]', $ptr );
};
is $ffi->cast( 'opaque' => 'opaque[2]', $ptr ), [$frooble,undef];
$free->call($frooble);
$free->call($ptr);
};
foreach my $type (qw( complex_float[2] complex_double[2] ))
{
subtest $type => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( 'malloc' => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( 'free' => [ 'opaque' ] => 'void' );
my $memcpy = $ffi->function( 'memcpy' => [ 'opaque', $type, 'size_t' ] => 'opaque' );
my $size = $ffi->sizeof($type);
my $ptr = $malloc->call($size);
$memcpy->call($ptr, [[1.0,2.0],[3.0,4.0]], $size);
no_leaks_ok {
$ffi->cast( 'opaque' => $type, $ptr );
};
is $ffi->cast( 'opaque' => $type, $ptr ), [[1.0,2.0],[3.0,4.0]];
$free->call($ptr);
};
}
done_testing;
FFI-Platypus-2.12/corpus/memory/return_custom.pl 000644 000000 000000 00000002340 15251066120 021725 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
my @types = map { "$_" } ( 'float', 'double',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
$ffi->custom_type( foo_t => {
native_type => $type,
native_to_perl => sub { $_[0] },
perl_to_native => sub { $_[0] },
perl_to_native_post => sub { $_[0] },
});
my $f = $ffi->function(0 => [ "foo_t" ] => 'foo_t' );
no_leaks_ok { $f->call(129) };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
$ffi->custom_type( foo_t => {
native_type => 'opaque',
native_to_perl => sub { $_[0] },
perl_to_native => sub { $_[0] },
perl_to_native_post => sub { $_[0] },
});
my $f = $ffi->function(0 => [ 'foo_t' ] => 'foo_t' );
no_leaks_ok { $f->call($ptr) };
$free->call($ptr);
no_leaks_ok { $f->call(undef) };
};
done_testing;
FFI-Platypus-2.12/corpus/memory/return_object.pl 000644 000000 000000 00000001715 15251066120 021666 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
my @types = map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 );
{
package Foo;
sub new
{
my($class, $arg) = @_;
bless \$arg, $class;
}
}
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new( api => 1 );
my $f = $ffi->function(0 => [] => "object(Foo,$type)" );
no_leaks_ok { $f->call };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( api => 1, lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
my $f = $ffi->function(0 => [ 'object(Foo)' ] => 'object(Foo)' );
my $foo1 = Foo->new($ptr);
no_leaks_ok { $f->call($foo1) };
$free->call($ptr);
my $foo2 = Foo->new(undef);
no_leaks_ok { $f->call($foo2) };
};
done_testing;
FFI-Platypus-2.12/corpus/memory/return_pointer.pl 000644 000000 000000 00000002626 15251066120 022102 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use lib 't/lib';
use Test::FauxAttach;
use FFI::Platypus;
use Test::LeakTrace qw( no_leaks_ok );
use FFI::Platypus::Memory qw( malloc free memset strdup );
my $ptr = malloc(400);
memset($ptr, 0, 400);
my @types = map { "$_*" } ( 'float', 'double', 'longdouble',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'opaque' ] => $type );
no_leaks_ok { $f->call($ptr) };
no_leaks_ok { $f->call(undef) };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'opaque' ] => 'opaque*' );
no_leaks_ok { $f->call($ptr) };
no_leaks_ok { $f->call(undef) };
my $f2 = $ffi->function(0 => [ 'opaque*' ] => 'opaque*' );
no_leaks_ok { $f2->call(\$ptr) };
};
subtest 'string' => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'opaque' ] => 'string*' );
my $ptr = strdup("hello world");
no_leaks_ok { $f->call($ptr) };
no_leaks_ok { $f->call(undef) };
free $ptr;
};
subtest 'complex' => sub {
foreach my $type (qw( complex_float* complex_double* ))
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'opaque' ] => $type );
no_leaks_ok { $f->call($ptr) };
};
}
};
free $ptr;
done_testing;
FFI-Platypus-2.12/corpus/memory/return_scalar.pl 000644 000000 000000 00000004237 15251066120 021667 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use lib 't/lib';
use Test::FauxAttach;
use FFI::Platypus;
use Math::Complex;
use Test::LeakTrace qw( no_leaks_ok );
use FFI::Platypus::Record::Meta;
my @types = ( 'void', 'float', 'double', 'longdouble',
map { ( "sint$_" , "uint$_" ) }
qw( 8 16 32 64 ));
foreach my $type (@types)
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [] => $type );
no_leaks_ok { $f->call };
}
}
subtest 'opaque' => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $malloc = $ffi->function( malloc => [ 'size_t' ] => 'opaque' );
my $free = $ffi->function( free => [ 'opaque' ] => 'void' );
my $ptr = $malloc->call(200);
my $f = $ffi->function(0 => [ 'opaque' ] => 'opaque' );
no_leaks_ok { $f->call($ptr) };
$free->call($ptr);
no_leaks_ok { $f->call(undef) };
};
subtest 'string' => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ 'string' ] => 'string' );
no_leaks_ok { $f->call("hello world") };
no_leaks_ok { $f->call(undef) };
};
subtest 'complex' => sub {
foreach my $type (qw( complex_float complex_double ))
{
subtest $type => sub {
my $ffi = FFI::Platypus->new;
my $f = $ffi->function(0 => [ $type ] => $type );
{
my $c = [1.0,2.0];
no_leaks_ok { $f->call($c) };
}
{
my $c = Math::Complex->make(1.0,2.0);
no_leaks_ok { $f->call($c) };
}
};
}
};
subtest 'record' => sub {
my $ffi = FFI::Platypus->new( api => 1 );
our $meta = FFI::Platypus::Record::Meta->new(['sint32']);
{
package Foo;
sub new
{
my $value = "\0" x 4;
return bless \$value, 'Foo';
}
sub _ffi_record_size { 4 }
sub _ffi_meta { $meta }
}
$ffi->type('record(Foo)' => 'foo_t');
my $foo = Foo->new;
foreach my $type (qw( foo_t foo_t* ))
{
subtest $type => sub {
my $f = $ffi->function(0 => [ $type ] => $type );
no_leaks_ok { $f->call($foo) };
}
}
subtest 'record(4)*' => sub {
my $f = $ffi->function(0 => [ 'foo_t' ] => 'record(4)*' );
no_leaks_ok { $f->call($foo) };
};
undef $meta;
};
done_testing;
FFI-Platypus-2.12/corpus/memory/supp/ 000755 000000 000000 00000000000 15251066120 017447 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/corpus/memory/supp/basic_type_cache.supp 000644 000000 000000 00000000340 15251066120 023622 0 ustar 00root root 000000 000000 {
<basic_type_cache>
Memcheck:Leak
match-leak-kinds: definite
fun:malloc
fun:Perl_safesysmalloc
fun:ffi_pl_type_new
fun:XS_FFI__Platypus__TypeParser_create_type_*
...
fun:Perl_pp_entersub
...
}
FFI-Platypus-2.12/dist.ini 000644 000000 000000 00000020207 15251066120 015302 0 ustar 00root root 000000 000000 name = FFI-Platypus
author = Graham Ollis <plicease@cpan.org>
license = Perl_5
copyright_holder = Graham Ollis
copyright_year = 2015-2022
version = 2.12
; authordep ExtUtils::MakeMaker
[@Author::Plicease]
:version = 2.69
release_tests = 1
installer = Author::Plicease::MakeMaker
copy_mm = 1
allow_dirty = Makefile.PL
diag = +Alien::Base
diag = +PkgConfig
diag = +Math::LongDouble
diag = +Devel::Hide
diag = +forks
test2_v0 = 1
irc = irc://irc.perl.org/#native
github_user = PerlFFI
github_repo = FFI-Platypus
homepage = https://pl.atypus.org
workflow = static
workflow = linux
workflow = windows
workflow = macos
workflow = msys2-mingw
underscore_eval_version = 0
diag_preamble = | $post_diag = sub {
diag_preamble = | eval {
diag_preamble = | require lib;
diag_preamble = | lib->import('inc');
diag_preamble = | require FFI::Platypus::ShareConfig;
diag_preamble = | require My::BuildConfig;
diag_preamble = | my $build_config = My::BuildConfig->new;
diag_preamble = | my $share_config = 'FFI::Platypus::ShareConfig';
diag_preamble = | my $class = $build_config->get('alien')->{class};
diag_preamble = | my $pm = "$class.pm";
diag_preamble = | $pm =~ s/::/\//g;
diag_preamble = | require $pm;
diag_preamble = | $Alien::FFI::pkgconfig::VERBOSE =
diag_preamble = | $Alien::FFI::pkgconfig::VERBOSE = 0;
diag_preamble = | require FFI::Platypus;
diag_preamble = | require FFI::Platypus::Memory;
diag_preamble = | diag "mode : ", $build_config->get('alien')->{mode};
diag_preamble = | diag "$class->VERSION = ", $class->VERSION;
diag_preamble = | diag "$class->install_type = ", $class->install_type;
diag_preamble = | diag "$class->cflags = ", $class->cflags;
diag_preamble = | diag "$class->libs = ", $class->libs;
diag_preamble = | diag "$class->version = ", $class->config('version');
diag_preamble = | diag "my_configure = ", $class->runtime_prop->{my_configure} if defined $class->runtime_prop->{my_configure};
diag_preamble = | spacer();
diag_preamble = | my %type_map = %{ $share_config->get('type_map') };
diag_preamble = | my $diag = $build_config->get('diag');
diag_preamble = | foreach my $key (sort keys %{ $diag->{args} })
diag_preamble = | {
diag_preamble = | diag "mb.args.$key=", $diag->{args}->{$key};
diag_preamble = | }
diag_preamble = | foreach my $key (sort keys %{ $diag->{config} })
diag_preamble = | {
diag_preamble = | diag "config.$key=", $diag->{config}->{$key};
diag_preamble = | }
diag_preamble = | diag "ffi.platypus.memory.strdup_impl =@{[ FFI::Platypus::Memory->_strdup_impl ]}";
diag_preamble = | diag "ffi.platypus.memory.strndup_impl=@{[ FFI::Platypus::Memory->_strndup_impl ]}";
diag_preamble = | spacer();
diag_preamble = | my %r;
diag_preamble = | foreach my $k (keys %type_map)
diag_preamble = | {
diag_preamble = | my $v = $type_map{$k};
diag_preamble = | push @{ $r{$v} }, $k;
diag_preamble = | }
diag_preamble = | diag "Types:";
diag_preamble = | foreach my $type (sort keys %r)
diag_preamble = | {
diag_preamble = | diag sprintf(" %-8s : %s", $type, join(', ', sort @{ $r{$type} }));
diag_preamble = | }
diag_preamble = | spacer();
diag_preamble = | my $abi = FFI::Platypus->abis;
diag_preamble = | diag "ABIs:";
diag_preamble = | foreach my $key (sort keys %$abi)
diag_preamble = | {
diag_preamble = | diag sprintf(" %-20s %s", $key, $abi->{$key});
diag_preamble = | }
diag_preamble = | spacer();
diag_preamble = | diag "Probes:";
diag_preamble = | my $probe = $share_config->get("probe");
diag_preamble = | diag sprintf(" %-20s %s", $_, $probe->{$_}) for keys %$probe;
diag_preamble = | };
diag_preamble = | diag "extended diagnostic failed: $@" if $@;
diag_preamble = | if(-f "/proc/cpuinfo")
diag_preamble = | {
diag_preamble = | open my $fh, '<', '/proc/cpuinfo';
diag_preamble = | my @lines = <$fh>;
diag_preamble = | close $fh;
diag_preamble = | my($model_name) = grep /^model name/, @lines;
diag_preamble = | my($flags) = grep /^flags/, @lines;
diag_preamble = | my($address_sizes) = grep /^address sizes/, @lines;
diag_preamble = | spacer();
diag_preamble = | diag "CPU Info:";
diag_preamble = | diag " $model_name";
diag_preamble = | diag " $flags" if $flags;;
diag_preamble = | diag " $address_sizes" if $address_sizes;
diag_preamble = | }
diag_preamble = | require IPC::Cmd;
diag_preamble = | require Capture::Tiny;
diag_preamble = | if(IPC::Cmd::can_run('lsb_release'))
diag_preamble = | {
diag_preamble = | spacer();
diag_preamble = | diag Capture::Tiny::capture_merged(sub {
diag_preamble = | system 'lsb_release', '-a';
diag_preamble = | ();
diag_preamble = | });
diag_preamble = | }
diag_preamble = | require FFI::Build::Platform;
diag_preamble = | spacer();
diag_preamble = | diag "[PLATFORM]\n";
diag_preamble = | diag(FFI::Build::Platform->diag);
diag_preamble = | };
[RemovePrereqs]
; comes with Perl 5.8.1 or better
remove = strict
remove = warnings
remove = overload
remove = open
remove = bytes
remove = utf8
remove = if
remove = lib
remove = B
remove = Cwd
remove = Env
remove = XSLoader
remove = File::Spec
remove = File::Copy
remove = Scalar::Util
remove = Exporter
remove = Carp
remove = Encode
remove = File::Glob
remove = File::Path
remove = File::Temp
remove = Text::ParseWords
remove = Data::Dumper
remove = File::Basename
; comes with Strawberry (only place we use it)
remove = Win32
remove = Win32::Process
remove = Win32API::File
; optional for testing
remove = Acme::Alien::DontPanic
remove = Sub::Identify
remove = Devel::Hide
remove = forks
; optional !!
remove = Alien::FFI::pkgconfig
; internal
remove = My::BuildConfig
[Prereqs / ConfigurePrereqs]
-phase = configure
ExtUtils::MakeMaker = 7.12
IPC::Cmd = 0
Capture::Tiny = 0
JSON::PP = 0
parent = 0
; 3.30 is actually pretty recent. If Parse is upgraded
; after running `perl Makefile.PL` but before running `make`
; depending on the versions, you may see an error like
;
; Undefined subroutine &ExtUtils::ParseXS::errors called at
;
; because the .pm file and the xsubpp do not match. Bump
; the ParseXS to a relatively recent version as a configure
; requires works around this most of the time.
ExtUtils::ParseXS = 3.30
[Prereqs / BuildPrereqs]
-phase = build
ExtUtils::CBuilder = 0
Alien::FFI = 0.20
[Prereqs / TestPrereqs]
-phase = test
Capture::Tiny = 0
[Prereqs]
constant = 1.32
FFI::CheckLib = 0.05
[Prereqs / DevPrereqs]
-phase = develop
Devel::PPPort = 3.28
Devel::Hide = 0
[Author::Plicease::Upload]
cpan = 1
[PPPort]
filename = include/ppport.h
[Meta::Dynamic::Config]
[MetaNoIndex]
directory = examples
[InsertExample]
:version = 0.10
remove_boiler = 1
[Author::Plicease::Thanks]
current = Graham Ollis <plicease@cpan.org>
; if you have a preference for how to display your name
; feel free send a PR. I don't use the git hisory.
contributor = Bakkiaraj Murugesan (bakkiaraj)
contributor = Dylan Cali (calid)
contributor = pipcet
contributor = Zaki Mughal (zmughal)
contributor = Fitz Elliott (felliott)
contributor = Vickenty Fesunov (vyf)
contributor = Gregor Herrmann (gregoa)
contributor = Shlomi Fish (shlomif)
contributor = Damyan Ivanov
contributor = Ilya Pavlov (Ilya33)
contributor = Petr PÃsaÅ™ (ppisar)
contributor = Mohammad S Anwar (MANWAR)
contributor = Håkon Hægland (hakonhagland, HAKONH)
contributor = Meredith (merrilymeredith, MHOWARD)
contributor = Diab Jerius (DJERIUS)
contributor = Eric Brine (IKEGAMI)
contributor = szTheory
contributor = José JoaquÃn Atria (JJATRIA)
contributor = Pete Houston (openstrike, HOUSTON)
contributor = Lukas Mai (MAUKE)
[PruneFiles]
match = /tmpbuild\.
match = \.o$
match = \.obj$
match = \.so$
match = \.dll$
match = \.dylib$
match = ^.tmp/
match = ^corpus/ffi_build_mm/project1/blib
filename = xt/author/pod_spelling_common.t
filename = xt/author/strict.t
[AlienBase::Wrapper::Bundle]
:version = 0.26
[CopyFilesFromBuild / CopyAlienBaseWrapper]
copy = inc/Alien/Base/Wrapper.pm
FFI-Platypus-2.12/examples/ 000755 000000 000000 00000000000 15251066120 015453 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/add.c 000644 000000 000000 00000000050 15251066120 016342 0 ustar 00root root 000000 000000 int add(int a, int b) {
return a+b;
}
FFI-Platypus-2.12/examples/add.pl 000644 000000 000000 00000000443 15251066120 016541 0 ustar 00root root 000000 000000 #!/usr/bin/env perl
use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use File::Basename qw( dirname );
my $ffi = FFI::Platypus->new( api => 2, lib => './add.so' );
$ffi->attach( add => ['int', 'int'] => 'int' );
print add(1,2), "\n"; # prints 3
FFI-Platypus-2.12/examples/archive.pl 000644 000000 000000 00000006267 15251066120 017444 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus ();
use FFI::Platypus::API ();
use FFI::CheckLib ();
# This example uses FreeBSD's libarchive to list the contents of any
# archive format that it suppors. We've also filled out a part of
# the ArchiveWrite class that could be used for writing archive formats
# supported by libarchive
my $ffi = My::Platypus->new;
$ffi->lib(FFI::CheckLib::find_lib_or_die lib => 'archive');
$ffi->custom_type(archive => {
native_type => 'opaque',
perl_to_native => sub { ${$_[0]} },
native_to_perl => sub {
# this works because archive_read_new ignores any arguments
# and we pass in the class name which we can get here.
my $class = FFI::Platypus::API::arguments_get_string(0);
bless \$_[0], $class;
},
});
$ffi->custom_type(archive_entry => {
native_type => 'opaque',
perl_to_native => sub { ${$_[0]} },
native_to_perl => sub {
# works likewise for archive_entry objects
my $class = FFI::Platypus::API::arguments_get_string(0);
bless \$_[0], $class,
},
});
package My::Platypus;
use parent qw( FFI::Platypus );
sub find_symbol
{
my($self, $name) = @_;
my $prefix = lcfirst caller(2);
$prefix =~ s{([A-Z])}{"_" . lc $1}eg;
$self->SUPER::find_symbol(join '_', $prefix, $name);
}
package Archive;
# base class is "abstract" having no constructor or destructor
$ffi->attach( error_string => ['archive'] => 'string' );
package ArchiveRead;
our @ISA = qw( Archive );
$ffi->attach( new => ['string'] => 'archive' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive'] => 'void' );
$ffi->attach( support_filter_all => ['archive'] => 'int' );
$ffi->attach( support_format_all => ['archive'] => 'int' );
$ffi->attach( open_filename => ['archive','string','size_t'] => 'int' );
$ffi->attach( next_header2 => ['archive', 'archive_entry' ] => 'int' );
$ffi->attach( data_skip => ['archive'] => 'int' );
# ... define additional read methods
package ArchiveWrite;
our @ISA = qw( Archive );
$ffi->attach( new => ['string'] => 'archive' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive'] => 'void' );
# ... define additional write methods
package ArchiveEntry;
$ffi->attach( new => ['string'] => 'archive_entry' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_entry'] => 'void' );
$ffi->attach( pathname => ['archive_entry'] => 'string' );
# ... define additional entry methods
package main;
use constant ARCHIVE_OK => 0;
# this is a Perl version of the C code here:
# https://github.com/libarchive/libarchive/wiki/Examples#List_contents_of_Archive_stored_in_File
my $archive_filename = shift @ARGV;
unless(defined $archive_filename)
{
print "usage: $0 archive.tar\n";
exit;
}
my $archive = ArchiveRead->new;
$archive->support_filter_all;
$archive->support_format_all;
my $r = $archive->open_filename($archive_filename, 1024);
die "error opening $archive_filename: ", $archive->error_string
unless $r == ARCHIVE_OK;
my $entry = ArchiveEntry->new;
while($archive->next_header2($entry) == ARCHIVE_OK)
{
print $entry->pathname, "\n";
$archive->data_skip;
}
FFI-Platypus-2.12/examples/archive.tar 000644 000000 000000 00000024000 15251066120 017600 0 ustar 00root root 000000 000000 archive.pl 0000664 0001750 0001750 00000006267 14330460142 012412 0 ustar ollisg ollisg use strict;
use warnings;
use FFI::Platypus ();
use FFI::Platypus::API ();
use FFI::CheckLib ();
# This example uses FreeBSD's libarchive to list the contents of any
# archive format that it suppors. We've also filled out a part of
# the ArchiveWrite class that could be used for writing archive formats
# supported by libarchive
my $ffi = My::Platypus->new;
$ffi->lib(FFI::CheckLib::find_lib_or_die lib => 'archive');
$ffi->custom_type(archive => {
native_type => 'opaque',
perl_to_native => sub { ${$_[0]} },
native_to_perl => sub {
# this works because archive_read_new ignores any arguments
# and we pass in the class name which we can get here.
my $class = FFI::Platypus::API::arguments_get_string(0);
bless \$_[0], $class;
},
});
$ffi->custom_type(archive_entry => {
native_type => 'opaque',
perl_to_native => sub { ${$_[0]} },
native_to_perl => sub {
# works likewise for archive_entry objects
my $class = FFI::Platypus::API::arguments_get_string(0);
bless \$_[0], $class,
},
});
package My::Platypus;
use parent qw( FFI::Platypus );
sub find_symbol
{
my($self, $name) = @_;
my $prefix = lcfirst caller(2);
$prefix =~ s{([A-Z])}{"_" . lc $1}eg;
$self->SUPER::find_symbol(join '_', $prefix, $name);
}
package Archive;
# base class is "abstract" having no constructor or destructor
$ffi->attach( error_string => ['archive'] => 'string' );
package ArchiveRead;
our @ISA = qw( Archive );
$ffi->attach( new => ['string'] => 'archive' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive'] => 'void' );
$ffi->attach( support_filter_all => ['archive'] => 'int' );
$ffi->attach( support_format_all => ['archive'] => 'int' );
$ffi->attach( open_filename => ['archive','string','size_t'] => 'int' );
$ffi->attach( next_header2 => ['archive', 'archive_entry' ] => 'int' );
$ffi->attach( data_skip => ['archive'] => 'int' );
# ... define additional read methods
package ArchiveWrite;
our @ISA = qw( Archive );
$ffi->attach( new => ['string'] => 'archive' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive'] => 'void' );
# ... define additional write methods
package ArchiveEntry;
$ffi->attach( new => ['string'] => 'archive_entry' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_entry'] => 'void' );
$ffi->attach( pathname => ['archive_entry'] => 'string' );
# ... define additional entry methods
package main;
use constant ARCHIVE_OK => 0;
# this is a Perl version of the C code here:
# https://github.com/libarchive/libarchive/wiki/Examples#List_contents_of_Archive_stored_in_File
my $archive_filename = shift @ARGV;
unless(defined $archive_filename)
{
print "usage: $0 archive.tar\n";
exit;
}
my $archive = ArchiveRead->new;
$archive->support_filter_all;
$archive->support_format_all;
my $r = $archive->open_filename($archive_filename, 1024);
die "error opening $archive_filename: ", $archive->error_string
unless $r == ARCHIVE_OK;
my $entry = ArchiveEntry->new;
while($archive->next_header2($entry) == ARCHIVE_OK)
{
print $entry->pathname, "\n";
$archive->data_skip;
}
archive_object.pl 0000664 0001750 0001750 00000005642 14331437766 013755 0 ustar ollisg ollisg use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
# This example uses FreeBSD's libarchive to list the contents of any
# archive format that it suppors. We've also filled out a part of
# the ArchiveWrite class that could be used for writing archive formats
# supported by libarchive
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(find_lib_or_die lib => 'archive');
$ffi->type('object(Archive)' => 'archive_t');
$ffi->type('object(ArchiveRead)' => 'archive_read_t');
$ffi->type('object(ArchiveWrite)' => 'archive_write_t');
$ffi->type('object(ArchiveEntry)' => 'archive_entry_t');
package Archive;
# base class is "abstract" having no constructor or destructor
$ffi->mangler(sub {
my($name) = @_;
"archive_$name";
});
$ffi->attach( error_string => ['archive_t'] => 'string' );
package ArchiveRead;
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_read_$name";
});
$ffi->attach( new => ['string'] => 'archive_read_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_t'] );
$ffi->attach( support_filter_all => ['archive_t'] => 'int' );
$ffi->attach( support_format_all => ['archive_t'] => 'int' );
$ffi->attach( open_filename => ['archive_t','string','size_t'] => 'int' );
$ffi->attach( next_header2 => ['archive_t', 'archive_entry_t' ] => 'int' );
$ffi->attach( data_skip => ['archive_t'] => 'int' );
# ... define additional read methods
package ArchiveWrite;
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_write_$name";
});
$ffi->attach( new => ['string'] => 'archive_write_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_write_t'] );
# ... define additional write methods
package ArchiveEntry;
$ffi->mangler(sub {
my($name) = @_;
"archive_entry_$name";
});
$ffi->attach( new => ['string'] => 'archive_entry_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_entry_t'] );
$ffi->attach( pathname => ['archive_entry_t'] => 'string' );
# ... define additional entry methods
package main;
use constant ARCHIVE_OK => 0;
# this is a Perl version of the C code here:
# https://github.com/libarchive/libarchive/wiki/Examples#List_contents_of_Archive_stored_in_File
my $archive_filename = shift @ARGV;
unless(defined $archive_filename)
{
print "usage: $0 archive.tar\n";
exit;
}
my $archive = ArchiveRead->new;
$archive->support_filter_all;
$archive->support_format_all;
my $r = $archive->open_filename($archive_filename, 1024);
die "error opening $archive_filename: ", $archive->error_string
unless $r == ARCHIVE_OK;
my $entry = ArchiveEntry->new;
while($archive->next_header2($entry) == ARCHIVE_OK)
{
print $entry->pathname, "\n";
$archive->data_skip;
}
FFI-Platypus-2.12/examples/archive_object.pl 000644 000000 000000 00000005744 15251066120 020771 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
# This example uses FreeBSD's libarchive to list the contents of any
# archive format that it suppors. We've also filled out a part of
# the ArchiveWrite class that could be used for writing archive formats
# supported by libarchive
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'archive'),
);
$ffi->type('object(Archive)' => 'archive_t');
$ffi->type('object(ArchiveRead)' => 'archive_read_t');
$ffi->type('object(ArchiveWrite)' => 'archive_write_t');
$ffi->type('object(ArchiveEntry)' => 'archive_entry_t');
package Archive {
# base class is "abstract" having no constructor or destructor
$ffi->mangler(sub {
my($name) = @_;
"archive_$name";
});
$ffi->attach( error_string => ['archive_t'] => 'string' );
}
package ArchiveRead {
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_read_$name";
});
$ffi->attach( new => ['string'] => 'archive_read_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_t'] );
$ffi->attach( support_filter_all => ['archive_t'] => 'int' );
$ffi->attach( support_format_all => ['archive_t'] => 'int' );
$ffi->attach( open_filename => ['archive_t','string','size_t'] => 'int' );
$ffi->attach( next_header2 => ['archive_t', 'archive_entry_t' ] => 'int' );
$ffi->attach( data_skip => ['archive_t'] => 'int' );
# ... define additional read methods
}
package ArchiveWrite {
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_write_$name";
});
$ffi->attach( new => ['string'] => 'archive_write_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_write_t'] );
# ... define additional write methods
}
package ArchiveEntry {
$ffi->mangler(sub {
my($name) = @_;
"archive_entry_$name";
});
$ffi->attach( new => ['string'] => 'archive_entry_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_entry_t'] );
$ffi->attach( pathname => ['archive_entry_t'] => 'string' );
# ... define additional entry methods
}
use constant ARCHIVE_OK => 0;
# this is a Perl version of the C code here:
# https://github.com/libarchive/libarchive/wiki/Examples#List_contents_of_Archive_stored_in_File
my $archive_filename = shift @ARGV;
unless(defined $archive_filename)
{
print "usage: $0 archive.tar\n";
exit;
}
my $archive = ArchiveRead->new;
$archive->support_filter_all;
$archive->support_format_all;
my $r = $archive->open_filename($archive_filename, 1024);
die "error opening $archive_filename: ", $archive->error_string
unless $r == ARCHIVE_OK;
my $entry = ArchiveEntry->new;
while($archive->next_header2($entry) == ARCHIVE_OK)
{
print $entry->pathname, "\n";
$archive->data_skip;
}
FFI-Platypus-2.12/examples/array_reverse.c 000644 000000 000000 00000000323 15251066120 020466 0 ustar 00root root 000000 000000 void
array_reverse(int a[], int len) {
int tmp, i;
for(i=0; i < len/2; i++) {
tmp = a[i];
a[i] = a[len-i-1];
a[len-i-1] = tmp;
}
}
void
array_reverse10(int a[10]) {
array_reverse(a, 10);
}
FFI-Platypus-2.12/examples/array_reverse.pl 000644 000000 000000 00000000567 15251066120 020671 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './array_reverse.so',
);
$ffi->attach( array_reverse => ['int[]','int'] );
$ffi->attach( array_reverse10 => ['int[10]'] );
my @a = (1..10);
array_reverse10( \@a );
print "$_ " for @a;
print "\n";
@a = (1..20);
array_reverse( \@a, 20 );
print "$_ " for @a;
print "\n";
FFI-Platypus-2.12/examples/array_sum.c 000644 000000 000000 00000000243 15251066120 017620 0 ustar 00root root 000000 000000 #include <stdlib.h>
int
array_sum(const int *a) {
int i, sum;
if(a == NULL)
return -1;
for(i=0, sum=0; a[i] != 0; i++)
sum += a[i];
return sum;
}
FFI-Platypus-2.12/examples/array_sum.pl 000644 000000 000000 00000000440 15251066120 020010 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './array_sum.so',
);
$ffi->attach( array_sum => ['int*'] => 'int' );
print array_sum(undef), "\n"; # -1
print array_sum([0]), "\n"; # 0
print array_sum([1,2,3,0]), "\n"; # 6
FFI-Platypus-2.12/examples/bundle-answer/ 000755 000000 000000 00000000000 15251066120 020221 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-answer/ffi/ 000755 000000 000000 00000000000 15251066120 020765 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-answer/ffi/answer.c 000644 000000 000000 00000000131 15251066120 022423 0 ustar 00root root 000000 000000 int
answer(void)
{
/* the answer to life the universe and everything */
return 42;
}
FFI-Platypus-2.12/examples/bundle-answer/ffi/answer.fbx 000644 000000 000000 00000000143 15251066120 022763 0 ustar 00root root 000000 000000 use strict;
use warnings;
our $DIR;
return {
cflags => "-I/include",
source => "$DIR/*.c",
}
FFI-Platypus-2.12/examples/bundle-answer/include/ 000755 000000 000000 00000000000 15251066120 021644 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-answer/include/answer.h 000644 000000 000000 00000000075 15251066120 023316 0 ustar 00root root 000000 000000 #ifndef ANSWER_H
#define ANSWER_H
int answer(void);
#endif
FFI-Platypus-2.12/examples/bundle-answer/lib/ 000755 000000 000000 00000000000 15251066120 020767 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-answer/lib/Answer.pm 000644 000000 000000 00000000337 15251066120 022567 0 ustar 00root root 000000 000000 package Answer;
use strict;
use warnings;
use FFI::Platypus 2.00;
use Exporter qw( import );
our @EXPORT = qw( answer );
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle;
$ffi->attach( answer => [] => 'int' );
1;
FFI-Platypus-2.12/examples/bundle-answer/t/ 000755 000000 000000 00000000000 15251066120 020464 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-answer/t/answer.t 000644 000000 000000 00000000075 15251066120 022152 0 ustar 00root root 000000 000000 use Test2::V0;
use Answer;
is(answer(), 42);
done_testing;
FFI-Platypus-2.12/examples/bundle-bzip2/ 000755 000000 000000 00000000000 15251066120 017750 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-bzip2/ffi/ 000755 000000 000000 00000000000 15251066120 020514 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-bzip2/ffi/bz2.fbx 000644 000000 000000 00000000127 15251066120 021712 0 ustar 00root root 000000 000000 use strict;
use warnings;
{
alien => ['Alien::Libbz2'],
source => ['ffi/*.c'],
};
FFI-Platypus-2.12/examples/bundle-bzip2/ffi/compress.c 000644 000000 000000 00000000372 15251066120 022515 0 ustar 00root root 000000 000000 #include <bzlib.h>
#include <stdlib.h>
int
bzip2__new(bz_stream **stream, int blockSize100k, int verbosity, int workFactor )
{
*stream = calloc(1, sizeof(bz_stream));
return BZ2_bzCompressInit(*stream, blockSize100k, verbosity, workFactor );
}
FFI-Platypus-2.12/examples/bundle-bzip2/lib/ 000755 000000 000000 00000000000 15251066120 020516 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-bzip2/lib/Bzip2.pm 000644 000000 000000 00000001313 15251066120 022040 0 ustar 00root root 000000 000000 package Bzip2;
use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( free );
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle;
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/bzip2__/ unless $name =~ /^BZ2_/;
$name;
});
=head2 new
my $bzip2 = Bzip2->new($block_size_100k, $verbosity, $work_flow);
=cut
$ffi->attach( new => ['opaque*', 'int', 'int', 'int'] => 'int' => sub {
my $xsub = shift;
my $class = shift;
my $ptr;
my $ret = $xsub->(\$ptr, @_);
return bless \$ptr, $class;
});
$ffi->attach( [ BZ2_bzCompressEnd => 'DESTROY' ] => ['opaque'] => 'int' => sub {
my $xsub = shift;
my $self = shift;
my $ret = $xsub->($$self);
free $$self;
});
1;
FFI-Platypus-2.12/examples/bundle-bzip2/t/ 000755 000000 000000 00000000000 15251066120 020213 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-bzip2/t/bzip2.t 000644 000000 000000 00000000175 15251066120 021431 0 ustar 00root root 000000 000000 use Test2::V0;
use Bzip2;
subtest 'compress' => sub {
my $bzip2 = Bzip2->new;
isa_ok $bzip2, 'Bzip2';
};
done_testing;
FFI-Platypus-2.12/examples/bundle-const/ 000755 000000 000000 00000000000 15251066120 020050 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-const/ffi/ 000755 000000 000000 00000000000 15251066120 020614 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-const/ffi/const.c 000644 000000 000000 00000000661 15251066120 022111 0 ustar 00root root 000000 000000 #include <ffi_platypus_bundle.h>
#include "myheader.h"
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c)
{
c->set_str("MYVERSION_STRING", MYVERSION_STRING);
c->set_uint("MYVERSION_MAJOR", MYVERSION_MAJOR);
c->set_uint("MYVERSION_MINOR", MYVERSION_MINOR);
c->set_uint("MYVERSION_PATCH", MYVERSION_PATCH);
c->set_sint("MYBAD", MYBAD);
c->set_sint("MYOK", MYOK);
c->set_double("MYPI", MYPI);
}
FFI-Platypus-2.12/examples/bundle-const/ffi/myheader.h 000644 000000 000000 00000000326 15251066120 022564 0 ustar 00root root 000000 000000 #ifndef MYHEADER_H
#define MYHEADER_H
#define MYVERSION_STRING "1.2.3"
#define MYVERSION_MAJOR 1
#define MYVERSION_MINOR 2
#define MYVERSION_PATCH 3
enum {
MYBAD = -1,
MYOK = 1
};
#define MYPI 3.14
#endif
FFI-Platypus-2.12/examples/bundle-const/lib/ 000755 000000 000000 00000000000 15251066120 020616 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-const/lib/Const.pm 000644 000000 000000 00000000207 15251066120 022241 0 ustar 00root root 000000 000000 package Const;
use strict;
use warnings;
use FFI::Platypus 2.00;
{
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle;
}
1;
FFI-Platypus-2.12/examples/bundle-const/t/ 000755 000000 000000 00000000000 15251066120 020313 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-const/t/const.t 000644 000000 000000 00000000235 15251066120 021626 0 ustar 00root root 000000 000000 use Test2::V0;
use Const;
foreach my $name (sort keys %Const::)
{
next unless $name =~ /^MY/;
note "$name=@{[ Const->$name ]}";
}
ok 1;
done_testing;
FFI-Platypus-2.12/examples/bundle-foo/ 000755 000000 000000 00000000000 15251066120 017505 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-foo/Makefile.PL 000644 000000 000000 00000000415 15251066120 021457 0 ustar 00root root 000000 000000 use strict;
use warnings;
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile(
$fbmm->mm_args(
NAME => 'Foo',
DISTNAME => 'Foo',
VERSION => '1.00',
# ...
)
);
sub MY::postamble
{
$fbmm->mm_postamble;
}
FFI-Platypus-2.12/examples/bundle-foo/ffi/ 000755 000000 000000 00000000000 15251066120 020251 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-foo/ffi/foo.c 000644 000000 000000 00000000762 15251066120 021205 0 ustar 00root root 000000 000000 #include <ffi_platypus_bundle.h>
#include <string.h>
typedef struct {
char *name;
int value;
} foo_t;
foo_t*
foo__new(const char *class_name, const char *name, int value) {
(void)class_name;
foo_t *self = malloc( sizeof( foo_t ) );
self->name = strdup(name);
self->value = value;
return self;
}
const char *
foo__name(foo_t *self) {
return self->name;
}
int
foo__value(foo_t *self) {
return self->value;
}
void
foo__DESTROY(foo_t *self) {
free(self->name);
free(self);
}
FFI-Platypus-2.12/examples/bundle-foo/lib/ 000755 000000 000000 00000000000 15251066120 020253 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-foo/lib/Foo.pm 000644 000000 000000 00000001012 15251066120 021326 0 ustar 00root root 000000 000000 package Foo;
use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('object(Foo)' => 'foo_t');
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/foo__/;
$name;
});
$ffi->bundle;
$ffi->attach( new => [ 'string', 'string', 'int' ] => 'foo_t' );
$ffi->attach( name => [ 'foo_t' ] => 'string' );
$ffi->attach( value => [ 'foo_t' ] => 'int' );
$ffi->attach( DESTROY => [ 'foo_t' ] => 'void' );
1;
FFI-Platypus-2.12/examples/bundle-foo/t/ 000755 000000 000000 00000000000 15251066120 017750 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-foo/t/foo.t 000644 000000 000000 00000000217 15251066120 020720 0 ustar 00root root 000000 000000 use Test2::V0;
use Foo;
my $foo = Foo->new("platypus", 10);
isa_ok $foo, 'Foo';
is $foo->name, "platypus";
is $foo->value, 10;
done_testing;
FFI-Platypus-2.12/examples/bundle-init/ 000755 000000 000000 00000000000 15251066120 017665 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-init/ffi/ 000755 000000 000000 00000000000 15251066120 020431 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-init/ffi/init.c 000644 000000 000000 00000000706 15251066120 021543 0 ustar 00root root 000000 000000 #include <ffi_platypus_bundle.h>
char buffer[512];
const char *version;
void (*say)(const char *);
void
ffi_pl_bundle_init(const char *package, int argc, void *argv[])
{
version = argv[0];
say = argv[1];
say("in init!");
snprintf(buffer, 512, "package = %s, version = %s", package, version);
say(buffer);
snprintf(buffer, 512, "args = %d", argc);
say(buffer);
}
void
ffi_pl_bundle_fini(const char *package)
{
say("in fini!");
}
FFI-Platypus-2.12/examples/bundle-init/lib/ 000755 000000 000000 00000000000 15251066120 020433 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-init/lib/Init.pm 000644 000000 000000 00000000601 15251066120 021671 0 ustar 00root root 000000 000000 package Init;
use strict;
use warnings;
use FFI::Platypus 2.00;
our $VERSION = '1.00';
{
my $ffi = FFI::Platypus->new( api => 2 );
my $say = $ffi->closure(sub {
my $string = shift;
print "$string\n";
});
$ffi->bundle([
$ffi->cast( 'string' => 'opaque', $VERSION ),
$ffi->cast( '(string)->void' => 'opaque', $say ),
]);
undef $ffi;
undef $say;
}
1;
FFI-Platypus-2.12/examples/bundle-init/t/ 000755 000000 000000 00000000000 15251066120 020130 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/examples/bundle-init/t/init.t 000644 000000 000000 00000000075 15251066120 021262 0 ustar 00root root 000000 000000 use Test2::V0;
use Init;
ok 'did not crash';
done_testing;
FFI-Platypus-2.12/examples/char.pl 000644 000000 000000 00000000646 15251066120 016733 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->type('int' => 'character');
my @list = qw(
alnum alpha ascii blank cntrl digit lower print punct
space upper xdigit
);
$ffi->attach("is$_" => ['character'] => 'int') for @list;
my $char = shift(@ARGV) || 'a';
no strict 'refs';
printf "'%s' is %s %s\n", $char, $_, &{'is'.$_}(ord $char) for @list;
FFI-Platypus-2.12/examples/closure-opaque.pl 000644 000000 000000 00000000664 15251066120 020762 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib('./closure.so');
$ffi->type('(int)->int' => 'closure_t');
$ffi->attach(set_closure => ['closure_t'] => 'void');
$ffi->attach(call_closure => ['int'] => 'int');
my $closure = $ffi->closure(sub { $_[0] * 6 });
my $opaque = $ffi->cast(closure_t => 'opaque', $closure);
set_closure($opaque);
print call_closure(2), "\n"; # prints "12"
FFI-Platypus-2.12/examples/closure.c 000644 000000 000000 00000000556 15251066120 017301 0 ustar 00root root 000000 000000 /*
* closure.c - on Linux compile with: gcc closure.c -shared -o closure.so -fPIC
*/
#include <stdio.h>
typedef int (*closure_t)(int);
closure_t my_closure = NULL;
void set_closure(closure_t value)
{
my_closure = value;
}
int call_closure(int value)
{
if(my_closure != NULL)
return my_closure(value);
else
fprintf(stderr, "closure is NULL\n");
}
FFI-Platypus-2.12/examples/closure.pl 000644 000000 000000 00000000761 15251066120 017470 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib('./closure.so');
$ffi->type('(int)->int' => 'closure_t');
$ffi->attach(set_closure => ['closure_t'] => 'void');
$ffi->attach(call_closure => ['int'] => 'int');
my $closure1 = $ffi->closure(sub { $_[0] * 2 });
set_closure($closure1);
print call_closure(2), "\n"; # prints "4"
my $closure2 = $ffi->closure(sub { $_[0] * 4 });
set_closure($closure2);
print call_closure(2), "\n"; # prints "8"
FFI-Platypus-2.12/examples/color.c 000644 000000 000000 00000000433 15251066120 016735 0 ustar 00root root 000000 000000 #include <stdint.h>
#include <string.h>
typedef struct color_t {
char name[8];
uint8_t red;
uint8_t green;
uint8_t blue;
} color_t;
color_t
color_increase_red(color_t color, uint8_t amount)
{
strcpy(color.name, "reddish");
color.red += amount;
return color;
}
FFI-Platypus-2.12/examples/color.pl 000644 000000 000000 00000001504 15251066120 017126 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './color.so'
);
package Color {
use FFI::Platypus::Record;
use overload
'""' => sub { shift->as_string },
bool => sub { 1 }, fallback => 1;
record_layout_1($ffi,
'string(8)' => 'name', qw(
uint8 red
uint8 green
uint8 blue
));
sub as_string {
my($self) = @_;
sprintf "%s: [red:%02x green:%02x blue:%02x]",
$self->name, $self->red, $self->green, $self->blue;
}
}
$ffi->type('record(Color)' => 'color_t');
$ffi->attach( color_increase_red => ['color_t','uint8'] => 'color_t' );
my $gray = Color->new(
name => 'gray',
red => 0xDC,
green => 0xDC,
blue => 0xDC,
);
my $slightly_red = color_increase_red($gray, 20);
print "$gray\n";
print "$slightly_red\n";
FFI-Platypus-2.12/examples/curl.pl 000644 000000 000000 00000001161 15251066120 016754 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use constant CURLOPT_URL => 10002;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'curl'),
);
my $curl_handle = $ffi->function( 'curl_easy_init' => [] => 'opaque' )
->call;
$ffi->function( 'curl_easy_setopt' => ['opaque', 'enum' ] => ['string'] )
->call($curl_handle, CURLOPT_URL, "https://pl.atypus.org" );
$ffi->function( 'curl_easy_perform' => ['opaque' ] => 'enum' )
->call($curl_handle);
$ffi->function( 'curl_easy_cleanup' => ['opaque' ] )
->call($curl_handle);
FFI-Platypus-2.12/examples/curl_callback.pl 000644 000000 000000 00000002134 15251066120 020571 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use FFI::Platypus::Buffer qw( window );
use constant CURLOPT_URL => 10002;
use constant CURLOPT_WRITEFUNCTION => 20011;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'curl'),
);
my $curl_handle = $ffi->function( 'curl_easy_init' => [] => 'opaque' )
->call;
$ffi->function( 'curl_easy_setopt' => [ 'opaque', 'enum' ] => ['string'] )
->call($curl_handle, CURLOPT_URL, "https://pl.atypus.org" );
my $html;
my $closure = $ffi->closure(sub {
my($ptr, $len, $num, $user) = @_;
window(my $buf, $ptr, $len*$num);
$html .= $buf;
return $len*$num;
});
$ffi->function( 'curl_easy_setopt' => [ 'opaque', 'enum' ] => ['(opaque,size_t,size_t,opaque)->size_t'] => 'enum' )
->call($curl_handle, CURLOPT_WRITEFUNCTION, $closure);
$ffi->function( 'curl_easy_perform' => [ 'opaque' ] => 'enum' )
->call($curl_handle);
$ffi->function( 'curl_easy_cleanup' => [ 'opaque' ] )
->call($curl_handle);
if($html =~ /<title>(.*?)<\/title>/) {
print "$1\n";
}
FFI-Platypus-2.12/examples/file_handle.pl 000644 000000 000000 00000001765 15251066120 020253 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
{
package FD;
use constant O_RDONLY => 0;
use constant O_WRONLY => 1;
use constant O_RDWR => 2;
use constant IN => bless \do { my $in=0 }, __PACKAGE__;
use constant OUT => bless \do { my $out=1 }, __PACKAGE__;
use constant ERR => bless \do { my $err=2 }, __PACKAGE__;
my $ffi = FFI::Platypus->new( api => 2, lib => [undef]);
$ffi->type('object(FD,int)' => 'fd');
$ffi->attach( [ 'open' => 'new' ] => [ 'string', 'int', 'mode_t' ] => 'fd' => sub {
my($xsub, $class, $fn, @rest) = @_;
my $fd = $xsub->($fn, @rest);
die "error opening $fn $!" if $$fd == -1;
$fd;
});
$ffi->attach( write => ['fd', 'string', 'size_t' ] => 'ssize_t' );
$ffi->attach( read => ['fd', 'string', 'size_t' ] => 'ssize_t' );
$ffi->attach( close => ['fd'] => 'int' );
}
my $fd = FD->new("file_handle.txt", FD::O_RDONLY);
my $buffer = "\0" x 10;
while(my $br = $fd->read($buffer, 10))
{
FD::OUT->write($buffer, $br);
}
$fd->close;
FFI-Platypus-2.12/examples/file_handle.txt 000644 000000 000000 00000000014 15251066120 020441 0 ustar 00root root 000000 000000 Hello World
FFI-Platypus-2.12/examples/list_integer_types.pl 000644 000000 000000 00000000471 15251066120 021726 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
foreach my $type_name (sort $ffi->types)
{
my $meta = $ffi->type_meta($type_name);
next unless defined $meta->{element_type} && $meta->{element_type} eq 'int';
printf "%20s %s\n", $type_name, $meta->{ffi_type};
}
FFI-Platypus-2.12/examples/malloc.pl 000644 000000 000000 00000000521 15251066120 017255 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( malloc free memcpy strdup );
my $ffi = FFI::Platypus->new( api => 2 );
my $buffer = malloc 14;
my $ptr_string = strdup("hello there!!\n");
memcpy $buffer, $ptr_string, 15;
print $ffi->cast('opaque' => 'string', $buffer);
free $ptr_string;
free $buffer;
FFI-Platypus-2.12/examples/math.pl 000644 000000 000000 00000000611 15251066120 016737 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::CheckLib;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->attach(puts => ['string'] => 'int');
$ffi->attach(fdim => ['double','double'] => 'double');
puts(fdim(7.0, 2.0));
$ffi->attach(cos => ['double'] => 'double');
puts(cos(2.0));
$ffi->attach(fmax => ['double', 'double'] => 'double');
puts(fmax(2.0,3.0));
FFI-Platypus-2.12/examples/notify.pl 000644 000000 000000 00000001420 15251066120 017315 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::CheckLib;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'notify'),
);
$ffi->attach( notify_init => ['string'] );
$ffi->attach( notify_uninit => [] );
$ffi->attach( notify_notification_new => ['string', 'string', 'string'] => 'opaque' );
$ffi->attach( notify_notification_show => ['opaque', 'opaque'] );
my $message = join "\n",
"Hello from Platypus!",
"Welcome to the fun",
"world of FFI";
notify_init('Platypus Hello');
my $n = notify_notification_new('Platypus Hello World', $message, 'dialog-information');
notify_notification_show($n, undef);
notify_uninit();
FFI-Platypus-2.12/examples/notify.png 000644 000000 000000 00000022603 15251066120 017474 0 ustar 00root root 000000 000000 ‰PNG
IHDR © i ÑK sBITÛáOà IDATx^í]|Uþß™íÙôM#‰B:„&(£(á<£T…S98TÔ³!‚XP¬çéyèÙ¢(Þ¢(èù÷"%"jè)¤oÚöòÿÍÌf3;óf¶d#›äÍ'âÌ{¿÷+ß÷æ»ïMù
‘ &ñvsH ‰þ³!®ˆ/@8$®6tk´3l½Âb =øÀ·á @@lBÀwØ]®ºm\@ó@À³!ÌHظՓ„Ä¢}|!~9å+àÏlƒ úл-_è`u#Â%–èÞáëìÐât€ÝGœþr«¢šQÝCÿëÖ}|üA×Q êDÕȯ*@—µqÂwÕpaAš-Ò,ÚÝ¡bM„N«Ž(ÖV´N&Z{™+\î€ãÁ>Ù;»œ9 ïé}4â0Þ‘dá6vXð;›’ìÐ-ÔŠ
"7 ¶rØww)Ü?"§}~…x/Rg
ª
¢Üs„ ”^ÊZŒ_ÉFÓé´€s‚!<»—ø6ø-aPã é_—ô‚šû eýqÏ-ú'›æîyé:¦ÏaÁs€OgL×rÕ¡:œ:Ï# ¹¬Sb¡âpÒ=#} ˜4Ñ5dVAxÓQ„ª*QEWu/&é>7qJ:»‘ƒ©w
;Œñ@󢇨Ž¡¬xÓébAẠ…€ÜGÍ Üo¨>z·ßq‹¹P•”?
¼‹ž4ú4«`…ƒ8o)&§Ìñ« 5{ñ‰=ù ÐzŸzÁÃï„Žu\™À„æX}RÄ÷Á”)•ðG$r$! ½“{hÅa7Þ콈õÙŒ/œÕTØ^ªî8QŠ;Ux#Ú*÷z Ê¿ ‹
]C•23m÷ ØÎÓ-;šÓ
¨å<³ÑjE#0ÌÆím€VM¯`Cɱl;w;†‘¨WH]´ï6J¹À0³+ЄR&hW¸†Õ¤ë³¯Ì:ém…7VLƒÅdô5"1
ˆ‹[¼tYÞ¸qR™˜°·¡`9Œ F #8vlßþÊK+kkjÚ[šúó’ ‘û¼r•*±ÿµÿù"""¢-pÞbMŒ F 0„††67ëfÏšUq¡Ül42J½¡?f%‹v–º0ãÃćF—b0A€ LË"""—,]¦Pª|rGŒûà ,uñŒÏ'@±0F #ð# L%t…ZÈ1îƒ6øŸp¸ #€ d¾ßðÀ}Áö#€ÀÌ}«Â`z 2¡÷½zLØQŒ F #àŽ€ëÙx‘¾À}‚›H¿ÅbÑ57MF“Ùd³ÙdR©\®P©ÔQZ¹\ΗÇ%Œ F »z7ìàqe`ÖF]}sKSlL\t´VVˤr“Ùh0èÛÚÛ.Tž‹ŒˆŠŽŒéú[JÝ
ÖÀô À}5uÕR9|è¨ÖÖ–¶öÖööv›Ís=™L Su©dâû¬8RŒ F Èè*÷µ··Zm本§ËNZ¶¤DxO$B©RšMf½A___³ÂÄø¤óÏ‚¤Fã}®À Ç
»‡À o¿ýV«ÕŽ =Z¡P€v³Ù¼oß¾úúú€ëê}ÞF]CrbÿŠª‹F£1±_ ¬m+I’¡šÐ¸¸x’ !€˜èØ]}À½Ç
1Þ„@XXXCCÃîÝ»4`+..⃷ֺ#Æ®Îû F½Z R}©Z£lŒPÖ9,62‰ÉŸ!#ªC¥Ç
ª°6S’R©2›LÝ Ö‰ÀôòòòvíÚÕÒÒôAÁNHHȘ1cº#À®Îûà½7«Õ ®"‡j C5¦ÉW¤e·Üúmˆâ’2¢0RuH*•Âë&vál<ÝÖ‰Àô8T*Õ¸qã4
° lpãØè¯;‘‰Ý~J¤ÆrD©P´¶µª•ê†ö!au¯ª¢fÉ#î•[/J¤Ñ0û³4½Ùj ¯›Àµ?•oƒ‘; y"¤M;àHTxHÞÈìiÓç6Zcþôø=©!/¿±F»Cþý¶D{Í”&:BÂ…Ä^‡ë«ÿöôÓŠ+²à…ÀgÞ]W}àLJn/ÈpÒ–®=Ä { )Ì)üÇú ûX½ 0ïê›çYla –=&k¬xì®I™×No5hþ´x~¬£æÃ×Þ×{¾u›=äá_´U•¼½üyR†7ŽaŒ@W F¢fKô;®ý®èD¶íê¼/TÞØÔ ©7'•7ü~׶÷,/9LÅö¶µçK—Õµ]o¶%ÊeŠöö¶°08HJZo™Ó”iziÄw[÷ýøÕÈ08…v‡bÓÖß}·žÐ7{#ße²Ó3lyôô)¹ÃQ^«3éjà7âø©0jŽž¿(7rú'ÙÔ^](±ÛáSJxÃ\~L&¬vaÆ×ø`ƒ$p…ÝáYW¯÷EFD—W”µëÛBÔ!«µÅ2~ûEvzüñÓÕvûÀ¬ðX©”0š ð¸_lL¼ ËïÆ]Ó([Ô ï×¼~ôLÙ(–«Móì[¯¶Vœ5ô¡jÙ•ƒÍ¾ã ‰&ò¡ÏÙªËlͼ§VȤ†þ¹¿?whËÓógõ ýûVƒú¥&KkŸ}ꓹO/JVF]U¸ã×í©yæ¤ñc fœk>¹|áàhëË/¼«“D,zn9Ywø½^m
MyïÓµgìµ™ôá¡êqÃθóAjµïÕFì=^±é›×\8«’Ù‡f¥Ìžu§*.Œ
mÄÞc›¾¥ä•RÛŒ³gÞ¦IÈ– –šb)KË+ä&ýᲪ0¢%-kü‘³{î²ÙJ)B´
Nd&¤H=Ì,o€Ê0*oƶ]ÿ»-?mؤ'XÊÉ ŠK¿ûj-ij*ÈË“Ù,6!7q9F üòË/Àz°òÅpíè
¯»îº€Ú¡”Á{ ‚I¡Eª\~Àý\xn¹¡¡>!¾ŸÙbNIxøðÁc„±Q7檱6›Õá ›tð Ÿ”tÎc}Œ¬kÒÙÉÚÒƒÅðžI\T¤[sÂ~ÕÔô‰ù¹jëþ“?ý¼1)âÓëf.º{ÚŒ¢µEdË…y·Í–„Gj¢2W ÙõöŸ u㜶7ýnâ(“JªÚ DŒ¢aÁ½÷ø¯uE_n”œ,‰¥@'Hn>ü‡ÊŽýºõÖü¡ƒFÔ6µ˜šÏ#±ÚÕ¬xƒSuºÊ¼jÕ«91Ò‡çßSÙ&ûôó›ê_^þô[Ôz µª4zçUT×-Sϵʶüï«êê—_zöM£’ò™ÙÂC ñÉíåû*/œ8uº:5.|ØèkׯÛÖRWsúÌ1’°ef >) G"¡. èÚ¥ºŠ}wL›šã–øìd¥qÝÚw¢HÌɷ o°·TïRzÉð¨XpFÀ{š››!a(ÜÜP*•Ð
ˆ
½×ཤ÷y©%<,æ}Í-:…\a2µ±Ñ×_[°õçÍ£®Ó™-&‡Ã2^jãˆYíÊçþ^Ä&DÉ
o¹ÓÊ’°XÍuÍöÛ¿0¶µÀÓ…pKå|e%ü@Œ 2äcu(Ñf½jè`{̇bPn~Éáÿ6ž?¹kÏ>µÔpmþM-´ µR?ðŽV¥fxù{6~t´´$u<Í}<w㣢¬„tסÓU-öÄÄ„¼Q#¨I IXwÍ5Òp-èؾ¿´íRhúåÈQ¹ÙPVM¼õ µf‡UjYu›¡¡Z"p1nÏÑcr³~b~æµ7Nγ«÷ +ª<\S^‘q•Ë/)iJKË=tîбgΖ™š‘š‘‘Ñ* =züDEy©Vn¼"%÷‡]h=’¤ñ G%ohþ"c\™ ì ¸äÄI¹ÅtÃÕ©ã'Ýœg Ýsô€Dw†‡.À Îs|À€Ý1ãcüîêš´ÀµImtÜ¥ÚJ˜AÚìÔò¨ªºþ…¥.Iðf[T¤V쎊(€RÒ|Ïôéò˜¤È0uêÀ4‰LÁ>K7í>Z¼ù›¼¬„Âû ßWnørõ_áUb¾>‚0ß<qòÛ‡·þÍ÷N+È ŒO‘è)A»Cb§}¶Z,LC’¾ÃcƒK`Ô§ØI£¡¹É4:#jñâgN” ¨«mظ¥ø§-W½ðWkd Ç IXn¾~ s¯£¤ÊÈp -ã˜8*õšÉs;.Ù%Q ’.]ÇpÀ%¿’ÍäÖ_›êë²n.LŠ UG%oزEalÏ/D¬.‡5*™B æLòÍ Câ€7s¨9 ñëØ\tðq/@ Ü(ÀŒÏn³·éÛÃÃÂáQ–c'J¡ðRMPžB¡Lˆ£¦¯þm„Ä6";ƒ¦ÄW¨BTr©"lÿÁŸI‡“X •R¥1Ù•[wïO¾âêcF¦ÇÇ¥ÜSºOMX ®êºNg4‡|´öCmêÕwm’‘–!9#Ô¡jRRÕX[¼{Ǿj3Ù\'¡ëÏÖV—îÎ蟚–’~üB•©¶Îdh•ò¸á¥D2&wÈæoC~)-KË>NDô++¯®,Û±ä¡åMHi‰äê!9 ÿ¿}'Ã⿃5o{åÉZEü€Á žššR$Sœ¯©
‘µL æSÓ†-Þ(“8†¤¥™H©žKìÉ3χ‘Y™ßË”? :q`ïÑz‰©îbÌk… 0= ˜åp7? •SR‡ä ’“›Ø/žÓ‘JI¸ÞWYYZAúaÑdòØarÇl;RýæÏ¥„)á¾'#ëÁ)o’…Æ}ºé§~ü·›•$Œ“'å%ÇÈÒr¯qéŠÔØU1¹6®s´Þ=í¦øì¼¥~ö¬yu|Ñþ e¾¤ŠîÇ“¤¼øHÙû ¯y÷7BM5wNQ%¤"|B¥'*-z2,qðûŸoøèýU¥{’š&rŸ$#IùÀý‹C²×nønï¶
yƒS }ð)öÅ>ƈ6Lª¥}HÒ†j´à§-;#>ÒKöLØ‘H¼ÔÃq93IuÇ]´“Ú¿Y*FÄ$£bÂeàE ^¥um\‚s §Fr =qe¼RFFí*9àå÷:¶lýÑd¶LŸ:S¡W_ªjh¬»x¡¢¦¶Þl+˜pãå –®e/—œÙúýÚ‡¦ qã]À ®'ÚÞyµ¨/ë.oaë®! ·†GÞ¦s.¥Øiû„.¸fÍ n7ét……·„‡‡×7ÔÂ-f‹%:&JQ•9Ûµ ÐÚæPÿ壵d]Ù„+ÓF]?]tÁ sXF #üŒû´Ú˜Í›7ü/TOè(äòšê˜÷AF¿ËŽ‚ŒloÅÆ
ñEjôÿþÇ;PÈÜð½ìNb0߀=¸øÀ¼Rø¹æ})466ü–ñ`[Œ FÀ6ïKOËüúë¯8˜À“ÏYY9Þøe0ŒÀo‰ ‚ûàyÁW=P®ÁÛvc‹q1ý¶ïØyàðx8NJ’#†æ^—
)‘VVVÆÄÄ0j£à2Œ F #ð[# 㾺E SȯBz¤–””ìf0àÕHb
ß-‚'cá1H>Yh0ë!qÃ…ŒÀeD 1ïómÖ×á; l‘‘~¾»v!À¦1>ˆ@ÀîuôAìpÈŒ@ÏE€Ï}Ä{ü=7>ì9F #€@! “¼¼•¾^ðCéÅeŒ F ˜àÏûÀ[ŸnóstØ7Œ F #€F É}hQ\ŠÀ`z
pŸ×-?²
6ã©_¯éb F O DÆâ2×cÊtúyT6úÖ†ó m¨}F $F #Ðà ¨Y›‹²Ü 5—ÃkÞ ÖÁØ]Œ F `î ŒX F #ÐÃ@½×ÑÃBÀîb0úû:¾Ü¨Àó><h0¾ˆ æ¾¾Øë8fŒ F s Œ@_D ¨¹oÁ²eͧövt‹lùªÏNlÿR¤—æ=¹H¡«×Žˆ0]ElÞ{vé3Ë_~écÕiO¾Õÿqéó‹ tÉ’§–<ùØÏ›>•ÓßÏqÌfWmøq“ÔÈúH¸o=Ho=\óÚ zÂÕ^ û;mBû}ú^‡Ã!ß¼só£3 âr¯c÷8dŸ–Jéòva# ó²wDdŒ¾Pk}þ•'§¦jsÆŠè³Û•À}³®mSiDÄpF #z*÷ :S÷õú5„¡M"1O›7<Š
±ëpù¦¯×(í…ÌzïÌi YW²¥>ørSóùãE__ÔîØùÈÂ'§?¾hÆØ›.ÔTæ$ª”ƒ&ðÎ}tÁœ ³wìßeÖ7Þ{ë¤ã†è’ ÿ5´7Ì»ubVÞ$Ôã“”µäØèÄìšÚ
mGö~»C¹ê³Ï[Ê[,¶(mÁœ»Cþó›odíö—ß+"äŽø´|Mãî÷,/+éMêGž_ô΢?ÉÓæ<²pZÞuMuµMM7 ïí·7à \:uÃëE:™Âj×<¼â±·æße‰ÉygÍê– Çe2…FÙþìc+Úåþ +.Âô|‚šûìÅÊ>'eëœum’Üñ°ßÐ*ÿì³×_~àaiLR‹ž|æ/Ͼ60]‘œÉéŽKMäê5¯¾ñÀ}a‡ì?Õôò‡OüãÙ¿˜C;³«ÎŸ1eIù©û¦ŒŠÌKM«M™o¿eÆ}ÕMÒgV.ä7´ÚÔZyõÊg– <¯ý¯ÏŸ|Í‹Ë— ½hz÷ï÷º¡M€_ÎW·6V I*œër$,÷Þ:!,t¼TóSÉ…}ùὋVÜ}Ë-»ŠÿõÔÂyæÈx]»ò©¾˜ÞtI•°íà±¼~ª~ƒÌðíq»2;Þ1mÖƒE±äµ2ü¢H™È „Å'*¢Û.]±>Þª7e
o§}¨”¯—`z.^>éÔÜçZ6ÒÝ ×ûV3ýQr¦Üªkó“uÌT+Ôf¯o¨Jäqß¡³å£úi´)9ÀÃÓ×DfV_(ÕæŒêT¹Ô;t, 5”KõcÇL4J$™É‰F©yÜÕ,1(1^g“Yô-’ˆX¶f î׊þC*¾UÈì÷NЦr} Óá ~>xî`ñf¸h²’–¶jŽK‘Ëà‘Swïünôäû·l߸xÒD3ý–¡LªÏ 6Î"‘¨ä–ìœkJ ⾌ÄØ
µ’uk?NMOÏÍ f#ÔÐV£RªÕ*¡Øq9F §# ÏöyÉzL¤AÍ}BŒW<ñøcFÂý _H¶Ã"¸6†RÊ æ€I”T*I‚”:è[ì
ˆ{ñ¼Yp½)dýhyÛîÿûèÅ'ž—„kÏTYß[u §DbŸ2þúwßþ"*½2Üp*%ç~½S‚´Ûœš¬6+DOR¸œ%7®ˆ•¾úìÊã§N<un݆§_}ìqY\JVRhÜôy<C¸ #ÐGðÀ Á‰ÊˆAÖÛÏ ÜA{Oœ«ºd§.üq·a©öV·é.ž„ŠƒgªÝ©~ýs…PÇ~7D)C”µ ±¡*UX¬Dw”ìWÛ¨k•a—É5ÆŽû¼b¡W\WôÉëÓóó
NÂ…U¹zWñpF×F ;ôSNöp¥Ü®I¨¯-
g*ëõ
•°Sßܦ´ë¯ÌÍš5õV{dZã¥óPh0[ŒÂ\„è“ôÈy_l„õÏ÷-ÿè˵¶õ?Ú%DRŒbѼEÜy—D’eŸ;çÉ>^£°[•rË’yb_ìén¿ŠèdWJOØ{å+}M c¢ï)Ãzv|þŒ§ÿþ‘FM,žÿGyüÀñãnØpò‡‘Wßhêh,“mÉϽô²¾Mwgþðø¬1V¢ýö© WÓÆÄ—¢"â@öLUû÷_~(µYûµé±I9ca~z´\·÷›¢ÅËÿX #ÐÀl֑ܺǥcQDÿßµB¢Þ}#R#Ã…"TFDî,9ÐÖ†˜R 5ÁåC€üÇúYö#fvÒú ýã/üE¯Á à ÌXS¯@ 44tôˆáML4Ì…?öÍ=Î>è‘ó¾^ÑYbAÔêÈ×ß~1^Ö|ËùóY±–¸#€ð<ïó',…À1~Ìûz低 îìF #Ð3ÀÜ×3ú {‰ÀÜçÓ³‚õ kÃ`0݇€îë>à 5mܳñ“WÿNUZîZ¸àÜ/›èVÄ¿·”~¶j¹‘\)BMºRîSþŽ0Ü·
i×ùh½sÏøè Çô`‚—û†ffýZvNM½Æ@ :}zè€ÔÃ'ÑîJOœ<:4»#1ÀåŸÉ¿"5zõ$OÂÈȘÜ3žYðÔÒªÄt¤ .Äô5üX¡ï3.9’Vé¥uÈ„Œ§Î¹qòû›>ºÓnm°…–Ÿû%cÊè]ñl.O×B®ÒØ
ïùÝV0:ûšBdZÙYÄ°ó¯<4wîžj?Œk º ÏqHÈ? þyßN}kôñ#¯™4ÛFâæعgæýá…yOÏä$q‘'eÌ}táíù7Ÿ¿t±¦¾î÷W¦2jûÚÉ€ãň#¼Ü¢0%
¸êôéc†ÖVîÍž3˾¥kÝÅS‹–l‰é—v^4›K]³ìÝV¾2ÿÚŒ‘v©o× ¥uÏÎRn ÏÃοr©Iºz
"Œ«ØÂP¦£¤• ¦Z']öâ‚ü174Èû‹›cçži5 »ÏjSd&H&O]ØbP=þ<¥VÝO| àZŒ@_C }ò
aÍÊ Vzò{GÿºÁÑ!6•,%uô™Ó‡ZƤ¦drñl.%eåWÆ+Ò‡CnxUV¾s?:‹xv–’³
ÞäŒaJ #„'˜Î»º ^YÓ†ËCµ©Íºš’f‡÷æ„ÕùfB”MdP«ÁÜ'.ï«xà>?VÑCÒ1,3cÝöweÉ¥W¦§[ÉàŒ¬ƒ{֜ҷΠžW½ÏæârÉì,¾Z0!„ŠC*“3u‘²°ød™Ä…Öæ IgÞiøR=?ÇŒ7¸ #ÐCðƒ©‚÷^ôAfr|%ì×_geä»ÇC¦ì(kh8»3#}ÔŠgs9hÀþó¥S€Œ`ÍÛÖªó/;‹¸pƒÅ£ N²þ8óhŽÝ™Ä…¯—`0|düy
;÷º lÊ·áw‰Rf z•þô¦~WdÃmÔð»,¢4Q Û Ò,‹gsÚûæ/{óË’Æ
ãWg»Ù´.âV 4÷ü+óÅMp’µð‘ñhŽÝD&E$qáëÄ%^ ’© Е€/@¤EFpp»¢T‰D¹}ï>NúÖë#ÐÃP«ÕcF]Éäqšc˜Nü#
¨5¯ÐGwz8:Ø}Œ F #àB ˜ïuànÂ`0^!À_Òršñó÷¡æ}^ÙÂBŒ F #àû<²i »ŽÀôa<¬yû028tŒ F Ç À™¥qV¸ü› PÒ›¹º¬}j9|êÛÕV»æá½5ÿ.xéÕS¯Bº”²-? SÜ=‡5àKŸ46Rê™ä”xé¿;ÈÂË–½þ‡[]Ÿ©ôd×c0@ xM…|âclxྠºæµÙlRúãg~oLº”GgÄå^ÇQ Þ]¾ðN£! ý¶Žb0>!àSyà>ŸÌVxýŽ“²3_O»gIy¹øé/ν)5¯ðÛ⳦#ŸÍ\ðŒ@F–…3ÆÞt¡¦2'QyÃÔ{;ü!¶•œýþ«#UŠŒ”+ä ßöfyKðµ±Ó¥<²ðÉv2x
,ìXF ¼§ô¨ÌÌU?œ»Ój)9Y>rÀÀ'Ž¥¹õèñC3s†gdQfÆÛo™q û ÅêFâóu¯¿ýȣʤô-%Zwmát-R;]
¼CÂÞìÅÊ>'eëáµÙÛ
FŒ(¸ j‘…}d á01Á‰€ÐU?f’èûü˜I
…¤˜½¼_Cõ¹c'Ý5馷¿ùx¶Y~þÌÎŒ› þá¬PFCîб¸…½ >waLrDhâ ‹Ä‘?4g]D,ÇCdò•¨lê#ßÈ
–·ËÜÁ_óò ‘Íq!F #p<2›™ ‚ žq ¸‹Þ+”‘ÆAéy‡ ¯©ø5#33$fHñÞ_’U&µ6”ð_C¦5Ûe2ß„ ®ýT ¸J¢®
hãkÂ%Œ@/A x¹ˆlXNî×ÛwÓ†X”ŠÌÌÑ_|÷Ÿ¼ô4#)ó˜.…Ý9 ¼¿ºÙÑR…Ç.ÔXšj8]瓶^Òí8 Œ@¯F fvB·w]qïš\ ™žZÔ¦Ÿ5ÜJHFff}ÿeýì»D’eO—ÂîV¾eú#+Þý ^¢RE° yaÄÐÚðKͽúÜÀÁõ2<®yùñ¢ò¸8œç=äqÙ¼»Øj…<¡xÃ`0Á‹€L&ËÏÃäqa{)2û æ5oð=Ã`‚ âçƒzÍüàb1`@À›5¯‹
a<ï †ŽÃ>`0Ý‹ {Èìcîë^ıvŒ Fà7C€¾»ëík ¸Ï›™äo6„À`°™ÊKúóÀ}Í: Ò.Ä`0Áƒ€Î©Ø@äd
E¹ÏáعmIŠÊOôØŒ F O" õó¶ðÅnŸ¢ã5›É´nõêƆ/ç>ÆÂŒ F ë ;544¬]½Úl2ú¤MìÙfxýU ûœ9ù×_ é“j,ŒÀþ!• /IDAT`ºo¾þê³µkkkjÚ[šù÷'Øó6×>#&Ê}à5AH•Jøsæ`åp~Ä—oÖ‰£[ñd;u‰Tu7”Ý£ßç€ØówÑ;Wwµ8÷·„L:îƒq‹Yí¹UÜc>f| ¤;|±NUP'X-Šß(Tå”FºG¿´! òÏX—¨ K®ÎHD×€ æ 3?R·zŽ2g lNÿù*¹Fјp aŒˆ˜2
“‰#’ø“ ìáÙfXBÛŒFøc°uñ-1%nåtðBNó58Ý‚&„P#4XA^*:Ѿ³Á9Üz×Ñy†|lŽc£ åìC—ŠkÜä:8Uð±{–)Ê·Aî< þç*§tqP`Õ»5ïÀƒ$ K4š‰!0âZȆ¢- ÅÌ ? pïCt\ToОRSØãu(Uåî÷ÐÙŸ"aq50?$®a)tú3:ÉÄ gÇÀ³ÖÙÅâš]=ä‰û\‚¢;.c\« ¬¨»ZÇ¢€|ðûƒBwEEõŽ1å»
Šõx'ôr'S±jéÓ
l@–UÆ(WŒÏŒïÞºZÀÈôƒGº`Û”?W ;Ž!dî)Ùa†z
ÎQ~çxã ÝÖ—îWß@†UË ˜D\³Ë߸‰#¿°³Ü¦O ¼ToÐ'"3p]ã×ë^rŸóQZ¨n¦æ`‡Úgþa(–žWPB A|ºž/æÞŠ3ä‚Ç 0_¹Ìúó£ ××Ë}ìÐ=ç‘QÄGÿàñOï#öÊ7ïÕ±$½|٠çûäpÑÓâyj”Sûî—:·Ø-]R†„&ûH¾ô©oüB¬5BBÞŸ³—œ2¨_'^Ç°{‘ÞèìEöìÁEŒ$ÕšŽ Ñvþø³†
ã £Úwz€ L ~“@±‘%Ð$ CEøL:y„Ì‹EÂ=]:c…‡Ú§þCˆ ª¤ts}¡—€¾DÁ"¨Ïåì~døZÆSO[C†ÙQèò‡} ƒ.d{êÚ§Èï)3´‘U šPNðÜåkfJ&y¢(<¡ xã ׌7?\ÐÆíW·“S¸c i‡_ì~tùÁnB òz¿³»U ½
OMQ«(Z]AïÓÌÇ¡ÑQî2ìtKHž¶ º!1äq¡›dC—)j@ó~D qVŠEÂê;7U>Z2á Òm À}ÜqN±M9õÐ?g“pFĹŠEáAOn¨ÑÐ9>(s(QºœåœkQBMœ¾ XÄ
*×Ý ÓŒ«79X¼O®N½à÷² Ë'JŽ’èÐÃÞ§=Ú?ú§mšR€b_ºÜ«ÍK1¯t@È{Ç»jÌûÀ;}è~Ϲ+‡#Ž58[6v³ÏéÒŽÂΈQ¾óX™ÃJ'†Ð8C!
Üõ@[ O S‹“Ãý¥?”;be(PÄä=Ö )dŸŒ.äi(`BH1%.V‡RÇ–÷ï—Æ‹ü5/Ê\Öð—’™qÅ:A:Áá 9ö¡Ð>çÔà {_΋â´ÞØi~ÆD1ÕÔNè4AOP<tŸA³ÞÉ}þžÕAÐ!¿ Ô¸ös
ãë)᫼ Êz>(c¦„BKNû^í߬Çw;n-اÅ~•îÄ.úÙÅ潓û W/ùöK×E8{fsä©/rz#å=…×È<‰¸×#Ï3¿Lûf×£´2 Ûú!àkÈquúpº
Ù-~„uù›ü?áà±&Üû; IEND®B`‚ FFI-Platypus-2.12/examples/person.c 000644 000000 000000 00000000732 15251066120 017127 0 ustar 00root root 000000 000000 #include <string.h>
#include <stdlib.h>
typedef struct person_t {
char *name;
unsigned int age;
} person_t;
person_t *
person_new(const char *name, unsigned int age) {
person_t *self = malloc(sizeof(person_t));
self->name = strdup(name);
self->age = age;
}
const char *
person_name(person_t *self) {
return self->name;
}
unsigned int
person_age(person_t *self) {
return self->age;
}
void
person_free(person_t *self) {
free(self->name);
free(self);
}
FFI-Platypus-2.12/examples/person.pl 000644 000000 000000 00000001174 15251066120 017321 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './person.so',
);
$ffi->type( 'opaque' => 'person_t' );
$ffi->attach( person_new => ['string','unsigned int'] => 'person_t' );
$ffi->attach( person_name => ['person_t'] => 'string' );
$ffi->attach( person_age => ['person_t'] => 'unsigned int' );
$ffi->attach( person_free => ['person_t'] );
my $person = person_new( 'Roger Frooble Bits', 35 );
print "name = ", person_name($person), "\n";
print "age = ", person_age($person), "\n";
person_free($person);
FFI-Platypus-2.12/examples/pipe.pl 000644 000000 000000 00000000360 15251066120 016744 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->attach([pipe=>'mypipe'] => ['int[2]'] => 'int');
my @fd = (0,0);
mypipe(\@fd);
my($fd1,$fd2) = @fd;
print "$fd1 $fd2\n";
FFI-Platypus-2.12/examples/puts.pl 000644 000000 000000 00000000256 15251066120 017006 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2, lib => undef );
$ffi->attach( puts => ['string'] => 'int' );
puts("hello world");
FFI-Platypus-2.12/examples/string_reverse.c 000644 000000 000000 00000000553 15251066120 020663 0 ustar 00root root 000000 000000 #include <string.h>
#include <stdlib.h>
const char *
string_reverse(const char *input)
{
static char *output = NULL;
int i, len;
if(output != NULL)
free(output);
if(input == NULL)
return NULL;
len = strlen(input);
output = malloc(len+1);
for(i=0; input[i]; i++)
output[len-i-1] = input[i];
output[len] = '\0';
return output;
}
FFI-Platypus-2.12/examples/string_reverse.pl 000644 000000 000000 00000000373 15251066120 021054 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './string_reverse.so',
);
$ffi->attach( string_reverse => ['string'] => 'string' );
print string_reverse("\nHello world");
string_reverse(undef);
FFI-Platypus-2.12/examples/swap.c 000644 000000 000000 00000000105 15251066120 016565 0 ustar 00root root 000000 000000 void
swap(int *a, int *b)
{
int tmp = *b;
*b = *a;
*a = tmp;
}
FFI-Platypus-2.12/examples/swap.pl 000644 000000 000000 00000000402 15251066120 016756 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './swap.so',
);
$ffi->attach( swap => ['int*','int*'] );
my $a = 1;
my $b = 2;
print "[a,b] = [$a,$b]\n";
swap( \$a, \$b );
print "[a,b] = [$a,$b]\n";
FFI-Platypus-2.12/examples/tcod.pl 000644 000000 000000 00000002011 15251066120 016733 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
my $ffi = FFI::Platypus->new(
api => 2,
lib => [find_lib_or_die lib => 'tcod'],
);
package TCOD::ColorRGB {
use overload
'""' => sub { shift->to_string },
"+" => sub { shift->add(@_) },
bool => sub { 1 },
fallback => 1;
use FFI::Platypus::Record;
record_layout_1(
uint8 => 'r',
uint8 => 'g',
uint8 => 'b',
);
$ffi->type('record(TCOD::ColorRGB)' => 'TCOD_color_t');
$ffi->attach( [ TCOD_color_add => 'add' ] => ['TCOD_color_t','TCOD_color_t'] => 'TCOD_color_t');
sub to_string
{
my($self) = @_;
sprintf "[%02x %02x %02x]",
$self->r,
$self->g,
$self->b;
}
}
$ffi->attach( TCOD_color_RGB => [ 'uint8', 'uint8', 'uint8' ] => 'TCOD_color_t' );
my $red = TCOD_color_RGB(255,0,0);
my $blue = TCOD_color_RGB(0,255,0);
my $purple = $red + $blue;
print "$red\n"; # [ff 00 00]
print "$blue\n"; # [00 00 ff]
print "$purple\n"; # [ff 00 ff]
FFI-Platypus-2.12/examples/time.pl 000644 000000 000000 00000003425 15251066120 016752 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Convert::Binary::C;
use FFI::Platypus 2.00;
use Data::Dumper qw( Dumper );
my $c = Convert::Binary::C->new;
# Alignment of zero (0) means use
# the alignment of your CPU
$c->configure( Alignment => 0 );
# parse the tm record structure so
# that Convert::Binary::C knows
# what to spit out and suck in
$c->parse(<<ENDC);
struct tm {
int tm_sec;
int tm_min;
int tm_hour;
int tm_mday;
int tm_mon;
int tm_year;
int tm_wday;
int tm_yday;
int tm_isdst;
long int tm_gmtoff;
const char *tm_zone;
};
ENDC
# get the size of tm so that we can give it
# to Platypus
my $tm_size = $c->sizeof("tm");
# create the Platypus instance and create the appropriate
# types and functions
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->type("record($tm_size)*" => 'tm');
$ffi->attach( [ localtime => 'my_localtime' ] => ['time_t*'] => 'tm' );
$ffi->attach( [ time => 'my_time' ] => ['tm'] => 'time_t' );
# ===============================================
# get the tm struct from the C localtime function
# note that we pass in a reference to the value that time
# returns because localtime takes a pointer to time_t
# for some reason.
my $time_hashref = $c->unpack( tm => my_localtime(\time) );
# tm_zone comes back from Convert::Binary::C as an opaque,
# cast it into a string. We localize it to just this do
# block so that it will be a pointer when we pass it back
# to C land below.
do {
local $time_hashref->{tm_zone} = $ffi->cast(opaque => string => $time_hashref->{tm_zone});
print Dumper($time_hashref);
};
# ===============================================
# convert the tm struct back into an epoch value
my $time = my_time( $c->pack( tm => $time_hashref ) );
print "time = $time\n";
print "perl time = ", time, "\n";
FFI-Platypus-2.12/examples/time_record.pl 000644 000000 000000 00000001633 15251066120 020307 0 ustar 00root root 000000 000000 use strict;
use warnings;
package Unix::TimeStruct;
use FFI::Platypus 2.00;
use FFI::Platypus::Record;
record_layout_1(qw(
int tm_sec
int tm_min
int tm_hour
int tm_mday
int tm_mon
int tm_year
int tm_wday
int tm_yday
int tm_isdst
long tm_gmtoff
string tm_zone
));
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
# define a record class Unix::TimeStruct and alias it to "tm"
$ffi->type("record(Unix::TimeStruct)*" => 'tm');
# attach the C localtime function as a constructor
$ffi->attach( localtime => ['time_t*'] => 'tm', sub {
my($inner, $class, $time) = @_;
$time = time unless defined $time;
$inner->(\$time);
});
package main;
# now we can actually use our Unix::TimeStruct class
my $time = Unix::TimeStruct->localtime;
printf "time is %d:%d:%d %s\n",
$time->tm_hour,
$time->tm_min,
$time->tm_sec,
$time->tm_zone;
FFI-Platypus-2.12/examples/time_struct.pl 000644 000000 000000 00000002072 15251066120 020353 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::C;
my $ffi = FFI::Platypus->new(
api => 2,
lib => [undef],
);
FFI::C->ffi($ffi);
package Unix::TimeStruct {
FFI::C->struct(tm => [
tm_sec => 'int',
tm_min => 'int',
tm_hour => 'int',
tm_mday => 'int',
tm_mon => 'int',
tm_year => 'int',
tm_wday => 'int',
tm_yday => 'int',
tm_isdst => 'int',
tm_gmtoff => 'long',
_tm_zone => 'opaque',
]);
# For now 'string' is unsupported by FFI::C, but we
# can cast the time zone from an opaque pointer to
# string.
sub tm_zone {
my $self = shift;
$ffi->cast('opaque', 'string', $self->_tm_zone);
}
# attach the C localtime function
$ffi->attach( localtime => ['time_t*'] => 'tm', sub {
my($inner, $class, $time) = @_;
$time = time unless defined $time;
$inner->(\$time);
});
}
# now we can actually use our Unix::TimeStruct class
my $time = Unix::TimeStruct->localtime;
printf "time is %d:%d:%d %s\n",
$time->tm_hour,
$time->tm_min,
$time->tm_sec,
$time->tm_zone;
FFI-Platypus-2.12/examples/var_array.c 000644 000000 000000 00000000211 15251066120 017577 0 ustar 00root root 000000 000000 int
sum(int *array, int size)
{
int total, i;
for (i = 0, total = 0; i < size; i++)
{
total += array[i];
}
return total;
}
FFI-Platypus-2.12/examples/var_array.pl 000644 000000 000000 00000000355 15251066120 020001 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib('./var_array.so');
$ffi->attach( sum => [ 'int[]', 'int' ] => 'int' );
my @list = (1..100);
print sum(\@list, scalar @list), "\n";
FFI-Platypus-2.12/examples/win32_beep.pl 000644 000000 000000 00000000403 15251066120 017742 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
my($freq, $duration) = @_;
$freq ||= 750;
$duration ||= 300;
FFI::Platypus
->new( api => 2, lib=>[undef], lang => 'Win32' )
->function( Beep => ['DWORD','DWORD']=>'BOOL')
->call($freq, $duration);
FFI-Platypus-2.12/examples/win32_getSystemTime.pl 000644 000000 000000 00000003012 15251066120 021631 0 ustar 00root root 000000 000000 # Author : Bakkiaraj M
# Script: Get System time from windows OS using GetLocalTime API.
use strict;
use warnings;
use FFI::CheckLib;
use FFI::Platypus;
use Convert::Binary::C;
#Get the system time using Kernel32.dll
#find the Kernel32.dll
my $libPath = find_lib(lib=>'Kernel32');
#Create FFI Object
my $ffiObj = FFI::Platypus->new();
$ffiObj->lib($libPath);
#Import the GetLocalTime function
$ffiObj->attach('GetLocalTime',['record(16)'],'void');
#Define SYSTEMTIME Struct as per https://msdn.microsoft.com/en-us/library/windows/desktop/ms724950(v=vs.85).aspx
#As per, C:\MinGW\include\windef.h, WORD id unsigned short
my $c = Convert::Binary::C->new->parse(<<ENDC);
struct SYSTEMTIME {
unsigned short wYear;
unsigned short wMonth;
unsigned short wDayOfWeek;
unsigned short wDay;
unsigned short wHour;
unsigned short wMinute;
unsigned short wSecond;
unsigned short wMilliseconds;
};
ENDC
my $dateStruct = {
wYear=>0,
wMonth=>0,
wDayOfWeek=>0,
wDay=>0,
wHour=>0,
wMinute=>0,
wSecond=>0,
wMilliseconds=>0,
};
my $packed = $c->pack('SYSTEMTIME', $dateStruct);
#Call the function by passing the structure reference
GetLocalTime($packed);
if (defined ($packed))
{
#Unpack the structure
my $sysDate = $c->unpack('SYSTEMTIME', $packed);
print "\n WINDOWS SYSTEM TIME: ",$$sysDate{'wHour'},':',$$sysDate{'wMinute'},':',$$sysDate{'wSecond'},'.',$$sysDate{'wMilliseconds'},' ',$$sysDate{'wDay'},'/',$$sysDate{'wMonth'},'/',$$sysDate{'wYear'}, "\n";
}
else
{
print "\n Something is wrong\n";
}
exit 0;
FFI-Platypus-2.12/examples/win32_messagebox.pl 000644 000000 000000 00000001030 15251066120 021161 0 ustar 00root root 000000 000000 use strict;
use warnings;
use utf8;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => [undef],
);
# see FFI::Platypus::Lang::Win32
$ffi->lang('Win32');
# Send a Unicode string to the Windows API MessageBoxW function.
use constant MB_OK => 0x00000000;
use constant MB_DEFAULT_DESKTOP_ONLY => 0x00020000;
$ffi->attach( [MessageBoxW => 'MessageBox'] => [ 'HWND', 'LPCWSTR', 'LPCWSTR', 'UINT'] => 'int' );
MessageBox(undef, "I â¤ï¸ Platypus", "Confession", MB_OK|MB_DEFAULT_DESKTOP_ONLY);
FFI-Platypus-2.12/examples/win32_messagebox.png 000644 000000 000000 00000010461 15251066120 021342 0 ustar 00root root 000000 000000 ‰PNG
IHDR Á ô "õB‚ sRGB ®Î é gAMA ± üa pHYs % %IR$ð ÆIDATx^íOL G‡ß8v¢ ¢’hs´ae{9˜"¸Z8‚XŠ72hO–O°Îa…>pð‰ @{ñ2''—•Œ9R#Ž Š½±Ä؃ñ!Š´’8¯Ï¾W]ÕSÝÓó<Ì¿÷û’¢º«{†nó¾ªWÕƒ¢OŸåÈ`+G.¶ R¬ €F"eë©x{Šÿ3x]ün?Ö^T êHBGk‹w Kð4ˆærÁ_ô8 D±`/.C A$À½àÛãµàoÐ(øA |#D¬IQß/šeÓî¼}?è ä ðƒÝá=—ÈÈl{HÅ%üR,E¥ðÎ nøÁíj.BøíA±ØàNÀ´½–
[¤²µÁß ^H@[
zûC m\¬y r~ ˾ÛævsL}[‡"Äk j‰ ÜRÙ 7¸6–Àlsñ·í~‚ôRÿ 컑ÀÕ.Ø!h$˜½:±Ç·oŽÉ¨ð–wì-þÚ·ž‹ äD€×tºýßÁ> -Àãÿžá¯V‚P3<¶K¤V7
°§?xH?ÿ0Îû 47ülŽ ¿ìæ-þC‡ƒÚŒ‡D ÁOe$õ±€V"÷ :ø âþP$·7Û®@Ðbˆ"€).Æ_ÇG_×@‹
¿‹q+ƒÅW h%L:dƒße=\ç%ˆ½=€VÂÌuy$ˆˆ`F?àýÚmÐ*¸à—ZŠàA @‹aF?®ƒíÂ9AX hE
c;&D FRLGÒ! 4°§‘ @ H Ô @MÈd2ôòåK»Wr¾¼î iY ¶–3æ0“Y¦-ÛêÇ—_~Iw¿û®bä<9_^wФ¨w§ËòAž Ùå^™rú£§oôû;îÐüƒm»çh§Þ‘‹t¦Íî Á÷m£Á±³tܶ <;ôèÎ<= ^¹x†ðöšØ¾ø‚>üðCÛZH¥çíóû¿þ»ýw¸¼ËåmŽþ#\ ÔH°EËÜ 8Fc^ì´§ ;ôb“Åë쨡 $ %°K!@9@`‰6;9è {âãgvp´· µ[µ¢Î\dÑ1
”¤”õ@¨º;~¢Mê¤Á³è‡A2I"ÔK ¡Ês›·ñ(° d»´iw ,Ql1çìp¾}–hyþ¹™F{ï]tCËÖ2e¢oÄoå]ËÎ#ºã½–_\¿\‹ÿz¦Ôñð˽ç~ï¯Åðÿ (5'¨®6Èxæ[áΦN±` ‚&:É?×}çàåã4q³3v
×6ibË×·Lt¶¢ãö# Äýµµj>1n;ê~Ü¥ÙZ. áøÙêmߦ㋛ 8g½s÷ðyD›ÏË-‚r /sïʽv^ Îá?áYúæOôhGöwi[æÓŸø×r< ðòÇ ©Ýý5'ñ‘À¥Fµ¦ŽÏ ¶è9÷|íÇ"ÐFÇ:ÍOŸÏòhï¤c‘“ÛÈø¶³Ëa^‚,Åöh;‡Ý6mïš žLó·\ºc¥ˆSîxœÞ_ ê)Bu%h;j~à;»oþ#«t4Ù ›Kîš-þü€¯\Vw;¹‡ž·Ç—ý-w|o Äý5 I)P=E¨òHpœ:8ÃØÞ|ñÆ=W5DŠ#¹µÿÌÂ?£9~Ö¶ôRûæeî<ŠÜK¹ã•r÷× $ ਗUO‡Ž÷ppl? å²9C)aªüÀ«íÙÇ zî¶3tQžìmoÒ‹¤[)w¼–÷×$”ÀQª?'°Á±ý`>±—ÜZÎçÔN˜ùØy[Ëóô`»šÏÜ$x‰¢Ì-‡ß[Vz¢’lI½ÍÓË /¤v÷×øT"€£Ö" àg‡ì’b>é¶Ä×ÈÎKXQ)\~ (lÞ¯`‰THxŽ_~´Ë™¦Õ¹ŽrÇ‹]cµï¯9‘9”|®œ >"À·ß~kÒÏ7¥vÏ hPêð: šH Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ W⟠ƒ@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨§ñ%Èf)»¸ÈUÖ6Ä)w €Ò4¬ÙÅqH¥(ÕÕE—¦†©‹ëTj€Æm°gi|€§º¨kxÊ OÑÀ8 œ@E4¤ÙÙì5ê^Ø \.G++9So,tÓÚp: Ò5LkÝ ´Áí¹ÜŠ9žÛX î5f`¶ª",Ž³l,hMj#Av–{õš$2ùÜKW‰f6Vhn(mÒCs´"žÉAVæ†(rFzˆæV6h†®Ò¥J¾62zÄË@EZ ©ø½àNãÓp#Áâ«´:v&¢ñŸG{ý¸ yÒ4q}ŒV¯Þà0¬„1Z0£‰-3DW9µzÓèÍ>£5» ›“ KÏ8rÆ. Ùý}2tC{ží§COOÐÊÂQfª²‘ 4=
;1nl²4k&å^ñF™Ó¤ºxDãíÌpp\›¹EÂ|Åoç &… ^+%ž¢%ÏS‚늞¤eáu¦Æ+ !õÐ`¤éD7ÑÚ¾ºp“ŠtÓ‰bS²2 •zýâ
zr=šBõg†ÃàKOðD]Úx{l!8‡§/<@ñ³z›¾ÜÞ"ÝÍõžÏÏoÖ¦hàÑ7±mïs‘b˜2c áµnÌœ´Ç€£áF ”Êóùd‚yÅÚWRœ宫«Ô?søëy‚.A Â)OChõɆm(‚IÓVé¶oÁâ]Êpëu´ÚM×W&òRðû3Ó¿÷?—ì÷t›‡#?½LOLìïÏ¥…i¼tˆla,CÃû ¶Çh8ÓÝH”–B¾——. ¯ÑÌFŽVŠÎÌ Ñ”h˜{s Â
R(CdO–EâÂöŸ¤.»éHŸ å‘eóœô Ï$%C
TŠ†œ ÍmìK„@€nZؘÛCo[ Ê_™²˜|<ÕE·GƒçRd.] &%Êܵ÷¤B Ý'¢K¿ûFVÒ6h¦ß‰^á2µ2tbœÞ³ªAÉð„uJ—sýò£EC×LPÞ•›²©PE‹aOÌD{ï¤iÂ>l\[å©DˆÓ •‹P3Búéd$_ –v+#MçGûy0X4©PâÜ# )ò˜´©”Îû÷O¿ì Cs fNRnꢖ@(/BÍ0y6÷¨7òW³8ÞE<—Žbóñ¤•.“ßg¦hjŸF#Qíàûõ—?y².sŽ±ëùÉr°Òt•ò—Ás”KÁ²lZã~·oFž¸À Á%Š‹Pû@à<Û.‰ºIñÔI¹>{8„ÏãÆUyúÌçD–ôÓçi´•6Ö³;ÆhãäTøþ)6@Ò¯È\hŽ6fxD±Ï!dŽòäºäÿö¸eÍ~ÿà}dÒ_~Σõ®åˆ^å¸ÐïA{eÊéžÒÏ?ŒgÖ¬éqÍÊOnŽ¨.T YY
&Öñy…Lº‡ir¯nJ8ýÙßiý׹ۇ˻\Þæè?Âåp3ŒD%Éf€1¹{±TÔš&’@p"ðhЬ0e?$jJ“I ˆÍ)€ùL‘ŒbHwŠ&” y1Ÿ)’‡k%š+} T H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@ žõ®åˆ^å¸ÐïA{eÊéžÒ¿nÿ98€&f`ô ´þëÇÜí¿Ãå].osô ár# ¨ õ@ H Ô €z P$ ê@= ¨ õ@ H Ô €zšö£Ôï¿ÿ¾ÝÍÈW_}EÓÓÓvïà)õQꦖà—_~±{ ™X^^¦ ü¼)N‚÷Þ{϶€fáîÝ»
%æ@= ¨ õ@ H Ô €z P$ ê@= ¨ õ@‚º±DGÒÑH9G7ŸÛÃ>K|l‚_åùÍsæuç_*Ô xGh}ú!íîîæËü)šì©0¨YŒžÉûty~—î]é°`?@‚Zóü&ý¥Xðβ—éþdMÄ»} Fn™÷˜ ´m`ß@‚³ô·Iºß7M-¼,{@·nܤÄñ€%:Çôñ(ª$¨)KôÏ[D}úŒJ%0'úˆî?£M»Ÿ‡ç=“D, R ê jÉó,su*]:€;Ò§øë:e#CÁ:Ý87B·.ÏC€* š[7’WÀ¾µ¤#M¦vñ<Ïšñ‚¢Æ)ºvï!M÷ݧɞÂåR° AMé¤ Ý/Ìö}6ŸÝ'ºü9Î{;èʽyºL·hä\‘‰3Ø3 ¦p_“¥Ÿ‘âK K4“çËŸ]>¢Ù]áþ$õ@„ª jÍà,=œîc
Š™‡h-²§©OD(ù@T$¨ WîÑ.÷æ§&{ìÇ%‚Ò3yŠæw+|Üq…î™
#t# ꆤ5ÞG&L™M˜0ò$9é˜iç×Ý»Rò¹(
$ ê@= ¨ õ@ H Ô €z P$ ê@= ¨§©ÿͲ¯¿þÚîfÿp_˜œœ´[ Y Ôüë• ” õ@ H Ô €z P$ ê@= ¨ e¤l§„…'ÐÜ$Åt*.œä
Hal{ÄBÐb¤’cœ%
wЯÝ6 Ç´ˆ`dpñí§CKü“ h’ãºpNàL‰H@+àbZê||[ âó' ÐZx1n;ûCù ß6ú'ÐJ˜¶± ÆzÁH ¸m¿
€V@ÖòÁïêõç‚ß/Îq‘ß/–Z~×ø7:ýÁ#9€–àñ:8â° òûÅRsyK$xÂQ/ÿû"üf‹ÈðŠ›þ—ß7‚H-çJek ꉟև5—”ôþ’ðO‡ä—ëó¿d üm‰È¾ü6è¾ rW·6 PCâÁϘM+ ~I…IÐçƒßòG)¦W—"Aîük"üëX¤Í@£ádà‰`dÑ ~×f%l`8ØͶëõ fÛ %p5 õÄ þ°–à·µ™»ÔH‚?_{6¸#"$8p5 € œ VÓ&/"ȶ!Åÿ}ú4—jÁn‡A/µlZB¼×D^@)z‡Û–šK(‚lÛÚ| „‚@–}Ûf| ht‚ ë0ð];Ãb°Ï8Ò=JÉ ×Í@dtâBä[ „Xp
vH š¸–9< •Ê @Qtd¦ÊvÓ!û®HÅu©@#›~ NòŠƒèÿ}fýùX‘]+ IEND®B`‚ FFI-Platypus-2.12/examples/xor_cipher.c 000644 000000 000000 00000000663 15251066120 017766 0 ustar 00root root 000000 000000 #include <string.h>
#include <stdlib.h>
char *
string_crypt(const char *input, int len, const char *key)
{
char *output;
int i, n;
if(input == NULL)
return NULL;
output = malloc(len+1);
output[len] = '\0';
for(i=0, n=0; i<len; i++, n++) {
if(key[n] == '\0')
n = 0;
output[i] = input[i] ^ key[n];
}
return output;
}
void
string_crypt_free(char *output)
{
if(output != NULL)
free(output);
}
FFI-Platypus-2.12/examples/xor_cipher.pl 000644 000000 000000 00000001325 15251066120 020153 0 ustar 00root root 000000 000000 use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::Platypus::Buffer qw( buffer_to_scalar );
use YAML ();
my $ffi = FFI::Platypus->new(
api => 2,
lib => './xor_cipher.so',
);
$ffi->attach( string_crypt_free => ['opaque'] );
$ffi->attach( string_crypt => ['string','int','string'] => 'opaque' => sub{
my($xsub, $input, $key) = @_;
my $ptr = $xsub->($input, length($input), $key);
my $output = buffer_to_scalar $ptr, length($input);
string_crypt_free($ptr);
return $output;
});
my $orig = "hello world";
my $key = "foobar";
print YAML::Dump($orig);
my $encrypted = string_crypt($orig, $key);
print YAML::Dump($encrypted);
my $decrypted = string_crypt($encrypted, $key);
print YAML::Dump($decrypted);
FFI-Platypus-2.12/examples/zmq3.pl 000644 000000 000000 00000004260 15251066120 016704 0 ustar 00root root 000000 000000 use strict;
use warnings;
use constant ZMQ_IO_THREADS => 1;
use constant ZMQ_MAX_SOCKETS => 2;
use constant ZMQ_REQ => 3;
use constant ZMQ_REP => 4;
use FFI::CheckLib qw( find_lib_or_die );
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( malloc );
use FFI::Platypus::Buffer qw( scalar_to_buffer window );
my $endpoint = "ipc://zmq-ffi-$$";
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die lib => 'zmq',
);
$ffi->attach(zmq_version => ['int*', 'int*', 'int*'] => 'void');
my($major,$minor,$patch);
zmq_version(\$major, \$minor, \$patch);
print "libzmq version $major.$minor.$patch\n";
die "this script only works with libzmq 3 or better" unless $major >= 3;
$ffi->type('opaque' => 'zmq_context');
$ffi->type('opaque' => 'zmq_socket');
$ffi->type('opaque' => 'zmq_msg_t');
$ffi->attach(zmq_ctx_new => [] => 'zmq_context');
$ffi->attach(zmq_ctx_set => ['zmq_context', 'int', 'int'] => 'int');
$ffi->attach(zmq_socket => ['zmq_context', 'int'] => 'zmq_socket');
$ffi->attach(zmq_connect => ['opaque', 'string'] => 'int');
$ffi->attach(zmq_bind => ['zmq_socket', 'string'] => 'int');
$ffi->attach(zmq_send => ['zmq_socket', 'opaque', 'size_t', 'int'] => 'int');
$ffi->attach(zmq_msg_init => ['zmq_msg_t'] => 'int');
$ffi->attach(zmq_msg_recv => ['zmq_msg_t', 'zmq_socket', 'int'] => 'int');
$ffi->attach(zmq_msg_data => ['zmq_msg_t'] => 'opaque');
$ffi->attach(zmq_errno => [] => 'int');
$ffi->attach(zmq_strerror => ['int'] => 'string');
my $context = zmq_ctx_new();
zmq_ctx_set($context, ZMQ_IO_THREADS, 1);
my $socket1 = zmq_socket($context, ZMQ_REQ);
zmq_connect($socket1, $endpoint);
my $socket2 = zmq_socket($context, ZMQ_REP);
zmq_bind($socket2, $endpoint);
{ # send
our $sent_message = "hello there";
my($pointer, $size) = scalar_to_buffer $sent_message;
my $r = zmq_send($socket1, $pointer, $size, 0);
die zmq_strerror(zmq_errno()) if $r == -1;
}
{ # recv
my $msg_ptr = malloc 100;
zmq_msg_init($msg_ptr);
my $size = zmq_msg_recv($msg_ptr, $socket2, 0);
die zmq_strerror(zmq_errno()) if $size == -1;
my $data_ptr = zmq_msg_data($msg_ptr);
window(my $recv_message, $data_ptr, $size);
print "recv_message = $recv_message\n";
}
FFI-Platypus-2.12/ffi/ 000755 000000 000000 00000000000 15251066120 014401 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/ffi/constant.c 000644 000000 000000 00000001172 15251066120 016377 0 ustar 00root root 000000 000000 #include <ffi_platypus_bundle.h>
#ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
EXPORT
ffi_platypus_constant_t *
ffi_platypus_constant__new(void* set_str,
void* set_sint,
void* set_uint,
void* set_double)
{
ffi_platypus_constant_t *self = malloc(sizeof(ffi_platypus_constant_t));
self->set_str = set_str;
self->set_sint = set_sint;
self->set_uint = set_uint;
self->set_double = set_double;
return self;
}
EXPORT
void
ffi_platypus_constant__DESTROY(ffi_platypus_constant_t *self)
{
free(self);
}
FFI-Platypus-2.12/ffi/memory.c 000644 000000 000000 00000001665 15251066120 016065 0 ustar 00root root 000000 000000 #include <string.h>
#include <stdlib.h>
/*
* strdup and strndup are useful, but technically not part of the
* C standard, and thus may be missing from some environments.
* If libc provides these functions then it will use them,
* otherwise it will fallback on these implementations.
*/
#ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
EXPORT
char *
ffi_platypus_memory__strdup(const char *olds)
{
char *news;
size_t size;
size = strlen(olds)+1;
news = malloc(size);
if(news != NULL)
{
memcpy(news, olds, size);
}
return news;
}
EXPORT
char *
ffi_platypus_memory__strndup(const char *olds, size_t max)
{
char *news;
size_t size;
#ifdef FFI_PL_PROBE_STRNLEN
size = strnlen(olds, max);
#else
for(size=0; size <max && olds[size] != '\0'; size++)
;
#endif
news = malloc(size+1);
if(news != NULL)
{
news[size] = '\0';
memcpy(news, olds, size);
}
return news;
}
FFI-Platypus-2.12/ffi/record_meta.c 000644 000000 000000 00000004420 15251066120 017031 0 ustar 00root root 000000 000000 #include <ffi_platypus.h>
#ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
/*
* Question: this is the documented way of creating a struct type.
* we already compute the size and alignment for the Perl interface
* to the members, can we use that instead?
*/
EXPORT
ffi_pl_record_meta_t *
ffi_platypus_record_meta__new(ffi_type *list[], int safe_to_return_from_closure)
{
int size, i;
ffi_pl_record_meta_t *t;
for(size=0; list[size] != NULL; size++)
;
t = malloc(sizeof(ffi_pl_record_meta_t) + sizeof(ffi_type*)*(size+1) );
if(t == NULL)
return NULL;
t->ffi_type.size = 0;
t->ffi_type.alignment = 0;
t->ffi_type.type = FFI_TYPE_STRUCT;
t->ffi_type.elements = (ffi_type**) &t->elements;
t->can_return_from_closure = safe_to_return_from_closure;
for(i=0; i<size+1; i++)
{
t->elements[i] = list[i];
}
return t;
}
EXPORT
ffi_type *
ffi_platypus_record_meta__ffi_type(ffi_pl_record_meta_t *t)
{
return &t->ffi_type;
}
EXPORT
size_t
ffi_platypus_record_meta__size(ffi_pl_record_meta_t *t)
{
return t->ffi_type.size;
}
EXPORT
unsigned short
ffi_platypus_record_meta__alignment(ffi_pl_record_meta_t *t)
{
return t->ffi_type.alignment;
}
EXPORT
ffi_type **
ffi_platypus_record_meta__element_pointers(ffi_pl_record_meta_t *t)
{
return t->ffi_type.elements;
}
EXPORT
void
ffi_platypus_record_meta__DESTROY(ffi_pl_record_meta_t *t)
{
free(t);
}
EXPORT
ffi_type *
ffi_platypus_record_meta___find_symbol(const char *name)
{
if(!strcmp(name, "sint8"))
return &ffi_type_sint8;
else if(!strcmp(name, "sint16"))
return &ffi_type_sint16;
else if(!strcmp(name, "sint32"))
return &ffi_type_sint32;
else if(!strcmp(name, "sint64"))
return &ffi_type_sint64;
else if(!strcmp(name, "uint8"))
return &ffi_type_uint8;
else if(!strcmp(name, "uint16"))
return &ffi_type_uint16;
else if(!strcmp(name, "uint32"))
return &ffi_type_uint32;
else if(!strcmp(name, "uint64"))
return &ffi_type_uint64;
else if(!strcmp(name, "pointer"))
return &ffi_type_pointer;
else if(!strcmp(name, "float"))
return &ffi_type_float;
else if(!strcmp(name, "double"))
return &ffi_type_double;
/* TODO: longdouble, complex_float, complex_duble, complex_longdouble */
else
return NULL;
}
FFI-Platypus-2.12/inc/ 000755 000000 000000 00000000000 15251066120 014406 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/inc/Alien/ 000755 000000 000000 00000000000 15251066120 015436 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/inc/Alien/Base/ 000755 000000 000000 00000000000 15251066120 016310 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/inc/Alien/Base/Wrapper.pm 000644 000000 000000 00000032325 15251066120 020273 0 ustar 00root root 000000 000000 package Alien::Base::Wrapper;
use strict;
use warnings;
use 5.006;
use Config;
use Text::ParseWords qw( shellwords );
# NOTE: Although this module is now distributed with Alien-Build,
# it should have NO non-perl-core dependencies for all Perls
# 5.6.0-5.30.1 (as of this writing, and any Perl more recent).
# You should be able to extract this module from the rest of
# Alien-Build and use it by itself. (There is a dzil plugin
# for this [AlienBase::Wrapper::Bundle]
# ABSTRACT: Compiler and linker wrapper for Alien
our $VERSION = '2.84'; # VERSION
sub _join
{
join ' ',
map {
my $x = $_;
$x =~ s/(\s)/\\$1/g;
$x;
} @_;
}
sub new
{
my($class, @aliens) = @_;
my $export = 1;
my $writemakefile = 0;
my @cflags_I;
my @cflags_other;
my @ldflags_L;
my @ldflags_l;
my @ldflags_other;
my %requires = (
'ExtUtils::MakeMaker' => '6.52',
'Alien::Base::Wrapper' => '1.97',
);
foreach my $alien (@aliens)
{
if($alien eq '!export')
{
$export = 0;
next;
}
if($alien eq 'WriteMakefile')
{
$writemakefile = 1;
next;
}
my $version = 0;
if($alien =~ s/=(.*)$//)
{
$version = $1;
}
$alien = "Alien::$alien" unless $alien =~ /::/;
$requires{$alien} = $version;
my $alien_pm = $alien . '.pm';
$alien_pm =~ s/::/\//g;
require $alien_pm unless eval { $alien->can('cflags') } && eval { $alien->can('libs') };
my $cflags;
my $libs;
if($alien->install_type eq 'share' && $alien->can('cflags_static'))
{
$cflags = $alien->cflags_static;
$libs = $alien->libs_static;
}
else
{
$cflags = $alien->cflags;
$libs = $alien->libs;
}
$cflags = '' unless defined $cflags;
$libs = '' unless defined $libs;
push @cflags_I, grep /^-I/, shellwords $cflags;
push @cflags_other, grep !/^-I/, shellwords $cflags;
push @ldflags_L, grep /^-L/, shellwords $libs;
push @ldflags_l, grep /^-l/, shellwords $libs;
push @ldflags_other, grep !/^-[Ll]/, shellwords $libs;
}
my @cflags_define = grep /^-D/, @cflags_other;
my @cflags_other2 = grep !/^-D/, @cflags_other;
my @mm;
push @mm, INC => _join @cflags_I if @cflags_I;
push @mm, CCFLAGS => _join(@cflags_other2) . " $Config{ccflags}" if @cflags_other2;
push @mm, DEFINE => _join(@cflags_define) if @cflags_define;
# TODO: handle spaces in -L paths
push @mm, LIBS => ["@ldflags_L @ldflags_l"];
my @ldflags = (@ldflags_L, @ldflags_other);
push @mm, LDDLFLAGS => _join(@ldflags) . " $Config{lddlflags}" if @ldflags;
push @mm, LDFLAGS => _join(@ldflags) . " $Config{ldflags}" if @ldflags;
my @mb;
push @mb, extra_compiler_flags => _join(@cflags_I, @cflags_other);
push @mb, extra_linker_flags => _join(@ldflags_l);
if(@ldflags)
{
push @mb, config => {
lddlflags => _join(@ldflags) . " $Config{lddlflags}",
ldflags => _join(@ldflags) . " $Config{ldflags}",
},
}
bless {
cflags_I => \@cflags_I,
cflags_other => \@cflags_other,
ldflags_L => \@ldflags_L,
ldflags_l => \@ldflags_l,
ldflags_other => \@ldflags_other,
mm => \@mm,
mb => \@mb,
_export => $export,
_writemakefile => $writemakefile,
requires => \%requires,
}, $class;
}
my $default_abw = __PACKAGE__->new;
# for testing only
sub _reset { __PACKAGE__->new }
sub _myexec
{
my @command = @_;
if($^O eq 'MSWin32')
{
# To handle weird quoting on MSWin32
# this logic needs to be improved.
my $command = "@command";
$command =~ s{"}{\\"}g;
system $command;
if($? == -1 )
{
die "failed to execute: $!\n";
}
elsif($? & 127)
{
die "child died with signal @{[ $? & 128 ]}";
}
else
{
exit($? >> 8);
}
}
else
{
exec @command;
}
}
sub cc
{
my @command = (
shellwords($Config{cc}),
@{ $default_abw->{cflags_I} },
@{ $default_abw->{cflags_other} },
@ARGV,
);
print "@command\n" unless $ENV{ALIEN_BASE_WRAPPER_QUIET};
_myexec @command;
}
sub ld
{
my @command = (
shellwords($Config{ld}),
@{ $default_abw->{ldflags_L} },
@{ $default_abw->{ldflags_other} },
@ARGV,
@{ $default_abw->{ldflags_l} },
);
print "@command\n" unless $ENV{ALIEN_BASE_WRAPPER_QUIET};
_myexec @command;
}
sub mm_args
{
my $self = ref $_[0] ? shift : $default_abw;
@{ $self->{mm} };
}
sub mm_args2
{
my $self = shift;
$self = $default_abw unless ref $self;
my %args = @_;
my @mm = @{ $self->{mm} };
while(@mm)
{
my $key = shift @mm;
my $value = shift @mm;
if(defined $args{$key})
{
if($args{$key} eq 'LIBS')
{
require Carp;
# Todo: support this maybe?
Carp::croak("please do not specify your own LIBS key with mm_args2");
}
else
{
$args{$key} = join ' ', $value, $args{$key};
}
}
else
{
$args{$key} = $value;
}
}
foreach my $module (keys %{ $self->{requires} })
{
$args{CONFIGURE_REQUIRES}->{$module} = $self->{requires}->{$module};
}
%args;
}
sub mb_args
{
my $self = ref $_[0] ? shift : $default_abw;
@{ $self->{mb} };
}
sub import
{
shift;
my $abw = $default_abw = __PACKAGE__->new(@_);
if($abw->_export)
{
my $caller = caller;
no strict 'refs';
*{"${caller}::cc"} = \&cc;
*{"${caller}::ld"} = \&ld;
}
if($abw->_writemakefile)
{
my $caller = caller;
no strict 'refs';
*{"${caller}::WriteMakefile"} = \&WriteMakefile;
}
}
sub WriteMakefile
{
my %args = @_;
require ExtUtils::MakeMaker;
ExtUtils::MakeMaker->VERSION('6.52');
my @aliens;
if(my $reqs = delete $args{alien_requires})
{
if(ref $reqs eq 'HASH')
{
@aliens = map {
my $module = $_;
my $version = $reqs->{$module};
$version ? "$module=$version" : "$module";
} sort keys %$reqs;
}
elsif(ref $reqs eq 'ARRAY')
{
@aliens = @$reqs;
}
else
{
require Carp;
Carp::croak("aliens_require must be either a hash or array reference");
}
}
else
{
require Carp;
Carp::croak("You are using Alien::Base::Wrapper::WriteMakefile, but didn't specify any alien requirements");
}
ExtUtils::MakeMaker::WriteMakefile(
Alien::Base::Wrapper->new(@aliens)->mm_args2(%args),
);
}
sub _export { shift->{_export} }
sub _writemakefile { shift->{_writemakefile} }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Base::Wrapper - Compiler and linker wrapper for Alien
=head1 VERSION
version 2.84
=head1 SYNOPSIS
From the command line:
% perl -MAlien::Base::Wrapper=Alien::Foo,Alien::Bar -e cc -- -o foo.o -c foo.c
% perl -MAlien::Base::Wrapper=Alien::Foo,Alien::Bar -e ld -- -o foo foo.o
From Makefile.PL (static):
use ExtUtils::MakeMaker;
use Alien::Base::Wrapper ();
WriteMakefile(
Alien::Base::Wrapper->new( 'Alien::Foo', 'Alien::Bar')->mm_args2(
'NAME' => 'Foo::XS',
'VERSION_FROM' => 'lib/Foo/XS.pm',
),
);
From Makefile.PL (static with wrapper)
use Alien::Base::Wrapper qw( WriteMakefile);
WriteMakefile(
'NAME' => 'Foo::XS',
'VERSION_FROM' => 'lib/Foo/XS.pm',
'alien_requires' => {
'Alien::Foo' => 0,
'Alien::Bar' => 0,
},
);
From Makefile.PL (dynamic):
use Devel::CheckLib qw( check_lib );
use ExtUtils::MakeMaker 6.52;
my @mm_args;
my @libs;
if(check_lib( lib => [ 'foo' ] )
{
push @mm_args, LIBS => [ '-lfoo' ];
}
else
{
push @mm_args,
CC => '$(FULLPERL) -MAlien::Base::Wrapper=Alien::Foo -e cc --',
LD => '$(FULLPERL) -MAlien::Base::Wrapper=Alien::Foo -e ld --',
BUILD_REQUIRES => {
'Alien::Foo' => 0,
'Alien::Base::Wrapper' => 0,
}
;
}
WriteMakefile(
'NAME' => 'Foo::XS',
'VERSION_FROM' => 'lib/Foo/XS.pm',
'CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => 6.52,
},
@mm_args,
);
=head1 DESCRIPTION
This module acts as a wrapper around one or more L<Alien> modules. It is designed to work
with L<Alien::Base> based aliens, but it should work with any L<Alien> which uses the same
essential API.
In the first example (from the command line), this class acts as a wrapper around the
compiler and linker that Perl is configured to use. It takes the normal compiler and
linker flags and adds the flags provided by the Aliens specified, and then executes the
command. It will print the command to the console so that you can see exactly what is
happening.
In the second example (from Makefile.PL non-dynamic), this class is used to generate the
appropriate L<ExtUtils::MakeMaker> (EUMM) arguments needed to C<WriteMakefile>.
In the third example (from Makefile.PL dynamic), we do a quick check to see if the simple
linker flag C<-lfoo> will work, if so we use that. If not, we use a wrapper around the
compiler and linker that will use the alien flags that are known at build time. The
problem that this form attempts to solve is that compiler and linker flags typically
need to be determined at I<configure> time, when a distribution is installed, meaning
if you are going to use an L<Alien> module then it needs to be a configure prerequisite,
even if the library is already installed and easily detected on the operating system.
The author of this module believes that the third (from Makefile.PL dynamic) form is
somewhat unnecessary. L<Alien> modules based on L<Alien::Base> have a few prerequisites,
but they are well maintained and reliable, so while there is a small cost in terms of extra
dependencies, the overall reliability thanks to reduced overall complexity.
=head1 CONSTRUCTOR
=head2 new
my $abw = Alien::Base::Wrapper->new(@aliens);
Instead of passing the aliens you want to use into this modules import you can create
a non-global instance of C<Alien::Base::Wrapper> using the OO interface.
=head1 FUNCTIONS
=head2 cc
% perl -MAlien::Base::Wrapper=Alien::Foo -e cc -- cflags
Invoke the C compiler with the appropriate flags from C<Alien::Foo> and what
is provided on the command line.
=head2 ld
% perl -MAlien::Base::Wrapper=Alien::Foo -e ld -- ldflags
Invoke the linker with the appropriate flags from C<Alien::Foo> and what
is provided on the command line.
=head2 mm_args
my %args = $abw->mm_args;
my %args = Alien::Base::Wrapper->mm_args;
Returns arguments that you can pass into C<WriteMakefile> to compile/link against
the specified Aliens. Note that this does not set C<CONFIGURE_REQUIRES>. You
probably want to use C<mm_args2> below instead for that reason.
=head2 mm_args2
my %args = $abw->mm_args2(%args);
my %args = Alien::Base::Wrapper->mm_args2(%args);
Returns arguments that you can pass into C<WriteMakefile> to compile/link against. It works
a little differently from C<mm_args> above in that you can pass in arguments. It also adds
the appropriate C<CONFIGURE_REQUIRES> for you so you do not have to do that explicitly.
=head2 mb_args
my %args = $abw->mb_args;
my %args = Alien::Base::Wrapper->mb_args;
Returns arguments that you can pass into the constructor to L<Module::Build>.
=head2 WriteMakefile
use Alien::Base::Wrapper qw( WriteMakefile );
WriteMakefile(%args, alien_requires => \%aliens);
WriteMakefile(%args, alien_requires => \@aliens);
This is a thin wrapper around C<WriteMakefile> from L<ExtUtils::MakeMaker>, which adds the
given aliens to the configure requirements and sets the appropriate compiler and linker
flags.
If the aliens are specified as a hash reference, then the keys are the module names and the
values are the versions. For a list it is just the name of the aliens.
For the list form you can specify a version by appending C<=version> to the name of the
Aliens, that is:
WriteMakefile(
alien_requires => [ 'Alien::libfoo=1.23', 'Alien::libbar=4.56' ],
);
The list form is recommended if the ordering of the aliens matter. The aliens are sorted in
the hash form to make it consistent, but it may not be the order that you want.
=head1 ENVIRONMENT
Alien::Base::Wrapper responds to these environment variables:
=over 4
=item ALIEN_BASE_WRAPPER_QUIET
If set to true, do not print the command before executing
=back
=head1 SEE ALSO
L<Alien::Base>, L<Alien::Base>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr PÃsaÅ™ (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José JoaquÃn Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/inc/Alien/FFI/ 000755 000000 000000 00000000000 15251066120 016042 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/inc/Alien/FFI/PkgConfigPP.pm 000644 000000 000000 00000001202 15251066120 020502 0 ustar 00root root 000000 000000 package Alien::FFI::PkgConfigPP;
use strict;
use warnings;
our $VERBOSE = !!$ENV{V};
my $pkg;
sub _pkg
{
$pkg ||= eval {
require PkgConfig;
my $pkg = PkgConfig->find('libffi');
die $pkg->errmsg if $pkg->errmsg;
$pkg;
};
die "libffi not found" unless $pkg;
$pkg;
}
sub exists
{
!!eval { _pkg };
}
sub version {
_pkg->pkg_version;
}
sub config
{
my($class, $key) = @_;
die "unimplemented for $key" unless $key eq 'version';
$class->version;
}
sub cflags
{
scalar _pkg->get_cflags;
}
sub libs
{
scalar _pkg->get_ldflags;
}
sub install_type { return 'system' }
sub runtime_prop { return {} }
1;
FFI-Platypus-2.12/inc/Alien/FFI/Vcpkg.pm 000644 000000 000000 00000000777 15251066120 017465 0 ustar 00root root 000000 000000 package Alien::FFI::Vcpkg;
use strict;
use warnings;
my $pkg;
sub vcpkg
{
$pkg ||= do {
require Win32::Vcpkg::List;
Win32::Vcpkg::List->new->search('libffi');
};
}
sub exists
{
!!vcpkg();
}
sub version
{
vcpkg->version;
}
sub config
{
my($class, $key) = @_;
die "unimplemented for $key" unless $key eq 'version';
$class->version;
}
sub cflags
{
scalar vcpkg->cflags;
}
sub libs
{
scalar vcpkg->libs;
}
sub install_type { return 'system' }
sub runtime_prop { return {} }
1;
FFI-Platypus-2.12/inc/Alien/FFI/pkgconfig.pm 000644 000000 000000 00000003473 15251066120 020356 0 ustar 00root root 000000 000000 package Alien::FFI::pkgconfig;
use strict;
use warnings;
use Config;
use IPC::Cmd ();
use Capture::Tiny qw( capture );
use Env qw( @PKG_CONFIG_PATH );
use File::Glob qw( bsd_glob );
our $VERBOSE = !!$ENV{V};
sub pkg_config_exe
{
foreach my $cmd ($ENV{PKG_CONFIG}, qw( pkgconf pkg-config ))
{
next unless defined $cmd;
return $cmd if IPC::Cmd::can_run($cmd);
}
return;
}
sub _pkg_config
{
my(@args) = @_;
local $ENV{PKG_CONFIG_PATH} = $ENV{PKG_CONFIG_PATH};
if($^O eq 'darwin' && -d '/usr/local/Cellar/libffi')
{
my($dir) = bsd_glob '/usr/local/Cellar/libffi/*/lib/pkgconfig';
push @PKG_CONFIG_PATH, $dir if $dir && -d $dir;
}
my $cmd = pkg_config_exe;
if(defined $cmd)
{
my @cmd = ($cmd, @args);
print "+@cmd\n" if $VERBOSE;
my($out, $err, $ret) = capture {
system @cmd;
$?;
};
chomp $out; chomp $err;
print "[out]\n$out\n" if $out ne '' && $VERBOSE;
print "[err]\n$err\n" if $err ne '' && $VERBOSE;
die "command failed" if $ret;
my $value = $out;
$value;
}
else
{
print "no pkg-config.\n" if $VERBOSE;
return;
}
}
my $version;
my $exists;
my $cflags;
my $libs;
sub exists
{
return $exists if defined $exists;
return $exists = '' unless pkg_config_exe;
$exists = !!eval { _pkg_config('--exists', 'libffi'); 1 };
}
sub version
{
unless(defined $version)
{
$version = _pkg_config('--modversion', 'libffi');
}
$version;
}
sub config
{
my($class, $key) = @_;
die "unimplemented for $key" unless $key eq 'version';
$class->version;
}
sub cflags
{
unless(defined $cflags)
{
$cflags = _pkg_config('--cflags', 'libffi');
}
$cflags;
}
sub libs
{
unless(defined $libs)
{
$libs = _pkg_config('--libs', 'libffi');
}
$libs;
}
sub install_type {'system'}
sub runtime_prop { return {} }
1;
FFI-Platypus-2.12/inc/Alien/psapi.pm 000644 000000 000000 00000000562 15251066120 017113 0 ustar 00root root 000000 000000 package Alien::psapi;
use strict;
use warnings;
use Config;
sub cflags {''}
sub libs
{
if($^O eq 'MSWin32')
{
if($Config{ccname} eq 'cl')
{
return "psapi.lib ";
}
else
{
return "-lpsapi";
}
}
elsif($^O eq 'cygwin' || $^O eq 'msys')
{
return "-L/usr/lib/w32api -lpsapi ";
}
'';
}
sub install_type {'system'}
1;
FFI-Platypus-2.12/inc/My/ 000755 000000 000000 00000000000 15251066120 014773 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/inc/My/BuildConfig.pm 000644 000000 000000 00000000351 15251066120 017515 0 ustar 00root root 000000 000000 package My::BuildConfig;
use strict;
use warnings;
use File::Spec ();
use parent qw( My::ConfigPl );
sub dir { File::Spec->catdir( qw( _mm )) }
sub file { File::Spec->catfile( shift->dir, qw( config.pl )) }
1;
FFI-Platypus-2.12/inc/My/Config.pm 000644 000000 000000 00000025646 15251066120 016553 0 ustar 00root root 000000 000000 package My::Config;
use strict;
use warnings;
use Config;
use File::Spec;
use FindBin;
use Text::ParseWords qw( shellwords );
use My::BuildConfig;
use My::ShareConfig;
use My::ConfigH;
use My::ShareConfig;
use lib 'lib';
use FFI::Probe;
use FFI::Probe::Runner;
use FFI::Probe::Runner::Builder;
use File::Glob qw( bsd_glob );
use File::Basename qw( basename );
use JSON::PP qw( decode_json );
my @probe_types = split /\n/, <<EOF;
char
signed char
unsigned char
short
signed short
unsigned short
int
signed int
unsigned int
long
signed long
unsigned long
uint8_t
int8_t
uint16_t
int16_t
uint32_t
int32_t
uint64_t
int64_t
size_t
ssize_t
SSIZE_T
float
double
long double
float complex
double complex
long double complex
bool
_Bool
pointer
uintptr_t
intptr_t
enum
senum
intmax_t
uintmax_t
EOF
my @extra_probe_types = split /\n/, <<EOF;
long long
signed long long
unsigned long long
dev_t
ino_t
mode_t
nlink_t
uid_t
gid_t
off_t
blksize_t
blkcnt_t
time_t
ptrdiff_t
wchar_t
wint_t
EOF
push @probe_types, @extra_probe_types unless $ENV{FFI_PLATYPUS_NO_EXTRA_TYPES};
sub new
{
my($class) = @_;
bless {}, $class;
}
my $ppport_h = File::Spec->catfile(qw( include ppport.h ));
sub generate_dev
{
if(!-r $ppport_h || -d '.git')
{
my $ppport_version = 3.28;
require Devel::PPPort;
die "Devel::PPPort $ppport_version or better required for development"
unless $Devel::PPPort::VERSION >= $ppport_version;
my $old = '';
if(-e $ppport_h)
{
open my $fh, '<', $ppport_h;
$old = do { local $/; <$fh> };
close $fh;
}
my $content = Devel::PPPort::GetFileContents('include/ppport.h');
if($content ne $old)
{
print "XX $ppport_h\n";
open my $fh, '>', $ppport_h;
print $fh $content;
close $fh;
}
}
}
sub clean
{
unlink $ppport_h;
}
sub share_config
{
my($self) = @_;
$self->{share_config} ||= My::ShareConfig->new;
}
sub build_config
{
my($self) = @_;
$self->{build_config} ||= My::BuildConfig->new;
}
sub probe
{
my($self) = @_;
$self->{probe} ||= FFI::Probe->new(
runner => $self->probe_runner,
log => "config.log",
data_filename => "./blib/lib/auto/share/dist/FFI-Platypus/probe/probe.pl",
alien => [$self->build_config->get('alien')->{class}],
cflags => ['-Iinclude'],
);
}
sub probe_runner
{
my($self) = @_;
my $builder = FFI::Probe::Runner::Builder->new;
my $exe = $builder->exe;
if(-e $exe)
{
return FFI::Probe::Runner->new( exe => $exe );
}
else
{
return undef;
}
}
sub probe_runner_build
{
my($self) = @_;
my $probe = $self->probe;
my $builder = FFI::Probe::Runner::Builder->new;
foreach my $key (qw( cc ccflags optimize ld ldflags ))
{ @{ $builder->$key } = @{ $self->build_config->get('eumm')->{$key} } }
$builder->build unless -e $builder->exe;
}
sub configure
{
my($self) = @_;
my $probe = $self->probe;
my $config_h = File::Spec->rel2abs( File::Spec->catfile( 'include', 'ffi_platypus_config.h' ) );
return if -r $config_h && ref($self->share_config->get( 'type_map' )) eq 'HASH';
my $ch = My::ConfigH->new;
$ch->define_var( do {
my $os = uc $^O;
$os =~ s/-/_/;
$os =~ s/[^A-Z0-9_]//g;
"PERL_OS_$os";
} => 1 );
$ch->define_var( PERL_OS_WINDOWS => 1 ) if $^O =~ /^(MSWin32|cygwin|msys)$/;
{
my($major, $minor, $patch) = $] =~ /^(5|[7-9])\.([0-9]{3})([0-9]{3})/;
$ch->define_var( FFI_PL_PERL_VERSION_MAJOR => int $major );
$ch->define_var( FFI_PL_PERL_VERSION_MINOR => int $minor );
$ch->define_var( FFI_PL_PERL_VERSION_PATCH => int $patch );
}
{
my($major, $minor, $patch) = (@{ $self->build_config->get('version') }, 0);
$ch->define_var( FFI_PL_VERSION_MAJOR => int $major );
$ch->define_var( FFI_PL_VERSION_MINOR => int $minor );
$ch->define_var( FFI_PL_VERSION_PATCH => int $patch );
}
foreach my $header (qw( stdlib stdint sys/types sys/stat unistd alloca dlfcn limits stddef wchar signal inttypes windows sys/cygwin string psapi stdio stdbool complex ))
{
if($probe->check_header("$header.h"))
{
my $var = uc $header;
$var =~ s{/}{_}g;
$var = "HAVE_${var}_H";
$ch->define_var( $var => 1 );
}
}
if(!$self->build_config->get('config_debug_fake32') && $Config{ivsize} >= 8)
{
$ch->define_var( HAVE_IV_IS_64 => 1 );
}
my %type_map;
my %align;
foreach my $type (@probe_types)
{
if($type =~ /^(float|double|long double)/)
{
if(my $basic = $probe->check_type_float($type))
{
$type_map{$type} = $basic;
$align{$type} = $probe->data->{type}->{$type}->{align};
}
}
elsif($type eq 'pointer')
{
$probe->check_type_pointer;
$align{pointer} = $probe->data->{type}->{pointer}->{align};
}
elsif($type eq 'enum')
{
if(my $basic = $probe->check_type_enum)
{
$type_map{enum} = $basic;
$align{$basic} ||= $probe->data->{type}->{enum}->{align};
}
}
elsif($type eq 'senum')
{
if(my $basic = $probe->check_type_signed_enum)
{
$type_map{senum} = $basic;
$align{$basic} ||= $probe->data->{type}->{senum}->{align};
}
}
else
{
if(my $basic = $probe->check_type_int($type))
{
$type_map{$type} = $basic;
$align{$basic} ||= $probe->data->{type}->{$type}->{align};
}
elsif($type =~ /^(unsigned |signed )?(char|short|int|long)$/)
{
print "Unable to perform basic type check for: \"$type\"\n";
print "Please check config.log for detailed diagnostics.\n";
die "unable to configure Platypus";
}
}
}
# Visual C++ uses SSIZE_T instead of ssize_t
if($^O eq 'MSWin32' && $Config{ccname} eq 'cl' && defined $type_map{SSIZE_T})
{
$type_map{ssize_t} = delete $type_map{SSIZE_T};
}
elsif(defined $type_map{SSIZE_T})
{
delete $type_map{SSIZE_T};
}
$ch->define_var( SIZEOF_VOIDP => $probe->data->{type}->{pointer}->{size} );
if(my $size = $probe->data->{type}->{'float complex'}->{size})
{ $ch->define_var( SIZEOF_FLOAT_COMPLEX => $size ) }
if(my $size = $probe->data->{type}->{'double complex'}->{size})
{ $ch->define_var( SIZEOF_DOUBLE_COMPLEX => $size ) }
if(my $size = $probe->data->{type}->{'long double complex'}->{size})
{ $ch->define_var( SIZEOF_LONG_DOUBLE_COMPLEX => $size ) }
# short aliases
$type_map{uchar} = $type_map{'unsigned char'};
$type_map{ushort} = $type_map{'unsigned short'};
$type_map{uint} = $type_map{'unsigned int'};
$type_map{ulong} = $type_map{'unsigned long'};
# on Linux and OS X at least the test for bool fails
# but _Bool works (even though code using bool seems
# to work for both). May be because bool is a macro
# for _Bool or something.
$type_map{bool} ||= delete $type_map{_Bool};
delete $type_map{_Bool};
$ch->write_config_h;
my %probe;
if(defined $ENV{FFI_PLATYPUS_PROBE_OVERRIDE})
{
foreach my $kv (split /:/, $ENV{FFI_PLATYPUS_PROBE_OVERRIDE})
{
my($k,$v) = split /=/, $kv, 2;
$probe{$k} = $v;
}
}
if($Config{byteorder} =~ /^(1234|12345678)$/)
{
$probe{bigendian} = 0;
$probe{bigendian64} = 0;
}
if($self->build_config->get('config_no_alloca'))
{
$probe{alloca} = 0;
}
foreach my $cfile (bsd_glob 'inc/probe/*.c')
{
my $name = basename $cfile;
$name =~ s/\.c$//;
unless(defined $probe{$name})
{
my $code = do {
my $fh;
open $fh, '<', $cfile;
local $/;
<$fh>;
};
my $value = $probe->check($name, $code);
$probe{$name} = $value if defined $value;
}
if($probe{$name})
{
$ch->define_var( "FFI_PL_PROBE_" . uc($name) => 1 );
}
}
my %abi;
if(my $cpp_output = $probe->check_cpp("#include <ffi.h>\n"))
{
if($cpp_output =~ m/typedef\s+enum\s+ffi_abi\s+{(.*?)}/s)
{
my $enum = $1;
my %seen;
while($enum =~ s/FFI_([A-Z_0-9]+)//)
{
my $abi = $1;
next if $seen{$abi};
$seen{$abi}++;
next if $abi =~ /^(FIRST|LAST)_ABI$/;
$probe->check_eval(
decl => [
"#include \"ffi_platypus.h\"",
],
stmt => [
"ffi_cif cif;",
"ffi_type *args[1];",
"ffi_abi abi;",
"if(ffi_prep_cif(&cif, FFI_$abi, 0, &ffi_type_void, args) != FFI_OK) { return 2; }",
],
eval => {
"abi.@{[ lc $abi ]}" => [ '%d' => "FFI_$abi" ],
},
);
}
if(defined $probe->data->{abi})
{
%abi = %{ $probe->data->{abi} || {} };
}
else
{
$probe->log("[[[ Unable to verify any ffi_abis ]]]");
print "*** Unable to detect ffi_abis ***\n";
print "[[[ Unable to verify any ffi_abis ]]]\n";
print "[[[ will try all known ABIs ]]]\n";
}
}
else
{
$probe->log("[[[ ffi_abi enum not found ]]]");
print "*** Unable to detect ffi_abis ***\n";
print "[[[ ffi_abi enum not found ]]]\n";
print "[[[ will try all known ABIs ]]]\n";
}
}
else
{
$probe->log("[[[ C pre-processor failed... ]]]");
print "*** Unable to detect ffi_abis ***\n";
print "[[[ C pre-processor failed... ]]]\n";
print "[[[ will try all known ABIs ]]]\n";
}
unless(%abi)
{
if($probe->check_eval(
decl => [
"#include \"ffi_platypus.h\"",
],
eval => {
"abi.default_abi" => [ '%d' => "FFI_DEFAULT_ABI" ],
},
))
{
open my $fh, '<', 'inc/abi/abis-all.json'
or die "unable to read abis-all.json $!";
my @abis = @{ decode_json(do { local $/; <$fh> }) };
close $fh;
foreach my $abi (@abis)
{
$probe->check_eval(
decl => [
"#include \"ffi_platypus.h\"",
],
stmt => [
"ffi_cif cif;",
"ffi_type *args[1];",
"ffi_abi abi;",
"if(ffi_prep_cif(&cif, FFI_$abi, 0, &ffi_type_void, args) != FFI_OK) { return 2; }",
],
eval => {
"abi.@{[ lc $abi ]}" => [ '%d' => "FFI_$abi" ],
},
);
}
%abi = %{ $probe->data->{abi} || {} };
}
else
{
$probe->log("[[[ fatal: unable to determine even the default ABI ]]]");
print "Unable to determine even the default ABI\n";
die "unable to configure Platypus";
}
}
$ch->write_config_h;
$self->share_config->set( type_map => \%type_map );
$self->share_config->set( align => \%align );
$self->share_config->set( probe => \%probe );
$self->share_config->set( abi => \%abi );
}
sub platform
{
my($self) = @_;
my %Config = %Config;
my $eumm = $self->build_config->get('eumm');
foreach my $key (keys %$eumm)
{
$Config{$key} = $eumm->{$key};
}
require FFI::Build::Platform;
FFI::Build::Platform->new(\%Config);
}
sub alien
{
my($self) = @_;
my $class = $self->build_config->get('alien')->{class};
my $pm = "$class.pm";
$pm =~ s/::/\//g;
require $pm;
$self->build_config->get('alien')->{class};
}
1;
FFI-Platypus-2.12/inc/My/ConfigH.pm 000644 000000 000000 00000001445 15251066120 016652 0 ustar 00root root 000000 000000 package My::ConfigH;
use strict;
use warnings;
use Carp qw( croak );
use File::Basename qw( basename );
sub new
{
my($class, $filename) = @_;
$filename ||= "include/ffi_platypus_config.h";
my $self = bless {
content => '',
filename => $filename,
}, $class;
$self;
}
sub define_var
{
my($self, $key, $value) = @_;
croak "value for $key is not defined" unless defined $value;
$self->{content} .= "#define $key $value\n";
}
sub write_config_h
{
my($self) = @_;
my $once = uc basename($self->{filename});
$once =~ s/\./_/g;
my $fh;
my $fn = $self->{filename};
open $fh, '>', $fn or die "unable to write to $fn $!";
print $fh "#ifndef $once\n";
print $fh "#define $once\n\n";
print $fh "@{[ $self->{content} ]}\n";
print $fh "#endif\n";
close $fh;
}
1;
FFI-Platypus-2.12/inc/My/ConfigPl.pm 000644 000000 000000 00000001637 15251066120 017041 0 ustar 00root root 000000 000000 package My::ConfigPl;
use strict;
use warnings;
use Data::Dumper ();
use Carp qw( croak );
use File::Path qw( mkpath );
sub dir { croak "subclasss requires dir method" }
sub file { croak "subclasss requires file method" }
sub new
{
my $class = shift;
my $data;
if(-e $class->file)
{
$data = do "./@{[ $class->file ]}";
}
else
{
$data = { 'test-key' => 'test-value' };
}
bless { data => $data }, $class;
}
sub get
{
my($self, $name) = @_;
$self->{data}->{$name};
}
sub set
{
my($self, $name, $value) = @_;
$self->{data}->{$name} = $value;
my $dd = Data::Dumper->new([$self->{data}],['x'])
->Indent(1)
->Terse(0)
->Purity(1)
->Sortkeys(1)
->Dump;
mkpath( $self->dir, 0, 0755 ) unless -d $self->dir;
my $fh;
open($fh, '>', $self->file) || die "error writing @{[ $self->file ]}";
print $fh 'do { my ';
print $fh $dd;
print $fh '$x;}';
close $fh;
}
1;
FFI-Platypus-2.12/inc/My/ShareConfig.pm 000644 000000 000000 00000000407 15251066120 017522 0 ustar 00root root 000000 000000 package My::ShareConfig;
use strict;
use warnings;
use File::Spec ();
use parent qw( My::ConfigPl );
sub dir { File::Spec->catdir( qw( blib lib auto share dist FFI-Platypus )) }
sub file { File::Spec->catfile( shift->dir, qw( config.pl )) }
1;
FFI-Platypus-2.12/inc/abi/ 000755 000000 000000 00000000000 15251066120 015141 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/inc/abi/abis-all.json 000644 000000 000000 00000001377 15251066120 017530 0 ustar 00root root 000000 000000 [
"AIX",
"ARCOMPACT",
"COMPAT",
"COMPAT_GCC_SYSV",
"COMPAT_LINUX",
"COMPAT_LINUX64",
"COMPAT_LINUX_SOFT_FLOAT",
"COMPAT_SYSV",
"DARWIN",
"EABI",
"EFI64",
"ELFBSD",
"FASTCALL",
"GNUW64",
"LINUX",
"LINUX_LONG_DOUBLE_128",
"LINUX_LONG_DOUBLE_IEEE128",
"LINUX_STRUCT_ALIGN",
"MIPS_O32",
"MS_CDECL",
"N32",
"N32_SOFT_FLOAT",
"N64",
"N64_SOFT_FLOAT",
"O32",
"O32_SOFT_FLOAT",
"OBSD",
"OSF",
"PA32",
"PA64",
"PASCAL",
"REGISTER",
"STDCALL",
"SYSV",
"SYSV_IBM_LONG_DOUBLE",
"SYSV_LONG_DOUBLE_128",
"SYSV_SOFT_FLOAT",
"SYSV_STRUCT_RET",
"THISCALL",
"UNIX",
"UNIX64",
"UNUSED_1",
"UNUSED_2",
"UNUSED_3",
"V8",
"V9",
"VFP",
"WIN64"
]
FFI-Platypus-2.12/inc/abi/compute-all.pl 000644 000000 000000 00000003110 15251066120 017713 0 ustar 00root root 000000 000000 use strict;
use warnings;
use feature qw( say );
use Path::Tiny qw( path );
use Git::Wrapper;
use File::chdir;
use JSON::PP ();
# Only intended for use by the Platypus maintainer!
# Sometimes detecting the ABIs from the C compiler pre-processor is unreliable
# so we can look in the libffi source for all possible ABIs for all possible
# platforms and just try them all. This computes the list from the latest
# source (or libffi directory as specified by LIBFFI_ROOT). This list will
# used by the config step to detect ABIs available on your platform.
my $libffi_root;
if(defined $ENV{LIBFFI_ROOT})
{
die "no such directory: $ENV{LIBFFI_ROOT}" unless -d $ENV{LIBFFI_ROOT};
$libffi_root = path($ENV{LIBFFI_ROOT});
}
else
{
require Git::Wrapper;
$libffi_root = Path::Tiny->tempdir;
my $git = Git::Wrapper->new($libffi_root);
$git->clone('--depth=2', 'https://github.com/libffi/libffi.git', $libffi_root);
}
say $libffi_root;
my %abis;
$libffi_root->visit(
sub {
my($path) = @_;
return if $path->is_dir;
return unless $path->basename eq 'ffitarget.h';
say ' ' . $path->relative($libffi_root);
my $c = $path->slurp;
if($c =~ m/typedef\s+enum\s+ffi_abi\s+{(.*?)}/s)
{
my $c = $1;
while($c =~ s/FFI_([A-Z_0-9]+)//)
{
my $abi = $1;
next if $abi =~ /^(FIRST|LAST|DEFAULT)_ABI$/;
say ' ', $abi;
$abis{$abi}++;
}
}
else
{
say ' no abis';
}
},
{ recurse => 1 },
);
path(__FILE__)->parent->child("abis-all.json")->spew_raw(JSON::PP->new->pretty(1)->encode([sort keys %abis]));
FFI-Platypus-2.12/inc/bad-5100t.pl 000644 000000 000000 00000001241 15251066120 016236 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Config;
if($] == 5.010 && $Config{useithreads})
{
print "\n\n\n";
print " !! ERROR ERROR ERRORS ERROR !!\n";
print "\n";
print "The version of Perl you are using (5.10.0) when compiled\n";
print "with threads is buggy and not supported by the Platypus team.\n";
print "Please take the time to upgraded to a supported version of\n";
print "Perl. Easiest upgrade is probably to 5.10.0 unthreaded, or\n";
print "5.10.1. Better would be to upgrade to 5.32.\n";
print "\n";
print "https://github.com/PerlFFI/FFI-Platypus/issues/271\n";
print "\n";
print " !! ERROR ERROR ERRORS ERROR !!\n";
print "\n\n\n";
exit 2;
}
FFI-Platypus-2.12/inc/bad-forks.pl 000644 000000 000000 00000001451 15251066120 016614 0 ustar 00root root 000000 000000 use strict;
use warnings;
use File::Spec;
my $path;
foreach my $inc (@INC)
{
$path = File::Spec->catfile($inc, 'forks.pm');
last if -f $path;
}
if(-f $path)
{
eval q{ use forks };
if(my $error = $@)
{
print "There seems to be something wrong with your forks.pm module.\n";
print "This exception was raised when trying to use forks:\n\n";
print " $error\n\n";
print "Although forks.pm is not required by FFI-Platypus, it does test\n";
print "against forks.pm if it is installed, so please fix your forks.pm\n";
print "before trying to install FFI-Platypus.\n\n";
print "If you believe this to be an error in FFI-Platypus, please feel\n";
print "free to open a ticket here:\n\n";
print "https://github.com/PerlFFI/FFI-Platypus/issues\n\n";
exit 2;
}
}
FFI-Platypus-2.12/inc/bad-oldperl.pl 000644 000000 000000 00000001223 15251066120 017126 0 ustar 00root root 000000 000000 if($] < 5.008004)
{
print "\n\n\n";
print " !! ERROR ERROR ERRORS ERROR !!\n";
print "\n";
print "The version of Perl you are using is very old (at least 15 years)\n";
print "as of this writing. The FFI-Platypus team plans on dropping support\n";
print "for Perls older than 5.8.4 on or after July 1st 2020. At that time\n";
print "FFI-Platypus will refuse to install on these old Perls. Please take\n";
print "the time to migrate to a supported version of Perl ASAP.\n";
print "\n";
print "https://github.com/PerlFFI/FFI-Platypus/issues/271\n";
print "\n";
print " !! ERROR ERROR ERRORS ERROR !!\n";
print "\n\n\n";
exit 2;
}
FFI-Platypus-2.12/inc/mm-build.pl 000644 000000 000000 00000002634 15251066120 016456 0 ustar 00root root 000000 000000 use strict;
use warnings;
use File::Basename qw( basename );
use File::Path qw( mkpath );
use File::Copy qw( copy );
use lib 'inc';
use My::Config;
use lib 'lib';
use FFI::Build;
use Config ();
my $config = My::Config->new;
my $include = "blib/lib/auto/share/dist/FFI-Platypus/include";
mkpath $include, 0, 0755;
foreach my $h (qw( ffi_platypus_config.h ffi_platypus_bundle.h ))
{
my $from = "include/$h";
my $to = "$include/$h";
if(-f $to)
{
next if slurp($from) eq slurp($to);
}
copy($from => $to) || die "unable to copy $from => $to $!";
}
my $lib = FFI::Build->new(
'plfill',
source => ['ffi/*.c'],
verbose => 1,
dir => 'blib/lib/auto/share/dist/FFI-Platypus/lib',
platform => $config->platform,
alien => [$config->alien],
cflags => '-Iblib/lib/auto/share/dist/FFI-Platypus/include -Iinclude',
)->build;
my $name = basename($lib->basename);
foreach my $dir ( 'FFI/Platypus/Memory','FFI/Platypus/Record/Meta', 'FFI/Platypus/Constant' )
{
my($file) = $dir =~ m{/([^/]+)$};
mkpath("blib/arch/auto/$dir", 0, 0755);
my $txtfile = "blib/arch/auto/$dir/$file.txt";
my $fh;
open($fh, '>', $txtfile) || die "unable to write to $txtfile $!";
print $fh "FFI::Build\@auto/share/dist/FFI-Platypus/lib/$name\n";
close $fh;
}
sub slurp
{
my($filename) = @_;
my $fh;
open $fh, '<', $filename;
binmode $fh;
my $content = do { local $/; <$fh> };
close $fh;
$content;
}
FFI-Platypus-2.12/inc/mm-clean.pl 000644 000000 000000 00000001163 15251066120 016435 0 ustar 00root root 000000 000000 use strict;
use warnings;
use File::Glob qw( bsd_glob );
unlink $_ for map { bsd_glob($_) } (
'ffi/_build/*',
't/ffi/_build/*',
't/ffi/*.so',
't/ffi/*.dll',
't/ffi/*.bundle',
'xs/*.o',
'xs/*.obj',
'examples/*.o',
'examples/*.so',
'examples/*.dll',
'examples/*.bundle',
'corpus/ffi_build/project1/_build/*',
'config.log',
'test*.o',
'test*.c',
'*.core',
'core',
'include/ffi_platypus_config.h',
'FFI-Platypus-*.tar.gz',
);
rmdir 'ffi/_build' if -d 'ffi/_build';
rmdir 't/ffi/_build' if -d 't/ffi/_build';
rmdir 'corpus/ffi_build/project1/_build' if -d 'corpus/ffi_build/project1/_build';
FFI-Platypus-2.12/inc/mm-config-pb.pl 000644 000000 000000 00000000165 15251066120 017220 0 ustar 00root root 000000 000000 use strict;
use warnings;
use lib 'inc';
use My::Config;
my $config = My::Config->new;
$config->probe_runner_build;
FFI-Platypus-2.12/inc/mm-config-set.pl 000644 000000 000000 00000000327 15251066120 017412 0 ustar 00root root 000000 000000 use strict;
use warnings;
use lib 'inc';
use My::BuildConfig;
my($key, @value) = @ARGV;
my $config = My::BuildConfig->new;
my $eumm = $config->get('eumm');
$eumm->{$key} = [@value];
$config->set('eumm' => $eumm);
FFI-Platypus-2.12/inc/mm-config.pl 000644 000000 000000 00000000305 15251066120 016615 0 ustar 00root root 000000 000000 use strict;
use warnings;
use ExtUtils::CBuilder;
use lib 'inc';
use My::Config;
exit if -f '_mm/config';
my $config = My::Config->new;
$config->generate_dev;
$config->configure;
$config->alien;
FFI-Platypus-2.12/inc/mm-test.pl 000644 000000 000000 00000000564 15251066120 016336 0 ustar 00root root 000000 000000 use strict;
use warnings;
use lib 'lib';
use FFI::Build;
use lib 'inc';
use My::Config;
use My::ShareConfig;
my $config = My::Config->new;
FFI::Build->new(
'test',
source => ['t/ffi/*.c'],
verbose => 1,
alien => [$config->build_config->get('alien')->{class}],
cflags => ['-Iinclude'],
dir => 't/ffi',
platform => $config->platform,
)->build;
FFI-Platypus-2.12/inc/mymm.pl 000644 000000 000000 00000021625 15251066120 015730 0 ustar 00root root 000000 000000 package mymm;
use strict;
use warnings;
use Config;
use File::Glob qw( bsd_glob );
use ExtUtils::MakeMaker ();
use IPC::Cmd ();
use lib 'inc';
use File::Spec;
use My::BuildConfig;
use My::ShareConfig;
{
my $dh;
opendir $dh, 'inc';
my @files = map { File::Spec->catfile('inc', $_) } grep /^bad-.*\.pl$/, readdir $dh;
close $dh;
foreach my $badcheck (@files)
{
system $^X, $badcheck;
if($?)
{
print "bad check $badcheck failed\n";
exit;
}
}
}
sub vcpkg
{
return unless $Config{ccname} eq 'cl';
require Alien::FFI::Vcpkg;
!!eval { Alien::FFI::Vcpkg->vcpkg }
}
sub myWriteMakefile
{
my %args = @_;
my $build_config = My::BuildConfig->new;
my $share_config = My::ShareConfig->new;
my %diag;
my %alien;
ExtUtils::MakeMaker->VERSION('7.12');
$build_config->set(version => [ $args{VERSION} =~ /^([0-9]+)\.([0-9]{2})/ ]);
if(eval { require Alien::FFI; Alien::FFI->VERSION('0.20'); 1 })
{
print "using already installed Alien::FFI (version @{[ Alien::FFI->VERSION ]})\n";
$build_config->set(alien => { class => 'Alien::FFI', mode => 'already-installed' });
require Alien::Base::Wrapper;
Alien::Base::Wrapper->import( 'Alien::FFI', 'Alien::psapi', '!export' );
%alien = Alien::Base::Wrapper->mm_args;
}
elsif(vcpkg())
{
print "using vcpkg libffi package\n";
$build_config->set(alien => { class => 'Alien::FFI::Vcpkg', mode => 'system' });
require Alien::Base::Wrapper;
Alien::Base::Wrapper->import( 'Alien::FFI::Vcpkg', '!export');
%alien = Alien::Base::Wrapper->mm_args;
delete $args{BUILD_REQUIRES}->{'Alien::FFI'};
}
else
{
require Alien::FFI::pkgconfig if $^O ne 'MSWin32';
require Alien::FFI::PkgConfigPP if $^O eq 'MSWin32';
my $alien_install_type_unset = !defined $ENV{ALIEN_INSTALL_TYPE};
if($alien_install_type_unset && $^O eq 'MSWin32' && Alien::FFI::PkgConfigPP->exists)
{
print "using system libffia via PkgConfigPP\n";
$build_config->set(alien => { class => 'Alien::FFI::PkgConfigPP', mode => 'system' });
require Alien::Base::Wrapper;
Alien::Base::Wrapper->import( 'Alien::FFI::PkgConfigPP', 'Alien::psapi', '!export' );
%alien = Alien::Base::Wrapper->mm_args;
delete $args{BUILD_REQUIRES}->{'Alien::FFI'};
}
elsif($alien_install_type_unset && $^O ne 'MSWin32' && Alien::FFI::pkgconfig->exists)
{
print "using system libffi via @{[ Alien::FFI::pkgconfig->pkg_config_exe ]}\n";
$build_config->set(alien => { class => 'Alien::FFI::pkgconfig', mode => 'system' });
require Alien::Base::Wrapper;
Alien::Base::Wrapper->import( 'Alien::FFI::pkgconfig', 'Alien::psapi', '!export' );
%alien = Alien::Base::Wrapper->mm_args;
delete $args{BUILD_REQUIRES}->{'Alien::FFI'};
}
else
{
print "requiring Alien::FFI in fallback mode.\n";
$build_config->set(alien => { class => 'Alien::FFI', mode => 'fallback' });
%alien = (
CC => '$(FULLPERL) -Iinc -MAlien::Base::Wrapper=Alien::FFI,Alien::psapi -e cc --',
LD => '$(FULLPERL) -Iinc -MAlien::Base::Wrapper=Alien::FFI,Alien::psapi -e ld --',
);
}
}
$alien{INC} = defined $alien{INC} ? "-Iinclude $alien{INC}" : "-Iinclude";
%args = (%args, %alien);
if($ENV{FFI_PLATYPUS_DEBUG_FAKE32} || $Config{uvsize} < 8)
{
$args{BUILD_REQUIRES}->{'Math::Int64'} = '0.34';
}
if($ENV{FFI_PLATYPUS_DEBUG_FAKE32} && $Config{uvsize} == 8)
{
print "DEBUG_FAKE32:\n";
print " + making Math::Int64 a prereq\n";
print " + Using Math::Int64's C API to manipulate 64 bit values\n";
$build_config->set(config_debug_fake32 => 1);
$diag{config}->{config_debug_fake32} = 1;
}
if($ENV{FFI_PLATYPUS_NO_ALLOCA})
{
print "NO_ALLOCA:\n";
print " + alloca() will not be used, even if your platform supports it.\n";
$build_config->set(config_no_alloca => 1);
$diag{config}->{config_no_alloca} = 1;
}
delete $args{PM};
$args{XSMULTI} = 1;
$args{XSBUILD} = {
xs => {
'lib/FFI/Platypus' => {
OBJECT => 'lib/FFI/Platypus$(OBJ_EXT) ' . join(' ', map { s/\.c$/\$(OBJ_EXT)/; $_ } bsd_glob "xs/*.c"),
%alien,
},
},
};
$args{PREREQ_PM}->{'Math::Int64'} = '0.34'
if $ENV{FFI_PLATYPUS_DEBUG_FAKE32} || $Config{uvsize} < 8;
# dlext as understood by MB and MM
my @dlext = ($Config{dlext});
# extra dlext as understood by the OS
push @dlext, 'dll' if $^O =~ /^(cygwin|MSWin32|msys)$/;
push @dlext, 'xs.dll' if $^O =~ /^(MSWin32)$/;
push @dlext, 'so' if $^O =~ /^(cygwin|darwin)$/;
push @dlext, 'bundle', 'dylib' if $^O =~ /^(darwin)$/;
# uniq'ify it
@dlext = do { my %seen; grep { !$seen{$_}++ } @dlext };
$build_config->set(diag => \%diag);
$share_config->set(config_dlext => \@dlext);
ExtUtils::MakeMaker::WriteMakefile(%args);
}
#package MM;
#
#sub init_tools
#{
# my $self = shift;
# $self->SUPER::init_tools(@_);
#
# return if !!$ENV{V};
#
# my $noecho = $^O eq 'MSWin32' ? 'REM ' : '@';
#
# foreach my $tool (qw( RM_F RM_RF CP MV ))
# {
# $self->{$tool} = $noecho . $self->{$tool};
# }
#
# return;
#}
package MY;
use Config;
sub dynamic_lib
{
my($self, @therest) = @_;
my $dynamic_lib = $self->SUPER::dynamic_lib(@therest);
my %h = map { m!include/(.*?)$! && $1 => [$_] } File::Glob::bsd_glob('include/*.h');
push @{ $h{"ffi_platypus.h"} }, map { "include/ffi_platypus_$_.h" } qw( config );
my %targets = (
'include/ffi_platypus_config.h' => ['_mm/config'],
'lib/FFI/Platypus.c' => [File::Glob::bsd_glob('xs/*.xs'), 'lib/FFI/Platypus.xs', 'lib/FFI/typemap'],
);
foreach my $cfile (File::Glob::bsd_glob('xs/*.c'), 'lib/FFI/Platypus.c')
{
my $ofile = $cfile;
$ofile =~ s/\.c$/\$(OBJ_EXT)/;
my @deps = ($cfile, '_mm/config');
if(-d ".git")
{
# for a development build, lets go ahead and compute the .h
# dependencies to make it easier to do a partial rebuild.
my $source_file = $cfile;
$source_file = 'lib/FFI/Platypus.xs' if $source_file =~ /^lib\/FFI/;
my $fh;
open $fh, '<', $source_file;
while(<$fh>)
{
if(/^#include [<"](.*?)[>"]/ && $h{$1})
{
push @deps, @{$h{$1}};
}
}
close $fh;
}
$targets{$ofile} = \@deps;
}
$dynamic_lib .= "\n";
foreach my $target (sort keys %targets)
{
$dynamic_lib .= "$target : @{$targets{$target}}\n";
}
$dynamic_lib;
}
sub postamble {
my $postamble = '';
my $noecho = !!$ENV{V} ? '' : '$(NOECHO) ';
my $sep = $^O eq 'MSWin32' && $Config{make} eq 'nmake'
? '\\'
: '/';
$postamble .=
"flags: _mm${sep}flags\n" .
"_mm${sep}flags:\n";
foreach my $key (qw( cc inc ccflags cccdlflags optimize ld ldflags lddlflags ))
{
$postamble .=
sprintf "\t$noecho\$(FULLPERL) inc${sep}mm-config-set.pl %-20s \$(%s)\n", $key, uc $key;
}
$postamble .=
"\t$noecho\$(MKPATH) _mm\n" .
"\t$noecho\$(TOUCH) _mm${sep}flags\n\n";
$postamble .=
"probe-runner-builder prb: _mm${sep}probe-builder\n" .
"_mm${sep}probe-builder: _mm${sep}flags\n" .
"\t$noecho\$(FULLPERL) inc${sep}mm-config-pb.pl\n" .
"\t$noecho\$(MKPATH) _mm\n" .
"\t$noecho\$(TOUCH) _mm${sep}probe-builder\n\n";
$postamble .=
"config :: _mm${sep}config\n" .
"_mm${sep}config: _mm${sep}flags _mm${sep}probe-builder\n" .
"\t$noecho\$(FULLPERL) inc${sep}mm-config.pl\n" .
"\t$noecho\$(MKPATH) _mm\n" .
"\t$noecho\$(TOUCH) _mm${sep}config\n\n";
$postamble .=
"pure_all :: ffi\n" .
"ffi: _mm${sep}config\n" .
"\t$noecho\$(FULLPERL) inc${sep}mm-build.pl\n\n";
$postamble .=
"subdirs-test_dynamic subdirs-test_static subdirs-test :: ffi-test\n" .
"ffi-test : _mm${sep}config\n" .
"\t$noecho\$(FULLPERL) inc${sep}mm-test.pl\n\n";
$postamble .=
"clean :: mm-clean\n" .
"mm-clean :\n" .
"\t$noecho\$(FULLPERL) inc${sep}mm-clean.pl\n" .
"\t$noecho\$(RM_RF) _mm ffi-probe-*\n" .
"\t$noecho\$(RM_RF) .tmp\n" .
"\t$noecho\$(RM_RF) corpus${sep}*${sep}*${sep}tmpbuild*\n\n";
# Workaround for the tireless testers out there
# who want to make -jX a thing. For some reason.
#
# When bsd make is passed -jX it turns off compat
# mode, even if the Makefile itself turns off
# parallel build. Unfortunately the Makefile
# generated by EUMM does not work without compat
# mode. So we:
$postamble .=
# 1. turn off parallel build using the bsd-only
# faux rule `.NO_PARALLEL` rather than the
# more portable `.NOTPARALLEL`, because this
# will allow parallel build with gmake, which
# does work.
".NO_PARALLEL:\n\n";
if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
{
# nothing.
}
else
{
$postamble .=
# 2. turn compat mode back on.
".MAKE.MODE=compat\n\n";
}
$postamble;
}
sub special_targets {
my($self, @therest) = @_;
my $st = $self->SUPER::special_targets(@therest);
$st .= "\n.PHONY: flags probe-runner-builder prb ffi ffi-test\n";
$st;
}
1;
FFI-Platypus-2.12/inc/pdb 000755 000000 000000 00000001776 15251066120 015114 0 ustar 00root root 000000 000000 #!/usr/bin/env perl
use strict;
use warnings;
use lib 'inc';
use lib 'lib';
use FFI::Probe;
use FFI::Probe::Runner;
use FFI::Probe::Runner::Builder;
use My::BuildConfig;
use File::Temp;
use Path::Tiny qw( path );
my $dir = FFI::Temp->newdir;
my $data_filename = path( $dir, 'probe.pl' );
my $log_filename = path( $dir, 'config.log' );
my $probe = FFI::Probe->new(
runner => do {
my $builder = FFI::Probe::Runner::Builder->new;
my $exe = $builder->exe;
FFI::Probe::Runner->new( exe => $exe );
},
log => "$log_filename",
data_filename => "$data_filename",
alien => [My::BuildConfig->new->get('alien')->{class}],
cflags => ['-Iinclude'],
);
my $name = shift @ARGV;
$name ||= 'recordvalue'; # this is what I am strugling with right this minute.
my $fn = "inc/probe/$name.c";
my $code = do {
my $fh;
open $fh, '<', $fn;
local $/;
<$fh>;
};
my $value = $probe->check($name, $code);
$probe->save;
print "[log]\n";
print $log_filename->slurp;
print "[data]\n";
print $data_filename->slurp;
FFI-Platypus-2.12/inc/probe/ 000755 000000 000000 00000000000 15251066120 015515 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/inc/probe/abi.c 000644 000000 000000 00000000364 15251066120 016417 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
int
dlmain(int argc, char *argv[])
{
ffi_cif cif;
ffi_type *args[1];
ffi_abi abi;
abi = FFI_DEFAULT_ABI;
if(ffi_prep_cif(&cif, abi, 0, &ffi_type_void, args) == FFI_OK)
{
return 0;
}
return 2;
}
FFI-Platypus-2.12/inc/probe/alloca.c 000644 000000 000000 00000000213 15251066120 017110 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
int
dlmain(int argc, char *argv[])
{
void *ptr = alloca(100);
if(ptr == NULL)
return 2;
return 0;
}
FFI-Platypus-2.12/inc/probe/bigendian.c 000644 000000 000000 00000000654 15251066120 017606 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
unsigned char
my_foo(void)
{
return 0xaa;
}
int
dlmain(int argc, char *argv[])
{
ffi_cif cif;
ffi_type *args[1];
void *values[1];
unsigned char bytes[4] = { 0x00, 0x00, 0x00, 0x00 };
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 0, &ffi_type_uint8, args) ==FFI_OK)
{
ffi_call(&cif, (void *) my_foo, &bytes, values);
if(bytes[3] == 0xaa)
{
return 0;
}
}
return 2;
}
FFI-Platypus-2.12/inc/probe/bigendian64.c 000644 000000 000000 00000000704 15251066120 017754 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
unsigned char
my_foo(void)
{
return 0xaa;
}
int
dlmain(int argc, char *argv[])
{
ffi_cif cif;
ffi_type *args[1];
void *values[1];
unsigned char bytes[8] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 };
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 0, &ffi_type_uint8, args) ==FFI_OK)
{
ffi_call(&cif, (void *) my_foo, &bytes, values);
if(bytes[7] == 0xaa)
{
return 0;
}
}
return 2;
}
FFI-Platypus-2.12/inc/probe/complex.c 000644 000000 000000 00000004506 15251066120 017335 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
float
my_float_real(float complex c)
{
return crealf(c);
}
float
my_float_imag(float complex c)
{
return cimagf(c);
}
double
my_double_real(double complex c)
{
return creal(c);
}
double
my_double_imag(double complex c)
{
return cimag(c);
}
float complex
my_float_complex_ret(float r, float i)
{
return r + i*I;
}
double complex
my_double_complex_ret(double r, double i)
{
return r + i*I;
}
int
dlmain(int argc, char *argv[])
{
ffi_cif cif;
ffi_type *args[2];
void *values[2];
args[0] = &ffi_type_complex_float;
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1, &ffi_type_float, args) == FFI_OK)
{
float answer;
float complex input;
input = 1.0 + 2.0 * I;
values[0] = &input;
ffi_call(&cif, (void*) my_float_real, &answer, values);
/* printf("answer = %g\n", answer); */
if(answer != 1.0)
return 2;
ffi_call(&cif, (void*) my_float_imag, &answer, values);
/* printf("answer = %g\n", answer); */
if(answer != 2.0)
return 2;
}
else
{
return 2;
}
args[0] = &ffi_type_complex_double;
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1, &ffi_type_double, args) == FFI_OK)
{
double answer;
double complex input;
input = 1.0 + 2.0 * I;
values[0] = &input;
ffi_call(&cif, (void*) my_double_real, &answer, values);
/* printf("answer = %g\n", answer); */
if(answer != 1.0)
return 2;
ffi_call(&cif, (void*) my_double_imag, &answer, values);
/* printf("answer = %g\n", answer); */
if(answer != 2.0)
return 2;
}
else
{
return 2;
}
args[0] = &ffi_type_float;
args[1] = &ffi_type_float;
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 2, &ffi_type_complex_float, args) == FFI_OK)
{
float complex answer;
float r=1.0, i=2.0;
values[0] = &r;
values[1] = &i;
ffi_call(&cif, (void*) my_float_complex_ret, &answer, values);
if(creal(answer) != 1.0 || cimag(answer) != 2.0)
return 2;
}
args[0] = &ffi_type_double;
args[1] = &ffi_type_double;
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 2, &ffi_type_complex_double, args) == FFI_OK)
{
double complex answer;
double r=1.0, i=2.0;
values[0] = &r;
values[1] = &i;
ffi_call(&cif, (void*) my_double_complex_ret, &answer, values);
if(creal(answer) != 1.0 || cimag(answer) != 2.0)
return 2;
}
return 0;
}
FFI-Platypus-2.12/inc/probe/longdouble.c 000644 000000 000000 00000001263 15251066120 020015 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
long double
my_long_double(long double a, long double b)
{
if(a != 1.0L || b != 3.0L)
exit(2);
return a+b;
}
int
dlmain(int argc, char *argv[])
{
ffi_cif cif;
ffi_type *args[2];
void *values[2];
if(&ffi_type_longdouble == &ffi_type_double)
return 2;
args[0] = &ffi_type_longdouble;
args[1] = &ffi_type_longdouble;
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 2, &ffi_type_longdouble, args) == FFI_OK)
{
long double answer;
long double a = 1.0L;
long double b = 3.0L;
values[0] = &a;
values[1] = &b;
ffi_call(&cif, (void*) my_long_double, &answer, values);
if(answer == 4.0L)
return 0;
}
return 2;
}
FFI-Platypus-2.12/inc/probe/recordvalue.c 000644 000000 000000 00000002056 15251066120 020177 0 ustar 00root root 000000 000000 #include <ffi.h>
#include <string.h>
#include <stdlib.h>
#define is_signed(type) ((((type)-1) < 0) ? 1 : 0)
typedef struct {
char name[13];
int value;
} foo_t;
foo_t
get_foo(void)
{
foo_t self;
strcpy(self.name, "hello");
self.value = 42;
return self;
}
int
dlmain(int argc, char *argv[])
{
ffi_cif cif;
ffi_type ffi_type_foo_t;
int i;
foo_t foo;
ffi_type *arg_types[1] = { &ffi_type_void };
void *args[1] = { NULL };
ffi_type_foo_t.size = ffi_type_foo_t.alignment = 0;
ffi_type_foo_t.type = FFI_TYPE_STRUCT;
ffi_type_foo_t.elements = calloc(15, sizeof(ffi_type*));
for(i=0; i<13; i++)
ffi_type_foo_t.elements[i] = is_signed(char) ? &ffi_type_sint8 : &ffi_type_uint8;
ffi_type_foo_t.elements[13] = &ffi_type_sint32;
ffi_type_foo_t.elements[14] = NULL;
if(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 0, &ffi_type_foo_t, arg_types) == FFI_OK)
{
ffi_call(&cif, (void*) get_foo, &foo, args);
if(strcmp(foo.name, "hello"))
return 2;
if(foo.value != 42)
return 2;
}
else
return 2;
return 0;
}
FFI-Platypus-2.12/inc/probe/strnlen.c 000644 000000 000000 00000000272 15251066120 017347 0 ustar 00root root 000000 000000 #include <string.h>
int
dlmain(int argc, char *arg[])
{
const char *test = "123456789\0";
if(strnlen(test, 100) == 9 && strnlen(test, 4) == 4)
return 0;
else
return 2;
}
FFI-Platypus-2.12/inc/probe/variadic.c 000644 000000 000000 00000002407 15251066120 017446 0 ustar 00root root 000000 000000 #include <stdio.h>
#include <stdarg.h>
#include <ffi.h>
int
return_arg(int which, ...)
{
va_list args;
va_start(args, which);
int i, val;
for(i=0; i<which; i++)
{
val = va_arg(args, int);
}
va_end(args);
return val;
}
int
basic_test()
{
int answer;
answer = return_arg(4,10,20,30,40,50,60,70);
if(answer != 40)
{
/* basic varadic function fail */
printf("basic answer = %d\n", answer);
return 2;
}
return 0;
}
int
ffi_test()
{
ffi_cif cif;
ffi_type *args[8] = { &ffi_type_sint32, &ffi_type_sint32, &ffi_type_sint32, &ffi_type_sint32, &ffi_type_sint32, &ffi_type_sint32, &ffi_type_sint32, &ffi_type_sint32 };
int values[8] = { 4,10,20,30,40,50,60,70 };
void *ptrvalues[8] = { &values[0], &values[1], &values[2], &values[3], &values[4], &values[5], &values[6], &values[7] };
int answer = -1;
if(ffi_prep_cif_var(&cif, FFI_DEFAULT_ABI, 1, 8, &ffi_type_sint32, args) == FFI_OK)
{
ffi_call(&cif, (void*) return_arg, &answer, ptrvalues);
if(answer != 40)
{
printf("ffi ansewr = %d\n", answer);
return 2;
}
else
{
return 0;
}
}
else
{
return 2;
}
}
int
dlmain(int argc, char *argv[])
{
if(basic_test())
return 2;
if(ffi_test())
return 2;
return 0;
}
FFI-Platypus-2.12/include/ 000755 000000 000000 00000000000 15251066120 015260 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/include/ffi_platypus.h 000644 000000 000000 00000027626 15251066120 020153 0 ustar 00root root 000000 000000 #ifndef FFI_PLATYPUS_H
#define FFI_PLATYPUS_H
#include <ffi.h>
#include "ffi_platypus_config.h"
#ifdef HAVE_DLFCN_H
#ifndef PERL_OS_WINDOWS
#include <dlfcn.h>
#endif
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#ifdef HAVE_STDDEF_H
#include <stddef.h>
#endif
#ifdef HAVE_STDINT_H
#include <stdint.h>
#endif
#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#ifdef HAVE_ALLOCA_H
#include <alloca.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#ifdef HAVE_COMPLEX_H
#include <complex.h>
#endif
#ifdef __cplusplus
extern "C" {
#endif
#ifdef PERL_OS_WINDOWS
void *windlopen(const char *, int);
const char *windlerror(void);
void *windlsym(void *, const char *);
int windlclose(void *);
#define dlopen(filename, flag) windlopen(filename, flag)
#define dlerror() windlerror()
#define dlsym(handle, symbol) windlsym(handle, symbol)
#define dlclose(handle) windlclose(handle)
#endif
typedef enum _ffi_pl_type_code {
/*
* the first three bits represent the
* native unit size for each type.
*/
FFI_PL_SIZE_0 = 0x0000,
FFI_PL_SIZE_8 = 0x0001,
FFI_PL_SIZE_16 = 0x0002,
FFI_PL_SIZE_32 = 0x0003,
FFI_PL_SIZE_64 = 0x0004,
FFI_PL_SIZE_128 = 0x0005,
FFI_PL_SIZE_256 = 0x0006,
FFI_PL_SIZE_512 = 0x0007,
#if SIZEOF_VOIDP == 4
FFI_PL_SIZE_PTR = FFI_PL_SIZE_32,
#elif SIZEOF_VOIDP == 8
FFI_PL_SIZE_PTR = FFI_PL_SIZE_64,
#else
#error "strange pointer size"
#endif
FFI_PL_SIZE_MASK = 0x0007,
/*
* The next nine bits represent the type:
* basics: void, integer, float, complex
*
* opaque is a pointer to something, a void*
*
* string is a pointer to a null terminated string
* (a c string, basically)
*
* closure is a pointer to a function, usually a
* Perl function, enclosed within a FFI::Platypus::Closure
*
* record is a fixed bitmap, could be either a struct,
* or a fixed length string.
*/
FFI_PL_BASE_VOID = 0x0008,
FFI_PL_BASE_SINT = 0x0010,
FFI_PL_BASE_UINT = 0x0020,
FFI_PL_BASE_FLOAT = 0x0040,
FFI_PL_BASE_COMPLEX = 0x0080,
FFI_PL_BASE_OPAQUE = 0x0100,
FFI_PL_BASE_STRING = 0x0200,
FFI_PL_BASE_CLOSURE = 0x0400,
FFI_PL_BASE_RECORD = 0x0800,
FFI_PL_BASE_MASK = 0x0ff8,
/*
* The shape describes how the data is organized.
* sclar is a simple value, pointer is usually used
* for pass by reference, array is a list of objects
* and custom types allow users to create their own
* custom types.
*/
FFI_PL_SHAPE_SCALAR = 0x0000,
FFI_PL_SHAPE_POINTER = 0x1000,
FFI_PL_SHAPE_ARRAY = 0x2000,
FFI_PL_SHAPE_CUSTOM_PERL = 0x3000,
FFI_PL_SHAPE_OBJECT = 0x4000,
FFI_PL_SHAPE_MASK = 0xf000,
/*
* You can or together the different bit fields above to
* describe a type. An int for example (usually signed 32 bit integer)
* is `FFI_PL_SIZE_32 | FFI_PL_BASE_SINT`. Not all combinations
* have meaning, for example `FFI_PL_SIZE_8 | FFI_PL_BASE_FLOAT`
* is gibberish
*/
FFI_PL_TYPE_VOID = FFI_PL_SIZE_0 | FFI_PL_BASE_VOID,
FFI_PL_TYPE_SINT8 = FFI_PL_SIZE_8 | FFI_PL_BASE_SINT,
FFI_PL_TYPE_SINT16 = FFI_PL_SIZE_16 | FFI_PL_BASE_SINT,
FFI_PL_TYPE_SINT32 = FFI_PL_SIZE_32 | FFI_PL_BASE_SINT,
FFI_PL_TYPE_SINT64 = FFI_PL_SIZE_64 | FFI_PL_BASE_SINT,
FFI_PL_TYPE_UINT8 = FFI_PL_SIZE_8 | FFI_PL_BASE_UINT,
FFI_PL_TYPE_UINT16 = FFI_PL_SIZE_16 | FFI_PL_BASE_UINT,
FFI_PL_TYPE_UINT32 = FFI_PL_SIZE_32 | FFI_PL_BASE_UINT,
FFI_PL_TYPE_UINT64 = FFI_PL_SIZE_64 | FFI_PL_BASE_UINT,
FFI_PL_TYPE_FLOAT = FFI_PL_SIZE_32 | FFI_PL_BASE_FLOAT,
FFI_PL_TYPE_DOUBLE = FFI_PL_SIZE_64 | FFI_PL_BASE_FLOAT,
FFI_PL_TYPE_LONG_DOUBLE = FFI_PL_SIZE_128 | FFI_PL_BASE_FLOAT,
FFI_PL_TYPE_COMPLEX_FLOAT = FFI_PL_SIZE_64 | FFI_PL_BASE_COMPLEX,
FFI_PL_TYPE_COMPLEX_DOUBLE = FFI_PL_SIZE_128 | FFI_PL_BASE_COMPLEX,
FFI_PL_TYPE_OPAQUE = FFI_PL_SIZE_PTR | FFI_PL_BASE_OPAQUE,
/*
* These types are passed as pointers, and act like opaque types
* in terms of sizeof, alignof, etc, but get passed differently.
*/
FFI_PL_TYPE_STRING = FFI_PL_TYPE_OPAQUE | FFI_PL_BASE_STRING,
FFI_PL_TYPE_CLOSURE = FFI_PL_TYPE_OPAQUE | FFI_PL_BASE_CLOSURE,
FFI_PL_TYPE_RECORD = FFI_PL_TYPE_OPAQUE | FFI_PL_BASE_RECORD,
FFI_PL_TYPE_RECORD_VALUE = FFI_PL_BASE_RECORD,
} ffi_pl_type_code;
typedef enum _platypus_string_type {
FFI_PL_TYPE_STRING_RO = 0,
FFI_PL_TYPE_STRING_RW = 1
} platypus_string_type;
typedef struct _ffi_pl_type_extra_object {
char *class; /* base class */
} ffi_pl_type_extra_object;
typedef struct _ffi_pl_record_meta_t {
ffi_type ffi_type;
int can_return_from_closure;
ffi_type *elements[0];
} ffi_pl_record_meta_t;
typedef struct _ffi_pl_type_extra_record {
size_t size;
char *class; /* base class */
ffi_pl_record_meta_t *meta;
} ffi_pl_type_extra_record;
typedef struct _ffi_pl_type_extra_custom_perl {
union {
ffi_pl_type_extra_record record;
} ox;
void *perl_to_native;
void *native_to_perl;
void *perl_to_native_post;
int argument_count;
} ffi_pl_type_extra_custom_perl;
typedef struct _ffi_pl_type_extra_array {
int element_count;
} ffi_pl_type_extra_array;
struct _ffi_pl_type;
typedef struct _ffi_pl_type_extra_closure {
ffi_cif ffi_cif;
int flags;
struct _ffi_pl_type *return_type;
struct _ffi_pl_type *argument_types[0];
} ffi_pl_type_extra_closure;
typedef union _ffi_pl_type_extra {
ffi_pl_type_extra_custom_perl custom_perl;
ffi_pl_type_extra_array array;
ffi_pl_type_extra_closure closure;
ffi_pl_type_extra_record record;
ffi_pl_type_extra_object object;
} ffi_pl_type_extra;
typedef struct _ffi_pl_type {
unsigned short type_code;
unsigned short sub_type;
ffi_pl_type_extra extra[0];
} ffi_pl_type;
typedef struct _ffi_pl_function {
void *address;
void *platypus_sv; /* really a Perl SV* */
int platypus_api;
ffi_cif ffi_cif;
ffi_pl_type *return_type;
ffi_pl_type *argument_types[0];
} ffi_pl_function;
typedef struct _ffi_pl_closure {
ffi_closure *ffi_closure;
void *function_pointer; /* C function pointer */
void *coderef; /* Perl HV* pointing to FFI::Platypus::Closure object */
ffi_pl_type *type;
} ffi_pl_closure;
typedef const char *ffi_pl_string;
typedef union _ffi_pl_result {
void *pointer;
const char *string;
int8_t sint8;
uint8_t uint8;
#if defined FFI_PL_PROBE_BIGENDIAN
int8_t sint8_array[4];
uint8_t uint8_array[4];
#elif defined FFI_PL_PROBE_BIGENDIAN64
int8_t sint8_array[8];
uint8_t uint8_array[8];
#endif
int16_t sint16;
uint16_t uint16;
#if defined FFI_PL_PROBE_BIGENDIAN
int16_t sint16_array[2];
uint16_t uint16_array[2];
#elif defined FFI_PL_PROBE_BIGENDIAN64
int16_t sint16_array[4];
uint16_t uint16_array[4];
#endif
int32_t sint32;
uint32_t uint32;
#if defined FFI_PL_PROBE_BIGENDIAN64
uint32_t uint32_array[2];
int32_t sint32_array[2];
#endif
int64_t sint64;
uint64_t uint64;
float xfloat;
double xdouble;
#ifdef FFI_PL_PROBE_LONGDOUBLE
long double longdouble;
#endif
#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
#ifdef SIZEOF_FLOAT_COMPLEX
float complex complex_float;
#endif
#ifdef SIZEOF_DOUBLE_COMPLEX
double complex complex_double;
#endif
#endif
} ffi_pl_result;
typedef union _ffi_pl_argument {
void *pointer;
const char *string;
int8_t sint8;
uint8_t uint8;
int16_t sint16;
uint16_t uint16;
int32_t sint32;
uint32_t uint32;
int64_t sint64;
uint64_t uint64;
float xfloat;
double xdouble;
} ffi_pl_argument;
typedef struct _ffi_pl_arguments {
int count;
int reserved;
ffi_pl_argument slot[0];
} ffi_pl_arguments;
typedef struct _ffi_pl_record_member {
int offset;
int count;
} ffi_pl_record_member;
#define ffi_pl_arguments_count(arguments) (arguments->count)
#define ffi_pl_arguments_set_pointer(arguments, i, value) (arguments->slot[i].pointer = value)
#define ffi_pl_arguments_get_pointer(arguments, i) (arguments->slot[i].pointer)
#define ffi_pl_arguments_set_string(arguments, i, value) (arguments->slot[i].string = value)
#define ffi_pl_arguments_get_string(arguments, i) (arguments->slot[i].string)
#define ffi_pl_arguments_set_sint8(arguments, i, value) (arguments->slot[i].sint8 = value)
#define ffi_pl_arguments_get_sint8(arguments, i) (arguments->slot[i].sint8)
#define ffi_pl_arguments_set_uint8(arguments, i, value) (arguments->slot[i].uint8 = value)
#define ffi_pl_arguments_get_uint8(arguments, i) (arguments->slot[i].uint8)
#define ffi_pl_arguments_set_sint16(arguments, i, value) (arguments->slot[i].sint16 = value)
#define ffi_pl_arguments_get_sint16(arguments, i) (arguments->slot[i].sint16)
#define ffi_pl_arguments_set_uint16(arguments, i, value) (arguments->slot[i].uint16 = value)
#define ffi_pl_arguments_get_uint16(arguments, i) (arguments->slot[i].uint16)
#define ffi_pl_arguments_set_sint32(arguments, i, value) (arguments->slot[i].sint32 = value)
#define ffi_pl_arguments_get_sint32(arguments, i) (arguments->slot[i].sint32)
#define ffi_pl_arguments_set_uint32(arguments, i, value) (arguments->slot[i].uint32 = value)
#define ffi_pl_arguments_get_uint32(arguments, i) (arguments->slot[i].uint32)
#define ffi_pl_arguments_set_sint64(arguments, i, value) (arguments->slot[i].sint64 = value)
#define ffi_pl_arguments_get_sint64(arguments, i) (arguments->slot[i].sint64)
#define ffi_pl_arguments_set_uint64(arguments, i, value) (arguments->slot[i].uint64 = value)
#define ffi_pl_arguments_get_uint64(arguments, i) (arguments->slot[i].uint64)
#define ffi_pl_arguments_set_float(arguments, i, value) (arguments->slot[i].xfloat = value)
#define ffi_pl_arguments_get_float(arguments, i) (arguments->slot[i].xfloat)
#define ffi_pl_arguments_set_double(arguments, i, value) (arguments->slot[i].xdouble = value)
#define ffi_pl_arguments_get_double(arguments, i) (arguments->slot[i].xdouble)
#define ffi_pl_arguments_pointers(arguments) ((void**)&arguments->slot[arguments->count])
typedef struct _ffi_pl_heap {
void *_this;
void *_next;
} ffi_pl_heap;
#define ffi_pl_heap_add(ptr, count, type) { \
ffi_pl_heap *n; \
Newx(ptr, count, type); \
Newx(n, 1, ffi_pl_heap); \
n->_this = ptr; \
n->_next = (void*) heap; \
heap = n; \
}
#define ffi_pl_heap_add_ptr(ptr) { \
ffi_pl_heap *n; \
Newx(n, 1, ffi_pl_heap); \
n->_this = ptr; \
n->_next = (void*) heap; \
heap = n; \
}
#define ffi_pl_heap_free() { \
while(heap != NULL) \
{ \
ffi_pl_heap *old = heap; \
heap = (ffi_pl_heap *) old->_next; \
Safefree(old->_this); \
Safefree(old); \
} \
}
#define ffi_pl_croak \
ffi_pl_heap_free(); \
croak
#if defined(_MSC_VER)
#define Newx_or_alloca(ptr, count, type) ptr = _alloca(sizeof(type)*count)
#elif defined(FFI_PL_PROBE_ALLOCA)
#define Newx_or_alloca(ptr, count, type) ptr = alloca(sizeof(type)*count)
#else
#define Newx_or_alloca(ptr, count, type) ffi_pl_heap_add(ptr, count, type)
#endif
ffi_type *ffi_pl_type_to_libffi_type(ffi_pl_type *type);
ffi_pl_type *ffi_pl_type_new(size_t size);
#if SIZEOF_VOIDP == 4 && !defined(__hppa__)
uint64_t cast0(void);
#else
void *cast0(void);
#endif
#if SIZEOF_VOIDP == 4 && !defined(__hppa__)
uint64_t cast1(uint64_t value);
#else
void *cast1(void *value);
#endif
#ifdef __cplusplus
}
#endif
#endif
FFI-Platypus-2.12/include/ffi_platypus_bundle.h 000644 000000 000000 00000001436 15251066120 021473 0 ustar 00root root 000000 000000 #ifndef FFI_PLATYPUS_BUNDLE_H
#define FFI_PLATYPUS_BUNDLE_H
#include "ffi_platypus_config.h"
#ifdef HAVE_STDDEF_H
#include <stddef.h>
#endif
#ifdef HAVE_STDINT_H
#include <stdint.h>
#endif
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
typedef struct {
void (*set_str) (const char *name, const char *value);
void (*set_sint) (const char *name, int64_t value );
void (*set_uint) (const char *name, uint64_t value );
void (*set_double) (const char *name, double value );
} ffi_platypus_constant_t;
#ifdef _MSC_VER
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif
EXPORT void ffi_pl_bundle_init(const char *, int, void **);
EXPORT void ffi_pl_bundle_constant(const char *, ffi_platypus_constant_t *);
EXPORT void ffi_pl_bundle_fini(const char *);
#endif
FFI-Platypus-2.12/include/ffi_platypus_call.h 000644 000000 000000 00000172353 15251066120 021144 0 ustar 00root root 000000 000000
/*
* Philosophy: FFI dispatch should be as fast as possible considering
* reasonable trade offs.
*
* - don't allocate memory for small things using `malloc`, instead use
* alloca on platforms that allow it (most modern platforms do).
* - don't make function calls. You shouldn't have to make a function
* calls to call a function. Exceptions are for custom types and
* some of the more esoteric types.
* - one way we avoid making function calls is by putting the FFI dispatch
* in this header file so that it can be "called" twice without an
* extra function call. (`$ffi->function(...)->call(...)` and
* `$ffi->attach(foo => ...); foo(...)`). This is obviously absurd.
*
* Maybe each of these weird trade offs each save only a few ms on
* each call, but in the end the can add up. As a result of this
* priority set, FFI::Platypus does seem to perform considerably better
* than any other FFI implementations available in Perl ( see
* https://github.com/perl5-FFI/FFI-Performance ) and is even competitive
* with XS tbh.
*/
ffi_pl_heap *heap = NULL;
#if FFI_PL_CALL_NO_RECORD_VALUE
#define RESULT &result
ffi_pl_result result;
#elif FFI_PL_CALL_RET_NO_NORMAL
#define RESULT result_ptr
void *result_ptr;
Newx_or_alloca(result_ptr, self->return_type->extra[0].record.size, char);
#else
#define RESULT result_ptr
ffi_pl_result result;
void *result_ptr;
if(self->return_type->type_code == FFI_PL_TYPE_RECORD_VALUE
|| self->return_type->type_code == (FFI_PL_TYPE_RECORD_VALUE | FFI_PL_SHAPE_CUSTOM_PERL))
{
Newx_or_alloca(result_ptr, self->return_type->extra[0].record.size, char);
}
else
{
result_ptr = &result;
}
#endif
{
/* buffer contains the memory required for the arguments structure */
char *buffer;
size_t buffer_size = sizeof(ffi_pl_argument) * self->ffi_cif.nargs +
sizeof(void*) * self->ffi_cif.nargs +
sizeof(ffi_pl_arguments);
ffi_pl_heap_add(buffer, buffer_size, char);
MY_CXT.current_argv = arguments = (ffi_pl_arguments*) buffer;
}
arguments->count = self->ffi_cif.nargs;
argument_pointers = (void**) &arguments->slot[arguments->count];
/*
* ARGUMENT IN
*/
for(i=0, perl_arg_index=(EXTRA_ARGS); i < self->ffi_cif.nargs; i++, perl_arg_index++)
{
int type_code = self->argument_types[i]->type_code;
argument_pointers[i] = (void*) &arguments->slot[i];
arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
int custom_flag = (type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL;
if(custom_flag)
{
arg = ffi_pl_custom_perl(
self->argument_types[i]->extra[0].custom_perl.perl_to_native,
arg, i
);
if(arg == NULL)
{
int max = self->argument_types[i]->extra[0].custom_perl.argument_count;
for(n=0; n < max; n++)
{
i++;
argument_pointers[i] = &arguments->slot[i];
}
continue;
}
av_push(MY_CXT.custom_keepers, newRV_inc(arg));
type_code ^= FFI_PL_SHAPE_CUSTOM_PERL;
}
switch(type_code)
{
/*
* ARGUMENT IN - SCALAR TYPES
*/
case FFI_PL_TYPE_UINT8:
ffi_pl_arguments_set_uint8(arguments, i, SvOK(arg) ? SvUV(arg) : 0);
break;
case FFI_PL_TYPE_SINT8:
ffi_pl_arguments_set_sint8(arguments, i, SvOK(arg) ? SvIV(arg) : 0);
break;
case FFI_PL_TYPE_UINT16:
ffi_pl_arguments_set_uint16(arguments, i, SvOK(arg) ? SvUV(arg) : 0);
break;
case FFI_PL_TYPE_SINT16:
ffi_pl_arguments_set_sint16(arguments, i, SvOK(arg) ? SvIV(arg) : 0);
break;
case FFI_PL_TYPE_UINT32:
ffi_pl_arguments_set_uint32(arguments, i, SvOK(arg) ? SvUV(arg) : 0);
break;
case FFI_PL_TYPE_SINT32:
ffi_pl_arguments_set_sint32(arguments, i, SvOK(arg) ? SvIV(arg) : 0);
break;
case FFI_PL_TYPE_UINT64:
ffi_pl_arguments_set_uint64(arguments, i, SvOK(arg) ? SvU64(arg) : 0);
break;
case FFI_PL_TYPE_SINT64:
ffi_pl_arguments_set_sint64(arguments, i, SvOK(arg) ? SvI64(arg) : 0);
break;
case FFI_PL_TYPE_FLOAT:
ffi_pl_arguments_set_float(arguments, i, SvOK(arg) ? SvNV(arg) : 0.0);
break;
case FFI_PL_TYPE_DOUBLE:
ffi_pl_arguments_set_double(arguments, i, SvOK(arg) ? SvNV(arg) : 0.0);
break;
case FFI_PL_TYPE_OPAQUE:
ffi_pl_arguments_set_pointer(arguments, i, SvOK(arg) ? INT2PTR(void*, SvIV(arg)) : NULL);
break;
case FFI_PL_TYPE_STRING:
ffi_pl_arguments_set_string(arguments, i, SvOK(arg) ? SvPV_nolen(arg) : NULL);
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
{
long double *ptr;
Newx_or_alloca(ptr, 1, long double);
argument_pointers[i] = ptr;
ffi_pl_perl_to_long_double(arg, ptr);
}
break;
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT:
{
float *ptr;
Newx_or_alloca(ptr, 2, float);
argument_pointers[i] = ptr;
ffi_pl_perl_to_complex_float(arg, ptr);
}
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
{
double *ptr;
Newx_or_alloca(ptr, 2, double);
argument_pointers[i] = ptr;
ffi_pl_perl_to_complex_double(arg, ptr);
}
break;
#endif
case FFI_PL_TYPE_RECORD:
{
void *ptr;
STRLEN size;
int expected;
expected = self->argument_types[i]->extra[0].record.size;
if(SvROK(arg))
{
SV *arg2 = SvRV(arg);
ptr = SvOK(arg2) ? SvPV(arg2, size) : NULL;
}
else
{
ptr = SvOK(arg) ? SvPV(arg, size) : NULL;
}
if(ptr != NULL && expected != 0 && size != expected)
warn("record argument %d has wrong size (is %d, expected %d)", i, (int)size, expected);
ffi_pl_arguments_set_pointer(arguments, i, ptr);
}
break;
case FFI_PL_TYPE_RECORD_VALUE:
{
const char *record_class = self->argument_types[i]->extra[0].record.class;
/* TODO if object is read-onyl ? */
if(sv_isobject(arg) && sv_derived_from(arg, record_class))
{
argument_pointers[i] = SvPV_nolen(SvRV(arg));
}
else
{
ffi_pl_croak("argument %d is not an instance of %s", i, record_class);
}
}
break;
case FFI_PL_TYPE_CLOSURE:
{
if(!SvROK(arg))
{
ffi_pl_arguments_set_pointer(arguments, i, SvOK(arg) ? INT2PTR(void*, SvIV(arg)) : NULL);
}
else
{
ffi_pl_closure *closure;
ffi_status ffi_status;
SvREFCNT_inc(arg);
SvREFCNT_inc(SvRV(arg));
closure = ffi_pl_closure_get_data(arg, self->argument_types[i]);
if(closure != NULL)
{
ffi_pl_arguments_set_pointer(arguments, i, closure->function_pointer);
}
else
{
Newx(closure, 1, ffi_pl_closure);
closure->ffi_closure = ffi_closure_alloc(sizeof(ffi_closure), &closure->function_pointer);
if(closure->ffi_closure == NULL)
{
Safefree(closure);
ffi_pl_arguments_set_pointer(arguments, i, NULL);
warn("unable to allocate memory for closure");
}
else
{
closure->type = self->argument_types[i];
ffi_status = ffi_prep_closure_loc(
closure->ffi_closure,
&self->argument_types[i]->extra[0].closure.ffi_cif,
ffi_pl_closure_call,
closure,
closure->function_pointer
);
if(ffi_status != FFI_OK)
{
ffi_closure_free(closure->ffi_closure);
Safefree(closure);
ffi_pl_arguments_set_pointer(arguments, i, NULL);
warn("unable to create closure");
}
else
{
SV **svp;
svp = hv_fetch((HV *)SvRV(arg), "code", 4, 0);
if(svp != NULL)
{
closure->coderef = *svp;
SvREFCNT_inc(closure->coderef);
ffi_pl_closure_add_data(arg, closure);
ffi_pl_arguments_set_pointer(arguments, i, closure->function_pointer);
}
else
{
ffi_closure_free(closure->ffi_closure);
Safefree(closure);
ffi_pl_arguments_set_pointer(arguments, i, NULL);
warn("closure has no coderef");
}
}
}
}
}
}
break;
default:
switch(type_code & FFI_PL_SHAPE_MASK)
{
/*
* ARGUMENT IN - POINTER & ARRAY TYPES
*/
case FFI_PL_SHAPE_POINTER:
case FFI_PL_SHAPE_ARRAY:
{
void *ptr = NULL;
SSize_t count = 0;
int is_pointer = (type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_POINTER;
int is_bad = 0;
if(SvROK(arg))
{
SV *arg2 = SvRV(arg);
if(SvTYPE(arg2) < SVt_PVAV && is_pointer)
{
switch(type_code & (FFI_PL_BASE_MASK|FFI_PL_SIZE_MASK))
{
case FFI_PL_TYPE_UINT8:
Newx_or_alloca(ptr, 1, uint8_t);
*((uint8_t*)ptr) = SvOK(arg2) ? SvUV(arg2) : 0;
break;
case FFI_PL_TYPE_SINT8:
Newx_or_alloca(ptr, 1, int8_t);
*((int8_t*)ptr) = SvOK(arg2) ? SvIV(arg2) : 0;
break;
case FFI_PL_TYPE_UINT16:
Newx_or_alloca(ptr, 1, uint16_t);
*((uint16_t*)ptr) = SvOK(arg2) ? SvUV(arg2) : 0;
break;
case FFI_PL_TYPE_SINT16:
Newx_or_alloca(ptr, 1, int16_t);
*((int16_t*)ptr) = SvOK(arg2) ? SvIV(arg2) : 0;
break;
case FFI_PL_TYPE_UINT32:
Newx_or_alloca(ptr, 1, uint32_t);
*((uint32_t*)ptr) = SvOK(arg2) ? SvUV(arg2) : 0;
break;
case FFI_PL_TYPE_SINT32:
Newx_or_alloca(ptr, 1, int32_t);
*((int32_t*)ptr) = SvOK(arg2) ? SvIV(arg2) : 0;
break;
case FFI_PL_TYPE_UINT64:
Newx_or_alloca(ptr, 1, uint64_t);
*((uint64_t*)ptr) = SvOK(arg2) ? SvU64(arg2) : 0;
break;
case FFI_PL_TYPE_SINT64:
Newx_or_alloca(ptr, 1, int64_t);
*((int64_t*)ptr) = SvOK(arg2) ? SvI64(arg2) : 0;
break;
case FFI_PL_TYPE_FLOAT:
Newx_or_alloca(ptr, 1, float);
*((float*)ptr) = SvOK(arg2) ? SvNV(arg2) : 0.0;
break;
case FFI_PL_TYPE_DOUBLE:
Newx_or_alloca(ptr, 1, double);
*((double*)ptr) = SvOK(arg2) ? SvNV(arg2) : 0.0;
break;
case FFI_PL_TYPE_OPAQUE:
Newx_or_alloca(ptr, 1, void*);
{
SV *tmp = SvRV(arg);
*((void**)ptr) = SvOK(tmp) ? INT2PTR(void *, SvIV(tmp)) : NULL;
}
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
Newx_or_alloca(ptr, 1, long double);
ffi_pl_perl_to_long_double(arg2, (long double*)ptr);
break;
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT:
Newx_or_alloca(ptr, 1, float complex);
ffi_pl_perl_to_complex_float(arg2, (float *)ptr);
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
Newx_or_alloca(ptr, 1, double complex);
ffi_pl_perl_to_complex_double(arg2, (double *)ptr);
break;
#endif
case FFI_PL_TYPE_STRING:
Newx_or_alloca(ptr, 1, char *);
if(SvOK(arg2))
{
char *pv;
STRLEN len;
char *str;
pv = SvPV(arg2, len);
/* TODO: this should probably be a malloc since it could be arbitrarily large */
Newx_or_alloca(str, len+1, char);
memcpy(str, pv, len+1);
*((char**)ptr) = str;
}
else
{
*((char**)ptr) = NULL;
}
break;
default:
warn("argument type not supported (%d)", i);
Newx_or_alloca(ptr, 1, void*);
*((void**)ptr) = NULL;
break;
}
}
else if(SvTYPE(arg2) == SVt_PVAV && (!is_pointer) || (is_pointer && self->platypus_api >= 2))
{
AV *av = (AV*) arg2;
if(!is_pointer)
{
count = self->argument_types[i]->extra[0].array.element_count;
}
if(count == 0)
{
count = av_len(av)+1;
}
switch(type_code & (FFI_PL_BASE_MASK|FFI_PL_SIZE_MASK))
{
case FFI_PL_TYPE_UINT8:
Newx(ptr, count, uint8_t);
for(n=0; n<count; n++)
{
((uint8_t*)ptr)[n] = SvUV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_SINT8:
Newx(ptr, count, int8_t);
for(n=0; n<count; n++)
{
((int8_t*)ptr)[n] = SvIV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_UINT16:
Newx(ptr, count, uint16_t);
for(n=0; n<count; n++)
{
((uint16_t*)ptr)[n] = SvUV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_SINT16:
Newx(ptr, count, int16_t);
for(n=0; n<count; n++)
{
((int16_t*)ptr)[n] = SvIV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_UINT32:
Newx(ptr, count, uint32_t);
for(n=0; n<count; n++)
{
((uint32_t*)ptr)[n] = SvUV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_SINT32:
Newx(ptr, count, int32_t);
for(n=0; n<count; n++)
{
((int32_t*)ptr)[n] = SvIV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_UINT64:
Newx(ptr, count, uint64_t);
for(n=0; n<count; n++)
{
((uint64_t*)ptr)[n] = SvU64(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_SINT64:
Newx(ptr, count, int64_t);
for(n=0; n<count; n++)
{
((int64_t*)ptr)[n] = SvI64(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_FLOAT:
Newx(ptr, count, float);
for(n=0; n<count; n++)
{
((float*)ptr)[n] = SvNV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_DOUBLE:
Newx(ptr, count, double);
for(n=0; n<count; n++)
{
((double*)ptr)[n] = SvNV(*av_fetch(av, n, 1));
}
break;
case FFI_PL_TYPE_OPAQUE:
Newx(ptr, count, void*);
for(n=0; n<count; n++)
{
SV *sv = *av_fetch(av, n, 1);
((void**)ptr)[n] = SvOK(sv) ? INT2PTR(void*, SvIV(sv)) : NULL;
}
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
/* gh#236: lets hope the compiler is smart enough to opitmize this */
if(sizeof(long double) >= 16)
{
Newx(ptr, count, long double);
}
else
{
Newx(ptr, count*16, char);
}
for(n=0; n<count; n++)
{
SV *sv = *av_fetch(av, n, 1);
ffi_pl_perl_to_long_double(sv, &((long double*)ptr)[n]);
}
break;
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT:
Newx(ptr, count, float complex);
for(n=0; n<count; n++)
{
SV *sv = *av_fetch(av, n, 1);
ffi_pl_perl_to_complex_float(sv, &((float*)ptr)[n*2]);
}
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
Newx(ptr, count, double complex);
for(n=0; n<count; n++)
{
SV *sv = *av_fetch(av, n, 1);
ffi_pl_perl_to_complex_double(sv, &((double*)ptr)[n*2]);
}
break;
#endif
case FFI_PL_TYPE_STRING:
Newx(ptr, count, char *);
for(n=0; n<count; n++)
{
SV *sv = *av_fetch(av, n, 1);
if(SvOK(sv))
{
char *str;
char *pv;
STRLEN len;
pv = SvPV(sv, len);
/* TODO: this should probably be a malloc since it could be arbitrarily large */
Newx_or_alloca(str, len+1, char);
memcpy(str, pv, len+1);
((char**)ptr)[n] = str;
}
else
{
((char**)ptr)[n] = NULL;
}
}
break;
default:
Newxz(ptr, count*(1 << ((type_code & FFI_PL_SIZE_MASK)-1)), char);
warn("argument type not supported (%d)", i);
break;
}
ffi_pl_heap_add_ptr(ptr);
}
else
{
is_bad = 1;
}
}
else
{
if(is_pointer)
{
ptr = NULL;
}
else
{
is_bad = 1;
}
}
if(is_bad)
{
if(is_pointer)
{
if(self->platypus_api >= 2)
{
warn("argument type not a reference to scalar or array (%d)", i);
}
else
{
warn("argument type not a reference to scalar (%d)", i);
}
}
else
{
warn("passing non array reference into ffi/platypus array argument type");
count = self->argument_types[i]->extra[0].array.element_count;
Newxz(ptr, count*(1 << ((type_code & FFI_PL_SIZE_MASK)-1)), char);
ffi_pl_heap_add_ptr(ptr);
}
}
ffi_pl_arguments_set_pointer(arguments, i, ptr);
}
break;
/*
* ARGUMENT IN - OBJECT
*/
case FFI_PL_SHAPE_OBJECT:
{
if(sv_isobject(arg) && sv_derived_from(arg, self->argument_types[i]->extra[0].object.class))
{
SV *arg2 = SvRV(arg);
switch(type_code)
{
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_uint8(arguments, i, SvUV(arg2) );
break;
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_sint8(arguments, i, SvIV(arg2) );
break;
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_uint16(arguments, i, SvUV(arg2) );
break;
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_sint16(arguments, i, SvIV(arg2) );
break;
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_uint32(arguments, i, SvUV(arg2) );
break;
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_sint32(arguments, i, SvIV(arg2) );
break;
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_uint64(arguments, i, SvU64(arg2) );
break;
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_sint64(arguments, i, SvI64(arg2) );
break;
case FFI_PL_TYPE_OPAQUE | FFI_PL_SHAPE_OBJECT:
ffi_pl_arguments_set_pointer(arguments, i, SvOK(arg2) ? INT2PTR(void*, SvIV(arg2)) : NULL);
break;
default:
ffi_pl_croak("Object argument %d type not supported %d", i, type_code);
}
}
else
{
ffi_pl_croak("Object argument %d must be an object of class %s", i, self->argument_types[i]->extra[0].object.class);
}
}
break;
/*
* ARGUMENT IN - UNSUPPORTED
*/
default:
warn("FFI::Platypus: argument %d type not supported (%04x)", i, type_code);
break;
}
}
if(custom_flag)
{
int max = self->argument_types[i]->extra[0].custom_perl.argument_count;
SvREFCNT_dec(arg);
for(n=0; n < max; n++)
{
i++;
argument_pointers[i] = &arguments->slot[i];
}
}
}
/*
* CALL
*/
#if 0
fprintf(stderr, "# ===[%p]===\n", self->address);
for(i=0; i < self->ffi_cif.nargs; i++)
{
fprintf(stderr, "# [%d] <%04x> %p %p",
i,
self->argument_types[i]->type_code,
argument_pointers[i],
&arguments->slot[i]
);
switch(self->argument_types[i]->type_code)
{
case FFI_PL_TYPE_LONG_DOUBLE:
fprintf(stderr, " %Lg", *((long double*)argument_pointers[i]));
break;
case FFI_PL_TYPE_COMPLEX_FLOAT:
fprintf(stderr, " %g + %g * i",
crealf(*((float complex*)argument_pointers[i])),
cimagf(*((float complex*)argument_pointers[i]))
);
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
fprintf(stderr, " %g + %g * i",
creal(*((double complex*)argument_pointers[i])),
cimag(*((double complex*)argument_pointers[i]))
);
break;
default:
fprintf(stderr, "%016llx", ffi_pl_arguments_get_uint64(arguments, i));
break;
}
fprintf(stderr, "\n");
}
fprintf(stderr, "# === ===\n");
fflush(stderr);
#endif
MY_CXT.current_argv = NULL;
ffi_call(&self->ffi_cif, self->address, RESULT, ffi_pl_arguments_pointers(arguments));
/*
* ARGUMENT OUT
*/
MY_CXT.current_argv = arguments;
for(i=self->ffi_cif.nargs-1,perl_arg_index--; i >= 0; i--, perl_arg_index--)
{
int type_code = self->argument_types[i]->type_code;
switch(type_code)
{
/*
* ARGUMENT OUT - SCALAR TYPES
*/
case FFI_PL_TYPE_CLOSURE:
{
arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
if(SvROK(arg))
{
SvREFCNT_dec(arg);
SvREFCNT_dec(SvRV(arg));
}
}
break;
default:
switch(type_code & FFI_PL_SHAPE_MASK)
{
/*
* ARGUMENT OUT - POINTER & ARRAY TYPES
*/
case FFI_PL_SHAPE_POINTER:
case FFI_PL_SHAPE_ARRAY:
{
void *ptr = ffi_pl_arguments_get_pointer(arguments, i);
arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
if(ptr != NULL && SvOK(arg))
{
SV *arg2 = SvROK(arg) ? SvRV(arg) : &PL_sv_undef;
if(SvTYPE(arg2) == SVt_PVAV)
{
SSize_t count = 0;
AV *av = (AV*)arg2;
if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_ARRAY)
{
count = self->argument_types[i]->extra[0].array.element_count;
}
if(count == 0)
{
count = av_len(av)+1;
}
switch(type_code & (FFI_PL_BASE_MASK|FFI_PL_SIZE_MASK))
{
case FFI_PL_TYPE_UINT8:
for(n=0; n<count; n++)
{
sv_setuv(*av_fetch(av, n, 1), ((uint8_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_SINT8:
for(n=0; n<count; n++)
{
sv_setiv(*av_fetch(av, n, 1), ((int8_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_UINT16:
for(n=0; n<count; n++)
{
sv_setuv(*av_fetch(av, n, 1), ((uint16_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_SINT16:
for(n=0; n<count; n++)
{
sv_setiv(*av_fetch(av, n, 1), ((int16_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_UINT32:
for(n=0; n<count; n++)
{
sv_setuv(*av_fetch(av, n, 1), ((uint32_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_SINT32:
for(n=0; n<count; n++)
{
sv_setiv(*av_fetch(av, n, 1), ((int32_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_UINT64:
for(n=0; n<count; n++)
{
sv_setu64(*av_fetch(av, n, 1), ((uint64_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_SINT64:
for(n=0; n<count; n++)
{
sv_seti64(*av_fetch(av, n, 1), ((int64_t*)ptr)[n]);
}
break;
case FFI_PL_TYPE_FLOAT:
for(n=0; n<count; n++)
{
sv_setnv(*av_fetch(av, n, 1), ((float*)ptr)[n]);
}
break;
case FFI_PL_TYPE_OPAQUE:
case FFI_PL_TYPE_STRING:
for(n=0; n<count; n++)
{
if( ((void**)ptr)[n] == NULL)
{
av_store(av, n, &PL_sv_undef);
}
else
{
switch(type_code) {
case FFI_PL_TYPE_OPAQUE | FFI_PL_SHAPE_ARRAY:
sv_setnv(*av_fetch(av,n,1), PTR2IV( ((void**)ptr)[n]) );
break;
case FFI_PL_TYPE_STRING | FFI_PL_SHAPE_ARRAY:
sv_setpv(*av_fetch(av,n,1), ((char**)ptr)[n] );
break;
}
}
}
break;
case FFI_PL_TYPE_DOUBLE:
for(n=0; n<count; n++)
{
sv_setnv(*av_fetch(av, n, 1), ((double*)ptr)[n]);
}
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
for(n=0; n<count; n++)
{
SV *sv;
sv = *av_fetch(av, n, 1);
ffi_pl_long_double_to_perl(sv, &((long double*)ptr)[n]);
}
break;
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_DOUBLE:
for(n=0; n<count; n++)
{
SV *sv;
sv = *av_fetch(av, n, 1);
ffi_pl_complex_double_to_perl(sv, &((double*)ptr)[n*2]);
}
break;
case FFI_PL_TYPE_COMPLEX_FLOAT:
for(n=0; n<count; n++)
{
SV *sv;
sv = *av_fetch(av, n, 1);
ffi_pl_complex_float_to_perl(sv, &((float*)ptr)[n*2]);
}
break;
#endif
}
}
else if(SvTYPE(arg2) < SVt_PVAV && !SvREADONLY(arg2))
{
switch(type_code & (FFI_PL_BASE_MASK|FFI_PL_SIZE_MASK))
{
case FFI_PL_TYPE_UINT8:
sv_setuv(arg2, *((uint8_t*)ptr));
break;
case FFI_PL_TYPE_SINT8:
sv_setiv(arg2, *((int8_t*)ptr));
break;
case FFI_PL_TYPE_UINT16:
sv_setuv(arg2, *((uint16_t*)ptr));
break;
case FFI_PL_TYPE_SINT16:
sv_setiv(arg2, *((int16_t*)ptr));
break;
case FFI_PL_TYPE_UINT32:
sv_setuv(arg2, *((uint32_t*)ptr));
break;
case FFI_PL_TYPE_SINT32:
sv_setiv(arg2, *((int32_t*)ptr));
break;
case FFI_PL_TYPE_UINT64:
sv_setu64(arg2, *((uint64_t*)ptr));
break;
case FFI_PL_TYPE_SINT64:
sv_seti64(arg2, *((int64_t*)ptr));
break;
case FFI_PL_TYPE_FLOAT:
sv_setnv(arg2, *((float*)ptr));
break;
case FFI_PL_TYPE_OPAQUE:
if( *((void**)ptr) == NULL)
sv_setsv(arg2, &PL_sv_undef);
else
sv_setiv(arg2, PTR2IV(*((void**)ptr)));
break;
case FFI_PL_TYPE_DOUBLE:
sv_setnv(arg2, *((double*)ptr));
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
ffi_pl_long_double_to_perl(arg2,(long double*)ptr);
break;
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT:
ffi_pl_complex_float_to_perl(arg2, (float *)ptr);
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
ffi_pl_complex_double_to_perl(arg2, (double *)ptr);
break;
#endif
case FFI_PL_TYPE_STRING:
{
char **pv = ptr;
if(*pv == NULL)
{
sv_setsv(arg2, &PL_sv_undef);
}
else
{
sv_setpv(arg2, *pv);
}
}
break;
}
}
}
}
break;
/*
* ARGUMENT OUT - CUSTOM TYPE
*/
case FFI_PL_SHAPE_CUSTOM_PERL:
{
/* FIXME: need to fill out argument_types for skipping */
i -= self->argument_types[i]->extra[0].custom_perl.argument_count;
{
SV *coderef = self->argument_types[i]->extra[0].custom_perl.perl_to_native_post;
if(coderef != NULL)
{
arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
ffi_pl_custom_perl_cb(coderef, arg, i);
}
}
{
SV *sv = av_pop(MY_CXT.custom_keepers);
if(SvOK(sv))
SvREFCNT_dec(sv);
}
}
break;
default:
break;
}
}
}
{
int type_code = self->return_type->type_code;
/*
* TODO: This should always happen later if possible
*/
if((type_code & FFI_PL_SHAPE_MASK) != FFI_PL_SHAPE_CUSTOM_PERL
&& type_code != FFI_PL_TYPE_RECORD_VALUE)
ffi_pl_heap_free();
MY_CXT.current_argv = NULL;
/*
* RETURN VALUE
*/
switch(type_code)
{
/*
* RETURN VALUE - TYPE SCALAR
*/
#if ! FFI_PL_CALL_NO_RECORD_VALUE
case FFI_PL_TYPE_RECORD_VALUE:
{
SV *value, *ref;
value = newSV(0);
sv_setpvn(value, result_ptr, self->return_type->extra[0].record.size);
ref = ST(0) = sv_2mortal(newRV_noinc(value));
sv_bless(ref, gv_stashpv(self->return_type->extra[0].record.class, GV_ADD));
ffi_pl_heap_free();
XSRETURN(1);
}
break;
case FFI_PL_TYPE_RECORD_VALUE | FFI_PL_SHAPE_CUSTOM_PERL:
{
SV *value, *ref;
value = newSV(0);
sv_setpvn(value, result_ptr, self->return_type->extra[0].record.size);
ref = sv_2mortal(newRV_noinc(value));
sv_bless(ref, gv_stashpv(self->return_type->extra[0].record.class, GV_ADD));
MY_CXT.current_argv = arguments;
ST(0) = ffi_pl_custom_perl(
self->return_type->extra[0].custom_perl.native_to_perl,
ref,
-1
);
MY_CXT.current_argv = NULL;
ffi_pl_heap_free();
XSRETURN(1);
}
break;
#endif
#if ! FFI_PL_CALL_RET_NO_NORMAL
case FFI_PL_TYPE_VOID:
XSRETURN_EMPTY;
break;
case FFI_PL_TYPE_UINT8:
#if defined FFI_PL_PROBE_BIGENDIAN
XSRETURN_UV(result.uint8_array[3]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
XSRETURN_UV(result.uint8_array[7]);
#else
XSRETURN_UV(result.uint8);
#endif
break;
case FFI_PL_TYPE_SINT8:
#if defined FFI_PL_PROBE_BIGENDIAN
XSRETURN_IV(result.sint8_array[3]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
XSRETURN_IV(result.sint8_array[7]);
#else
XSRETURN_IV(result.sint8);
#endif
break;
case FFI_PL_TYPE_UINT16:
#if defined FFI_PL_PROBE_BIGENDIAN
XSRETURN_UV(result.uint16_array[1]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
XSRETURN_UV(result.uint16_array[3]);
#else
XSRETURN_UV(result.uint16);
#endif
break;
case FFI_PL_TYPE_SINT16:
#if defined FFI_PL_PROBE_BIGENDIAN
XSRETURN_IV(result.sint16_array[1]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
XSRETURN_IV(result.sint16_array[3]);
#else
XSRETURN_IV(result.sint16);
#endif
break;
case FFI_PL_TYPE_UINT32:
#if defined FFI_PL_PROBE_BIGENDIAN64
XSRETURN_UV(result.uint32_array[1]);
#else
XSRETURN_UV(result.uint32);
#endif
break;
case FFI_PL_TYPE_SINT32:
#if defined FFI_PL_PROBE_BIGENDIAN64
XSRETURN_IV(result.sint32_array[1]);
#else
XSRETURN_IV(result.sint32);
#endif
break;
case FFI_PL_TYPE_UINT64:
XSRETURN_U64(result.uint64);
break;
case FFI_PL_TYPE_SINT64:
XSRETURN_I64(result.sint64);
break;
case FFI_PL_TYPE_FLOAT:
XSRETURN_NV(result.xfloat);
break;
case FFI_PL_TYPE_DOUBLE:
XSRETURN_NV(result.xdouble);
break;
case FFI_PL_TYPE_OPAQUE:
case FFI_PL_TYPE_STRING:
if(result.pointer == NULL)
{
if(self->platypus_api >= 2)
{
XSRETURN_UNDEF;
}
else
{
XSRETURN_EMPTY;
}
}
else
{
switch(type_code)
{
case FFI_PL_TYPE_OPAQUE:
XSRETURN_IV(PTR2IV(result.pointer));
break;
case FFI_PL_TYPE_STRING:
XSRETURN_PV(result.pointer);
break;
}
}
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
{
#if !(defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE))
if(MY_CXT.loaded_math_longdouble == 1)
{
SV *sv;
long double *ptr;
Newx(ptr, 1, long double);
*ptr = result.longdouble;
sv = sv_newmortal();
sv_setref_pv(sv, "Math::LongDouble", (void*)ptr);
ST(0) = sv;
XSRETURN(1);
}
else
{
#endif
XSRETURN_NV((NV) result.longdouble);
#if !(defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE))
}
#endif
}
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT:
{
SV *c[2];
AV *av;
c[0] = sv_2mortal(newSVnv( ((float*)&result.complex_float)[0]) );
c[1] = sv_2mortal(newSVnv( ((float*)&result.complex_float)[1]) );
av = av_make(2,c);
ST(0) = sv_2mortal(newRV_noinc((SV*) av));
XSRETURN(1);
}
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
{
SV *c[2];
AV *av;
c[0] = sv_2mortal(newSVnv( ((double*)&result.complex_double)[0]) );
c[1] = sv_2mortal(newSVnv( ((double*)&result.complex_double)[1]) );
av = av_make(2,c);
ST(0) = sv_2mortal(newRV_noinc((SV*) av));
XSRETURN(1);
}
break;
#endif
case FFI_PL_TYPE_RECORD:
case FFI_PL_TYPE_RECORD | FFI_PL_SHAPE_CUSTOM_PERL:
if(result.pointer == NULL)
{
if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
{
MY_CXT.current_argv = arguments;
ST(0) = ffi_pl_custom_perl(
self->return_type->extra[0].custom_perl.native_to_perl,
&PL_sv_undef,
-1
);
MY_CXT.current_argv = NULL;
ffi_pl_heap_free();
XSRETURN(1);
}
if(self->platypus_api >= 2)
{
XSRETURN_UNDEF;
}
else
{
XSRETURN_EMPTY;
}
}
else
{
SV *ref;
SV *value = newSV(0);
sv_setpvn(value, result.pointer, self->return_type->extra[0].record.size);
if(self->return_type->extra[0].record.class != NULL)
{
ref = sv_2mortal(newRV_noinc(value));
sv_bless(ref, gv_stashpv(self->return_type->extra[0].record.class, GV_ADD));
}
else
{
ref = sv_2mortal(value);
}
if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
{
MY_CXT.current_argv = arguments;
ST(0) = ffi_pl_custom_perl(
self->return_type->extra[0].custom_perl.native_to_perl,
ref,
-1
);
MY_CXT.current_argv = NULL;
ffi_pl_heap_free();
}
else
{
ST(0) = ref;
}
XSRETURN(1);
}
break;
case FFI_PL_SHAPE_OBJECT | FFI_PL_TYPE_OPAQUE:
if(result.pointer == NULL)
{
if(self->platypus_api >= 2)
{
XSRETURN_UNDEF;
}
else
{
XSRETURN_EMPTY;
}
}
else
{
SV *ref;
SV *value = newSV(0);
sv_setiv(value, PTR2IV(((void*)result.pointer)));
ref = ST(0) = sv_2mortal(newRV_noinc(value));
sv_bless(ref, gv_stashpv(self->return_type->extra[0].object.class, GV_ADD));
XSRETURN(1);
}
break;
default:
switch(type_code & FFI_PL_SHAPE_MASK)
{
/*
* RETURN VALUE - TYPE POINTER
*/
case FFI_PL_SHAPE_POINTER:
if(result.pointer == NULL)
{
if(self->platypus_api >= 2)
{
XSRETURN_UNDEF;
}
else
{
XSRETURN_EMPTY;
}
}
else
{
SV *value;
switch(type_code)
{
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setuv(value, *((uint8_t*) result.pointer));
break;
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setiv(value, *((int8_t*) result.pointer));
break;
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setuv(value, *((uint16_t*) result.pointer));
break;
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setiv(value, *((int16_t*) result.pointer));
break;
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setuv(value, *((uint32_t*) result.pointer));
break;
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setiv(value, *((int32_t*) result.pointer));
break;
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setu64(value, *((uint64_t*) result.pointer));
break;
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_seti64(value, *((int64_t*) result.pointer));
break;
case FFI_PL_TYPE_FLOAT | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setnv(value, *((float*) result.pointer));
break;
case FFI_PL_TYPE_DOUBLE | FFI_PL_SHAPE_POINTER:
value = newSV(0);
sv_setnv(value, *((double*) result.pointer));
break;
case FFI_PL_TYPE_OPAQUE | FFI_PL_SHAPE_POINTER:
if( *((void**)result.pointer) == NULL )
value = &PL_sv_undef;
else
{
value = newSV(0);
sv_setiv(value, PTR2IV(*((void**)result.pointer)));
}
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE | FFI_PL_SHAPE_POINTER:
value = newSV(0);
ffi_pl_long_double_to_perl(value, (long double*)result.pointer);
break;
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT | FFI_PL_SHAPE_POINTER:
{
SV *c[2];
AV *av;
c[0] = sv_2mortal(newSVnv( ((float*)result.pointer)[0] ));
c[1] = sv_2mortal(newSVnv( ((float*)result.pointer)[1] ));
av = av_make(2, c);
value = newRV_noinc((SV*)av);
}
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE | FFI_PL_SHAPE_POINTER:
{
SV *c[2];
AV *av;
c[0] = sv_2mortal(newSVnv( ((double*)result.pointer)[0] ));
c[1] = sv_2mortal(newSVnv( ((double*)result.pointer)[1] ));
av = av_make(2, c);
value = newRV_noinc((SV*)av);
}
break;
#endif
case FFI_PL_TYPE_STRING | FFI_PL_SHAPE_POINTER:
value = newSV(0);
if( *((void**)result.pointer) == NULL )
value = &PL_sv_undef;
else
sv_setpv(value, (char*) result.pointer);
break;
default:
warn("return type not supported");
XSRETURN_EMPTY;
}
ST(0) = sv_2mortal(newRV_noinc(value));
XSRETURN(1);
}
break;
/*
* RETURN VALUE - TYPE ARRAY
*/
case FFI_PL_SHAPE_ARRAY:
if(result.pointer == NULL)
{
if(self->platypus_api >= 2)
{
XSRETURN_UNDEF;
}
else
{
XSRETURN_EMPTY;
}
}
else
{
int count = self->return_type->extra[0].array.element_count;
if(count == 0 && type_code & FFI_PL_TYPE_OPAQUE)
{
while(((void**)result.pointer)[count] != NULL)
count++;
}
AV *av;
SV **sv;
Newx(sv, count, SV*);
switch(type_code)
{
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSVuv( ((uint8_t*)result.pointer)[i] ));
}
break;
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSViv( ((int8_t*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSVuv( ((uint16_t*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSViv( ((int16_t*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSVuv( ((uint32_t*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSViv( ((int32_t*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSVu64( ((uint64_t*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSVi64( ((int64_t*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_FLOAT | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSVnv( ((float*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_DOUBLE | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal( newSVnv( ((double*)result.pointer)[i] ) );
}
break;
case FFI_PL_TYPE_STRING | FFI_PL_SHAPE_ARRAY:
case FFI_PL_TYPE_OPAQUE | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
if( ((void**)result.pointer)[i] == NULL)
{
sv[i] = &PL_sv_undef;
}
else
{
switch(type_code) {
case FFI_PL_TYPE_STRING | FFI_PL_SHAPE_ARRAY:
sv[i] = sv_2mortal( newSVpv( ((char**)result.pointer)[i], 0 ) );
break;
case FFI_PL_TYPE_OPAQUE | FFI_PL_SHAPE_ARRAY:
sv[i] = sv_2mortal( newSViv( PTR2IV( ((void**)result.pointer)[i] )) );
break;
}
}
}
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
sv[i] = sv_2mortal(newSV(0));
ffi_pl_long_double_to_perl(sv[i], &((long double*)result.pointer)[i]);
}
break;
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
SV *c[2];
AV *av;
c[0] = sv_2mortal(newSVnv(((float*)result.pointer)[i*2]));
c[1] = sv_2mortal(newSVnv(((float*)result.pointer)[i*2+1]));
av = av_make(2, c);
sv[i] = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE | FFI_PL_SHAPE_ARRAY:
for(i=0; i<count; i++)
{
SV *c[2];
AV *av;
c[0] = sv_2mortal(newSVnv(((double*)result.pointer)[i*2]));
c[1] = sv_2mortal(newSVnv(((double*)result.pointer)[i*2+1]));
av = av_make(2, c);
sv[i] = sv_2mortal(newRV_noinc((SV*)av));
}
break;
#endif
default:
warn("return type not supported");
XSRETURN_EMPTY;
}
av = av_make(count, sv);
Safefree(sv);
ST(0) = sv_2mortal(newRV_noinc((SV*)av));
XSRETURN(1);
}
break;
/*
* RETURN VALUE - CUSTOM PERL
*/
case FFI_PL_SHAPE_CUSTOM_PERL:
{
SV *ret_in=NULL, *ret_out;
switch(type_code)
{
/* TODO: FFI_PL_BASE_VOID, FFI_PL_BASE_COMPLEX, FFI_PL_BASE_STRING, FFI_PL_BASE_CLOSURE, FFI_PL_BASE_RECORD */
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_CUSTOM_PERL:
#if defined FFI_PL_PROBE_BIGENDIAN
ret_in = newSVuv(result.uint8_array[3]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
ret_in = newSVuv(result.uint8_array[7]);
#else
ret_in = newSVuv(result.uint8);
#endif
break;
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_CUSTOM_PERL:
#if defined FFI_PL_PROBE_BIGENDIAN
ret_in = newSViv(result.sint8_array[3]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
ret_in = newSViv(result.sint8_array[7]);
#else
ret_in = newSViv(result.sint8);
#endif
break;
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_CUSTOM_PERL:
#if defined FFI_PL_PROBE_BIGENDIAN
ret_in = newSVuv(result.uint16_array[1]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
ret_in = newSVuv(result.uint16_array[3]);
#else
ret_in = newSVuv(result.uint16);
#endif
break;
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_CUSTOM_PERL:
#if defined FFI_PL_PROBE_BIGENDIAN
ret_in = newSViv(result.sint16_array[1]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
ret_in = newSViv(result.sint16_array[3]);
#else
ret_in = newSViv(result.sint16);
#endif
break;
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_CUSTOM_PERL:
#if defined FFI_PL_PROBE_BIGENDIAN64
ret_in = newSVuv(result.uint32_array[1]);
#else
ret_in = newSVuv(result.uint32);
#endif
break;
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_CUSTOM_PERL:
#if defined FFI_PL_PROBE_BIGENDIAN64
ret_in = newSViv(result.sint32_array[1]);
#else
ret_in = newSViv(result.sint32);
#endif
break;
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_CUSTOM_PERL:
ret_in = newSVu64(result.uint64);
break;
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_CUSTOM_PERL:
ret_in = newSVi64(result.sint64);
break;
case FFI_PL_TYPE_FLOAT | FFI_PL_SHAPE_CUSTOM_PERL:
ret_in = newSVnv(result.xfloat);
break;
case FFI_PL_TYPE_DOUBLE | FFI_PL_SHAPE_CUSTOM_PERL:
ret_in = newSVnv(result.xdouble);
break;
case FFI_PL_TYPE_OPAQUE | FFI_PL_SHAPE_CUSTOM_PERL:
if(result.pointer != NULL)
ret_in = newSViv(PTR2IV(result.pointer));
break;
default:
ffi_pl_heap_free();
warn("return type not supported");
XSRETURN_EMPTY;
}
MY_CXT.current_argv = arguments;
ret_out = ffi_pl_custom_perl(
self->return_type->extra[0].custom_perl.native_to_perl,
ret_in != NULL ? ret_in : &PL_sv_undef,
-1
);
MY_CXT.current_argv = NULL;
ffi_pl_heap_free();
if(ret_in != NULL)
{
SvREFCNT_dec(ret_in);
}
if(ret_out == NULL)
{
if(self->platypus_api >= 2)
{
XSRETURN_UNDEF;
}
else
{
XSRETURN_EMPTY;
}
}
else
{
ST(0) = sv_2mortal(ret_out);
XSRETURN(1);
}
}
break;
case FFI_PL_SHAPE_OBJECT:
{
SV *ref;
SV *value = newSV(0);
switch(type_code)
{
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_OBJECT:
#if defined FFI_PL_PROBE_BIGENDIAN
sv_setiv(value, result.sint8_array[3]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
sv_setiv(value, result.sint8_array[7]);
#else
sv_setiv(value, result.sint8);
#endif
break;
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_OBJECT:
#if defined FFI_PL_PROBE_BIGENDIAN
sv_setuv(value, result.uint8_array[3]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
sv_setuv(value, result.uint8_array[7]);
#else
sv_setuv(value, result.uint8);
#endif
break;
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_OBJECT:
#if defined FFI_PL_PROBE_BIGENDIAN
sv_setiv(value, result.sint16_array[1]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
sv_setiv(value, result.sint16_array[3]);
#else
sv_setiv(value, result.sint16);
#endif
break;
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_OBJECT:
#if defined FFI_PL_PROBE_BIGENDIAN
sv_setiv(value, result.uint16_array[1]);
#elif defined FFI_PL_PROBE_BIGENDIAN64
sv_setuv(value, result.uint16_array[3]);
#else
sv_setuv(value, result.uint16);
#endif
break;
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_OBJECT:
#if defined FFI_PL_PROBE_BIGENDIAN64
sv_setiv(value, result.sint32_array[1]);
#else
sv_setiv(value, result.sint32);
#endif
break;
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_OBJECT:
#if defined FFI_PL_PROBE_BIGENDIAN64
sv_setuv(value, result.uint32_array[1]);
#else
sv_setuv(value, result.uint32);
#endif
break;
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_OBJECT:
sv_seti64(value, result.sint64);
break;
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_OBJECT:
sv_setu64(value, result.uint64);
break;
default:
break;
}
ref = ST(0) = sv_2mortal(newRV_noinc(value));
sv_bless(ref, gv_stashpv(self->return_type->extra[0].object.class, GV_ADD));
XSRETURN(1);
}
break;
default:
warn("return type not supported");
XSRETURN_EMPTY;
break;
}
#endif
}
}
warn("return type not supported");
XSRETURN_EMPTY;
#undef EXTRA_ARGS
#undef FFI_PL_CALL_NO_RECORD_VALUE
#undef FFI_PL_CALL_RET_NO_NORMAL
#undef RESULT
FFI-Platypus-2.12/include/ffi_platypus_guts.h 000644 000000 000000 00000005761 15251066120 021211 0 ustar 00root root 000000 000000 #ifndef FFI_PLATYPUS_GUTS_H
#define FFI_PLATYPUS_GUTS_H
#ifdef __cplusplus
extern "C" {
#endif
void ffi_pl_closure_call(ffi_cif *, void *, void **, void *);
void ffi_pl_closure_add_data(SV *closure, ffi_pl_closure *closure_data);
ffi_pl_closure *ffi_pl_closure_get_data(SV *closure, ffi_pl_type *type);
SV* ffi_pl_custom_perl(SV*,SV*,int);
void ffi_pl_custom_perl_cb(SV *, SV*, int);
HV *ffi_pl_get_type_meta(ffi_pl_type *);
size_t ffi_pl_sizeof(ffi_pl_type *);
void ffi_pl_perl_to_complex_float(SV *sv, float *ptr);
void ffi_pl_complex_float_to_perl(SV *sv, float *ptr);
void ffi_pl_perl_to_complex_double(SV *sv, double *ptr);
void ffi_pl_complex_double_to_perl(SV *sv, double *ptr);
#define ffi_pl_perl_to_long_double(sv, ptr) \
if(!SvOK(sv)) \
{ \
*(ptr) = 0.0L; \
} \
else if(sv_isobject(sv) && sv_derived_from(sv, "Math::LongDouble")) \
{ \
*(ptr) = *INT2PTR(long double *, SvIV((SV*) SvRV(sv))); \
} \
else \
{ \
*(ptr) = (long double) SvNV(sv); \
}
/*
* CAVEATS:
* - We are mucking about with the innerds of Math::LongDouble
* so if the innerds change we may break Math::LongDouble,
* FFI::Platypus or both!
* - This makes Math::LongDouble mutable. Note however, that
* Math::LongDouble overloads ++ and increments the actual
* longdouble pointed to in memory, so we are at least not
* introducing the sin of mutability. See LongDouble.xs
* C function _overload_inc.
*/
#define ffi_pl_long_double_to_perl(sv, ptr) \
if(sv_isobject(sv) && sv_derived_from(sv, "Math::LongDouble")) \
{ \
*INT2PTR(long double *, SvIV((SV*) SvRV(sv))) = *(ptr); \
} \
else if(MY_CXT.loaded_math_longdouble == 1) \
{ \
long double *tmp; \
Newx(tmp, 1, long double); \
*tmp = *(ptr); \
sv_setref_pv(sv, "Math::LongDouble", (void*)tmp); \
} \
else \
{ \
sv_setnv(sv, *(ptr)); \
}
#ifdef __cplusplus
}
#endif
#endif
FFI-Platypus-2.12/include/libtest.h 000644 000000 000000 00000000326 15251066120 017100 0 ustar 00root root 000000 000000 #ifndef LIBTEST_H
#define LIBTEST_H
#include "ffi_platypus.h"
#ifdef HAVE_STDIO_H
#include <stdio.h>
#endif
#ifdef _MSC_VER
#define EXTERN extern __declspec(dllexport)
#else
#define EXTERN extern
#endif
#endif
FFI-Platypus-2.12/include/perl_math_int64.h 000644 000000 000000 00000005343 15251066120 020435 0 ustar 00root root 000000 000000 /*
* perl_math_int64.h - This file is in the public domain
* Author: Salvador Fandino <sfandino@yahoo.com>
* Version: 2.1
*
* Generated on: 2014-10-30 11:43:56
* Math::Int64 version: 0.33
* Module::CAPIMaker version: 0.02
*/
/* Platypus specific begin */
#ifdef HAVE_IV_IS_64
#define SvU64(a) SvUV(a)
#define SvI64(a) SvIV(a)
#define sv_seti64(a,b) sv_setiv(a,b)
#define sv_setu64(a,b) sv_setuv(a,b)
#define newSVi64(a) newSViv(a)
#define newSVu64(a) newSVuv(a)
#define XSRETURN_U64(a) XSRETURN_UV(a)
#define XSRETURN_I64(a) XSRETURN_IV(a)
#define PERL_MATH_INT64_LOAD_OR_CROAK
#else
#define XSRETURN_U64(a) { \
ST(0) = sv_newmortal(); \
sv_setu64(ST(0), a); \
XSRETURN(1); \
}
#define XSRETURN_I64(a) { \
ST(0) = sv_newmortal(); \
sv_seti64(ST(0), a); \
XSRETURN(1); \
}
/* Platypus specific end */
#if !defined (PERL_MATH_INT64_H_INCLUDED)
#define PERL_MATH_INT64_H_INCLUDED
#define MATH_INT64_C_API_REQUIRED_VERSION 2
#define MATH_INT64_VERSION MATH_INT64_C_API_REQUIRED_VERSION
int perl_math_int64_load(int required_version);
#define PERL_MATH_INT64_LOAD perl_math_int64_load(MATH_INT64_C_API_REQUIRED_VERSION)
#define PERL_MATH_INT64_LOAD_OR_CROAK \
if (PERL_MATH_INT64_LOAD); \
else croak(NULL);
#define MATH_INT64_BOOT PERL_MATH_INT64_LOAD_OR_CROAK
extern HV *math_int64_c_api_hash;
extern int math_int64_c_api_min_version;
extern int math_int64_c_api_max_version;
#define math_int64_capi_version math_int64_c_api_max_version
#if (defined(MATH_INT64_NATIVE_IF_AVAILABLE) && (IVSIZE == 8))
#define MATH_INT64_NATIVE 1
#endif
extern int64_t (*math_int64_c_api_SvI64)(pTHX_ SV*);
#define SvI64(a) ((*math_int64_c_api_SvI64)(aTHX_ (a)))
extern int (*math_int64_c_api_SvI64OK)(pTHX_ SV*);
#define SvI64OK(a) ((*math_int64_c_api_SvI64OK)(aTHX_ (a)))
extern uint64_t (*math_int64_c_api_SvU64)(pTHX_ SV*);
#define SvU64(a) ((*math_int64_c_api_SvU64)(aTHX_ (a)))
extern int (*math_int64_c_api_SvU64OK)(pTHX_ SV*);
#define SvU64OK(a) ((*math_int64_c_api_SvU64OK)(aTHX_ (a)))
extern SV * (*math_int64_c_api_newSVi64)(pTHX_ int64_t);
#define newSVi64(a) ((*math_int64_c_api_newSVi64)(aTHX_ (a)))
extern SV * (*math_int64_c_api_newSVu64)(pTHX_ uint64_t);
#define newSVu64(a) ((*math_int64_c_api_newSVu64)(aTHX_ (a)))
extern uint64_t (*math_int64_c_api_randU64)(pTHX);
#define randU64() ((*math_int64_c_api_randU64)(aTHX))
#if MATH_INT64_NATIVE
#undef newSVi64
#define newSVi64 newSViv
#undef newSVu64
#define newSVu64 newSVuv
#define sv_seti64 sv_setiv_mg
#define sv_setu64 sv_setuv_mg
#else
#define sv_seti64(target, i64) (sv_setsv_mg(target, sv_2mortal(newSVi64(i64))))
#define sv_setu64(target, u64) (sv_setsv_mg(target, sv_2mortal(newSVu64(u64))))
#endif
#endif
#endif
FFI-Platypus-2.12/include/ppport.h 000644 000000 000000 00002113751 15251066120 016767 0 ustar 00root root 000000 000000 #if 0
my $void = <<'SKIP';
#endif
/*
----------------------------------------------------------------------
include/ppport.h -- Perl/Pollution/Portability Version 3.73
Automatically created by Devel::PPPort running under perl 5.042003.
Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
includes in parts/inc/ instead.
Use 'perldoc include/ppport.h' to view the documentation below.
----------------------------------------------------------------------
SKIP
=pod
=head1 NAME
include/ppport.h - Perl/Pollution/Portability version 3.73
=head1 SYNOPSIS
perl include/ppport.h [options] [source files]
Searches current directory for files if no [source files] are given
--help show short help
--version show version
--patch=file write one patch file with changes
--copy=suffix write changed copies with suffix
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
--strip strip all script and doc functionality
from include/ppport.h
--list-provided list provided API
--list-unsupported list API that isn't supported all the way
back
--api-info=name show Perl API portability information
=head1 COMPATIBILITY
This version of F<include/ppport.h> is designed to support operation with Perl
installations back to 5.003_07, and has been tested up to 5.35.9.
=head1 OPTIONS
=head2 --help
Display a brief usage summary.
=head2 --version
Display the version of F<include/ppport.h>.
=head2 --patch=I<file>
If this option is given, a single patch file will be created if
any changes are suggested. This requires a working diff program
to be installed on your system.
=head2 --copy=I<suffix>
If this option is given, a copy of each file will be saved with
the given suffix that contains the suggested changes. This does
not require any external programs. Note that this does not
automagically add a dot between the original filename and the
suffix. If you want the dot, you have to include it in the option
argument.
If neither C<--patch> or C<--copy> are given, the default is to
simply print the diffs for each file. This requires either
C<Text::Diff> or a C<diff> program to be installed.
=head2 --diff=I<program>
Manually set the diff program and options to use. The default
is to use C<Text::Diff>, when installed, and output unified
context diffs.
=head2 --compat-version=I<version>
Tell F<include/ppport.h> to check for compatibility with the given
Perl version. The default is to check for compatibility with Perl
version 5.003_07. You can use this option to reduce the output
of F<include/ppport.h> if you intend to be backward compatible only
down to a certain Perl version.
=head2 --cplusplus
Usually, F<include/ppport.h> will detect C++ style comments and
replace them with C style comments for portability reasons.
Using this option instructs F<include/ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
=head2 --nohints
Don't output any hints. Hints often contain useful portability
notes. Warnings will still be displayed.
=head2 --nochanges
Don't suggest any changes. Only give diagnostic output and hints
unless these are also deactivated.
=head2 --nofilter
Don't filter the list of input files. By default, files not looking
like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
=head2 --strip
Strip all script and documentation functionality from F<include/ppport.h>.
This reduces the size of F<include/ppport.h> dramatically and may be useful
if you want to include F<include/ppport.h> in smaller modules without
increasing their distribution size too much.
The stripped F<include/ppport.h> will have a C<--unstrip> option that allows
you to undo the stripping, but only if an appropriate C<Devel::PPPort>
module is installed.
=head2 --list-provided
Lists the API elements for which compatibility is provided by
F<include/ppport.h>. Also lists if it must be explicitly requested,
if it has dependencies, and if there are hints or warnings for it.
=head2 --list-unsupported
Lists the API elements that are known not to be FULLY supported by F<include/ppport.h>,
and below which version of Perl they probably won't be available or work.
By FULLY, we mean that support isn't provided all the way back to the first
version of Perl that F<include/ppport.h> supports at all.
=head2 --api-info=I<name>
Show portability information for elements matching I<name>.
If I<name> is surrounded by slashes, it is interpreted as a regular
expression.
Normally, only API elements are shown, but if there are no matching API
elements but there are some other matching elements, those are shown. This
allows you to conveniently find when functions internal to the core
implementation were added; only people working on the core are likely to find
this last part useful.
=head1 DESCRIPTION
In order for a Perl extension (XS) module to be as portable as possible
across differing versions of Perl itself, certain steps need to be taken.
=over 4
=item *
Including this header is the first major one. This alone will give you
access to a large part of the Perl API that hasn't been available in
earlier Perl releases. Use
perl include/ppport.h --list-provided
to see which API elements are provided by include/ppport.h.
=item *
You should avoid using deprecated parts of the API. For example, using
global Perl variables without the C<PL_> prefix is deprecated. Also,
some API functions used to have a C<perl_> prefix. Using this form is
also deprecated. You can safely use the supported API, as F<include/ppport.h>
will provide wrappers for older Perl versions.
=item *
Although the purpose of F<include/ppport.h> is to keep you from having to concern
yourself with what version you are running under, there may arise instances
where you have to do so. These macros, the same ones as in base Perl, are
available to you in all versions, and are what you should use:
=over 4
=item C<PERL_VERSION_I<xx>(major, minor, patch)>
Returns whether or not the perl currently being compiled has the specified
relationship I<xx> to the perl given by the parameters. I<xx> is one of
C<EQ>, C<NE>, C<LT>, C<LE>, C<GT>, C<GE>.
For example,
#if PERL_VERSION_GT(5,24,2)
code that will only be compiled on perls after v5.24.2
#else
fallback code
#endif
Note that this is usable in making compile-time decisions
You may use the special value '*' for the final number to mean ALL possible
values for it. Thus,
#if PERL_VERSION_EQ(5,31,'*')
means all perls in the 5.31 series. And
#if PERL_VERSION_NE(5,24,'*')
means all perls EXCEPT 5.24 ones. And
#if PERL_VERSION_LE(5,9,'*')
is effectively
#if PERL_VERSION_LT(5,10,0)
=back
=item *
If you use one of a few functions or variables that were not present in
earlier versions of Perl, and that can't be provided using a macro, you
have to explicitly request support for these functions by adding one or
more C<#define>s in your source code before the inclusion of F<include/ppport.h>.
These functions or variables will be marked C<explicit> in the list shown
by C<--list-provided>.
Depending on whether you module has a single or multiple files that
use such functions or variables, you want either C<static> or global
variants.
For a C<static> function or variable (used only in a single source
file), use:
#define NEED_function
#define NEED_variable
For a global function or variable (used in multiple source files),
use:
#define NEED_function_GLOBAL
#define NEED_variable_GLOBAL
Note that you mustn't have more than one global request for the
same function or variable in your project.
Function / Variable Static Request Global Request
-----------------------------------------------------------------------------------------
caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
ck_warner() NEED_ck_warner NEED_ck_warner_GLOBAL
ck_warner_d() NEED_ck_warner_d NEED_ck_warner_d_GLOBAL
croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL
die_sv() NEED_die_sv NEED_die_sv_GLOBAL
eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
grok_number() NEED_grok_number NEED_grok_number_GLOBAL
grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
load_module() NEED_load_module NEED_load_module_GLOBAL
mess() NEED_mess NEED_mess_GLOBAL
mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL
mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL
mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
my_strnlen() NEED_my_strnlen NEED_my_strnlen_GLOBAL
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
sv_vstring_get() NEED_sv_vstring_get NEED_sv_vstring_get_GLOBAL
utf8_to_uvchr_buf() NEED_utf8_to_uvchr_buf NEED_utf8_to_uvchr_buf_GLOBAL
vload_module() NEED_vload_module NEED_vload_module_GLOBAL
vmess() NEED_vmess NEED_vmess_GLOBAL
warner() NEED_warner NEED_warner_GLOBAL
To avoid namespace conflicts, you can change the namespace of the
explicitly exported functions / variables using the C<DPPP_NAMESPACE>
macro. Just C<#define> the macro before including C<include/ppport.h>:
#define DPPP_NAMESPACE MyOwnNamespace_
#include "include/ppport.h"
The default namespace is C<DPPP_>.
=back
The good thing is that most of the above can be checked by running
F<include/ppport.h> on your source code. See the next section for
details.
=head1 EXAMPLES
To verify whether F<include/ppport.h> is needed for your module, whether you
should make any changes to your code, and whether any special defines
should be used, F<include/ppport.h> can be run as a Perl script to check your
source code. Simply say:
perl include/ppport.h
The result will usually be a list of patches suggesting changes
that should at least be acceptable, if not necessarily the most
efficient solution, or a fix for all possible problems.
If you know that your XS module uses features only available in
newer Perl releases, if you're aware that it uses C++ comments,
and if you want all suggestions as a single patch file, you could
use something like this:
perl include/ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
If you only want your code to be scanned without any suggestions
for changes, use:
perl include/ppport.h --nochanges
You can specify a different C<diff> program or options, using
the C<--diff> option:
perl include/ppport.h --diff='diff -C 10'
This would output context diffs with 10 lines of context.
If you want to create patched copies of your files instead, use:
perl include/ppport.h --copy=.new
To display portability information for the C<newSVpvn> function,
use:
perl include/ppport.h --api-info=newSVpvn
Since the argument to C<--api-info> can be a regular expression,
you can use
perl include/ppport.h --api-info=/_nomg$/
to display portability information for all C<_nomg> functions or
perl include/ppport.h --api-info=/./
to display information for all known API elements.
=head1 BUGS
Some of the suggested edits and/or generated patches may not compile as-is
without tweaking manually. This is generally due to the need for an extra
parameter to be added to the call to prevent buffer overflow.
If this version of F<include/ppport.h> is causing failure during
the compilation of this module, please check if newer versions
of either this module or C<Devel::PPPort> are available on CPAN
before sending a bug report.
If F<include/ppport.h> was generated using the latest version of
C<Devel::PPPort> and is causing failure of this module, please
file a bug report at L<https://github.com/Dual-Life/Devel-PPPort/issues>
Please include the following information:
=over 4
=item 1.
The complete output from running "perl -V"
=item 2.
This file.
=item 3.
The name and version of the module you were trying to build.
=item 4.
A full log of the build that failed.
=item 5.
Any other information that you think could be relevant.
=back
For the latest version of this code, please get the C<Devel::PPPort>
module from CPAN.
=head1 COPYRIGHT
Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
Version 2.x, Copyright (C) 2001, Paul Marquess.
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
See L<Devel::PPPort>.
=cut
# These are tools that must be included in include/ppport.h. It doesn't work if given
# a .pl suffix.
#
# WARNING: Use only constructs that are legal as far back as D:P handles, as
# this is run in the perl version being tested.
# What revisions are legal, to be output as-is and converted into a pattern
# that matches them precisely
my $r_pat = "[57]";
sub format_version
{
# Given an input version that is acceptable to parse_version(), return a
# string of the standard representation of it.
my($r,$v,$s) = parse_version(shift);
if ($r < 5 || ($r == 5 && $v < 6)) {
my $ver = sprintf "%d.%03d", $r, $v;
$s > 0 and $ver .= sprintf "_%02d", $s;
return $ver;
}
return sprintf "%d.%d.%d", $r, $v, $s;
}
sub parse_version
{
# Returns a triplet, (revision, major, minor) from the input, treated as a
# string, which can be in any of several typical formats.
my $ver = shift;
$ver = "" unless defined $ver;
my($r,$v,$s);
if ( ($r, $v, $s) = $ver =~ /^([0-9]+)([0-9]{3})([0-9]{3})$/ # 5029010, from the file
# names in our
# parts/base/ and
# parts/todo directories
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)$/ # 5.25.7
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]{3})([0-9]{3})$/ # 5.025008, from the
# output of $]
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]{1,3})()$/ # 5.24, 5.004
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.(00[1-5])_?([0-9]{2})$/ # 5.003_07
) {
$s = 0 unless $s;
die "Only Perl $r_pat are supported '$ver'\n" unless $r =~ / ^ $r_pat $ /x;
die "Invalid version number: $ver\n" if $v >= 1000 || $s >= 1000;
return (0 +$r, 0 + $v, 0 + $s);
}
# For some safety, don't assume something is a version number if it has a
# literal dot as one of the three characters. This will have to be fixed
# when we reach x.46 (since 46 is ord('.'))
if ($ver !~ /\./ && (($r, $v, $s) = $ver =~ /^(.)(.)(.)$/)) # vstring 5.25.7
{
$r = ord $r;
$v = ord $v;
$s = ord $s;
die "Only Perl $r_pat are supported '$ver'\n" unless $r =~ / ^ $r_pat $ /x;
return ($r, $v, $s);
}
my $mesg = "";
$mesg = ". (In 5.00x_yz, x must be 1-5.)" if $ver =~ /_/;
die "Invalid version number format: '$ver'$mesg\n";
}
sub int_parse_version
{
# Returns integer 7 digit human-readable version, suitable for use in file
# names in parts/todo parts/base.
return 0 + join "", map { sprintf("%03d", $_) } parse_version(shift);
}
sub ivers # Shorter name for int_parse_version
{
return int_parse_version(shift);
}
sub format_version_line
{
# Returns a floating point representation of the input version
my $version = int_parse_version(shift);
$version =~ s/ ^ ( $r_pat ) \B /$1./x;
return $version;
}
BEGIN {
if ("$]" < "5.006" ) {
# On early perls, the implicit pass by reference doesn't work, so we have
# to use the globals to initialize.
eval q[sub dictionary_order($$) { _dictionary_order($a, $b) } ];
} elsif ("$]" < "5.022" ) {
eval q[sub dictionary_order($$) { _dictionary_order(@_) } ];
} else {
eval q[sub dictionary_order :prototype($$) { _dictionary_order(@_) } ];
}
}
sub _dictionary_order { # Sort caselessly, ignoring punct
my ($valid_a, $valid_b) = @_;
my ($lc_a, $lc_b);
my ($squeezed_a, $squeezed_b);
$valid_a = '' unless defined $valid_a;
$valid_b = '' unless defined $valid_b;
$lc_a = lc $valid_a;
$lc_b = lc $valid_b;
$squeezed_a = $lc_a;
$squeezed_a =~ s/^_+//g; # No leading underscores
$squeezed_a =~ s/\B_+\B//g; # No connecting underscores
$squeezed_a =~ s/[\W]//g; # No punct
$squeezed_b = $lc_b;
$squeezed_b =~ s/^_+//g;
$squeezed_b =~ s/\B_+\B//g;
$squeezed_b =~ s/[\W]//g;
return( $squeezed_a cmp $squeezed_b
or $lc_a cmp $lc_b
or $valid_a cmp $valid_b);
}
sub sort_api_lines # Sort lines of the form flags|return|name|args...
# by 'name'
{
$a =~ / ^ [^|]* \| [^|]* \| ( [^|]* ) /x; # 3rd field '|' is sep
my $a_name = $1;
$b =~ / ^ [^|]* \| [^|]* \| ( [^|]* ) /x;
my $b_name = $1;
return dictionary_order($a_name, $b_name);
}
1;
use strict;
BEGIN { require warnings if "$]" > '5.006' }
# Disable broken TRIE-optimization
BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= "5.009004" && "$]" <= "5.009005"}
my $VERSION = 3.73;
my %opt = (
quiet => 0,
diag => 1,
hints => 1,
changes => 1,
cplusplus => 0,
filter => 1,
strip => 0,
version => 0,
);
my($ppport) = $0 =~ /([\w.]+)$/;
my $LF = '(?:\r\n|[\r\n])'; # line feed
my $HS = "[ \t]"; # horizontal whitespace
# Never use C comments in this file!
my $ccs = '/'.'*';
my $cce = '*'.'/';
my $rccs = quotemeta $ccs;
my $rcce = quotemeta $cce;
eval {
require Getopt::Long;
Getopt::Long::GetOptions(\%opt, qw(
help quiet diag! filter! hints! changes! cplusplus strip version
patch=s copy=s diff=s compat-version=s
list-provided list-unsupported api-info=s
)) or usage();
};
if ($@ and grep /^-/, @ARGV) {
usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
die "Getopt::Long not found. Please don't use any options.\n";
}
if ($opt{version}) {
print "This is $0 $VERSION.\n";
exit 0;
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
(index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
(index($4, 'n') >= 0 ? ( noTHXarg => 1 ) : ()),
(index($4, 'c') >= 0 ? ( core_only => 1 ) : ()),
(index($4, 'd') >= 0 ? ( deprecated => 1 ) : ()),
(index($4, 'i') >= 0 ? ( inaccessible => 1 ) : ()),
(index($4, 'x') >= 0 ? ( experimental => 1 ) : ()),
(index($4, 'u') >= 0 ? ( undocumented => 1 ) : ()),
(index($4, 'o') >= 0 ? ( ppport_fnc => 1 ) : ()),
(index($4, 'V') >= 0 ? ( unverified => 1 ) : ()),
} )
: die "invalid spec: $_" } qw(
ABDAY_1|5.027010||Viu
ABDAY_2|5.027010||Viu
ABDAY_3|5.027010||Viu
ABDAY_4|5.027010||Viu
ABDAY_5|5.027010||Viu
ABDAY_6|5.027010||Viu
ABDAY_7|5.027010||Viu
ABMON_10|5.027010||Viu
ABMON_11|5.027010||Viu
ABMON_12|5.027010||Viu
ABMON_1|5.027010||Viu
ABMON_2|5.027010||Viu
ABMON_3|5.027010||Viu
ABMON_4|5.027010||Viu
ABMON_5|5.027010||Viu
ABMON_6|5.027010||Viu
ABMON_7|5.027010||Viu
ABMON_8|5.027010||Viu
ABMON_9|5.027010||Viu
ABORT|5.003007||Viu
abort|5.005000||Viu
abort_execution|5.025010||Viu
accept|5.005000||Viu
ACCEPT|5.009005||Viu
ACCEPT_t8|5.035004||Viu
ACCEPT_t8_p8|5.033003||Viu
ACCEPT_t8_pb|5.033003||Viu
ACCEPT_tb|5.035004||Viu
ACCEPT_tb_p8|5.033003||Viu
ACCEPT_tb_pb|5.033003||Viu
access|5.005000||Viu
add_above_Latin1_folds|5.021001||Viu
add_cp_to_invlist|5.013011||Viu
add_data|5.005000||Vniu
add_multi_match|5.021004||Viu
_add_range_to_invlist|5.016000||cViu
add_utf16_textfilter|5.011001||Viu
adjust_size_and_find_bucket|5.019003||Vniu
advance_one_LB|5.023007||Viu
advance_one_SB|5.021009||Viu
advance_one_WB|5.021009||Viu
AHOCORASICK|5.009005||Viu
AHOCORASICKC|5.009005||Viu
AHOCORASICKC_t8|5.035004||Viu
AHOCORASICKC_t8_p8|5.033003||Viu
AHOCORASICKC_t8_pb|5.033003||Viu
AHOCORASICKC_tb|5.035004||Viu
AHOCORASICKC_tb_p8|5.033003||Viu
AHOCORASICKC_tb_pb|5.033003||Viu
AHOCORASICK_t8|5.035004||Viu
AHOCORASICK_t8_p8|5.033003||Viu
AHOCORASICK_t8_pb|5.033003||Viu
AHOCORASICK_tb|5.035004||Viu
AHOCORASICK_tb_p8|5.033003||Viu
AHOCORASICK_tb_pb|5.033003||Viu
ALIGNED_TYPE_NAME|||Viu
ALIGNED_TYPE|||Viu
alloccopstash|5.017001|5.017001|x
alloc_LOGOP|5.025004||xViu
allocmy|5.008001||Viu
ALLOC_THREAD_KEY|5.005003||Viu
ALT_DIGITS|5.027010||Viu
amagic_call|5.003007|5.003007|u
amagic_cmp|5.009003||Viu
amagic_cmp_desc|5.031011||Viu
amagic_cmp_locale|5.009003||Viu
amagic_cmp_locale_desc|5.031011||Viu
amagic_deref_call|5.013007|5.013007|u
amagic_i_ncmp|5.009003||Viu
amagic_i_ncmp_desc|5.031011||Viu
amagic_is_enabled|5.015008||Viu
amagic_ncmp|5.009003||Viu
amagic_ncmp_desc|5.031011||Viu
AMG_CALLun|5.003007||Viu
AMG_CALLunary|5.013009||Viu
AMGfallNEVER|5.003007||Viu
AMGfallNO|5.003007||Viu
AMGfallYES|5.003007||Viu
AMGf_assign|5.003007||Viu
AMGf_noleft|5.003007||Viu
AMGf_noright|5.003007||Viu
AMGf_numarg|5.021009||Viu
AMGf_numeric|5.013002||Viu
AMGf_unary|5.003007||Viu
AMGf_want_list|5.017002||Viu
AM_STR|5.027010||Viu
AMT_AMAGIC|5.004000||Viu
AMT_AMAGIC_off|5.004000||Viu
AMT_AMAGIC_on|5.004000||Viu
AMTf_AMAGIC|5.004000||Viu
_aMY_CXT|5.009000|5.009000|p
aMY_CXT|5.009000|5.009000|p
aMY_CXT_|5.009000|5.009000|p
anchored_end_shift|5.009005||Viu
anchored_offset|5.005000||Viu
anchored_substr|5.005000||Viu
anchored_utf8|5.008000||Viu
ANGSTROM_SIGN|5.017003||Viu
anonymise_cv_maybe|5.013003||Viu
any_dup|5.006000||Vu
ANYOF|5.003007||Viu
ANYOF_ALNUM|5.006000||Viu
ANYOF_ALNUML|5.004000||Viu
ANYOF_ALPHA|5.006000||Viu
ANYOF_ALPHANUMERIC|5.017008||Viu
ANYOF_ASCII|5.006000||Viu
ANYOF_BIT|5.004005||Viu
ANYOF_BITMAP|5.006000||Viu
ANYOF_BITMAP_BYTE|5.006000||Viu
ANYOF_BITMAP_CLEAR|5.006000||Viu
ANYOF_BITMAP_CLEARALL|5.007003||Viu
ANYOF_BITMAP_SET|5.006000||Viu
ANYOF_BITMAP_SETALL|5.007003||Viu
ANYOF_BITMAP_SIZE|5.006000||Viu
ANYOF_BITMAP_TEST|5.006000||Viu
ANYOF_BITMAP_ZERO|5.006000||Viu
ANYOF_BLANK|5.006001||Viu
ANYOF_CASED|5.017008||Viu
ANYOF_CLASS_OR|5.017007||Viu
ANYOF_CLASS_SETALL|5.013011||Viu
ANYOF_CLASS_TEST_ANY_SET|5.013008||Viu
ANYOF_CNTRL|5.006000||Viu
ANYOF_COMMON_FLAGS|5.019008||Viu
ANYOFD|5.023003||Viu
ANYOF_DIGIT|5.006000||Viu
ANYOFD_t8|5.035004||Viu
ANYOFD_t8_p8|5.033003||Viu
ANYOFD_t8_pb|5.033003||Viu
ANYOFD_tb|5.035004||Viu
ANYOFD_tb_p8|5.033003||Viu
ANYOFD_tb_pb|5.033003||Viu
ANYOF_FLAGS|5.006000||Viu
ANYOF_FLAGS_ALL|5.006000||Viu
ANYOF_GRAPH|5.006000||Viu
ANYOFH|5.029007||Viu
ANYOFHb|5.031001||Viu
ANYOFHb_t8|5.035004||Viu
ANYOFHb_t8_p8|5.033003||Viu
ANYOFHb_t8_pb|5.033003||Viu
ANYOFHb_tb|5.035004||Viu
ANYOFHb_tb_p8|5.033003||Viu
ANYOFHb_tb_pb|5.033003||Viu
ANYOF_HORIZWS|5.009005||Viu
ANYOFHr|5.031002||Viu
ANYOFHr_t8|5.035004||Viu
ANYOFHr_t8_p8|5.033003||Viu
ANYOFHr_t8_pb|5.033003||Viu
ANYOFHr_tb|5.035004||Viu
ANYOFHr_tb_p8|5.033003||Viu
ANYOFHr_tb_pb|5.033003||Viu
ANYOFHs|5.031007||Viu
ANYOFHs_t8|5.035004||Viu
ANYOFHs_t8_p8|5.033003||Viu
ANYOFHs_t8_pb|5.033003||Viu
ANYOFHs_tb|5.035004||Viu
ANYOFHs_tb_p8|5.033003||Viu
ANYOFHs_tb_pb|5.033003||Viu
ANYOFH_t8|5.035004||Viu
ANYOFH_t8_p8|5.033003||Viu
ANYOFH_t8_pb|5.033003||Viu
ANYOFH_tb|5.035004||Viu
ANYOFH_tb_p8|5.033003||Viu
ANYOFH_tb_pb|5.033003||Viu
ANYOF_INVERT|5.004000||Viu
ANYOFL|5.021008||Viu
ANYOFL_FOLD|5.023007||Viu
ANYOF_LOCALE_FLAGS|5.019005||Viu
ANYOF_LOWER|5.006000||Viu
ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD|5.023007||Viu
ANYOFL_SOME_FOLDS_ONLY_IN_UTF8_LOCALE|5.023007||Viu
ANYOFL_t8|5.035004||Viu
ANYOFL_t8_p8|5.033003||Viu
ANYOFL_t8_pb|5.033003||Viu
ANYOFL_tb|5.035004||Viu
ANYOFL_tb_p8|5.033003||Viu
ANYOFL_tb_pb|5.033003||Viu
ANYOFL_UTF8_LOCALE_REQD|5.023007||Viu
ANYOFM|5.027009||Viu
ANYOF_MATCHES_ALL_ABOVE_BITMAP|5.021004||Viu
ANYOF_MATCHES_POSIXL|5.021004||Viu
ANYOF_MAX|5.006000||Viu
ANYOFM_t8|5.035004||Viu
ANYOFM_t8_p8|5.033003||Viu
ANYOFM_t8_pb|5.033003||Viu
ANYOFM_tb|5.035004||Viu
ANYOFM_tb_p8|5.033003||Viu
ANYOFM_tb_pb|5.033003||Viu
ANYOF_NALNUM|5.006000||Viu
ANYOF_NALNUML|5.004000||Viu
ANYOF_NALPHA|5.006000||Viu
ANYOF_NALPHANUMERIC|5.017008||Viu
ANYOF_NASCII|5.006000||Viu
ANYOF_NBLANK|5.006001||Viu
ANYOF_NCASED|5.017008||Viu
ANYOF_NCNTRL|5.006000||Viu
ANYOF_NDIGIT|5.006000||Viu
ANYOF_NGRAPH|5.006000||Viu
ANYOF_NHORIZWS|5.009005||Viu
ANYOF_NLOWER|5.006000||Viu
ANYOF_NPRINT|5.006000||Viu
ANYOF_NPUNCT|5.006000||Viu
ANYOF_NSPACE|5.006000||Viu
ANYOF_NSPACEL|5.004000||Viu
ANYOF_NUPPER|5.006000||Viu
ANYOF_NVERTWS|5.009005||Viu
ANYOF_NWORDCHAR|5.017005||Viu
ANYOF_NXDIGIT|5.006000||Viu
ANYOF_ONLY_HAS_BITMAP|5.021004||Viu
ANYOFPOSIXL|5.029004||Viu
ANYOF_POSIXL_AND|5.019005||Viu
ANYOF_POSIXL_BITMAP|5.035003||Viu
ANYOF_POSIXL_CLEAR|5.019005||Viu
ANYOF_POSIXL_MAX|5.019005||Viu
ANYOF_POSIXL_OR|5.019005||Viu
ANYOF_POSIXL_SET|5.019005||Viu
ANYOF_POSIXL_SETALL|5.019005||Viu
ANYOF_POSIXL_SET_TO_BITMAP|5.029004||Viu
ANYOF_POSIXL_SSC_TEST_ALL_SET|5.019009||Viu
ANYOF_POSIXL_SSC_TEST_ANY_SET|5.019009||Viu
ANYOFPOSIXL_t8|5.035004||Viu
ANYOFPOSIXL_t8_p8|5.033003||Viu
ANYOFPOSIXL_t8_pb|5.033003||Viu
ANYOFPOSIXL_tb|5.035004||Viu
ANYOFPOSIXL_tb_p8|5.033003||Viu
ANYOFPOSIXL_tb_pb|5.033003||Viu
ANYOF_POSIXL_TEST|5.019005||Viu
ANYOF_POSIXL_TEST_ALL_SET|5.019005||Viu
ANYOF_POSIXL_TEST_ANY_SET|5.019005||Viu
ANYOF_POSIXL_ZERO|5.019005||Viu
ANYOF_PRINT|5.006000||Viu
ANYOF_PUNCT|5.006000||Viu
ANYOFR|5.031007||Viu
ANYOFRb|5.031007||Viu
ANYOFRbase|5.031007||Viu
ANYOFR_BASE_BITS|5.031007||Viu
ANYOFRb_t8|5.035004||Viu
ANYOFRb_t8_p8|5.033003||Viu
ANYOFRb_t8_pb|5.033003||Viu
ANYOFRb_tb|5.035004||Viu
ANYOFRb_tb_p8|5.033003||Viu
ANYOFRb_tb_pb|5.033003||Viu
ANYOFRdelta|5.031007||Viu
ANYOFR_t8|5.035004||Viu
ANYOFR_t8_p8|5.033003||Viu
ANYOFR_t8_pb|5.033003||Viu
ANYOFR_tb|5.035004||Viu
ANYOFR_tb_p8|5.033003||Viu
ANYOFR_tb_pb|5.033003||Viu
ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER|5.023003||Viu
ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP|5.023006||Viu
ANYOF_SPACE|5.006000||Viu
ANYOF_SPACEL|5.004000||Viu
ANYOF_t8|5.035004||Viu
ANYOF_t8_p8|5.033003||Viu
ANYOF_t8_pb|5.033003||Viu
ANYOF_tb|5.035004||Viu
ANYOF_tb_p8|5.033003||Viu
ANYOF_tb_pb|5.033003||Viu
ANYOF_UNIPROP|5.017006||Viu
ANYOF_UPPER|5.006000||Viu
ANYOF_VERTWS|5.009005||Viu
ANYOF_WORDCHAR|5.017005||Viu
ANYOF_XDIGIT|5.006000||Viu
ao|5.005000||Viu
_append_range_to_invlist|5.013010||Viu
append_utf8_from_native_byte|5.019004||cVniu
apply|5.003007||Viu
apply_attrs|5.006000||Viu
apply_attrs_my|5.007003||Viu
apply_attrs_string|5.006001|5.006001|xu
ARCHLIB|5.003007|5.003007|Vn
ARCHLIB_EXP|5.003007|5.003007|Vn
ARCHNAME|5.004000|5.004000|Vn
ARG1|5.003007||Viu
ARG1_LOC|5.005000||Viu
ARG1_SET|5.005000||Viu
ARG2|5.003007||Viu
ARG2L|5.009005||Viu
ARG2L_LOC|5.009005||Viu
ARG2_LOC|5.005000||Viu
ARG2L_SET|5.009005||Viu
ARG2_SET|5.005000||Viu
ARG|5.005000||Viu
ARG_LOC|5.005000||Viu
ARGp|5.031010||Viu
ARGp_LOC|5.031010||Viu
ARGp_SET|5.031010||Viu
ARG__SET|5.005000||Viu
ARG_SET|5.005000||Viu
ARGTARG|5.003007||Viu
ARG_VALUE|5.005000||Viu
argvout_final|5.029006||Viu
ASCIIish|5.005003||Viu
ASCII_MORE_RESTRICT_PAT_MODS|5.013010||Viu
ASCII_PLATFORM_UTF8_MAXBYTES|5.035004||Viu
ASCII_RESTRICT_PAT_MOD|5.013009||Viu
ASCII_RESTRICT_PAT_MODS|5.013009||Viu
ASCII_TO_NATIVE|5.007001||Viu
ASCII_TO_NEED|5.019004||dcVnu
asctime|5.009000||Viu
ASCTIME_R_PROTO|5.008000|5.008000|Vn
assert|5.003007||Viu
__ASSERT_|5.019007|5.008008|p
ASSERT_CURPAD_ACTIVE|5.008001||Viu
ASSERT_CURPAD_LEGAL|5.008001||Viu
ASSERT_IS_LITERAL|||Viu
ASSERT_IS_PTR|||Viu
assert_not_glob|5.009004||Viu
ASSERT_NOT_PTR|5.035004||Viu
assert_not_ROK|5.008001||Viu
assert_uft8_cache_coherent|5.013003||Viu
assignment_type|5.021005||Viu
ASSUME|5.019006|5.003007|p
atfork_lock|5.007003|5.007003|nu
atfork_unlock|5.007003|5.007003|nu
aTHX|5.006000|5.003007|p
aTHX_|5.006000|5.003007|p
aTHXa|5.017006||Viu
aTHXo|5.006000||Viu
aTHXR||5.003007|ponu
aTHXR_||5.003007|ponu
aTHXx|5.006000||Viu
Atof|5.006000||Viu
Atol|5.006000||Viu
atoll|5.008000||Viu
Atoul|5.006000||Viu
AvALLOC|5.003007||Viu
AvARRAY|5.003007|5.003007|
AvARYLEN|5.003007||Viu
av_arylen_p|||cu
av_clear|5.003007|5.003007|
av_count|5.033001|5.003007|p
av_create_and_push|||
av_create_and_unshift_one|||
av_delete|5.006000|5.006000|
av_exists|5.006000|5.006000|
av_extend|5.003007|5.003007|
av_extend_guts|5.017004||Viu
av_fetch|5.003007|5.003007|
av_fetch_simple|5.035002||cV
av_fill|5.003007|5.003007|
AvFILL|5.003007|5.003007|
AvFILLp|5.004005||pcV
av_iter_p|||cu
av_len|5.003007|5.003007|
av_make|5.003007|5.003007|
AvMAX|5.003007||Viu
av_new_alloc|5.035001|5.035001|
av_nonelem|5.027009||Viu
av_pop|5.003007|5.003007|
av_push|5.003007|5.003007|
AvREAL|5.003007||Viu
AvREALISH|5.003007||Viu
AvREAL_off|5.003007||Viu
AvREAL_on|5.003007||Viu
AvREAL_only|5.009003||Viu
AvREIFY|5.003007||Viu
av_reify|5.004004||cViu
AvREIFY_off|5.003007||Viu
AvREIFY_on|5.003007||Viu
AvREIFY_only|5.009003||Viu
av_shift|5.003007|5.003007|
av_store|5.003007|5.003007|
av_store_simple|5.035002||cV
av_tindex|5.017009|5.003007|p
av_tindex_skip_len_mg|5.025010||Viu
av_top_index|5.017009|5.003007|p
av_top_index_skip_len_mg|5.025010||Viu
av_undef|5.003007|5.003007|
av_unshift|5.003007|5.003007|
ax|5.003007|5.003007|
backup_one_GCB|5.025003||Viu
backup_one_LB|5.023007||Viu
backup_one_SB|5.021009||Viu
backup_one_WB|5.021009||Viu
bad_type_gv|5.019002||Viu
bad_type_pv|5.016000||Viu
BADVERSION|5.011004||Viu
BASEOP|5.003007||Viu
BhkDISABLE|5.013003||xV
BhkENABLE|5.013003||xV
BhkENTRY|5.013003||xVi
BhkENTRY_set|5.013003||xV
BHKf_bhk_eval|5.013006||Viu
BHKf_bhk_post_end|5.013006||Viu
BHKf_bhk_pre_end|5.013006||Viu
BHKf_bhk_start|5.013006||Viu
BhkFLAGS|5.013003||xVi
BIN|5.003007|5.003007|Vn
bind|5.005000||Viu
bind_match|5.003007||Viu
BIN_EXP|5.004000|5.004000|Vn
BIT_BUCKET|5.003007||Viu
BIT_DIGITS|5.004000||Viu
BITMAP_BYTE|5.009005||Viu
BITMAP_TEST|5.009005||Viu
blk_eval|5.003007||Viu
blk_format|5.011000||Viu
blk_gimme|5.003007||Viu
blk_givwhen|5.027008||Viu
blk_loop|5.003007||Viu
blk_oldcop|5.003007||Viu
blk_oldmarksp|5.003007||Viu
blk_oldpm|5.003007||Viu
blk_oldsaveix|5.023008||Viu
blk_oldscopesp|5.003007||Viu
blk_oldsp|5.003007||Viu
blk_old_tmpsfloor|5.023008||Viu
blk_sub|5.003007||Viu
blk_u16|5.011000||Viu
block_end|5.021006|5.021006|
block_gimme|5.004000|5.004000|u
blockhook_register|||x
block_start|5.021006|5.021006|
BmFLAGS|5.009005||Viu
BmPREVIOUS|5.003007||Viu
BmRARE|5.003007||Viu
BmUSEFUL|5.003007||Viu
BOL|5.003007||Viu
BOL_t8|5.035004||Viu
BOL_t8_p8|5.033003||Viu
BOL_t8_pb|5.033003||Viu
BOL_tb|5.035004||Viu
BOL_tb_p8|5.033003||Viu
BOL_tb_pb|5.033003||Viu
BOM_UTF8|5.025005|5.003007|p
BOM_UTF8_FIRST_BYTE|5.019004||Viu
BOM_UTF8_TAIL|5.019004||Viu
boolSV|5.004000|5.003007|p
boot_core_builtin|5.035007||Viu
boot_core_mro|5.009005||Viu
boot_core_PerlIO|5.007002||Viu
boot_core_UNIVERSAL|5.003007||Viu
BOUND|5.003007||Viu
BOUNDA|5.013009||Viu
BOUNDA_t8|5.035004||Viu
BOUNDA_t8_p8|5.033003||Viu
BOUNDA_t8_pb|5.033003||Viu
BOUNDA_tb|5.035004||Viu
BOUNDA_tb_p8|5.033003||Viu
BOUNDA_tb_pb|5.033003||Viu
BOUNDL|5.004000||Viu
BOUNDL_t8|5.035004||Viu
BOUNDL_t8_p8|5.033003||Viu
BOUNDL_t8_pb|5.033003||Viu
BOUNDL_tb|5.035004||Viu
BOUNDL_tb_p8|5.033003||Viu
BOUNDL_tb_pb|5.033003||Viu
BOUND_t8|5.035004||Viu
BOUND_t8_p8|5.033003||Viu
BOUND_t8_pb|5.033003||Viu
BOUND_tb|5.035004||Viu
BOUND_tb_p8|5.033003||Viu
BOUND_tb_pb|5.033003||Viu
BOUNDU|5.013009||Viu
BOUNDU_t8|5.035004||Viu
BOUNDU_t8_p8|5.033003||Viu
BOUNDU_t8_pb|5.033003||Viu
BOUNDU_tb|5.035004||Viu
BOUNDU_tb_p8|5.033003||Viu
BOUNDU_tb_pb|5.033003||Viu
BRANCH|5.003007||Viu
BRANCHJ|5.005000||Viu
BRANCHJ_t8|5.035004||Viu
BRANCHJ_t8_p8|5.033003||Viu
BRANCHJ_t8_pb|5.033003||Viu
BRANCHJ_tb|5.035004||Viu
BRANCHJ_tb_p8|5.033003||Viu
BRANCHJ_tb_pb|5.033003||Viu
BRANCH_next|5.009005||Viu
BRANCH_next_fail|5.009005||Viu
BRANCH_next_fail_t8|5.035004||Viu
BRANCH_next_fail_t8_p8|5.033003||Viu
BRANCH_next_fail_t8_pb|5.033003||Viu
BRANCH_next_fail_tb|5.035004||Viu
BRANCH_next_fail_tb_p8|5.033003||Viu
BRANCH_next_fail_tb_pb|5.033003||Viu
BRANCH_next_t8|5.035004||Viu
BRANCH_next_t8_p8|5.033003||Viu
BRANCH_next_t8_pb|5.033003||Viu
BRANCH_next_tb|5.035004||Viu
BRANCH_next_tb_p8|5.033003||Viu
BRANCH_next_tb_pb|5.033003||Viu
BRANCH_t8|5.035004||Viu
BRANCH_t8_p8|5.033003||Viu
BRANCH_t8_pb|5.033003||Viu
BRANCH_tb|5.035004||Viu
BRANCH_tb_p8|5.033003||Viu
BRANCH_tb_pb|5.033003||Viu
BSD_GETPGRP|5.003007||Viu
BSDish|5.008001||Viu
BSD_SETPGRP|5.003007||Viu
BUFSIZ|5.003007||Viu
_byte_dump_string|5.025006||cViu
BYTEORDER|5.003007|5.003007|Vn
bytes_cmp_utf8|5.013007|5.013007|
bytes_from_utf8|5.007001|5.007001|x
bytes_from_utf8_loc|5.027001||xcVn
bytes_to_utf8|5.006001|5.006001|x
call_argv|5.006000|5.003007|p
call_atexit|5.006000|5.006000|u
CALL_BLOCK_HOOKS|5.013003||xVi
CALL_CHECKER_REQUIRE_GV|5.021004|5.021004|
caller_cx|5.013005|5.006000|p
CALL_FPTR|5.006000||Viu
call_list|5.004000|5.004000|u
call_method|5.006000|5.003007|p
calloc|5.029005||Vn
call_pv|5.006000|5.003007|p
CALLREGCOMP|5.005000||Viu
CALLREGCOMP_ENG|5.009005||Viu
CALLREGDUPE|5.009005||Viu
CALLREGDUPE_PVT|5.009005||Viu
CALLREGEXEC|5.005000||Viu
CALLREGFREE|5.006000||Viu
CALLREGFREE_PVT|5.009005||Viu
CALLREG_INTUIT_START|5.006000||Viu
CALLREG_INTUIT_STRING|5.006000||Viu
CALLREG_NAMED_BUFF_ALL|5.009005||Viu
CALLREG_NAMED_BUFF_CLEAR|5.009005||Viu
CALLREG_NAMED_BUFF_COUNT|5.009005||Viu
CALLREG_NAMED_BUFF_DELETE|5.009005||Viu
CALLREG_NAMED_BUFF_EXISTS|5.009005||Viu
CALLREG_NAMED_BUFF_FETCH|5.009005||Viu
CALLREG_NAMED_BUFF_FIRSTKEY|5.009005||Viu
CALLREG_NAMED_BUFF_NEXTKEY|5.009005||Viu
CALLREG_NAMED_BUFF_SCALAR|5.009005||Viu
CALLREG_NAMED_BUFF_STORE|5.009005||Viu
CALLREG_NUMBUF_FETCH|5.009005||Viu
CALLREG_NUMBUF_LENGTH|5.009005||Viu
CALLREG_NUMBUF_STORE|5.009005||Viu
CALLREG_PACKAGE|5.009005||Viu
CALLRUNOPS|5.005000||Viu
call_sv|5.006000|5.003007|p
CAN64BITHASH|5.027001||Viu
CAN_COW_FLAGS|5.009000||Viu
CAN_COW_MASK|5.009000||Viu
cando|5.003007||Viu
CAN_PROTOTYPE|5.003007||Viu
C_ARRAY_END|5.013002|5.003007|p
C_ARRAY_LENGTH|5.008001|5.003007|p
case_100_SBOX32|5.027001||Viu
case_101_SBOX32|5.027001||Viu
case_102_SBOX32|5.027001||Viu
case_103_SBOX32|5.027001||Viu
case_104_SBOX32|5.027001||Viu
case_105_SBOX32|5.027001||Viu
case_106_SBOX32|5.027001||Viu
case_107_SBOX32|5.027001||Viu
case_108_SBOX32|5.027001||Viu
case_109_SBOX32|5.027001||Viu
case_10_SBOX32|5.027001||Viu
case_110_SBOX32|5.027001||Viu
case_111_SBOX32|5.027001||Viu
case_112_SBOX32|5.027001||Viu
case_113_SBOX32|5.027001||Viu
case_114_SBOX32|5.027001||Viu
case_115_SBOX32|5.027001||Viu
case_116_SBOX32|5.027001||Viu
case_117_SBOX32|5.027001||Viu
case_118_SBOX32|5.027001||Viu
case_119_SBOX32|5.027001||Viu
case_11_SBOX32|5.027001||Viu
case_120_SBOX32|5.027001||Viu
case_121_SBOX32|5.027001||Viu
case_122_SBOX32|5.027001||Viu
case_123_SBOX32|5.027001||Viu
case_124_SBOX32|5.027001||Viu
case_125_SBOX32|5.027001||Viu
case_126_SBOX32|5.027001||Viu
case_127_SBOX32|5.027001||Viu
case_128_SBOX32|5.027001||Viu
case_129_SBOX32|5.027001||Viu
case_12_SBOX32|5.027001||Viu
case_130_SBOX32|5.027001||Viu
case_131_SBOX32|5.027001||Viu
case_132_SBOX32|5.027001||Viu
case_133_SBOX32|5.027001||Viu
case_134_SBOX32|5.027001||Viu
case_135_SBOX32|5.027001||Viu
case_136_SBOX32|5.027001||Viu
case_137_SBOX32|5.027001||Viu
case_138_SBOX32|5.027001||Viu
case_139_SBOX32|5.027001||Viu
case_13_SBOX32|5.027001||Viu
case_140_SBOX32|5.027001||Viu
case_141_SBOX32|5.027001||Viu
case_142_SBOX32|5.027001||Viu
case_143_SBOX32|5.027001||Viu
case_144_SBOX32|5.027001||Viu
case_145_SBOX32|5.027001||Viu
case_146_SBOX32|5.027001||Viu
case_147_SBOX32|5.027001||Viu
case_148_SBOX32|5.027001||Viu
case_149_SBOX32|5.027001||Viu
case_14_SBOX32|5.027001||Viu
case_150_SBOX32|5.027001||Viu
case_151_SBOX32|5.027001||Viu
case_152_SBOX32|5.027001||Viu
case_153_SBOX32|5.027001||Viu
case_154_SBOX32|5.027001||Viu
case_155_SBOX32|5.027001||Viu
case_156_SBOX32|5.027001||Viu
case_157_SBOX32|5.027001||Viu
case_158_SBOX32|5.027001||Viu
case_159_SBOX32|5.027001||Viu
case_15_SBOX32|5.027001||Viu
case_160_SBOX32|5.027001||Viu
case_161_SBOX32|5.027001||Viu
case_162_SBOX32|5.027001||Viu
case_163_SBOX32|5.027001||Viu
case_164_SBOX32|5.027001||Viu
case_165_SBOX32|5.027001||Viu
case_166_SBOX32|5.027001||Viu
case_167_SBOX32|5.027001||Viu
case_168_SBOX32|5.027001||Viu
case_169_SBOX32|5.027001||Viu
case_16_SBOX32|5.027001||Viu
case_170_SBOX32|5.027001||Viu
case_171_SBOX32|5.027001||Viu
case_172_SBOX32|5.027001||Viu
case_173_SBOX32|5.027001||Viu
case_174_SBOX32|5.027001||Viu
case_175_SBOX32|5.027001||Viu
case_176_SBOX32|5.027001||Viu
case_177_SBOX32|5.027001||Viu
case_178_SBOX32|5.027001||Viu
case_179_SBOX32|5.027001||Viu
case_17_SBOX32|5.027001||Viu
case_180_SBOX32|5.027001||Viu
case_181_SBOX32|5.027001||Viu
case_182_SBOX32|5.027001||Viu
case_183_SBOX32|5.027001||Viu
case_184_SBOX32|5.027001||Viu
case_185_SBOX32|5.027001||Viu
case_186_SBOX32|5.027001||Viu
case_187_SBOX32|5.027001||Viu
case_188_SBOX32|5.027001||Viu
case_189_SBOX32|5.027001||Viu
case_18_SBOX32|5.027001||Viu
case_190_SBOX32|5.027001||Viu
case_191_SBOX32|5.027001||Viu
case_192_SBOX32|5.027001||Viu
case_193_SBOX32|5.027001||Viu
case_194_SBOX32|5.027001||Viu
case_195_SBOX32|5.027001||Viu
case_196_SBOX32|5.027001||Viu
case_197_SBOX32|5.027001||Viu
case_198_SBOX32|5.027001||Viu
case_199_SBOX32|5.027001||Viu
case_19_SBOX32|5.027001||Viu
case_1_SBOX32|5.027001||Viu
case_200_SBOX32|5.027001||Viu
case_201_SBOX32|5.027001||Viu
case_202_SBOX32|5.027001||Viu
case_203_SBOX32|5.027001||Viu
case_204_SBOX32|5.027001||Viu
case_205_SBOX32|5.027001||Viu
case_206_SBOX32|5.027001||Viu
case_207_SBOX32|5.027001||Viu
case_208_SBOX32|5.027001||Viu
case_209_SBOX32|5.027001||Viu
case_20_SBOX32|5.027001||Viu
case_210_SBOX32|5.027001||Viu
case_211_SBOX32|5.027001||Viu
case_212_SBOX32|5.027001||Viu
case_213_SBOX32|5.027001||Viu
case_214_SBOX32|5.027001||Viu
case_215_SBOX32|5.027001||Viu
case_216_SBOX32|5.027001||Viu
case_217_SBOX32|5.027001||Viu
case_218_SBOX32|5.027001||Viu
case_219_SBOX32|5.027001||Viu
case_21_SBOX32|5.027001||Viu
case_220_SBOX32|5.027001||Viu
case_221_SBOX32|5.027001||Viu
case_222_SBOX32|5.027001||Viu
case_223_SBOX32|5.027001||Viu
case_224_SBOX32|5.027001||Viu
case_225_SBOX32|5.027001||Viu
case_226_SBOX32|5.027001||Viu
case_227_SBOX32|5.027001||Viu
case_228_SBOX32|5.027001||Viu
case_229_SBOX32|5.027001||Viu
case_22_SBOX32|5.027001||Viu
case_230_SBOX32|5.027001||Viu
case_231_SBOX32|5.027001||Viu
case_232_SBOX32|5.027001||Viu
case_233_SBOX32|5.027001||Viu
case_234_SBOX32|5.027001||Viu
case_235_SBOX32|5.027001||Viu
case_236_SBOX32|5.027001||Viu
case_237_SBOX32|5.027001||Viu
case_238_SBOX32|5.027001||Viu
case_239_SBOX32|5.027001||Viu
case_23_SBOX32|5.027001||Viu
case_240_SBOX32|5.027001||Viu
case_241_SBOX32|5.027001||Viu
case_242_SBOX32|5.027001||Viu
case_243_SBOX32|5.027001||Viu
case_244_SBOX32|5.027001||Viu
case_245_SBOX32|5.027001||Viu
case_246_SBOX32|5.027001||Viu
case_247_SBOX32|5.027001||Viu
case_248_SBOX32|5.027001||Viu
case_249_SBOX32|5.027001||Viu
case_24_SBOX32|5.027001||Viu
case_250_SBOX32|5.027001||Viu
case_251_SBOX32|5.027001||Viu
case_252_SBOX32|5.027001||Viu
case_253_SBOX32|5.027001||Viu
case_254_SBOX32|5.027001||Viu
case_255_SBOX32|5.027001||Viu
case_256_SBOX32|5.027001||Viu
case_25_SBOX32|5.027001||Viu
case_26_SBOX32|5.027001||Viu
case_27_SBOX32|5.027001||Viu
case_28_SBOX32|5.027001||Viu
case_29_SBOX32|5.027001||Viu
case_2_SBOX32|5.027001||Viu
case_30_SBOX32|5.027001||Viu
case_31_SBOX32|5.027001||Viu
case_32_SBOX32|5.027001||Viu
case_33_SBOX32|5.027001||Viu
case_34_SBOX32|5.027001||Viu
case_35_SBOX32|5.027001||Viu
case_36_SBOX32|5.027001||Viu
case_37_SBOX32|5.027001||Viu
case_38_SBOX32|5.027001||Viu
case_39_SBOX32|5.027001||Viu
case_3_SBOX32|5.027001||Viu
case_40_SBOX32|5.027001||Viu
case_41_SBOX32|5.027001||Viu
case_42_SBOX32|5.027001||Viu
case_43_SBOX32|5.027001||Viu
case_44_SBOX32|5.027001||Viu
case_45_SBOX32|5.027001||Viu
case_46_SBOX32|5.027001||Viu
case_47_SBOX32|5.027001||Viu
case_48_SBOX32|5.027001||Viu
case_49_SBOX32|5.027001||Viu
case_4_SBOX32|5.027001||Viu
case_50_SBOX32|5.027001||Viu
case_51_SBOX32|5.027001||Viu
case_52_SBOX32|5.027001||Viu
case_53_SBOX32|5.027001||Viu
case_54_SBOX32|5.027001||Viu
case_55_SBOX32|5.027001||Viu
case_56_SBOX32|5.027001||Viu
case_57_SBOX32|5.027001||Viu
case_58_SBOX32|5.027001||Viu
case_59_SBOX32|5.027001||Viu
case_5_SBOX32|5.027001||Viu
case_60_SBOX32|5.027001||Viu
case_61_SBOX32|5.027001||Viu
case_62_SBOX32|5.027001||Viu
case_63_SBOX32|5.027001||Viu
case_64_SBOX32|5.027001||Viu
case_65_SBOX32|5.027001||Viu
case_66_SBOX32|5.027001||Viu
case_67_SBOX32|5.027001||Viu
case_68_SBOX32|5.027001||Viu
case_69_SBOX32|5.027001||Viu
case_6_SBOX32|5.027001||Viu
case_70_SBOX32|5.027001||Viu
case_71_SBOX32|5.027001||Viu
case_72_SBOX32|5.027001||Viu
case_73_SBOX32|5.027001||Viu
case_74_SBOX32|5.027001||Viu
case_75_SBOX32|5.027001||Viu
case_76_SBOX32|5.027001||Viu
case_77_SBOX32|5.027001||Viu
case_78_SBOX32|5.027001||Viu
case_79_SBOX32|5.027001||Viu
case_7_SBOX32|5.027001||Viu
case_80_SBOX32|5.027001||Viu
case_81_SBOX32|5.027001||Viu
case_82_SBOX32|5.027001||Viu
case_83_SBOX32|5.027001||Viu
case_84_SBOX32|5.027001||Viu
case_85_SBOX32|5.027001||Viu
case_86_SBOX32|5.027001||Viu
case_87_SBOX32|5.027001||Viu
case_88_SBOX32|5.027001||Viu
case_89_SBOX32|5.027001||Viu
case_8_SBOX32|5.027001||Viu
case_90_SBOX32|5.027001||Viu
case_91_SBOX32|5.027001||Viu
case_92_SBOX32|5.027001||Viu
case_93_SBOX32|5.027001||Viu
case_94_SBOX32|5.027001||Viu
case_95_SBOX32|5.027001||Viu
case_96_SBOX32|5.027001||Viu
case_97_SBOX32|5.027001||Viu
case_98_SBOX32|5.027001||Viu
case_99_SBOX32|5.027001||Viu
case_9_SBOX32|5.027001||Viu
CASE_STD_PMMOD_FLAGS_PARSE_SET|5.009005||Viu
CASTFLAGS|5.003007|5.003007|Vn
cast_i32|5.006000||cVnu
cast_iv|5.006000||cVnu
CASTNEGFLOAT|5.003007|5.003007|Vn
cast_ulong|5.003007||cVnu
cast_uv|5.006000||cVnu
CAT2|5.003007|5.003007|Vn
CATCH_GET|5.004000||Viu
CATCH_SET|5.004000||Viu
category_name|5.027008||Vniu
cBINOP|5.003007||Viu
cBINOPo|5.004005||Viu
cBINOPx|5.006000||Viu
cBOOL|5.013000|5.003007|p
cCOP|5.003007||Viu
cCOPo|5.004005||Viu
cCOPx|5.006000||Viu
C_FAC_POSIX|5.009003||Viu
cGVOP_gv|5.006000||Viu
cGVOPo_gv|5.006000||Viu
cGVOPx_gv|5.006000||Viu
change_engine_size|5.029004||Viu
CHANGE_MULTICALL_FLAGS|5.018000||Viu
CHARBITS|5.011002|5.011002|Vn
CHARSET_PAT_MODS|5.013010||Viu
chdir|5.005000||Viu
checkcomma|5.003007||Viu
check_end_shift|5.009005||Viu
check_locale_boundary_crossing|5.015006||Viu
CHECK_MALLOC_TAINT|5.008001||Viu
CHECK_MALLOC_TOO_LATE_FOR|5.008001||Viu
check_offset_max|5.005000||Viu
check_offset_min|5.005000||Viu
check_substr|5.005000||Viu
check_type_and_open|5.009003||Viu
check_uni|5.003007||Viu
check_utf8|5.008000||Viu
check_utf8_print|5.013009||Viu
child_offset_bits|5.009003||Viu
chmod|5.005000||Viu
chsize|5.005000||Viu
ckDEAD|5.006000||Viu
ck_entersub_args_core|||iu
ck_entersub_args_list|5.013006|5.013006|
ck_entersub_args_proto|5.013006|5.013006|
ck_entersub_args_proto_or_list|5.013006|5.013006|
ckWARN2|5.006000|5.003007|p
ckWARN2_d|5.006000|5.003007|p
ckWARN3|5.007003|5.003007|p
ckWARN3_d|5.007003|5.003007|p
ckWARN4|5.007003|5.003007|p
ckWARN4_d|5.007003|5.003007|p
ckWARN|5.006000|5.003007|p
ckwarn_common|5.011001||Viu
ckwarn|||cu
ckWARN_d|5.006000|5.003007|p
ckwarn_d|||cu
ck_warner|5.011001||pvV
ck_warner_d|5.011001||pvV
CLANG_DIAG_IGNORE|5.023006||Viu
CLANG_DIAG_IGNORE_DECL|5.027007||Viu
CLANG_DIAG_IGNORE_STMT|5.027007||Viu
CLANG_DIAG_PRAGMA|5.023006||Viu
CLANG_DIAG_RESTORE|5.023006||Viu
CLANG_DIAG_RESTORE_DECL|5.027007||Viu
CLANG_DIAG_RESTORE_STMT|5.027007||Viu
CLASS||5.003007|
CLEAR_ARGARRAY|5.006000||Viu
clear_defarray|5.023008|5.023008|u
clearerr|5.003007||Viu
CLEAR_ERRSV|5.025007|5.025007|
CLEARFEATUREBITS|5.031006||Viu
clear_placeholders|5.009004||xViu
clear_special_blocks|5.021003||Viu
cLISTOP|5.003007||Viu
cLISTOPo|5.004005||Viu
cLISTOPx|5.006000||Viu
cLOGOP|5.003007||Viu
cLOGOPo|5.004005||Viu
cLOGOPx|5.006000||Viu
CLONEf_CLONE_HOST|5.007002||Viu
CLONEf_COPY_STACKS|5.007001||Viu
CLONEf_JOIN_IN|5.008001||Viu
CLONEf_KEEP_PTR_TABLE|5.007001||Viu
clone_params_del|||nu
clone_params_new|||nu
cLOOP|5.003007||Viu
cLOOPo|5.004005||Viu
cLOOPx|5.006000||Viu
CLOSE|5.003007||Viu
close|5.005000||Viu
closedir|5.005000||Viu
closest_cop|5.007002||Viu
CLOSE_t8|5.035004||Viu
CLOSE_t8_p8|5.033003||Viu
CLOSE_t8_pb|5.033003||Viu
CLOSE_tb|5.035004||Viu
CLOSE_tb_p8|5.033003||Viu
CLOSE_tb_pb|5.033003||Viu
CLUMP_2IV|5.006000||Viu
CLUMP_2UV|5.006000||Viu
CLUMP|5.006000||Viu
CLUMP_t8|5.035004||Viu
CLUMP_t8_p8|5.033003||Viu
CLUMP_t8_pb|5.033003||Viu
CLUMP_tb|5.035004||Viu
CLUMP_tb_p8|5.033003||Viu
CLUMP_tb_pb|5.033003||Viu
cMETHOPx|5.021005||Viu
cMETHOPx_meth|5.021005||Viu
cMETHOPx_rclass|5.021007||Viu
cmpchain_extend|5.031011||Viu
cmpchain_finish|5.031011||Viu
cmpchain_start|5.031011||Viu
cmp_desc|5.031011||Viu
cmp_locale_desc|5.031011||Viu
cntrl_to_mnemonic|5.021004||cVniu
CODESET|5.027010||Viu
COMBINING_DOT_ABOVE_UTF8|5.029008||Viu
COMBINING_GRAVE_ACCENT_UTF8|5.017004||Viu
COMMIT|5.009005||Viu
COMMIT_next|5.009005||Viu
COMMIT_next_fail|5.009005||Viu
COMMIT_next_fail_t8|5.035004||Viu
COMMIT_next_fail_t8_p8|5.033003||Viu
COMMIT_next_fail_t8_pb|5.033003||Viu
COMMIT_next_fail_tb|5.035004||Viu
COMMIT_next_fail_tb_p8|5.033003||Viu
COMMIT_next_fail_tb_pb|5.033003||Viu
COMMIT_next_t8|5.035004||Viu
COMMIT_next_t8_p8|5.033003||Viu
COMMIT_next_t8_pb|5.033003||Viu
COMMIT_next_tb|5.035004||Viu
COMMIT_next_tb_p8|5.033003||Viu
COMMIT_next_tb_pb|5.033003||Viu
COMMIT_t8|5.035004||Viu
COMMIT_t8_p8|5.033003||Viu
COMMIT_t8_pb|5.033003||Viu
COMMIT_tb|5.035004||Viu
COMMIT_tb_p8|5.033003||Viu
COMMIT_tb_pb|5.033003||Viu
compile_wildcard|5.031010||Viu
compute_EXACTish|5.017003||Vniu
COND_BROADCAST|5.005000||Viu
COND_DESTROY|5.005000||Viu
COND_INIT|5.005000||Viu
COND_SIGNAL|5.005000||Viu
COND_WAIT|5.005000||Viu
connect|5.005000||Viu
construct_ahocorasick_from_trie|5.021001||Viu
CONTINUE_PAT_MOD|5.009005||Viu
cop_fetch_label|5.031004|5.031004|x
CopFILE|5.006000|5.003007|p
CopFILEAV|5.006000|5.003007|p
CopFILEAVn|5.035006|5.035006|
cop_file_avn|5.035006||cVu
CopFILEAVx|5.009003||Viu
CopFILE_free|5.007003||Viu
CopFILEGV|5.006000|5.003007|p
CopFILEGV_set|5.006000|5.003007|p
CopFILE_set|5.006000|5.003007|p
CopFILE_setn|5.009005||Viu
CopFILESV|5.006000|5.003007|p
cop_free|5.006000||Viu
cophh_2hv|5.013007|5.013007|x
cophh_copy|5.013007|5.013007|x
cophh_delete_pv|5.013007|5.013007|x
cophh_delete_pvn|5.013007|5.013007|x
cophh_delete_pvs|5.013007|5.013007|x
cophh_delete_sv|5.013007|5.013007|x
COPHH_EXISTS|5.033008||Viu
cophh_exists_pv|5.033008|5.033008|x
cophh_exists_pvn|5.033008|5.033008|x
cophh_exists_pvs|5.033008|5.033008|x
cophh_exists_sv|5.033008|5.033008|x
cophh_fetch_pv|5.013007|5.013007|x
cophh_fetch_pvn|5.013007|5.013007|x
cophh_fetch_pvs|5.013007|5.013007|x
cophh_fetch_sv|5.013007|5.013007|x
cophh_free|5.013007|5.013007|x
COPHH_KEY_UTF8|5.013007|5.013007|
cophh_new_empty|5.013007|5.013007|x
cophh_store_pv|5.013007|5.013007|x
cophh_store_pvn|5.013007|5.013007|x
cophh_store_pvs|5.013007|5.013007|x
cophh_store_sv|5.013007|5.013007|x
CopHINTHASH_get|5.013007||Viu
CopHINTHASH_set|5.013007||Viu
cop_hints_2hv|5.013007|5.013007|
cop_hints_exists_pv|5.033008|5.033008|
cop_hints_exists_pvn|5.033008|5.033008|
cop_hints_exists_pvs|5.033008|5.033008|
cop_hints_exists_sv|5.033008|5.033008|
cop_hints_fetch_pv|5.013007|5.013007|
cop_hints_fetch_pvn|5.013007|5.013007|
cop_hints_fetch_pvs|5.013007|5.013007|
cop_hints_fetch_sv|5.013007|5.013007|
CopHINTS_get|5.009004||Viu
CopHINTS_set|5.009004||Viu
CopLABEL|5.009005|5.009005|
CopLABEL_alloc|5.009005||Viu
CopLABEL_len|5.016000|5.016000|
CopLABEL_len_flags|5.016000|5.016000|
CopLINE|5.006000|5.006000|
CopLINE_dec|5.006000||Viu
CopLINE_inc|5.006000||Viu
CopLINE_set|5.006000||Viu
COP_SEQMAX_INC|5.021006||Viu
COP_SEQ_RANGE_HIGH|5.009005||Viu
COP_SEQ_RANGE_LOW|5.009005||Viu
CopSTASH|5.006000|5.003007|p
CopSTASH_eq|5.006000|5.003007|p
CopSTASH_ne|5.006000||Viu
CopSTASHPV|5.006000|5.003007|p
CopSTASHPV_set|5.017001|5.017001|p
CopSTASH_set|5.006000|5.003007|p
cop_store_label|5.031004|5.031004|x
Copy|5.003007|5.003007|
CopyD|5.009002|5.003007|p
copy_length|||Viu
core_prototype|5.015002||Vi
coresub_op|5.015003||Viu
CowREFCNT|5.017007||Viu
cPADOP|5.006000||Viu
cPADOPo|5.006000||Viu
cPADOPx|5.006000||Viu
CPERLarg|5.005000||Viu
CPERLscope|5.005000|5.003007|pdV
cPMOP|5.003007||Viu
cPMOPo|5.004005||Viu
cPMOPx|5.006000||Viu
CPPLAST|5.006000|5.006000|Vn
CPPMINUS|5.003007|5.003007|Vn
CPPRUN|5.006000|5.006000|Vn
CPPSTDIN|5.003007|5.003007|Vn
cPVOP|5.003007||Viu
cPVOPo|5.004005||Viu
cPVOPx|5.006000||Viu
create_eval_scope|5.009004||xViu
CR_NATIVE|5.019004||Viu
CRNCYSTR|5.027010||Viu
croak|5.003007||vV
croak_caller|5.025004||vVniu
croak_memory_wrap|5.019003||pcVnu
croak_nocontext|5.006000||pvVn
croak_no_mem|5.017006||Vniu
croak_no_modify|5.013003|5.003007|pn
croak_popstack|5.017008||cVniu
croak_sv|5.013001|5.003007|p
croak_xs_usage|5.010001|5.003007|pn
cr_textfilter|5.006000||Viu
crypt|5.009000||Viu
CRYPT_R_PROTO|5.008000|5.008000|Vn
CSH|5.003007|5.003007|Vn
csighandler1|5.031007||cVnu
csighandler3|5.031007||cVnu
csighandler|5.008001||cVnu
cSVOP|5.003007||Viu
cSVOPo|5.004005||Viu
cSVOPo_sv|5.006000||Viu
cSVOP_sv|5.006000||Viu
cSVOPx|5.006000||Viu
cSVOPx_sv|5.006000||Viu
cSVOPx_svp|5.006000||Viu
ctermid|5.009000||Viu
CTERMID_R_PROTO|5.008000|5.008000|Vn
ctime|5.009000||Viu
CTIME_R_PROTO|5.008000|5.008000|Vn
Ctl|5.003007||Viu
CTYPE256|5.003007||Viu
cUNOP|5.003007||Viu
cUNOP_AUX|5.021007||Viu
cUNOP_AUXo|5.021007||Viu
cUNOP_AUXx|5.021007||Viu
cUNOPo|5.004005||Viu
cUNOPx|5.006000||Viu
CURLY|5.003007||Viu
CURLY_B_max|5.009005||Viu
CURLY_B_max_fail|5.009005||Viu
CURLY_B_max_fail_t8|5.035004||Viu
CURLY_B_max_fail_t8_p8|5.033003||Viu
CURLY_B_max_fail_t8_pb|5.033003||Viu
CURLY_B_max_fail_tb|5.035004||Viu
CURLY_B_max_fail_tb_p8|5.033003||Viu
CURLY_B_max_fail_tb_pb|5.033003||Viu
CURLY_B_max_t8|5.035004||Viu
CURLY_B_max_t8_p8|5.033003||Viu
CURLY_B_max_t8_pb|5.033003||Viu
CURLY_B_max_tb|5.035004||Viu
CURLY_B_max_tb_p8|5.033003||Viu
CURLY_B_max_tb_pb|5.033003||Viu
CURLY_B_min|5.009005||Viu
CURLY_B_min_fail|5.009005||Viu
CURLY_B_min_fail_t8|5.035004||Viu
CURLY_B_min_fail_t8_p8|5.033003||Viu
CURLY_B_min_fail_t8_pb|5.033003||Viu
CURLY_B_min_fail_tb|5.035004||Viu
CURLY_B_min_fail_tb_p8|5.033003||Viu
CURLY_B_min_fail_tb_pb|5.033003||Viu
CURLY_B_min_t8|5.035004||Viu
CURLY_B_min_t8_p8|5.033003||Viu
CURLY_B_min_t8_pb|5.033003||Viu
CURLY_B_min_tb|5.035004||Viu
CURLY_B_min_tb_p8|5.033003||Viu
CURLY_B_min_tb_pb|5.033003||Viu
CURLYM|5.005000||Viu
CURLYM_A|5.009005||Viu
CURLYM_A_fail|5.009005||Viu
CURLYM_A_fail_t8|5.035004||Viu
CURLYM_A_fail_t8_p8|5.033003||Viu
CURLYM_A_fail_t8_pb|5.033003||Viu
CURLYM_A_fail_tb|5.035004||Viu
CURLYM_A_fail_tb_p8|5.033003||Viu
CURLYM_A_fail_tb_pb|5.033003||Viu
CURLYM_A_t8|5.035004||Viu
CURLYM_A_t8_p8|5.033003||Viu
CURLYM_A_t8_pb|5.033003||Viu
CURLYM_A_tb|5.035004||Viu
CURLYM_A_tb_p8|5.033003||Viu
CURLYM_A_tb_pb|5.033003||Viu
CURLYM_B|5.009005||Viu
CURLYM_B_fail|5.009005||Viu
CURLYM_B_fail_t8|5.035004||Viu
CURLYM_B_fail_t8_p8|5.033003||Viu
CURLYM_B_fail_t8_pb|5.033003||Viu
CURLYM_B_fail_tb|5.035004||Viu
CURLYM_B_fail_tb_p8|5.033003||Viu
CURLYM_B_fail_tb_pb|5.033003||Viu
CURLYM_B_t8|5.035004||Viu
CURLYM_B_t8_p8|5.033003||Viu
CURLYM_B_t8_pb|5.033003||Viu
CURLYM_B_tb|5.035004||Viu
CURLYM_B_tb_p8|5.033003||Viu
CURLYM_B_tb_pb|5.033003||Viu
CURLYM_t8|5.035004||Viu
CURLYM_t8_p8|5.033003||Viu
CURLYM_t8_pb|5.033003||Viu
CURLYM_tb|5.035004||Viu
CURLYM_tb_p8|5.033003||Viu
CURLYM_tb_pb|5.033003||Viu
CURLYN|5.005000||Viu
CURLYN_t8|5.035004||Viu
CURLYN_t8_p8|5.033003||Viu
CURLYN_t8_pb|5.033003||Viu
CURLYN_tb|5.035004||Viu
CURLYN_tb_p8|5.033003||Viu
CURLYN_tb_pb|5.033003||Viu
CURLY_t8|5.035004||Viu
CURLY_t8_p8|5.033003||Viu
CURLY_t8_pb|5.033003||Viu
CURLY_tb|5.035004||Viu
CURLY_tb_p8|5.033003||Viu
CURLY_tb_pb|5.033003||Viu
CURLYX|5.003007||Viu
CURLYX_end|5.009005||Viu
CURLYX_end_fail|5.009005||Viu
CURLYX_end_fail_t8|5.035004||Viu
CURLYX_end_fail_t8_p8|5.033003||Viu
CURLYX_end_fail_t8_pb|5.033003||Viu
CURLYX_end_fail_tb|5.035004||Viu
CURLYX_end_fail_tb_p8|5.033003||Viu
CURLYX_end_fail_tb_pb|5.033003||Viu
CURLYX_end_t8|5.035004||Viu
CURLYX_end_t8_p8|5.033003||Viu
CURLYX_end_t8_pb|5.033003||Viu
CURLYX_end_tb|5.035004||Viu
CURLYX_end_tb_p8|5.033003||Viu
CURLYX_end_tb_pb|5.033003||Viu
CURLYX_t8|5.035004||Viu
CURLYX_t8_p8|5.033003||Viu
CURLYX_t8_pb|5.033003||Viu
CURLYX_tb|5.035004||Viu
CURLYX_tb_p8|5.033003||Viu
CURLYX_tb_pb|5.033003||Viu
CURRENT_FEATURE_BUNDLE|5.015007||Viu
CURRENT_HINTS|5.015007||Viu
current_re_engine|5.017001||cViu
curse|5.013009||Viu
custom_op_desc|5.007003|5.007003|d
custom_op_get_field|5.019006||cViu
custom_op_name|5.007003|5.007003|d
custom_op_register|||
CUTGROUP|5.009005||Viu
CUTGROUP_next|5.009005||Viu
CUTGROUP_next_fail|5.009005||Viu
CUTGROUP_next_fail_t8|5.035004||Viu
CUTGROUP_next_fail_t8_p8|5.033003||Viu
CUTGROUP_next_fail_t8_pb|5.033003||Viu
CUTGROUP_next_fail_tb|5.035004||Viu
CUTGROUP_next_fail_tb_p8|5.033003||Viu
CUTGROUP_next_fail_tb_pb|5.033003||Viu
CUTGROUP_next_t8|5.035004||Viu
CUTGROUP_next_t8_p8|5.033003||Viu
CUTGROUP_next_t8_pb|5.033003||Viu
CUTGROUP_next_tb|5.035004||Viu
CUTGROUP_next_tb_p8|5.033003||Viu
CUTGROUP_next_tb_pb|5.033003||Viu
CUTGROUP_t8|5.035004||Viu
CUTGROUP_t8_p8|5.033003||Viu
CUTGROUP_t8_pb|5.033003||Viu
CUTGROUP_tb|5.035004||Viu
CUTGROUP_tb_p8|5.033003||Viu
CUTGROUP_tb_pb|5.033003||Viu
CvANON|5.003007||Viu
CvANONCONST|5.021008||Viu
CvANONCONST_off|5.021008||Viu
CvANONCONST_on|5.021008||Viu
CvANON_off|5.003007||Viu
CvANON_on|5.003007||Viu
CvAUTOLOAD|5.015004||Viu
CvAUTOLOAD_off|5.015004||Viu
CvAUTOLOAD_on|5.015004||Viu
cv_ckproto|5.009004||Viu
cv_ckproto_len_flags|5.015004||xcViu
CvCLONE|5.003007||Viu
cv_clone|5.015001|5.015001|
CvCLONED|5.003007||Viu
CvCLONED_off|5.003007||Viu
CvCLONED_on|5.003007||Viu
cv_clone_into|5.017004||Viu
CvCLONE_off|5.003007||Viu
CvCLONE_on|5.003007||Viu
CvCONST|5.007001||Viu
CvCONST_off|5.007001||Viu
CvCONST_on|5.007001||Viu
cv_const_sv|5.003007|5.003007|n
cv_const_sv_or_av|5.019003||Vniu
CvCVGV_RC|5.013003||Viu
CvCVGV_RC_off|5.013003||Viu
CvCVGV_RC_on|5.013003||Viu
CvDEPTH|5.003007|5.003007|nu
CvDEPTHunsafe|5.021006||Viu
cv_dump|5.006000||Vi
CvDYNFILE|5.015002||Viu
CvDYNFILE_off|5.015002||Viu
CvDYNFILE_on|5.015002||Viu
CvEVAL|5.005003||Viu
CvEVAL_off|5.005003||Viu
CvEVAL_on|5.005003||Viu
CVf_ANON|5.003007||Viu
CVf_ANONCONST|5.021008||Viu
CVf_AUTOLOAD|5.015004||Viu
CVf_BUILTIN_ATTRS|5.008000||Viu
CVf_CLONE|5.003007||Viu
CVf_CLONED|5.003007||Viu
CVf_CONST|5.007001||Viu
CVf_CVGV_RC|5.013003||Viu
CVf_DYNFILE|5.015002||Viu
CVf_HASEVAL|5.017002||Viu
CvFILE|5.006000||Viu
CvFILEGV|5.003007||Viu
CvFILE_set_from_cop|5.007002||Viu
CVf_ISXSUB|5.009004||Viu
CvFLAGS|5.003007||Viu
CVf_LEXICAL|5.021004||Viu
CVf_LVALUE|5.006000||Viu
CVf_METHOD|5.005000||Viu
CVf_NAMED|5.017004||Viu
CVf_NODEBUG|5.004000||Viu
cv_forget_slab|5.017002||Vi
CVf_SIGNATURE|5.035009||Viu
CVf_SLABBED|5.017002||Viu
CVf_UNIQUE|5.004000||Viu
CVf_WEAKOUTSIDE|5.008001||Viu
cv_get_call_checker|5.013006|5.013006|
cv_get_call_checker_flags|5.027003|5.027003|
CvGV|5.003007|5.003007|
cvgv_from_hek|||ciu
cvgv_set|5.013003||cViu
CvGV_set|5.013003||Viu
CvHASEVAL|5.017002||Viu
CvHASEVAL_off|5.017002||Viu
CvHASEVAL_on|5.017002||Viu
CvHASGV|5.021004||Viu
CvHSCXT|5.021006||Viu
CvISXSUB|5.009004||Viu
CvISXSUB_off|5.009004||Viu
CvISXSUB_on|5.009004||Viu
CvLEXICAL|5.021004||Viu
CvLEXICAL_off|5.021004||Viu
CvLEXICAL_on|5.021004||Viu
CvLVALUE|5.006000||Viu
CvLVALUE_off|5.006000||Viu
CvLVALUE_on|5.006000||Viu
CvMETHOD|5.005000||Viu
CvMETHOD_off|5.005000||Viu
CvMETHOD_on|5.005000||Viu
cv_name|5.021005|5.021005|
CvNAMED|5.017004||Viu
CvNAMED_off|5.017004||Viu
CvNAMED_on|5.017004||Viu
CvNAME_HEK_set|5.017004||Viu
CV_NAME_NOTQUAL|5.021005|5.021005|
CvNODEBUG|5.004000||Viu
CvNODEBUG_off|5.004000||Viu
CvNODEBUG_on|5.004000||Viu
CvOUTSIDE|5.003007||Viu
CvOUTSIDE_SEQ|5.008001||Viu
CvPADLIST|5.008001|5.008001|x
CvPADLIST_set|5.021006||Viu
CvPROTO|5.015004||Viu
CvPROTOLEN|5.015004||Viu
CvROOT|5.003007||Viu
cv_set_call_checker|5.013006|5.013006|
cv_set_call_checker_flags|5.021004|5.021004|
CvSIGNATURE|5.035009||Viu
CvSIGNATURE_off|5.035009||Viu
CvSIGNATURE_on|5.035009||Viu
CvSLABBED|5.017002||Viu
CvSLABBED_off|5.017002||Viu
CvSLABBED_on|5.017002||Viu
CvSPECIAL|5.005003||Viu
CvSPECIAL_off|5.005003||Viu
CvSPECIAL_on|5.005003||Viu
CvSTART|5.003007||Viu
CvSTASH|5.003007|5.003007|
cvstash_set|5.013007||cViu
CvSTASH_set|5.013007||Viu
cv_undef|5.003007|5.003007|
cv_undef_flags|5.021004||Viu
CV_UNDEF_KEEP_NAME|5.021004||Viu
CvUNIQUE|5.004000||Viu
CvUNIQUE_off|5.004000||Viu
CvUNIQUE_on|5.004000||Viu
CvWEAKOUTSIDE|5.008001||Vi
CvWEAKOUTSIDE_off|5.008001||Viu
CvWEAKOUTSIDE_on|5.008001||Viu
CvXSUB|5.003007||Viu
CvXSUBANY|5.003007||Viu
CX_CUR|5.023008||Viu
CX_CURPAD_SAVE|5.008001||Vi
CX_CURPAD_SV|5.008001||Vi
CX_DEBUG|5.023008||Viu
cx_dump|5.003007||cVu
cx_dup|5.006000||cVu
CxEVALBLOCK|5.033007||Viu
CxEVAL_TXT_REFCNTED|5.025007||Viu
CxFOREACH|5.009003||Viu
CxHASARGS|5.010001||Viu
cxinc|5.003007||cVu
CXINC|5.003007||Viu
CxITERVAR|5.006000||Viu
CxLABEL|5.010001||Viu
CxLABEL_len|5.016000||Viu
CxLABEL_len_flags|5.016000||Viu
CX_LEAVE_SCOPE|5.023008||Viu
CxLVAL|5.010001||Viu
CxMULTICALL|5.009003||Viu
CxOLD_IN_EVAL|5.010001||Viu
CxOLD_OP_TYPE|5.010001||Viu
CxONCE|5.010001||Viu
CxPADLOOP|5.006000||Viu
CXp_EVALBLOCK|5.033007||Viu
CXp_FINALLY|5.035008||Viu
CXp_FOR_DEF|5.027008||Viu
CXp_FOR_GV|5.023008||Viu
CXp_FOR_LVREF|5.021005||Viu
CXp_FOR_PAD|5.023008||Viu
CXp_HASARGS|5.011000||Viu
CXp_MULTICALL|5.009003||Viu
CXp_ONCE|5.011000||Viu
CX_POP|5.023008||Viu
cx_popblock|5.023008||xcVu
cx_popeval|5.023008||xcVu
cx_popformat|5.023008||xcVu
cx_popgiven|5.027008||xcVu
cx_poploop|5.023008||xcVu
CX_POP_SAVEARRAY|5.023008||Viu
cx_popsub|5.023008||xcVu
cx_popsub_args|5.023008||xcVu
cx_popsub_common|5.023008||xcVu
CX_POPSUBST|5.023008||Viu
cx_popwhen|5.027008||xcVu
CXp_REAL|5.005003||Viu
CXp_SUB_RE|5.018000||Viu
CXp_SUB_RE_FAKE|5.018000||Viu
CXp_TRY|5.033007||Viu
CXp_TRYBLOCK|5.006000||Viu
cx_pushblock|5.023008||xcVu
cx_pusheval|5.023008||xcVu
cx_pushformat|5.023008||xcVu
cx_pushgiven|5.027008||xcVu
cx_pushloop_for|5.023008||xcVu
cx_pushloop_plain|5.023008||xcVu
cx_pushsub|5.023008||xcVu
CX_PUSHSUB_GET_LVALUE_MASK|5.023008||Viu
CX_PUSHSUBST|5.023008||Viu
cx_pushtry|5.033007||xcVu
cx_pushwhen|5.027008||xcVu
CxREALEVAL|5.005003||Viu
cxstack|5.005000||Viu
cxstack_ix|5.005000||Viu
cxstack_max|5.005000||Viu
CXt_BLOCK|5.003007||Viu
CXt_DEFER|5.035004||Viu
CXt_EVAL|5.003007||Viu
CXt_FORMAT|5.006000||Viu
CXt_GIVEN|5.027008||Viu
CXt_LOOP_ARY|5.023008||Viu
CXt_LOOP_LAZYIV|5.011000||Viu
CXt_LOOP_LAZYSV|5.011000||Viu
CXt_LOOP_LIST|5.023008||Viu
CXt_LOOP_PLAIN|5.011000||Viu
CXt_NULL|5.003007||Viu
cx_topblock|5.023008||xcVu
CxTRY|5.033007||Viu
CxTRYBLOCK|5.006000||Viu
CXt_SUB|5.003007||Viu
CXt_SUBST|5.003007||Viu
CXt_WHEN|5.027008||Viu
CxTYPE|5.005003||Viu
cx_type|5.009005||Viu
CxTYPE_is_LOOP|5.011000||Viu
CXTYPEMASK|5.005003||Viu
dATARGET|5.003007||Viu
dAX|5.007002|5.003007|p
dAXMARK|5.009003|5.003007|p
DAY_1|5.027010||Viu
DAY_2|5.027010||Viu
DAY_3|5.027010||Viu
DAY_4|5.027010||Viu
DAY_5|5.027010||Viu
DAY_6|5.027010||Viu
DAY_7|5.027010||Viu
DB_Hash_t|5.003007|5.003007|Vn
DBM_ckFilter|5.008001||Viu
DBM_setFilter|5.008001||Viu
DB_Prefix_t|5.003007|5.003007|Vn
DBVARMG_COUNT|5.021005||Viu
DBVARMG_SIGNAL|5.021005||Viu
DBVARMG_SINGLE|5.021005||Viu
DBVARMG_TRACE|5.021005||Viu
DB_VERSION_MAJOR_CFG|5.007002|5.007002|Vn
DB_VERSION_MINOR_CFG|5.007002|5.007002|Vn
DB_VERSION_PATCH_CFG|5.007002|5.007002|Vn
deb|5.003007||vVu
deb_curcv|5.007002||Viu
deb_nocontext|5.006000||vVnu
debop|5.005000|5.005000|u
debprof|5.005000||Viu
debprofdump|5.005000|5.005000|u
debstack|5.007003|5.007003|u
deb_stack_all|5.008001||Viu
deb_stack_n|5.008001||Viu
debstackptrs|5.007003|5.007003|u
DEBUG|5.003007||Viu
DEBUG_A|5.009001||Viu
DEBUG_A_FLAG|5.009001||Viu
DEBUG_A_TEST|5.009001||Viu
DEBUG_B|5.011000||Viu
DEBUG_B_FLAG|5.011000||Viu
DEBUG_BOTH_FLAGS_TEST|5.033007||Viu
DEBUG_B_TEST|5.011000||Viu
DEBUG_BUFFERS_r|5.009005||Viu
DEBUG_c|5.003007||Viu
DEBUG_C|5.009000||Viu
DEBUG_c_FLAG|5.007001||Viu
DEBUG_C_FLAG|5.009000||Viu
DEBUG_COMPILE_r|5.009002||Viu
DEBUG_c_TEST|5.007001||Viu
DEBUG_C_TEST|5.009000||Viu
DEBUG_D|5.003007||Viu
DEBUG_DB_RECURSE_FLAG|5.007001||Viu
DEBUG_D_FLAG|5.007001||Viu
DEBUG_D_TEST|5.007001||Viu
DEBUG_DUMP_PRE_OPTIMIZE_r|5.031004||Viu
DEBUG_DUMP_r|5.009004||Viu
DEBUG_EXECUTE_r|5.009002||Viu
DEBUG_EXTRA_r|5.009004||Viu
DEBUG_f|5.003007||Viu
DEBUG_f_FLAG|5.007001||Viu
DEBUG_FLAGS_r|5.009005||Viu
DEBUG_f_TEST|5.007001||Viu
DEBUG_GPOS_r|5.011000||Viu
DEBUG_i|5.025002||Viu
DEBUG_i_FLAG|5.025002||Viu
DEBUG_INTUIT_r|5.009004||Viu
DEBUG_i_TEST|5.025002||Viu
DEBUG_J_FLAG|5.007003||Viu
DEBUG_J_TEST|5.007003||Viu
DEBUG_l|5.003007||Viu
DEBUG_L|5.019009||Viu
DEBUG_l_FLAG|5.007001||Viu
DEBUG_L_FLAG|5.019009||Viu
DEBUG_l_TEST|5.007001||Viu
DEBUG_L_TEST|5.019009||Viu
DEBUG_Lv|5.023003||Viu
DEBUG_Lv_TEST|5.023003||Viu
DEBUG_m|5.003007||Viu
DEBUG_M|5.027008||Viu
DEBUG_MASK|5.007001||Viu
DEBUG_MATCH_r|5.009004||Viu
DEBUG_m_FLAG|5.007001||Viu
DEBUG_M_FLAG|5.027008||Viu
DEBUG_m_TEST|5.007001||Viu
DEBUG_M_TEST|5.027008||Viu
DEBUG_o|5.003007||Viu
DEBUG_o_FLAG|5.007001||Viu
DEBUG_OPTIMISE_MORE_r|5.009005||Viu
DEBUG_OPTIMISE_r|5.009002||Viu
DEBUG_o_TEST|5.007001||Viu
DEBUG_P|5.003007||Viu
DEBUG_p|5.003007||Viu
DEBUG_PARSE_r|5.009004||Viu
DEBUG_P_FLAG|5.007001||Viu
DEBUG_p_FLAG|5.007001||Viu
DEBUG_POST_STMTS|5.033008||Viu
DEBUG_PRE_STMTS|5.033008||Viu
DEBUG_P_TEST|5.007001||Viu
DEBUG_p_TEST|5.007001||Viu
DEBUG_Pv|5.013008||Viu
DEBUG_Pv_TEST|5.013008||Viu
DEBUG_q|5.009001||Viu
DEBUG_q_FLAG|5.009001||Viu
DEBUG_q_TEST|5.009001||Viu
DEBUG_r|5.003007||Viu
DEBUG_R|5.007001||Viu
DEBUG_R_FLAG|5.007001||Viu
DEBUG_r_FLAG|5.007001||Viu
DEBUG_R_TEST|5.007001||Viu
DEBUG_r_TEST|5.007001||Viu
DEBUG_s|5.003007||Viu
DEBUG_S|5.017002||Viu
DEBUG_SBOX32_HASH|5.027001||Viu
DEBUG_SCOPE|5.008001||Viu
DEBUG_s_FLAG|5.007001||Viu
DEBUG_S_FLAG|5.017002||Viu
DEBUG_STACK_r|5.009005||Viu
debug_start_match|5.009004||Viu
DEBUG_STATE_r|5.009004||Viu
DEBUG_s_TEST|5.007001||Viu
DEBUG_S_TEST|5.017002||Viu
DEBUG_t|5.003007||Viu
DEBUG_T|5.007001||Viu
DEBUG_TEST_r|5.021005||Viu
DEBUG_T_FLAG|5.007001||Viu
DEBUG_t_FLAG|5.007001||Viu
DEBUG_TOP_FLAG|5.007001||Viu
DEBUG_TRIE_COMPILE_MORE_r|5.009002||Viu
DEBUG_TRIE_COMPILE_r|5.009002||Viu
DEBUG_TRIE_EXECUTE_MORE_r|5.009002||Viu
DEBUG_TRIE_EXECUTE_r|5.009002||Viu
DEBUG_TRIE_r|5.009002||Viu
DEBUG_T_TEST|5.007001||Viu
DEBUG_t_TEST|5.007001||Viu
DEBUG_u|5.003007||Viu
DEBUG_U|5.009005||Viu
DEBUG_u_FLAG|5.007001||Viu
DEBUG_U_FLAG|5.009005||Viu
DEBUG_u_TEST|5.007001||Viu
DEBUG_U_TEST|5.009005||Viu
DEBUG_Uv|5.009005||Viu
DEBUG_Uv_TEST|5.009005||Viu
DEBUG_v|5.008001||Viu
DEBUG_v_FLAG|5.008001||Viu
DEBUG_v_TEST|5.008001||Viu
DEBUG_X|5.003007||Viu
DEBUG_x|5.003007||Viu
DEBUG_X_FLAG|5.007001||Viu
DEBUG_x_FLAG|5.007001||Viu
DEBUG_X_TEST|5.007001||Viu
DEBUG_x_TEST|5.007001||Viu
DEBUG_Xv|5.008001||Viu
DEBUG_Xv_TEST|5.008001||Viu
DEBUG_y|5.031007||Viu
DEBUG_y_FLAG|5.031007||Viu
DEBUG_y_TEST|5.031007||Viu
DEBUG_yv|5.031007||Viu
DEBUG_yv_TEST|5.031007||Viu
DEBUG_ZAPHOD32_HASH|5.027001||Viu
DECLARATION_FOR_LC_NUMERIC_MANIPULATION|5.021010|5.021010|p
DECLARE_AND_GET_RE_DEBUG_FLAGS|5.031011||Viu
DECLARE_AND_GET_RE_DEBUG_FLAGS_NON_REGEX|5.031011||Viu
DEFAULT_INC_EXCLUDES_DOT|5.025011|5.025011|Vn
DEFAULT_PAT_MOD|5.013006||Viu
defelem_target|5.019002||Viu
DEFINE_INC_MACROS|5.027006||Viu
DEFINEP|5.009005||Viu
DEFINEP_t8|5.035004||Viu
DEFINEP_t8_p8|5.033003||Viu
DEFINEP_t8_pb|5.033003||Viu
DEFINEP_tb|5.035004||Viu
DEFINEP_tb_p8|5.033003||Viu
DEFINEP_tb_pb|5.033003||Viu
DEFSV|5.004005|5.003007|p
DEFSV_set|5.010001|5.003007|p
del_body_by_type|||Viu
delete_eval_scope|5.009004||xViu
delimcpy|5.004000|5.004000|n
delimcpy_no_escape|5.025005||cVni
DEL_NATIVE|5.017010||Viu
del_sv|5.005000||Viu
DEPENDS_PAT_MOD|5.013009||Viu
DEPENDS_PAT_MODS|5.013009||Viu
deprecate|5.011001||Viu
deprecate_disappears_in|5.025009||Viu
deprecate_fatal_in|5.025009||Viu
despatch_signals|5.007001||cVu
destroy_matcher|5.027008||Viu
DETACH|5.005000||Viu
dEXT|5.003007||Viu
dEXTCONST|5.004000||Viu
DFA_RETURN_FAILURE|5.035004||Viu
DFA_RETURN_SUCCESS|5.035004||Viu
DFA_TEASE_APART_FF|5.035004||Viu
D_FMT|5.027010||Viu
DIE|5.003007||Viu
die|5.003007||vV
die_nocontext|5.006000||vVn
die_sv|5.013001|5.003007|p
die_unwind|5.013001||Viu
Direntry_t|5.003007|5.003007|Vn
dirp_dup|5.013007|5.013007|u
dITEMS|5.007002|5.003007|p
div128|5.005000||Viu
dJMPENV|5.004000||Viu
djSP|5.004005||Vi
dMARK|5.003007|5.003007|
DM_ARRAY_ISA|5.013002||Viu
DM_DELAY|5.003007||Viu
DM_EGID|5.003007||Viu
DM_EUID|5.003007||Viu
DM_GID|5.003007||Viu
DM_RGID|5.003007||Viu
DM_RUID|5.003007||Viu
DM_UID|5.003007||Viu
dMULTICALL|5.009003|5.009003|
dMY_CXT|5.009000|5.009000|p
dMY_CXT_INTERP|5.009003||Viu
dMY_CXT_SV|5.007003|5.003007|pV
dNOOP|5.006000|5.003007|p
do_aexec|5.009003||Viu
do_aexec5|5.006000||Viu
do_aspawn|5.008000||Vu
do_binmode|5.004005|5.004005|du
docatch|5.005000||Vi
do_chomp|5.003007||Viu
do_close|5.003007|5.003007|u
do_delete_local|5.011000||Viu
do_dump_pad|5.008001||Vi
do_eof|5.003007||Viu
does_utf8_overflow|5.025006||Vniu
doeval_compile|5.023008||Viu
do_exec3|5.006000||Viu
do_exec|5.009003||Viu
dofile|5.005003||Viu
dofindlabel|5.003007||Viu
doform|5.005000||Viu
do_gv_dump|5.006000||cVu
do_gvgv_dump|5.006000||cVu
do_hv_dump|5.006000||cVu
doing_taint|5.008001||cVnu
DOINIT|5.003007||Viu
do_ipcctl|5.003007||Viu
do_ipcget|5.003007||Viu
do_join|5.003007|5.003007|u
do_magic_dump|5.006000||cVu
do_msgrcv|5.003007||Viu
do_msgsnd|5.003007||Viu
do_ncmp|5.015001||Viu
do_oddball|5.006000||Viu
dooneliner|5.006000||Viu
do_op_dump|5.006000||cVu
do_open|5.003007|5.003007|u
do_open6|5.019010||xViu
do_open9|5.006000|5.006000|du
do_openn|5.007001|5.007001|u
doopen_pm|5.008001||Viu
do_open_raw|5.019010||xViu
doparseform|5.005000||Viu
do_pmop_dump|5.006000||cVu
dopoptoeval|5.003007||Viu
dopoptogivenfor|5.027008||Viu
dopoptolabel|5.005000||Viu
dopoptoloop|5.005000||Viu
dopoptosub_at|5.005000||Viu
dopoptowhen|5.027008||Viu
do_print|5.003007||Viu
do_readline|5.003007||Viu
doref|5.009003|5.009003|u
dORIGMARK|5.003007|5.003007|
do_seek|5.003007||Viu
do_semop|5.003007||Viu
do_shmio|5.003007||Viu
DOSISH|5.003007||Viu
do_smartmatch|5.027008||Viu
do_spawn|5.008000||Vu
do_spawn_nowait|5.008000||Vu
do_sprintf|5.003007|5.003007|u
do_sv_dump|5.006000||cVu
do_sysseek|5.004000||Viu
do_tell|5.003007||Viu
do_trans|5.003007||Viu
do_trans_complex|5.006001||Viu
do_trans_count|5.006001||Viu
do_trans_count_invmap|5.031006||Viu
do_trans_invmap|5.031006||Viu
do_trans_simple|5.006001||Viu
DOUBLE_BIG_ENDIAN|5.021009||Viu
DOUBLE_HAS_INF|5.025003|5.025003|Vn
DOUBLE_HAS_NAN|5.025003|5.025003|Vn
DOUBLE_HAS_NEGATIVE_ZERO|5.025007|5.025007|Vn
DOUBLE_HAS_SUBNORMALS|5.025007|5.025007|Vn
DOUBLEINFBYTES|5.023000|5.023000|Vn
DOUBLE_IS_CRAY_SINGLE_64_BIT|5.025006|5.025006|Vn
DOUBLE_IS_IBM_DOUBLE_64_BIT|5.025006|5.025006|Vn
DOUBLE_IS_IBM_SINGLE_32_BIT|5.025006|5.025006|Vn
DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE|5.021006|5.021006|Vn
DOUBLE_IS_IEEE_FORMAT|5.025003||Viu
DOUBLE_IS_UNKNOWN_FORMAT|5.021006|5.021006|Vn
DOUBLE_IS_VAX_D_FLOAT|5.025003|5.025003|Vn
DOUBLE_IS_VAX_F_FLOAT|5.025003|5.025003|Vn
DOUBLE_IS_VAX_FLOAT|5.025003||Viu
DOUBLE_IS_VAX_G_FLOAT|5.025003|5.025003|Vn
DOUBLEKIND|5.021006|5.021006|Vn
DOUBLE_LITTLE_ENDIAN|5.021009||Viu
DOUBLEMANTBITS|5.023000|5.023000|Vn
DOUBLE_MIX_ENDIAN|5.021009||Viu
DOUBLENANBYTES|5.023000|5.023000|Vn
DOUBLESIZE|5.005000|5.005000|Vn
DOUBLE_STYLE_IEEE|5.025007|5.025007|Vn
DOUBLE_VAX_ENDIAN|5.025003||Viu
do_uniprop_match|5.031011||cVniu
dounwind|5.003007|5.003007|u
DO_UTF8|5.006000|5.006000|
do_vecget|5.006000||Viu
do_vecset|5.003007||Viu
do_vop|5.003007||Viu
dowantarray|5.003007|5.003007|u
dPOPiv|5.003007||Viu
dPOPnv|5.003007||Viu
dPOPnv_nomg|5.013002||Viu
dPOPPOPiirl|5.003007||Viu
dPOPPOPnnrl|5.003007||Viu
dPOPPOPssrl|5.003007||Viu
dPOPss|5.003007||Viu
dPOPTOPiirl|5.003007||Viu
dPOPTOPiirl_nomg|5.013002||Viu
dPOPTOPiirl_ul_nomg|5.013002||Viu
dPOPTOPnnrl|5.003007||Viu
dPOPTOPnnrl_nomg|5.013002||Viu
dPOPTOPssrl|5.003007||Viu
dPOPuv|5.004000||Viu
dPOPXiirl|5.004000||Viu
dPOPXiirl_ul_nomg|5.013002||Viu
dPOPXnnrl|5.004000||Viu
dPOPXssrl|5.004000||Viu
DPTR2FPTR|5.009003||Viu
Drand01|5.006000|5.006000|
drand48_init_r|||cniu
drand48_r|||cniu
DRAND48_R_PROTO|5.008000|5.008000|Vn
dSAVEDERRNO|5.010001||Vi
dSAVE_ERRNO|5.010001||Vi
dSP|5.003007|5.003007|
dSS_ADD|5.017007||Viu
dTARG|5.003007||Viu
dTARGET|5.003007|5.003007|
dTARGETSTACKED|5.003007||Viu
D_T_FMT|5.027010||Viu
dTHR|5.004005|5.003007|p
dTHX|5.003007|5.003007|p
dTHXa|5.006000|5.003007|p
dTHX_DEBUGGING|5.027009||Viu
dTHXo|5.006000||Viu
dTHXoa|5.006001|5.003007|p
dTHXR||5.003007|ponu
dTHXs|5.007002||Viu
dTHXx|5.006000||Viu
dTOPiv|5.003007||Viu
dTOPnv|5.003007||Viu
dTOPss|5.003007||Viu
dTOPuv|5.004000||Viu
dtrace_probe_call|||ciu
dtrace_probe_load|||ciu
dtrace_probe_op|||ciu
dtrace_probe_phase|||ciu
dump_all|5.006000|5.006000|
dump_all_perl|5.011000||Viu
dump_c_backtrace|5.021001||V
dump_eval|5.006000|5.006000|u
dump_exec_pos|5.009004||Viu
dump_form|5.006000|5.006000|u
dump_indent|5.006000||vcVu
dump_mstats|5.003007||Vu
dump_packsubs|5.006000|5.006000|
dump_packsubs_perl|5.011000||Viu
dump_regex_sets_structures|5.025006||Viu
dump_sub|5.006000|5.006000|u
dump_sub_perl|5.011000||Viu
dump_sv_child|5.009003||Viu
dump_trie|5.009004||Viu
dump_trie_interim_list|5.009004||Viu
dump_trie_interim_table|5.009004||Viu
dumpuntil|5.005000||Viu
dump_vindent|5.006000||cVu
dUNDERBAR|5.009002|5.003007|p
dup2|5.005000||Viu
dup|5.005000||Viu
dup_attrlist|5.006000||Viu
DUP_WARNINGS|5.009004||Viu
dup_warnings|||ciu
dVAR|5.009003|5.003007|p
dXCPT|5.009002|5.003007|p
dXSARGS|5.003007|5.003007|
dXSBOOTARGSAPIVERCHK|5.021006||Viu
dXSBOOTARGSNOVERCHK|5.021006||Viu
dXSBOOTARGSXSAPIVERCHK|5.021006||Viu
dXSFUNCTION|5.005000||Viu
dXSI32|5.003007|5.003007|V
dXSTARG|5.006000|5.003007|poVnu
dXSUB_SYS|5.003007||Viu
edit_distance|5.023008||Vniu
EIGHT_BIT_UTF8_TO_NATIVE|5.023003||Viu
ELEMENT_RANGE_MATCHES_INVLIST|5.023002||Viu
EMBEDMYMALLOC|5.006000||Viu
emulate_cop_io|||xciu
emulate_setlocale|5.027009||Vniu
END|5.003007||Viu
END_EXTERN_C|5.005000|5.003007|pV
endgrent|5.009000||Viu
ENDGRENT_R_HAS_FPTR|5.008000||Viu
ENDGRENT_R_PROTO|5.008000|5.008000|Vn
endhostent|5.005000||Viu
ENDHOSTENT_R_PROTO|5.008000|5.008000|Vn
ENDLIKE|5.009005||Viu
ENDLIKE_t8|5.035004||Viu
ENDLIKE_t8_p8|5.033003||Viu
ENDLIKE_t8_pb|5.033003||Viu
ENDLIKE_tb|5.035004||Viu
ENDLIKE_tb_p8|5.033003||Viu
ENDLIKE_tb_pb|5.033003||Viu
endnetent|5.005000||Viu
ENDNETENT_R_PROTO|5.008000|5.008000|Vn
endprotoent|5.005000||Viu
ENDPROTOENT_R_PROTO|5.008000|5.008000|Vn
endpwent|5.009000||Viu
ENDPWENT_R_HAS_FPTR|5.008000||Viu
ENDPWENT_R_PROTO|5.008000|5.008000|Vn
endservent|5.005000||Viu
ENDSERVENT_R_PROTO|5.008000|5.008000|Vn
END_t8|5.035004||Viu
END_t8_p8|5.033003||Viu
END_t8_pb|5.033003||Viu
END_tb|5.035004||Viu
END_tb_p8|5.033003||Viu
END_tb_pb|5.033003||Viu
ENTER|5.003007|5.003007|
ENTER_with_name|5.011002|5.011002|
ENV_INIT|5.031011||Viu
environ|5.003007||Viu
ENV_LOCALE_LOCK|5.031011||Viu
ENV_LOCALE_READ_LOCK|5.031011||Viu
ENV_LOCALE_READ_UNLOCK|5.031011||Viu
ENV_LOCALE_UNLOCK|5.031011||Viu
ENV_LOCK|5.031011||Viu
ENV_READ_LOCK|5.033005||Viu
ENV_READ_UNLOCK|5.033005||Viu
ENV_TERM|5.031011||Viu
ENV_UNLOCK|5.031011||Viu
EOF|5.003007||Viu
EOF_NONBLOCK|5.003007|5.003007|Vn
EOL|5.003007||Viu
EOL_t8|5.035004||Viu
EOL_t8_p8|5.033003||Viu
EOL_t8_pb|5.033003||Viu
EOL_tb|5.035004||Viu
EOL_tb_p8|5.033003||Viu
EOL_tb_pb|5.033003||Viu
EOS|5.005000||Viu
EOS_t8|5.035004||Viu
EOS_t8_p8|5.033003||Viu
EOS_t8_pb|5.033003||Viu
EOS_tb|5.035004||Viu
EOS_tb_p8|5.033003||Viu
EOS_tb_pb|5.033003||Viu
ERA|5.027010||Viu
ERA_D_FMT|5.027010||Viu
ERA_D_T_FMT|5.027010||Viu
ERA_T_FMT|5.027010||Viu
ERRSV|5.004005|5.003007|p
ESC_NATIVE|5.021004||Viu
EVAL|5.005000||Viu
EVAL_B|5.025010||Viu
EVAL_B_fail|5.025010||Viu
EVAL_B_fail_t8|5.035004||Viu
EVAL_B_fail_t8_p8|5.033003||Viu
EVAL_B_fail_t8_pb|5.033003||Viu
EVAL_B_fail_tb|5.035004||Viu
EVAL_B_fail_tb_p8|5.033003||Viu
EVAL_B_fail_tb_pb|5.033003||Viu
EVAL_B_t8|5.035004||Viu
EVAL_B_t8_p8|5.033003||Viu
EVAL_B_t8_pb|5.033003||Viu
EVAL_B_tb|5.035004||Viu
EVAL_B_tb_p8|5.033003||Viu
EVAL_B_tb_pb|5.033003||Viu
EVAL_INEVAL|5.006000||Viu
EVAL_INREQUIRE|5.007001||Viu
EVAL_KEEPERR|5.006000||Viu
EVAL_NULL|5.006000||Viu
EVAL_postponed_AB|5.025010||Viu
EVAL_postponed_AB_fail|5.025010||Viu
EVAL_postponed_AB_fail_t8|5.035004||Viu
EVAL_postponed_AB_fail_t8_p8|5.033003||Viu
EVAL_postponed_AB_fail_t8_pb|5.033003||Viu
EVAL_postponed_AB_fail_tb|5.035004||Viu
EVAL_postponed_AB_fail_tb_p8|5.033003||Viu
EVAL_postponed_AB_fail_tb_pb|5.033003||Viu
EVAL_postponed_AB_t8|5.035004||Viu
EVAL_postponed_AB_t8_p8|5.033003||Viu
EVAL_postponed_AB_t8_pb|5.033003||Viu
EVAL_postponed_AB_tb|5.035004||Viu
EVAL_postponed_AB_tb_p8|5.033003||Viu
EVAL_postponed_AB_tb_pb|5.033003||Viu
eval_pv|5.006000|5.003007|p
EVAL_RE_REPARSING|5.017011||Viu
eval_sv|5.006000|5.003007|p
EVAL_t8|5.035004||Viu
EVAL_t8_p8|5.033003||Viu
EVAL_t8_pb|5.033003||Viu
EVAL_tb|5.035004||Viu
EVAL_tb_p8|5.033003||Viu
EVAL_tb_pb|5.033003||Viu
EVAL_WARNONLY|5.006000||Viu
EXACT|5.004000||Viu
EXACTF|5.004000||Viu
EXACTFAA|5.027009||Viu
EXACTFAA_NO_TRIE|5.027009||Viu
EXACTFAA_NO_TRIE_t8|5.035004||Viu
EXACTFAA_NO_TRIE_t8_p8|5.033003||Viu
EXACTFAA_NO_TRIE_t8_pb|5.033003||Viu
EXACTFAA_NO_TRIE_tb|5.035004||Viu
EXACTFAA_NO_TRIE_tb_p8|5.033003||Viu
EXACTFAA_NO_TRIE_tb_pb|5.033003||Viu
EXACTFAA_t8|5.035004||Viu
EXACTFAA_t8_p8|5.033003||Viu
EXACTFAA_t8_pb|5.033003||Viu
EXACTFAA_tb|5.035004||Viu
EXACTFAA_tb_p8|5.033003||Viu
EXACTFAA_tb_pb|5.033003||Viu
EXACTFL|5.004000||Viu
EXACTFL_t8|5.035004||Viu
EXACTFL_t8_p8|5.033003||Viu
EXACTFL_t8_pb|5.033003||Viu
EXACTFL_tb|5.035004||Viu
EXACTFL_tb_p8|5.033003||Viu
EXACTFL_tb_pb|5.033003||Viu
EXACTFLU8|5.021008||Viu
EXACTFLU8_t8|5.035004||Viu
EXACTFLU8_t8_p8|5.033003||Viu
EXACTFLU8_t8_pb|5.033003||Viu
EXACTFLU8_tb|5.035004||Viu
EXACTFLU8_tb_p8|5.033003||Viu
EXACTFLU8_tb_pb|5.033003||Viu
EXACTF_t8|5.035004||Viu
EXACTF_t8_p8|5.033003||Viu
EXACTF_t8_pb|5.033003||Viu
EXACTF_tb|5.035004||Viu
EXACTF_tb_p8|5.033003||Viu
EXACTF_tb_pb|5.033003||Viu
EXACTFU|5.013008||Viu
EXACTFUP|5.029007||Viu
EXACTFUP_t8|5.035004||Viu
EXACTFUP_t8_p8|5.033003||Viu
EXACTFUP_t8_pb|5.033003||Viu
EXACTFUP_tb|5.035004||Viu
EXACTFUP_tb_p8|5.033003||Viu
EXACTFUP_tb_pb|5.033003||Viu
EXACTFU_REQ8|5.031006||Viu
EXACTFU_REQ8_t8|5.035004||Viu
EXACTFU_REQ8_t8_p8|5.033003||Viu
EXACTFU_REQ8_t8_pb|5.033003||Viu
EXACTFU_REQ8_tb|5.035004||Viu
EXACTFU_REQ8_tb_p8|5.033003||Viu
EXACTFU_REQ8_tb_pb|5.033003||Viu
EXACTFU_S_EDGE|5.029007||Viu
EXACTFU_S_EDGE_t8|5.035004||Viu
EXACTFU_S_EDGE_t8_p8|5.033003||Viu
EXACTFU_S_EDGE_t8_pb|5.033003||Viu
EXACTFU_S_EDGE_tb|5.035004||Viu
EXACTFU_S_EDGE_tb_p8|5.033003||Viu
EXACTFU_S_EDGE_tb_pb|5.033003||Viu
EXACTFU_t8|5.035004||Viu
EXACTFU_t8_p8|5.033003||Viu
EXACTFU_t8_pb|5.033003||Viu
EXACTFU_tb|5.035004||Viu
EXACTFU_tb_p8|5.033003||Viu
EXACTFU_tb_pb|5.033003||Viu
EXACTL|5.021008||Viu
EXACTL_t8|5.035004||Viu
EXACTL_t8_p8|5.033003||Viu
EXACTL_t8_pb|5.033003||Viu
EXACTL_tb|5.035004||Viu
EXACTL_tb_p8|5.033003||Viu
EXACTL_tb_pb|5.033003||Viu
EXACT_REQ8|5.031006||Viu
EXACT_REQ8_t8|5.035004||Viu
EXACT_REQ8_t8_p8|5.033003||Viu
EXACT_REQ8_t8_pb|5.033003||Viu
EXACT_REQ8_tb|5.035004||Viu
EXACT_REQ8_tb_p8|5.033003||Viu
EXACT_REQ8_tb_pb|5.033003||Viu
EXACT_t8|5.035004||Viu
EXACT_t8_p8|5.033003||Viu
EXACT_t8_pb|5.033003||Viu
EXACT_tb|5.035004||Viu
EXACT_tb_p8|5.033003||Viu
EXACT_tb_pb|5.033003||Viu
EXEC_ARGV_CAST|5.007001||Viu
exec_failed|5.009004||Viu
execl|5.005000||Viu
EXEC_PAT_MOD|5.009005||Viu
EXEC_PAT_MODS|5.009005||Viu
execute_wildcard|5.031010||Viu
execv|5.005000||Viu
execvp|5.005000||Viu
exit|5.005000||Viu
EXPECT|5.009004||Viu
expect_number|5.007001||Viu
EXT|5.003007||Viu
EXTCONST|5.004000||Viu
EXTEND|5.003007|5.003007|
EXTEND_HWM_SET|5.027002||Viu
EXTEND_MORTAL|5.004000||Viu
EXTEND_SKIP|5.027002||Viu
EXTERN_C|5.005000|5.003007|pV
EXT_MGVTBL|5.009004||Viu
EXT_PAT_MODS|5.009005||Viu
EXTRA_SIZE|5.005000||Viu
EXTRA_STEP_2ARGS|5.005000||Viu
F0convert|5.009003||Vniu
FAKE_BIT_BUCKET|5.009005||Viu
FAKE_DEFAULT_SIGNAL_HANDLERS|5.009003||Viu
FAKE_PERSISTENT_SIGNAL_HANDLERS|5.009003||Viu
FALSE|5.003007||Viu
FATAL_ABOVE_FF_MSG|5.027010||Viu
F_atan2_amg|5.004000||Viu
FBMcf_TAIL|5.006000||Viu
FBMcf_TAIL_DOLLAR|5.006000||Viu
FBMcf_TAIL_DOLLARM|5.006000||Viu
FBMcf_TAIL_Z|5.006000||Viu
FBMcf_TAIL_z|5.006000||Viu
fbm_compile|5.005000|5.005000|
fbm_instr|5.005000|5.005000|
FBMrf_MULTILINE|5.006000||Viu
fclose|5.003007||Viu
fcntl|5.006000||Viu
FCNTL_CAN_LOCK|5.007001|5.007001|Vn
F_cos_amg|5.004000||Viu
FD_CLR|5.008000||Viu
FD_ISSET|5.008000||Viu
fdopen|5.003007||Viu
FD_SET|5.008000||Viu
fd_set|5.008000||Viu
FD_ZERO|5.008000||Viu
FEATURE_BAREWORD_FILEHANDLES_BIT|5.033006||Viu
FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED|5.033006||Viu
FEATURE_BITWISE_BIT|5.031006||Viu
FEATURE_BITWISE_IS_ENABLED|5.021009||Viu
FEATURE_BUNDLE_510|5.015007||Viu
FEATURE_BUNDLE_511|5.015007||Viu
FEATURE_BUNDLE_515|5.015007||Viu
FEATURE_BUNDLE_523|5.023001||Viu
FEATURE_BUNDLE_527|5.027008||Viu
FEATURE_BUNDLE_535|5.035003||Viu
FEATURE_BUNDLE_CUSTOM|5.015007||Viu
FEATURE_BUNDLE_DEFAULT|5.015007||Viu
FEATURE_DEFER_BIT|5.035004||Viu
FEATURE_DEFER_IS_ENABLED|5.035004||Viu
FEATURE_EVALBYTES_BIT|5.031006||Viu
FEATURE_EVALBYTES_IS_ENABLED|5.015007||Viu
FEATURE_FC_BIT|5.031006||Viu
FEATURE_FC_IS_ENABLED|5.015008||Viu
FEATURE_INDIRECT_BIT|5.031010||Viu
FEATURE_INDIRECT_IS_ENABLED|5.031010||Viu
FEATURE_ISA_BIT|5.031007||Viu
FEATURE_ISA_IS_ENABLED|5.031007||Viu
FEATURE_IS_ENABLED_MASK|5.031006||Viu
FEATURE_MULTIDIMENSIONAL_BIT|5.033001||Viu
FEATURE_MULTIDIMENSIONAL_IS_ENABLED|5.033001||Viu
FEATURE_MYREF_BIT|5.031006||Viu
FEATURE_MYREF_IS_ENABLED|5.025003||Viu
FEATURE_POSTDEREF_QQ_BIT|5.031006||Viu
FEATURE_POSTDEREF_QQ_IS_ENABLED|5.019005||Viu
FEATURE_REFALIASING_BIT|5.031006||Viu
FEATURE_REFALIASING_IS_ENABLED|5.021005||Viu
FEATURE_SAY_BIT|5.031006||Viu
FEATURE_SAY_IS_ENABLED|5.015007||Viu
FEATURE_SIGNATURES_BIT|5.031006||Viu
FEATURE_SIGNATURES_IS_ENABLED|5.019009||Viu
FEATURE_STATE_BIT|5.031006||Viu
FEATURE_STATE_IS_ENABLED|5.015007||Viu
FEATURE___SUB___BIT|5.031006||Viu
FEATURE___SUB___IS_ENABLED|5.015007||Viu
FEATURE_SWITCH_BIT|5.031006||Viu
FEATURE_SWITCH_IS_ENABLED|5.015007||Viu
FEATURE_TRY_BIT|5.033007||Viu
FEATURE_TRY_IS_ENABLED|5.033007||Viu
FEATURE_UNICODE_BIT|5.031006||Viu
FEATURE_UNICODE_IS_ENABLED|5.015007||Viu
FEATURE_UNIEVAL_BIT|5.031006||Viu
FEATURE_UNIEVAL_IS_ENABLED|5.015007||Viu
feof|5.003007||Viu
ferror|5.003007||Viu
FETCHFEATUREBITSHH|5.031006||Viu
F_exp_amg|5.004000||Viu
FF_0DECIMAL|5.007001||Viu
FF_BLANK|5.003007||Viu
FF_CHECKCHOP|5.003007||Viu
FF_CHECKNL|5.003007||Viu
FF_CHOP|5.003007||Viu
FF_DECIMAL|5.003007||Viu
FF_END|5.003007||Viu
FF_FETCH|5.003007||Viu
FF_HALFSPACE|5.003007||Viu
FF_ITEM|5.003007||Viu
FF_LINEGLOB|5.003007||Viu
FF_LINEMARK|5.003007||Viu
FF_LINESNGL|5.009001||Viu
FF_LITERAL|5.003007||Viu
Fflush|5.003007||Viu
fflush|5.003007||Viu
FFLUSH_NULL|5.006000|5.006000|Vn
FF_MORE|5.003007||Viu
FF_NEWLINE|5.003007||Viu
FF_SKIP|5.003007||Viu
FF_SPACE|5.003007||Viu
fgetc|5.003007||Viu
fgetpos|5.003007||Viu
fgets|5.003007||Viu
FILE|5.003007||Viu
FILE_base|5.007000|5.007000|
FILE_bufsiz|5.007000|5.007000|
FILE_cnt|5.007000|5.007000|
fileno|5.003007||Viu
FILE_ptr|5.007000|5.007000|
FILL_ADVANCE_NODE_2L_ARG|5.021005||Viu
FILL_ADVANCE_NODE|5.005000||Viu
FILL_ADVANCE_NODE_ARG|5.005000||Viu
FILL_ADVANCE_NODE_ARGp|5.031010||Viu
FILL_NODE|5.029004||Viu
filter_add|5.003007|5.003007|
FILTER_DATA|5.003007||Viu
filter_del|5.003007|5.003007|u
filter_gets|5.005000||Viu
FILTER_ISREADER|5.003007||Viu
filter_read|5.003007|5.003007|
FILTER_READ|5.003007||Viu
finalize_op|5.015002||Viu
finalize_optree|5.015002||Vi
find_and_forget_pmops|5.009005||Viu
find_array_subscript|5.009004||Viu
find_beginning|5.005000||Viu
find_byclass|5.006000||Viu
find_default_stash|5.019004||Viu
find_first_differing_byte_pos|5.031007||Vniu
find_hash_subscript|5.009004||Viu
find_in_my_stash|5.006001||Viu
find_lexical_cv|5.019001||Viu
find_next_masked|5.027009||Vniu
find_runcv|5.009005|5.009005|
FIND_RUNCV_level_eq|5.017002||Viu
FIND_RUNCV_padid_eq|5.017004||Viu
find_runcv_where|5.017002||Viu
find_rundefsv|5.013002|5.013002|
find_rundefsvoffset|5.009002|5.009002|d
find_script|5.004005||Viu
find_span_end|5.027009||Vniu
find_span_end_mask|5.027009||Vniu
find_uninit_var|5.009002||xVi
FIRST_NON_ASCII_DECIMAL_DIGIT|5.027007||Viu
first_symbol|5.009003||Vniu
FIT_ARENA0|||Viu
FIT_ARENAn|||Viu
FIT_ARENA|||Viu
FITS_IN_8_BITS|5.013005||Viu
fixup_errno_string|5.019007||Viu
FLAGS|5.013006||Viu
FLEXFILENAMES|5.003007|5.003007|Vn
float_end_shift|5.009005||Viu
float_max_offset|5.005000||Viu
float_min_offset|5.005000||Viu
float_substr|5.005000||Viu
float_utf8|5.008000||Viu
flock|5.005000||Viu
flockfile|5.003007||Viu
F_log_amg|5.004000||Viu
FmLINES|5.003007||Viu
fold_constants|5.003007||Viu
foldEQ|5.013002|5.013002|n
foldEQ_latin1|5.013008||cVnu
foldEQ_latin1_s2_folded|5.029007||Vniu
foldEQ_locale|5.013002|5.013002|n
FOLDEQ_LOCALE|5.019009||cV
FOLDEQ_S1_ALREADY_FOLDED|5.015004||cV
FOLDEQ_S1_FOLDS_SANE|5.021008||cV
FOLDEQ_S2_ALREADY_FOLDED|5.015004||cV
FOLDEQ_S2_FOLDS_SANE|5.021008||cV
foldEQ_utf8|5.013002|5.007003|p
foldEQ_utf8_flags|5.013010||cVu
FOLDEQ_UTF8_NOMIX_ASCII|5.013010||cV
FOLD_FLAGS_FULL|5.015006||Viu
FOLD_FLAGS_LOCALE|5.015006||Viu
FOLD_FLAGS_NOMIX_ASCII|5.017000||Viu
fopen|5.003007||Viu
forbid_setid|5.005000||Viu
force_ident|5.003007||Viu
force_ident_maybe_lex|5.017004||Viu
force_list|5.003007||Viu
force_next|5.003007||Viu
_force_out_malformed_utf8_message|5.025009||cVu
force_strict_version|5.011004||Viu
force_version|5.005000||Viu
force_word|5.003007||Viu
forget_pmop|5.017007||Viu
form|5.004000||vV
form_alien_digit_msg|5.031009||cViu
form_cp_too_large_msg|5.031009||cViu
form_nocontext|5.006000||vVn
fp_dup|5.007003|5.007003|u
Fpos_t|5.003007|5.003007|Vn
F_pow_amg|5.004000||Viu
FP_PINF|5.021004||Viu
FP_QNAN|5.021004||Viu
fprintf|5.003007||Viu
fprintf_nocontext|5.006000||vdVnu
FPTR2DPTR|5.009003||Viu
fputc|5.003007||Viu
fputs|5.003007||Viu
fread|5.003007||Viu
free|5.003007||Viu
free_and_set_cop_warnings|5.031011||Viu
free_c_backtrace|5.021001||Vi
FreeOp|5.008001||Viu
Free_t|5.003007|5.003007|Vn
FREE_THREAD_KEY|5.006001||Viu
free_tied_hv_pool|5.008001||Viu
FREETMPS|5.003007|5.003007|
free_tmps|5.003007||cVu
freopen|5.003007||Viu
frewind|5.005000||Viu
FROM_INTERNAL_SIZE|5.023002||Viu
fscanf|5.003007||Viu
fseek|5.003007||Viu
FSEEKSIZE|5.006000||Viu
fsetpos|5.003007||Viu
F_sin_amg|5.004000||Viu
F_sqrt_amg|5.004000||Viu
Fstat|5.003007||Viu
fstat|5.005000||Viu
ftell|5.003007||Viu
ftruncate|5.006000||Viu
ftrylockfile|5.003007||Viu
FUNCTION|5.009003||Viu
funlockfile|5.003007||Viu
fwrite1|5.003007||Viu
fwrite|5.003007||Viu
G_ARRAY|5.003007||Viu
GCB_BREAKABLE|5.025003||Viu
GCB_EX_then_EM|5.025003||Viu
GCB_Maybe_Emoji_NonBreak|5.029002||Viu
GCB_NOBREAK|5.025003||Viu
GCB_RI_then_RI|5.025003||Viu
GCC_DIAG_IGNORE|5.019007||Viu
GCC_DIAG_IGNORE_DECL|5.027007||Viu
GCC_DIAG_IGNORE_STMT|5.027007||Viu
GCC_DIAG_PRAGMA|5.021001||Viu
GCC_DIAG_RESTORE|5.019007||Viu
GCC_DIAG_RESTORE_DECL|5.027007||Viu
GCC_DIAG_RESTORE_STMT|5.027007||Viu
Gconvert|5.003007|5.003007|
GDBMNDBM_H_USES_PROTOTYPES|5.032001|5.032001|Vn
G_DISCARD|5.003007|5.003007|
gen_constant_list|5.003007||Viu
get_and_check_backslash_N_name|5.017006||cViu
get_and_check_backslash_N_name_wrapper|5.029009||Viu
get_ANYOF_cp_list_for_ssc|5.019005||Viu
get_ANYOFM_contents|5.027009||Viu
GETATARGET|5.003007||Viu
get_aux_mg|5.011000||Viu
get_av|5.006000|5.003007|p
getc|5.003007||Viu
get_c_backtrace|5.021001||Vi
get_c_backtrace_dump|5.021001||V
get_context|5.006000|5.006000|nu
getc_unlocked|5.003007||Viu
get_cv|5.006000|5.003007|p
get_cvn_flags|5.009005|5.003007|p
get_cvs|5.011000|5.003007|p
getcwd_sv|5.007002|5.007002|
get_db_sub|||iu
get_debug_opts|5.008001||Viu
get_deprecated_property_msg|5.031011||cVniu
getegid|5.005000||Viu
getenv|5.005000||Viu
getenv_len|5.006000||Viu
GETENV_LOCK|5.033005||Viu
GETENV_PRESERVES_OTHER_THREAD|5.033005|5.033005|Vn
GETENV_UNLOCK|5.033005||Viu
geteuid|5.005000||Viu
getgid|5.005000||Viu
getgrent|5.009000||Viu
GETGRENT_R_HAS_BUFFER|5.008000||Viu
GETGRENT_R_HAS_FPTR|5.008000||Viu
GETGRENT_R_HAS_PTR|5.008000||Viu
GETGRENT_R_PROTO|5.008000|5.008000|Vn
getgrgid|5.009000||Viu
GETGRGID_R_HAS_BUFFER|5.008000||Viu
GETGRGID_R_HAS_PTR|5.008000||Viu
GETGRGID_R_PROTO|5.008000|5.008000|Vn
getgrnam|5.009000||Viu
GETGRNAM_R_HAS_BUFFER|5.008000||Viu
GETGRNAM_R_HAS_PTR|5.008000||Viu
GETGRNAM_R_PROTO|5.008000|5.008000|Vn
get_hash_seed|5.008001||Viu
gethostbyaddr|5.005000||Viu
GETHOSTBYADDR_R_HAS_BUFFER|5.008000||Viu
GETHOSTBYADDR_R_HAS_ERRNO|5.008000||Viu
GETHOSTBYADDR_R_HAS_PTR|5.008000||Viu
GETHOSTBYADDR_R_PROTO|5.008000|5.008000|Vn
gethostbyname|5.005000||Viu
GETHOSTBYNAME_R_HAS_BUFFER|5.008000||Viu
GETHOSTBYNAME_R_HAS_ERRNO|5.008000||Viu
GETHOSTBYNAME_R_HAS_PTR|5.008000||Viu
GETHOSTBYNAME_R_PROTO|5.008000|5.008000|Vn
gethostent|5.005000||Viu
GETHOSTENT_R_HAS_BUFFER|5.008000||Viu
GETHOSTENT_R_HAS_ERRNO|5.008000||Viu
GETHOSTENT_R_HAS_PTR|5.008000||Viu
GETHOSTENT_R_PROTO|5.008000|5.008000|Vn
gethostname|5.005000||Viu
get_hv|5.006000|5.003007|p
get_invlist_iter_addr|5.015001||Vniu
get_invlist_offset_addr|5.019002||Vniu
get_invlist_previous_index_addr|5.017004||Vniu
getlogin|5.005000||Viu
GETLOGIN_R_PROTO|5.008000|5.008000|Vn
get_mstats|5.006000||Vu
getnetbyaddr|5.005000||Viu
GETNETBYADDR_R_HAS_BUFFER|5.008000||Viu
GETNETBYADDR_R_HAS_ERRNO|5.008000||Viu
GETNETBYADDR_R_HAS_PTR|5.008000||Viu
GETNETBYADDR_R_PROTO|5.008000|5.008000|Vn
getnetbyname|5.005000||Viu
GETNETBYNAME_R_HAS_BUFFER|5.008000||Viu
GETNETBYNAME_R_HAS_ERRNO|5.008000||Viu
GETNETBYNAME_R_HAS_PTR|5.008000||Viu
GETNETBYNAME_R_PROTO|5.008000|5.008000|Vn
getnetent|5.005000||Viu
GETNETENT_R_HAS_BUFFER|5.008000||Viu
GETNETENT_R_HAS_ERRNO|5.008000||Viu
GETNETENT_R_HAS_PTR|5.008000||Viu
GETNETENT_R_PROTO|5.008000|5.008000|Vn
get_no_modify|5.005000||Viu
get_num|5.008001||Viu
get_opargs|5.005000||Viu
get_op_descs|5.005000|5.005000|u
get_op_names|5.005000|5.005000|u
getpeername|5.005000||Viu
getpid|5.006000||Viu
get_ppaddr|5.006000|5.006000|u
get_prop_definition|5.031011||cViu
get_prop_values|5.031011||cVniu
getprotobyname|5.005000||Viu
GETPROTOBYNAME_R_HAS_BUFFER|5.008000||Viu
GETPROTOBYNAME_R_HAS_PTR|5.008000||Viu
GETPROTOBYNAME_R_PROTO|5.008000|5.008000|Vn
getprotobynumber|5.005000||Viu
GETPROTOBYNUMBER_R_HAS_BUFFER|5.008000||Viu
GETPROTOBYNUMBER_R_HAS_PTR|5.008000||Viu
GETPROTOBYNUMBER_R_PROTO|5.008000|5.008000|Vn
getprotoent|5.005000||Viu
GETPROTOENT_R_HAS_BUFFER|5.008000||Viu
GETPROTOENT_R_HAS_PTR|5.008000||Viu
GETPROTOENT_R_PROTO|5.008000|5.008000|Vn
getpwent|5.009000||Viu
GETPWENT_R_HAS_BUFFER|5.008000||Viu
GETPWENT_R_HAS_FPTR|5.008000||Viu
GETPWENT_R_HAS_PTR|5.008000||Viu
GETPWENT_R_PROTO|5.008000|5.008000|Vn
getpwnam|5.009000||Viu
GETPWNAM_R_HAS_BUFFER|5.008000||Viu
GETPWNAM_R_HAS_PTR|5.008000||Viu
GETPWNAM_R_PROTO|5.008000|5.008000|Vn
getpwuid|5.009000||Viu
GETPWUID_R_HAS_PTR|5.008000||Viu
GETPWUID_R_PROTO|5.008000|5.008000|Vn
get_quantifier_value|5.033006||Viu
get_re_arg|||xciu
get_re_gclass_nonbitmap_data|5.031011||Viu
get_regclass_nonbitmap_data|5.031011||Viu
get_regex_charset_name|5.031004||Vniu
getservbyname|5.005000||Viu
GETSERVBYNAME_R_HAS_BUFFER|5.008000||Viu
GETSERVBYNAME_R_HAS_PTR|5.008000||Viu
GETSERVBYNAME_R_PROTO|5.008000|5.008000|Vn
getservbyport|5.005000||Viu
GETSERVBYPORT_R_HAS_BUFFER|5.008000||Viu
GETSERVBYPORT_R_HAS_PTR|5.008000||Viu
GETSERVBYPORT_R_PROTO|5.008000|5.008000|Vn
getservent|5.005000||Viu
GETSERVENT_R_HAS_BUFFER|5.008000||Viu
GETSERVENT_R_HAS_PTR|5.008000||Viu
GETSERVENT_R_PROTO|5.008000|5.008000|Vn
getsockname|5.005000||Viu
getsockopt|5.005000||Viu
getspnam|5.009000||Viu
GETSPNAM_R_HAS_BUFFER|5.031011||Viu
GETSPNAM_R_HAS_PTR|5.008000||Viu
GETSPNAM_R_PROTO|5.008000|5.008000|Vn
get_sv|5.006000|5.003007|p
GETTARGET|5.003007||Viu
GETTARGETSTACKED|5.003007||Viu
gettimeofday|5.008000||Viu
getuid|5.005000||Viu
get_vtbl|5.005003|5.005003|u
getw|5.003007||Viu
G_EVAL|5.003007|5.003007|
G_FAKINGEVAL|5.009004||Viu
Gid_t|5.003007|5.003007|Vn
Gid_t_f|5.006000|5.006000|Vn
Gid_t_sign|5.006000|5.006000|Vn
Gid_t_size|5.006000|5.006000|Vn
GIMME|5.003007|5.003007|d
GIMME_V|5.004000|5.004000|
gimme_V|5.031005||xcVu
G_KEEPERR|5.003007|5.003007|
G_LIST|5.035001|5.003007|
glob_2number|5.009004||Viu
GLOBAL_PAT_MOD|5.009005||Viu
glob_assign_glob|5.009004||Viu
G_METHOD|5.006001|5.003007|p
G_METHOD_NAMED|5.019002|5.019002|
gmtime|5.031011||Viu
GMTIME_MAX|5.010001|5.010001|Vn
GMTIME_MIN|5.010001|5.010001|Vn
GMTIME_R_PROTO|5.008000|5.008000|Vn
G_NOARGS|5.003007|5.003007|
G_NODEBUG|5.004005||Viu
GOSUB|5.009005||Viu
GOSUB_t8|5.035004||Viu
GOSUB_t8_p8|5.033003||Viu
GOSUB_t8_pb|5.033003||Viu
GOSUB_tb|5.035004||Viu
GOSUB_tb_p8|5.033003||Viu
GOSUB_tb_pb|5.033003||Viu
gp_dup|5.007003|5.007003|u
gp_free|5.003007|5.003007|u
GPOS|5.004000||Viu
GPOS_t8|5.035004||Viu
GPOS_t8_p8|5.033003||Viu
GPOS_t8_pb|5.033003||Viu
GPOS_tb|5.035004||Viu
GPOS_tb_p8|5.033003||Viu
GPOS_tb_pb|5.033003||Viu
gp_ref|5.003007|5.003007|u
GREEK_CAPITAL_LETTER_MU|5.013011||Viu
GREEK_SMALL_LETTER_MU|5.013008||Viu
G_RE_REPARSING|5.017011||Viu
G_RETHROW|5.031002|5.003007|p
grok_atoUV|5.021010||cVni
grok_bin|5.007003|5.003007|p
grok_bin_oct_hex|5.031008||cVu
grok_bslash_c|5.013001||cViu
grok_bslash_N|5.017003||Viu
grok_bslash_o|5.013003||cViu
grok_bslash_x|5.017002||cViu
grok_hex|5.007003|5.003007|p
grok_infnan|5.021004|5.021004|
grok_number|5.007002|5.003007|p
grok_number_flags|5.021002|5.021002|
GROK_NUMERIC_RADIX|5.007002|5.003007|p
grok_numeric_radix|5.007002|5.003007|p
grok_oct|5.007003|5.003007|p
group_end|5.007003||Viu
GROUPP|5.005000||Viu
GROUPPN|5.031001||Viu
GROUPPN_t8|5.035004||Viu
GROUPPN_t8_p8|5.033003||Viu
GROUPPN_t8_pb|5.033003||Viu
GROUPPN_tb|5.035004||Viu
GROUPPN_tb_p8|5.033003||Viu
GROUPPN_tb_pb|5.033003||Viu
GROUPP_t8|5.035004||Viu
GROUPP_t8_p8|5.033003||Viu
GROUPP_t8_pb|5.033003||Viu
GROUPP_tb|5.035004||Viu
GROUPP_tb_p8|5.033003||Viu
GROUPP_tb_pb|5.033003||Viu
Groups_t|5.003007|5.003007|Vn
GRPASSWD|5.005000|5.005000|Vn
G_SCALAR|5.003007|5.003007|
G_UNDEF_FILL|5.013001||Viu
GV_ADD|5.003007|5.003007|
gv_add_by_type|5.011000|5.011000|u
GV_ADDMG|5.015003|5.015003|
GV_ADDMULTI|5.003007|5.003007|
GV_ADDWARN|5.003007|5.003007|
Gv_AMG|5.003007||Viu
Gv_AMupdate|5.011000|5.011000|u
GvASSUMECV|5.003007||Viu
GvASSUMECV_off|5.003007||Viu
GvASSUMECV_on|5.003007||Viu
gv_autoload4|5.004000|5.004000|
GV_AUTOLOAD|5.011000||Viu
GV_AUTOLOAD_ISMETHOD|5.015004||Viu
gv_autoload_pv|5.015004|5.015004|u
gv_autoload_pvn|5.015004|5.015004|u
gv_autoload_sv|5.015004|5.015004|u
GvAV|5.003007|5.003007|
gv_AVadd|5.003007|5.003007|u
GvAVn|5.003007||Viu
GV_CACHE_ONLY|5.021004||Vi
gv_check|5.003007||cVu
gv_const_sv|5.009003|5.009003|
GV_CROAK|5.011000||Viu
GvCV|5.003007|5.003007|
GvCVGEN|5.003007||Viu
GvCV_set|5.013010||Viu
GvCVu|5.004000||Viu
gv_dump|5.006000|5.006000|u
gv_efullname3|5.003007|5.003007|u
gv_efullname4|5.006001|5.006001|u
gv_efullname|5.003007|5.003007|du
GvEGV|5.003007||Viu
GvEGVx|5.013000||Viu
GvENAME|5.003007||Viu
GvENAME_HEK|5.015004||Viu
GvENAMELEN|5.015004||Viu
GvENAMEUTF8|5.015004||Viu
GvESTASH|5.003007||Viu
GVf_ASSUMECV|5.003007||Viu
gv_fetchfile|5.003007|5.003007|
gv_fetchfile_flags|5.009005|5.009005|
gv_fetchmeth|5.003007|5.003007|
gv_fetchmeth_autoload|5.007003|5.007003|
gv_fetchmeth_internal|5.021007||Viu
gv_fetchmethod|5.003007|5.003007|
gv_fetchmethod_autoload|5.004000|5.004000|
gv_fetchmethod_flags|5.015004||Viu
gv_fetchmethod_pv_flags|5.015004|5.015004|xu
gv_fetchmethod_pvn_flags|5.015004|5.015004|xu
gv_fetchmethod_sv_flags|5.015004|5.015004|xu
gv_fetchmeth_pv|5.015004|5.015004|
gv_fetchmeth_pv_autoload|5.015004|5.015004|
gv_fetchmeth_pvn|5.015004|5.015004|
gv_fetchmeth_pvn_autoload|5.015004|5.015004|
gv_fetchmeth_sv|5.015004|5.015004|
gv_fetchmeth_sv_autoload|5.015004|5.015004|
gv_fetchpv|5.003007|5.003007|
gv_fetchpvn|5.013006|5.013006|
gv_fetchpvn_flags|5.009002|5.003007|p
gv_fetchpvs|5.009004|5.003007|p
gv_fetchsv|5.009002|5.003007|p
gv_fetchsv_nomg|5.015003|5.015003|
GvFILE|5.006000||Viu
GvFILEGV|5.003007||Viu
GvFILE_HEK|5.009004||Viu
GvFILEx|5.019006||Viu
GVf_IMPORTED|5.003007||Viu
GVf_IMPORTED_AV|5.003007||Viu
GVf_IMPORTED_CV|5.003007||Viu
GVf_IMPORTED_HV|5.003007||Viu
GVf_IMPORTED_SV|5.003007||Viu
GVf_INTRO|5.003007||Viu
GvFLAGS|5.003007||Viu
GVf_MULTI|5.003007||Viu
GVF_NOADD|5.035006||Viu
GvFORM|5.003007||Viu
gv_fullname3|5.003007|5.003007|u
gv_fullname4|5.006001|5.006001|u
gv_fullname|5.003007|5.003007|du
GvGP|5.003007||Viu
GvGPFLAGS|5.021004||Viu
GvGP_set|5.013010||Viu
gv_handler|5.007001|5.007001|u
GvHV|5.003007|5.003007|
gv_HVadd|5.003007|5.003007|u
GvHVn|5.003007||Viu
GvIMPORTED|5.003007||Viu
GvIMPORTED_AV|5.003007||Viu
GvIMPORTED_AV_off|5.003007||Viu
GvIMPORTED_AV_on|5.003007||Viu
GvIMPORTED_CV|5.003007||Viu
GvIMPORTED_CV_off|5.003007||Viu
GvIMPORTED_CV_on|5.003007||Viu
GvIMPORTED_HV|5.003007||Viu
GvIMPORTED_HV_off|5.003007||Viu
GvIMPORTED_HV_on|5.003007||Viu
GvIMPORTED_off|5.003007||Viu
GvIMPORTED_on|5.003007||Viu
GvIMPORTED_SV|5.003007||Viu
GvIMPORTED_SV_off|5.003007||Viu
GvIMPORTED_SV_on|5.003007||Viu
gv_init|5.003007|5.003007|
gv_init_pv|5.015004|5.015004|
gv_init_pvn|5.015004|5.003007|p
gv_init_sv|5.015004|5.015004|
gv_init_svtype|5.015004||Viu
GvIN_PAD|5.006000||Viu
GvIN_PAD_off|5.006000||Viu
GvIN_PAD_on|5.006000||Viu
GvINTRO|5.003007||Viu
GvINTRO_off|5.003007||Viu
GvINTRO_on|5.003007||Viu
GvIO|5.003007||Viu
gv_IOadd|5.003007|5.003007|u
GvIOn|5.003007||Viu
GvIOp|5.003007||Viu
gv_is_in_main|5.019004||Viu
GvLINE|5.003007||Viu
gv_magicalize|5.019004||Viu
gv_magicalize_isa|5.013005||Viu
gv_method_changed|5.017007||Viu
GvMULTI|5.003007||Viu
GvMULTI_off|5.003007||Viu
GvMULTI_on|5.003007||Viu
GvNAME|5.003007||Viu
GvNAME_get|5.009004||Viu
GvNAME_HEK|5.009004||Viu
GvNAMELEN|5.003007||Viu
GvNAMELEN_get|5.009004||Viu
gv_name_set|5.009004|5.009004|u
GvNAMEUTF8|5.015004||Viu
GV_NOADD_MASK|5.009005||Viu
GV_NOADD_NOINIT|5.009003|5.009003|
GV_NOEXPAND|5.009003|5.009003|
GV_NOINIT|5.004005|5.004005|
GV_NO_SVGMAGIC|5.015003|5.015003|
GV_NOTQUAL|5.009004|5.009004|
GV_NOUNIVERSAL|5.033009||Viu
G_VOID|5.004000|5.004000|
gv_override|5.019006||Viu
GvREFCNT|5.003007||Viu
gv_setref|5.021005||Viu
GvSTASH|5.003007||Viu
gv_stashpv|5.003007|5.003007|
gv_stashpvn|5.003007|5.003007|p
gv_stashpvn_internal|5.021004||Viu
gv_stashpvs|5.009003|5.003007|p
gv_stashsv|5.003007|5.003007|
gv_stashsvpvn_cached|5.021004||Vi
GV_SUPER|5.017004|5.017004|
GvSV|5.003007|5.003007|
gv_SVadd|5.011000||Vu
GvSVn|5.009003|5.003007|p
gv_try_downgrade|5.011002||xcVi
GvXPVGV|5.003007||Viu
G_WANT|5.010001||Viu
G_WARN_ALL_MASK|5.006000||Viu
G_WARN_ALL_OFF|5.006000||Viu
G_WARN_ALL_ON|5.006000||Viu
G_WARN_OFF|5.006000||Viu
G_WARN_ON|5.006000||Viu
G_WARN_ONCE|5.006000||Viu
G_WRITING_TO_STDERR|5.013009||Viu
HADNV|||Viu
handle_named_backref|5.023008||Viu
handle_names_wildcard|5.031011||Viu
handle_possible_posix|5.023008||Viu
handle_regex_sets|5.017009||Viu
handle_user_defined_property|5.029008||Viu
HAS_ACCEPT4|5.027008|5.027008|Vn
HAS_ACCESS|5.006000|5.006000|Vn
HAS_ACOSH|5.021004|5.021004|Vn
HAS_ALARM|5.003007|5.003007|Vn
HASARENA|||Viu
HAS_ASCTIME_R|5.010000|5.010000|Vn
HAS_ASINH|5.021006|5.021006|Vn
HAS_ATANH|5.021006|5.021006|Vn
HAS_ATOLL|5.006000|5.006000|Vn
HASATTRIBUTE_ALWAYS_INLINE|5.031007|5.031007|Vn
HASATTRIBUTE_DEPRECATED|5.010001|5.010001|Vn
HASATTRIBUTE_FORMAT|5.009003|5.009003|Vn
HASATTRIBUTE_MALLOC|5.009003|5.009003|Vn
HASATTRIBUTE_NONNULL|5.009003|5.009003|Vn
HASATTRIBUTE_NORETURN|5.009003|5.009003|Vn
HASATTRIBUTE_PURE|5.009003|5.009003|Vn
HASATTRIBUTE_UNUSED|5.009003|5.009003|Vn
HASATTRIBUTE_WARN_UNUSED_RESULT|5.009003|5.009003|Vn
HAS_BACKTRACE|5.021001|5.021001|Vn
HAS_BUILTIN_CHOOSE_EXPR|5.009004|5.009004|Vn
HAS_BUILTIN_EXPECT|5.010001|5.010001|Vn
HAS_BUILTIN_UNREACHABLE|5.033003||Viu
HAS_C99|5.021004||Viu
HAS_C99_VARIADIC_MACROS|5.009004|5.009004|Vn
HAS_CBRT|5.021006|5.021006|Vn
HAS_CF_AUX_TABLES|5.027011||Viu
HAS_CHOWN|5.003007|5.003007|Vn
HAS_CHROOT|5.003007|5.003007|Vn
HAS_CHSIZE|5.004005|5.004005|Vn
HAS_CLEARENV|5.009003|5.009003|Vn
HAS_COPYSIGN|5.021006|5.021006|Vn
HAS_COPYSIGNL|5.008001|5.008001|Vn
HAS_CRYPT|5.003007|5.003007|Vn
HAS_CRYPT_R|5.010000|5.010000|Vn
HAS_CSH|5.005000|5.005000|Vn
HAS_CTERMID|5.009005|5.009005|Vn
HAS_CTIME_R|5.010000|5.010000|Vn
HAS_CUSERID|5.003007|5.003007|Vn
HAS_DBMINIT_PROTO|5.032001|5.032001|Vn
HAS_DIFFTIME|5.003007|5.003007|Vn
HAS_DIRFD|5.007003|5.007003|Vn
HAS_DLADDR|5.021001|5.021001|Vn
HAS_DLERROR|5.003007|5.003007|Vn
HAS_DRAND48_PROTO|5.006000|5.006000|Vn
HAS_DRAND48_R|5.010000|5.010000|Vn
HAS_DUP2|5.003007|5.003007|Vn
HAS_DUP3|5.027008|5.027008|Vn
HAS_DUPLOCALE|5.027011|5.027011|Vn
HAS_EACCESS|5.006000|5.006000|Vn
HAS_ENDGRENT|5.005000|5.005000|Vn
HAS_ENDHOSTENT|5.005000|5.005000|Vn
HAS_ENDNETENT|5.005000|5.005000|Vn
HAS_ENDPROTOENT|5.005000|5.005000|Vn
HAS_ENDPWENT|5.005000|5.005000|Vn
HAS_ENDSERVENT|5.005000|5.005000|Vn
HAS_ERF|5.021006|5.021006|Vn
HAS_ERFC|5.021006|5.021006|Vn
HAS_EXP2|5.021006|5.021006|Vn
HAS_EXPM1|5.021006|5.021006|Vn
HAS_EXTRA_LONG_UTF8|5.035004||Viu
HAS_FAST_STDIO|5.008001|5.008001|Vn
HAS_FCHDIR|5.007002|5.007002|Vn
HAS_FCHMOD|5.003007|5.003007|Vn
HAS_FCHMODAT|5.027004|5.027004|Vn
HAS_FCHOWN|5.003007|5.003007|Vn
HAS_FCNTL|5.003007|5.003007|Vn
HAS_FDIM|5.021006|5.021006|Vn
HAS_FD_SET|5.006000|5.006000|Vn
HAS_FEGETROUND|5.021004|5.021004|Vn
HAS_FFS|5.035001|5.035001|Vn
HAS_FFSL|5.035001|5.035001|Vn
HAS_FGETPOS|5.003007|5.003007|Vn
HAS_FINITE|5.007003|5.007003|Vn
HAS_FINITEL|5.007003|5.007003|Vn
HAS_FLOCK|5.003007|5.003007|Vn
HAS_FLOCK_PROTO|5.007002|5.007002|Vn
HAS_FMA|5.021006|5.021006|Vn
HAS_FMAX|5.021006|5.021006|Vn
HAS_FMIN|5.021006|5.021006|Vn
HAS_FORK|5.003007|5.003007|Vn
HAS_FPATHCONF|5.003007|5.003007|Vn
HAS_FPCLASSIFY|5.021004|5.021004|Vn
HAS_FREELOCALE|5.023009|5.023009|Vn
HAS_FREXPL|5.006001|5.006001|Vn
HAS_FSEEKO|5.006000|5.006000|Vn
HAS_FSETPOS|5.003007|5.003007|Vn
HAS_FSTATFS|5.023005|5.023005|Vn
HAS_FSTATVFS|5.023005|5.023005|Vn
HAS_FSYNC|5.007001|5.007001|Vn
HAS_FTELLO|5.006000|5.006000|Vn
HAS_FUTIMES|5.009003|5.009003|Vn
HAS_GAI_STRERROR|5.025004|5.025004|Vn
HAS_GETADDRINFO|5.010001|5.010001|Vn
HAS_GETCWD|5.006000|5.006000|Vn
HAS_GETGRENT|5.005000|5.005000|Vn
HAS_GETGRENT_R|5.010000|5.010000|Vn
HAS_GETGRGID_R|5.010000|5.010000|Vn
HAS_GETGRNAM_R|5.010000|5.010000|Vn
HAS_GETGROUPS|5.003007|5.003007|Vn
HAS_GETHOSTBYADDR|5.005000|5.005000|Vn
HAS_GETHOSTBYADDR_R|5.010000|5.010000|Vn
HAS_GETHOSTBYNAME|5.005000|5.005000|Vn
HAS_GETHOSTBYNAME_R|5.010000|5.010000|Vn
HAS_GETHOSTENT|5.003007|5.003007|Vn
HAS_GETHOSTENT_R|5.010000|5.010000|Vn
HAS_GETHOSTNAME|5.006000|5.006000|Vn
HAS_GETHOST_PROTOS|5.005000|5.005000|Vn
HAS_GETITIMER|5.007001|5.007001|Vn
HAS_GETLOGIN|5.003007|5.003007|Vn
HAS_GETLOGIN_R|5.010000|5.010000|Vn
HAS_GETMNTENT|5.023005|5.023005|Vn
HAS_GETNAMEINFO|5.010001|5.010001|Vn
HAS_GETNETBYADDR|5.005000|5.005000|Vn
HAS_GETNETBYADDR_R|5.010000|5.010000|Vn
HAS_GETNETBYNAME|5.005000|5.005000|Vn
HAS_GETNETBYNAME_R|5.010000|5.010000|Vn
HAS_GETNETENT|5.005000|5.005000|Vn
HAS_GETNETENT_R|5.010000|5.010000|Vn
HAS_GETNET_PROTOS|5.005000|5.005000|Vn
HAS_GETPAGESIZE|5.007001|5.007001|Vn
HAS_GETPGID|5.003007|5.003007|Vn
HAS_GETPGRP|5.003007|5.003007|Vn
HAS_GETPPID|5.003007|5.003007|Vn
HAS_GETPRIORITY|5.003007|5.003007|Vn
HAS_GETPROTOBYNAME|5.005000|5.005000|Vn
HAS_GETPROTOBYNAME_R|5.010000|5.010000|Vn
HAS_GETPROTOBYNUMBER|5.005000|5.005000|Vn
HAS_GETPROTOBYNUMBER_R|5.010000|5.010000|Vn
HAS_GETPROTOENT|5.005000|5.005000|Vn
HAS_GETPROTOENT_R|5.010000|5.010000|Vn
HAS_GETPROTO_PROTOS|5.005000|5.005000|Vn
HAS_GETPWENT|5.005000|5.005000|Vn
HAS_GETPWENT_R|5.010000|5.010000|Vn
HAS_GETPWNAM_R|5.010000|5.010000|Vn
HAS_GETPWUID_R|5.010000|5.010000|Vn
HAS_GETSERVBYNAME|5.005000|5.005000|Vn
HAS_GETSERVBYNAME_R|5.010000|5.010000|Vn
HAS_GETSERVBYPORT|5.005000|5.005000|Vn
HAS_GETSERVBYPORT_R|5.010000|5.010000|Vn
HAS_GETSERVENT|5.005000|5.005000|Vn
HAS_GETSERVENT_R|5.010000|5.010000|Vn
HAS_GETSERV_PROTOS|5.005000|5.005000|Vn
HAS_GETSPNAM|5.006000|5.006000|Vn
HAS_GETSPNAM_R|5.010000|5.010000|Vn
HAS_GETTIMEOFDAY|5.004000|5.004000|Vn
HAS_GMTIME_R|5.010000|5.010000|Vn
HAS_GNULIBC|5.004005|5.004005|Vn
HAS_GROUP|5.003007||Viu
HAS_HASMNTOPT|5.023005|5.023005|Vn
HAS_HTONL|5.003007|5.003007|Vn
HAS_HTONS|5.003007|5.003007|Vn
HAS_HYPOT|5.021006|5.021006|Vn
HAS_ILOGB|5.021006|5.021006|Vn
HAS_ILOGBL|5.008001|5.008001|Vn
HAS_INET_ATON|5.004000|5.004000|Vn
HAS_INETNTOP|5.010001|5.010001|Vn
HAS_INETPTON|5.010001|5.010001|Vn
HAS_INT64_T|5.006000|5.006000|Vn
HAS_IOCTL|5.003007||Viu
HAS_IP_MREQ|5.017002|5.017002|Vn
HAS_IP_MREQ_SOURCE|5.017004|5.017004|Vn
HAS_IPV6_MREQ|5.015008|5.015008|Vn
HAS_ISASCII|5.003007|5.003007|Vn
HAS_ISBLANK|5.015007|5.015007|Vn
HAS_ISFINITE|5.021004|5.021004|Vn
HAS_ISINF|5.007003|5.007003|Vn
HAS_ISINFL|5.021004|5.021004|Vn
HAS_ISLESS|5.031007|5.031007|Vn
HAS_ISNAN|5.006001|5.006001|Vn
HAS_ISNANL|5.006001|5.006001|Vn
HAS_ISNORMAL|5.021006|5.021006|Vn
HAS_IVCF_AUX_TABLES|5.027011||Viu
HAS_J0|5.021004|5.021004|Vn
HAS_J0L|5.021004|5.021004|Vn
HAS_KILL|5.003007||Viu
HAS_KILLPG|5.003007|5.003007|Vn
HAS_LC_AUX_TABLES|5.027011||Viu
HAS_LCHOWN|5.005000|5.005000|Vn
HAS_LC_MONETARY_2008|5.021005|5.021005|Vn
HAS_LDBL_DIG|5.006000|5.006000|Vn
HAS_LDEXPL|5.021003|5.021003|Vn
HAS_LGAMMA|5.021006|5.021006|Vn
HAS_LGAMMA_R|5.021006|5.021006|Vn
HAS_LINK|5.003007|5.003007|Vn
HAS_LINKAT|5.027004|5.027004|Vn
HAS_LLRINT|5.021006|5.021006|Vn
HAS_LLRINTL|5.021009|5.021009|Vn
HAS_LLROUND|5.021006|5.021006|Vn
HAS_LLROUNDL|5.021009|5.021009|Vn
HAS_LOCALECONV|5.003007|5.003007|Vn
HAS_LOCALTIME_R|5.010000|5.010000|Vn
HAS_LOCKF|5.003007|5.003007|Vn
HAS_LOG1P|5.021006|5.021006|Vn
HAS_LOG2|5.021006|5.021006|Vn
HAS_LOGB|5.021006|5.021006|Vn
HAS_LONG_DOUBLE|5.005000|5.005000|Vn
HAS_LONG_LONG|5.005000|5.005000|Vn
HAS_LRINT|5.021006|5.021006|Vn
HAS_LRINTL|5.021009|5.021009|Vn
HAS_LROUND|5.021006|5.021006|Vn
HAS_LROUNDL|5.021009|5.021009|Vn
HAS_LSEEK_PROTO|5.006000|5.006000|Vn
HAS_LSTAT|5.003007|5.003007|Vn
HAS_MADVISE|5.006000|5.006000|Vn
HAS_MBLEN|5.003007|5.003007|Vn
HAS_MBRLEN|5.027006|5.027006|Vn
HAS_MBRTOWC|5.027006|5.027006|Vn
HAS_MBSTOWCS|5.003007|5.003007|Vn
HAS_MBTOWC|5.003007|5.003007|Vn
HAS_MEMMEM|5.024000|5.024000|Vn
HAS_MEMRCHR|5.027005|5.027005|Vn
HAS_MKDIR|5.003007|5.003007|Vn
HAS_MKDTEMP|5.006000|5.006000|Vn
HAS_MKFIFO|5.003007|5.003007|Vn
HAS_MKOSTEMP|5.027008|5.027008|Vn
HAS_MKSTEMP|5.006000|5.006000|Vn
HAS_MKSTEMPS|5.006000|5.006000|Vn
HAS_MKTIME|5.003007|5.003007|Vn
HAS_MMAP|5.006000|5.006000|Vn
HAS_MODFL|5.006001|5.006001|Vn
HAS_MODFL_PROTO|5.009003|5.009003|Vn
HAS_MPROTECT|5.006000|5.006000|Vn
HAS_MSG|5.003007|5.003007|Vn
HAS_MSYNC|5.006000|5.006000|Vn
HAS_MUNMAP|5.006000|5.006000|Vn
HAS_NAN|5.021006|5.021006|Vn
HAS_NANOSLEEP|5.027006|5.027006|Vn
HAS_NEARBYINT|5.021006|5.021006|Vn
HAS_NEWLOCALE|5.023009|5.023009|Vn
HAS_NEXTAFTER|5.021006|5.021006|Vn
HAS_NEXTTOWARD|5.021006|5.021006|Vn
HAS_NICE|5.003007|5.003007|Vn
HAS_NL_LANGINFO|5.007002|5.007002|Vn
HAS_NL_LANGINFO_L|5.035001|5.035001|Vn
HAS_NON_INT_BITFIELDS|5.035001|5.035001|Vn
HAS_NONLATIN1_FOLD_CLOSURE|5.033005||Viu
HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE|5.033005||Viu
HAS_NTOHL|5.003007|5.003007|Vn
HAS_NTOHS|5.003007|5.003007|Vn
HAS_OFF64_T|5.010000|5.010000|Vn
HAS_OPEN3|5.003007|5.003007|Vn
HAS_OPENAT|5.027004|5.027004|Vn
HAS_PASSWD|5.003007||Viu
HAS_PATHCONF|5.003007|5.003007|Vn
HAS_PAUSE|5.003007|5.003007|Vn
HAS_PIPE2|5.027008|5.027008|Vn
HAS_PIPE|5.003007|5.003007|Vn
HAS_POLL|5.003007|5.003007|Vn
HAS_POSIX_2008_LOCALE|5.027003||Viu
HAS_PRCTL|5.013000|5.013000|Vn
HAS_PRCTL_SET_NAME|5.013000|5.013000|Vn
HAS_PROCSELFEXE|5.007003|5.007003|Vn
HAS_PTHREAD_ATFORK|5.010000|5.010000|Vn
HAS_PTHREAD_ATTR_SETSCOPE|5.008001|5.008001|Vn
HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP|5.007002||Viu
HAS_PTHREAD_YIELD|5.009005|5.009005|Vn
HAS_PTRDIFF_T|5.021001|5.021001|Vn
HAS_QUAD|5.003007|5.003007|Vn
HAS_RANDOM_R|5.010000|5.010000|Vn
HAS_READDIR|5.003007|5.003007|Vn
HAS_READDIR64_R|5.010000|5.010000|Vn
HAS_READDIR_R|5.010000|5.010000|Vn
HAS_READLINK|5.003007|5.003007|Vn
HAS_READV|5.007001|5.007001|Vn
HAS_RECVMSG|5.007001|5.007001|Vn
HAS_REGCOMP|5.021007|5.021007|Vn
HAS_REMAINDER|5.021006|5.021006|Vn
HAS_REMQUO|5.021006|5.021006|Vn
HAS_RENAME|5.003007|5.003007|Vn
HAS_RENAMEAT|5.027004|5.027004|Vn
HAS_REWINDDIR|5.003007|5.003007|Vn
HAS_RINT|5.021006|5.021006|Vn
HAS_RMDIR|5.003007|5.003007|Vn
HAS_ROUND|5.021006|5.021006|Vn
HAS_SBRK_PROTO|5.007001|5.007001|Vn
HAS_SCALBN|5.021006|5.021006|Vn
HAS_SCALBNL|5.008001|5.008001|Vn
HAS_SCHED_YIELD|5.005000|5.005000|Vn
HAS_SCX_AUX_TABLES|5.027008||Viu
HAS_SEEKDIR|5.003007|5.003007|Vn
HAS_SELECT|5.003007|5.003007|Vn
HAS_SEM|5.003007|5.003007|Vn
HAS_SENDMSG|5.007001|5.007001|Vn
HAS_SETEGID|5.003007|5.003007|Vn
HAS_SETEUID|5.003007|5.003007|Vn
HAS_SETGRENT|5.005000|5.005000|Vn
HAS_SETGROUPS|5.004000|5.004000|Vn
HAS_SETHOSTENT|5.005000|5.005000|Vn
HAS_SETITIMER|5.007001|5.007001|Vn
HAS_SETLINEBUF|5.003007|5.003007|Vn
HAS_SETLOCALE|5.003007|5.003007|Vn
HAS_SETNETENT|5.005000|5.005000|Vn
HAS_SETPGID|5.003007|5.003007|Vn
HAS_SETPGRP|5.003007|5.003007|Vn
HAS_SETPRIORITY|5.003007|5.003007|Vn
HAS_SETPROTOENT|5.005000|5.005000|Vn
HAS_SETPWENT|5.005000|5.005000|Vn
HAS_SETREGID|5.003007|5.003007|Vn
HAS_SETRESGID|5.003007|5.003007|Vn
HAS_SETRESGID_PROTO|5.010000|5.010000|Vn
HAS_SETRESUID|5.003007|5.003007|Vn
HAS_SETRESUID_PROTO|5.010000|5.010000|Vn
HAS_SETREUID|5.003007|5.003007|Vn
HAS_SETSERVENT|5.005000|5.005000|Vn
HAS_SETSID|5.003007|5.003007|Vn
HAS_SETVBUF|5.005000|5.005000|Vn
HAS_SHM|5.003007|5.003007|Vn
HAS_SHMAT_PROTOTYPE|5.003007|5.003007|Vn
HAS_SIGACTION|5.003007|5.003007|Vn
HAS_SIGINFO_SI_ADDR|5.023008|5.023008|Vn
HAS_SIGINFO_SI_BAND|5.023008|5.023008|Vn
HAS_SIGINFO_SI_ERRNO|5.023008|5.023008|Vn
HAS_SIGINFO_SI_PID|5.023008|5.023008|Vn
HAS_SIGINFO_SI_STATUS|5.023008|5.023008|Vn
HAS_SIGINFO_SI_UID|5.023008|5.023008|Vn
HAS_SIGINFO_SI_VALUE|5.023008|5.023008|Vn
HAS_SIGNBIT|5.009005|5.009005|Vn
HAS_SIGPROCMASK|5.007001|5.007001|Vn
HAS_SIGSETJMP|5.003007|5.003007|Vn
HAS_SIN6_SCOPE_ID|5.013009|5.013009|Vn
HAS_SKIP_LOCALE_INIT|5.019002||Viu
HAS_SNPRINTF|5.009003|5.009003|Vn
HAS_SOCKADDR_IN6|5.015008|5.015008|Vn
HAS_SOCKADDR_STORAGE|5.032001|5.032001|Vn
HAS_SOCKATMARK|5.007001|5.007001|Vn
HAS_SOCKATMARK_PROTO|5.007002|5.007002|Vn
HAS_SOCKET|5.003007|5.003007|Vn
HAS_SOCKETPAIR|5.003007|5.003007|Vn
HAS_SQRTL|5.006000|5.006000|Vn
HAS_SRAND48_R|5.010000|5.010000|Vn
HAS_SRANDOM_R|5.010000|5.010000|Vn
HAS_STAT|5.021007|5.021007|Vn
HAS_STATIC_INLINE|5.013004|5.013004|Vn
HAS_STRCOLL|5.003007|5.003007|Vn
HAS_STRERROR_L|5.025002|5.025002|Vn
HAS_STRERROR_R|5.010000|5.010000|Vn
HAS_STRFTIME|5.007002|5.007002|Vn
HAS_STRNLEN|5.027006|5.027006|Vn
HAS_STRTOD|5.004000|5.004000|Vn
HAS_STRTOD_L|5.027011|5.027011|Vn
HAS_STRTOL|5.004000|5.004000|Vn
HAS_STRTOLD|5.006000|5.006000|Vn
HAS_STRTOLD_L|5.027006|5.027006|Vn
HAS_STRTOLL|5.006000|5.006000|Vn
HAS_STRTOQ|5.007001|5.007001|Vn
HAS_STRTOUL|5.004000|5.004000|Vn
HAS_STRTOULL|5.006000|5.006000|Vn
HAS_STRTOUQ|5.006000|5.006000|Vn
HAS_STRUCT_CMSGHDR|5.007001|5.007001|Vn
HAS_STRUCT_MSGHDR|5.007001|5.007001|Vn
HAS_STRUCT_STATFS|5.023005|5.023005|Vn
HAS_STRUCT_STATFS_F_FLAGS|5.023005|5.023005|Vn
HAS_STRXFRM|5.003007|5.003007|Vn
HAS_STRXFRM_L|5.035001|5.035001|Vn
HAS_SYMLINK|5.003007|5.003007|Vn
HAS_SYSCALL|5.003007|5.003007|Vn
HAS_SYSCALL_PROTO|5.007002|5.007002|Vn
HAS_SYSCONF|5.003007|5.003007|Vn
HAS_SYS_ERRLIST|5.003007|5.003007|Vn
HAS_SYSTEM|5.003007|5.003007|Vn
HAS_TC_AUX_TABLES|5.027011||Viu
HAS_TCGETPGRP|5.003007|5.003007|Vn
HAS_TCSETPGRP|5.003007|5.003007|Vn
HAS_TELLDIR|5.003007|5.003007|Vn
HAS_TELLDIR_PROTO|5.006000|5.006000|Vn
HAS_TGAMMA|5.021006|5.021006|Vn
HAS_THREAD_SAFE_NL_LANGINFO_L|5.027006|5.027006|Vn
HAS_TIME|5.008000|5.008000|Vn
HAS_TIMEGM|5.010001|5.010001|Vn
HAS_TIMES|5.003007|5.003007|Vn
HAS_TMPNAM_R|5.010000|5.010000|Vn
HAS_TM_TM_GMTOFF|5.008001|5.008001|Vn
HAS_TM_TM_ZONE|5.008000|5.008000|Vn
HAS_TOWLOWER|5.029009|5.029009|Vn
HAS_TOWUPPER|5.029009|5.029009|Vn
HAS_TRUNC|5.021006|5.021006|Vn
HAS_TRUNCATE|5.003007|5.003007|Vn
HAS_TRUNCL|5.021004|5.021004|Vn
HAS_TTYNAME_R|5.010000|5.010000|Vn
HAS_TZNAME|5.003007|5.003007|Vn
HAS_UALARM|5.007001|5.007001|Vn
HAS_UC_AUX_TABLES|5.027011||Viu
HAS_UMASK|5.003007|5.003007|Vn
HAS_UNAME|5.003007|5.003007|Vn
HAS_UNLINKAT|5.027004|5.027004|Vn
HAS_UNSETENV|5.009003|5.009003|Vn
HAS_USELOCALE|5.023009|5.023009|Vn
HAS_USLEEP|5.007001|5.007001|Vn
HAS_USLEEP_PROTO|5.007002|5.007002|Vn
HAS_USTAT|5.023005|5.023005|Vn
HAS_UTIME|5.003007||Viu
HAS_VSNPRINTF|5.009003|5.009003|Vn
HAS_WAIT4|5.003007|5.003007|Vn
HAS_WAIT|5.003007||Viu
HAS_WAITPID|5.003007|5.003007|Vn
HAS_WCRTOMB|5.031007|5.031007|Vn
HAS_WCSCMP|5.021001|5.021001|Vn
HAS_WCSTOMBS|5.003007|5.003007|Vn
HAS_WCSXFRM|5.021001|5.021001|Vn
HAS_WCTOMB|5.003007|5.003007|Vn
HAS_WRITEV|5.007001|5.007001|Vn
HE_ARENA_ROOT_IX|5.035005||Viu
he_dup|5.007003|5.007003|u
HEf_SVKEY|5.003007|5.003007|p
HeHASH|5.003007|5.003007|
HEK_BASESIZE|5.004000||Viu
hek_dup|5.009000|5.009000|u
HeKEY|5.003007|5.003007|
HeKEY_hek|5.004000||Viu
HeKEY_sv|5.004000||Viu
HEKf256|5.015004||Viu
HEKf|5.015004||Viu
HEKfARG|5.015004||Viu
HEK_FLAGS|5.008000||Viu
HeKFLAGS|5.008000||Viu
HEK_HASH|5.004000||Viu
HEK_KEY|5.004000||Viu
HeKLEN|5.003007|5.003007|
HEK_LEN|5.004000||Viu
HeKLEN_UTF8|5.007001||Viu
HEK_UTF8|5.007001||Viu
HeKUTF8|5.007001||Viu
HEK_UTF8_off|5.008000||Viu
HEK_UTF8_on|5.008000||Viu
HEK_WASUTF8|5.008000||Viu
HeKWASUTF8|5.008000||Viu
HEK_WASUTF8_off|5.008000||Viu
HEK_WASUTF8_on|5.008000||Viu
HeNEXT|5.003007||Viu
HePV|5.004000|5.004000|
HeSVKEY|5.003007|5.003007|
HeSVKEY_force|5.003007|5.003007|
HeSVKEY_set|5.004000|5.004000|
HeUTF8|5.010001|5.008000|p
HeVAL|5.003007|5.003007|
hfree_next_entry|||iu
HIGHEST_ANYOF_HRx_BYTE|5.031002||Viu
HIGHEST_CASE_CHANGING_CP|5.033005||Viu
HINT_ALL_STRICT|5.033002||Viu
HINT_BLOCK_SCOPE|5.003007||Viu
HINT_BYTES|5.007002||Viu
HINT_EXPLICIT_STRICT_REFS|5.016000||Viu
HINT_EXPLICIT_STRICT_SUBS|5.016000||Viu
HINT_EXPLICIT_STRICT_VARS|5.016000||Viu
HINT_FEATURE_MASK|5.015007||Viu
HINT_FEATURE_SHIFT|5.015007||Viu
HINT_FILETEST_ACCESS|5.006000||Viu
HINT_INTEGER|5.003007||Viu
HINT_LEXICAL_IO_IN|5.009005||Viu
HINT_LEXICAL_IO_OUT|5.009005||Viu
HINT_LOCALE|5.004000||Viu
HINT_LOCALE_PARTIAL|5.021001||Viu
HINT_LOCALIZE_HH|5.005000||Viu
HINT_NEW_BINARY|5.005000||Viu
HINT_NEW_FLOAT|5.005000||Viu
HINT_NEW_INTEGER|5.005000||Viu
HINT_NEW_RE|5.005000||Viu
HINT_NEW_STRING|5.005000||Viu
HINT_NO_AMAGIC|5.010001||Viu
HINT_RE_EVAL|5.005000||Viu
HINT_RE_FLAGS|5.013007||Viu
HINT_RE_TAINT|5.004005||Viu
HINTS_DEFAULT|5.033002||Viu
HINTS_REFCNT_INIT|5.009004||Viu
HINTS_REFCNT_LOCK|5.009004||Viu
HINTS_REFCNT_TERM|5.009004||Viu
HINTS_REFCNT_UNLOCK|5.009004||Viu
HINT_STRICT_REFS|5.003007||Viu
HINT_STRICT_SUBS|5.003007||Viu
HINT_STRICT_VARS|5.003007||Viu
HINT_UNI_8_BIT|5.011002||Viu
HINT_UTF8|5.006000||Viu
H_PERL|5.003007||Viu
HS_APIVERLEN_MAX|5.021006||Viu
HS_CXT|5.021006||Viu
HSf_IMP_CXT|5.021006||Viu
HSf_NOCHK|5.021006||Viu
HSf_POPMARK|5.021006||Viu
HSf_SETXSUBFN|5.021006||Viu
HS_GETAPIVERLEN|5.021006||Viu
HS_GETINTERPSIZE|5.021006||Viu
HS_GETXSVERLEN|5.021006||Viu
HS_KEY|5.021006||Viu
HS_KEYp|5.021006||Viu
HSm_APIVERLEN|5.021006||Viu
HSm_INTRPSIZE|5.021006||Viu
HSm_KEY_MATCH|5.021006||Viu
HSm_XSVERLEN|5.021006||Viu
hsplit|5.005000||Viu
HS_XSVERLEN_MAX|5.021006||Viu
htoni|5.003007||Viu
htonl|5.003007||Viu
htons|5.003007||Viu
htovl|5.003007||Viu
htovs|5.003007||Viu
HvAMAGIC|5.017000||Viu
HvAMAGIC_off|5.017000||Viu
HvAMAGIC_on|5.017000||Viu
HvARRAY|5.003007||Viu
hv_assert|||
HvAUX|5.009003||Viu
hv_auxalloc|||iu
HVAUX_ARENA_ROOT_IX|5.035005||Viu
HvAUXf_NO_DEREF|5.019010||Viu
HvAUXf_SCAN_STASH|5.019010||Viu
hv_auxinit|5.009003||Viu
hv_backreferences_p|||xiu
hv_bucket_ratio|5.025003|5.025003|x
hv_clear|5.003007|5.003007|
hv_clear_placeholders|5.009001|5.009001|
hv_common|5.010000||cVu
hv_common_key_len|5.010000||cVu
hv_copy_hints_hv|5.013005|5.013005|
hv_delayfree_ent|5.004000|5.004000|u
hv_delete|5.003007|5.003007|
HV_DELETE|5.009005||Viu
hv_delete_common|5.009001||xViu
hv_delete_ent|5.003007|5.003007|
hv_deletehek|5.019006||Viu
hv_deletes|5.025006||Viu
HV_DISABLE_UVAR_XKEY|5.010000||Viu
HvEITER|5.003007||Viu
HvEITER_get|5.009003||Viu
hv_eiter_p|||u
HvEITER_set|5.009003||Viu
hv_eiter_set|||u
HvENAME|5.013007|5.013007|
hv_ename_add|5.013007||Vi
hv_ename_delete|5.013007||Vi
HvENAME_get|5.013007||Viu
HvENAME_HEK|5.013007||Viu
HvENAME_HEK_NN|5.013007||Viu
HvENAMELEN|5.015004|5.015004|
HvENAMELEN_get|5.013007||Viu
HvENAMEUTF8|5.015004|5.015004|
hv_exists|5.003007|5.003007|
hv_exists_ent|5.003007|5.003007|
hv_existshek|5.035003||Viu
hv_existss|5.025006||Viu
hv_fetch|5.003007|5.003007|
HV_FETCH_EMPTY_HE|5.013007||Viu
hv_fetch_ent|5.003007|5.003007|
hv_fetchhek|5.019006||Viu
HV_FETCH_ISEXISTS|5.009005||Viu
HV_FETCH_ISSTORE|5.009005||Viu
HV_FETCH_JUST_SV|5.009005||Viu
HV_FETCH_LVALUE|5.009005||Viu
hv_fetchs|5.009003|5.003007|p
hv_fill|||
HvFILL|5.003007|5.003007|
hv_free_ent|5.004000|5.004000|u
hv_free_ent_ret|5.015000||Viu
hv_free_entries|5.027002||Viu
HvHASKFLAGS|5.008000||Viu
HvHASKFLAGS_off|5.008000||Viu
HvHASKFLAGS_on|5.008000||Viu
HVhek_ENABLEHVKFLAGS|5.008002||Viu
HVhek_FREEKEY|5.008000||Viu
HVhek_KEYCANONICAL|5.010001||Viu
HVhek_MASK|5.008000||Viu
HVhek_PLACEHOLD|5.008000||Viu
HVhek_UNSHARED|5.009004||Viu
HVhek_UTF8|5.008000||Viu
HVhek_WASUTF8|5.008000||Viu
hv_iterinit|5.003007|5.003007|
hv_iterkey|5.003007|5.003007|
hv_iterkeysv|5.003007|5.003007|
hv_iternext|5.003007|5.003007|
hv_iternext_flags|5.008000|5.008000|x
hv_iternextsv|5.003007|5.003007|
HV_ITERNEXT_WANTPLACEHOLDERS|5.008000|5.008000|
hv_iterval|5.003007|5.003007|
HvKEYS|5.003007||Viu
hv_kill_backrefs|||xiu
hv_ksplit|5.003007|5.003007|u
HvLASTRAND_get|5.017011||Viu
HvLAZYDEL|5.003007||Viu
HvLAZYDEL_off|5.003007||Viu
HvLAZYDEL_on|5.003007||Viu
hv_magic|5.003007|5.003007|
hv_magic_check|5.006000||Vniu
HvMAX|5.003007||Viu
HvMROMETA|5.010001|5.010001|
HvNAME|5.003007|5.003007|
HvNAME_get|5.009003||pcV
HvNAME_HEK|5.009003||Viu
HvNAME_HEK_NN|5.013007||Viu
HvNAMELEN|5.015004|5.015004|
HvNAMELEN_get|5.009003|5.003007|p
hv_name_set|5.009003|5.009003|u
HV_NAME_SETALL|5.013008||Viu
hv_name_sets|5.025006||Viu
HvNAMEUTF8|5.015004|5.015004|
hv_notallowed|5.008000||Viu
HvPLACEHOLDERS|5.007003||Viu
HvPLACEHOLDERS_get|5.009003||Viu
hv_placeholders_get|||u
hv_placeholders_p|||ciu
HvPLACEHOLDERS_set|5.009003||Viu
hv_placeholders_set|||u
hv_pushkv|5.027003||Viu
HvRAND_get|5.017011||Viu
hv_rand_set|5.018000|5.018000|u
HVrhek_delete|5.009004||Viu
HVrhek_IV|5.009004||Viu
HVrhek_PV|5.009004||Viu
HVrhek_PV_UTF8|5.009005||Viu
HVrhek_typemask|5.009004||Viu
HVrhek_undef|5.009004||Viu
HVrhek_UV|5.009004||Viu
HvRITER|5.003007||Viu
HvRITER_get|5.009003||Viu
hv_riter_p|||u
HvRITER_set|5.009003||Viu
hv_riter_set|||u
hv_scalar|5.009001|5.009001|
HvSHAREKEYS|5.003007||Viu
HvSHAREKEYS_off|5.003007||Viu
HvSHAREKEYS_on|5.003007||Viu
hv_store|5.003007|5.003007|
hv_store_ent|5.003007|5.003007|
hv_store_flags|5.008000|5.008000|xu
hv_storehek|5.019006||Viu
hv_stores|5.009004|5.003007|p
HvTOTALKEYS|5.007003||Viu
hv_undef|5.003007|5.003007|
hv_undef_flags|||ciu
HvUSEDKEYS|5.007003||Viu
HYPHEN_UTF8|5.017004||Viu
I16_MAX|5.003007||Viu
I16_MIN|5.003007||Viu
I16SIZE|5.006000|5.006000|Vn
I16TYPE|5.006000|5.006000|Vn
I_32|5.006000|5.003007|
I32_MAX|5.003007||Viu
I32_MAX_P1|5.007002||Viu
I32_MIN|5.003007||Viu
I32SIZE|5.006000|5.006000|Vn
I32TYPE|5.006000|5.006000|Vn
I64SIZE|5.006000|5.006000|Vn
I64TYPE|5.006000|5.006000|Vn
I8SIZE|5.006000|5.006000|Vn
I8_TO_NATIVE|5.015006||Viu
I8_TO_NATIVE_UTF8|5.019004||Viu
I8TYPE|5.006000|5.006000|Vn
I_ARPA_INET|5.005000|5.005000|Vn
ibcmp|5.003007|5.003007|
ibcmp_locale|5.004000|5.004000|
ibcmp_utf8|5.007003|5.007003|
I_CRYPT|5.008000|5.008000|Vn
I_DBM|5.032001|5.032001|Vn
I_DIRENT|5.003007|5.003007|Vn
I_DLFCN|5.003007|5.003007|Vn
I_EXECINFO|5.021001|5.021001|Vn
I_FENV|5.021004|5.021004|Vn
IFMATCH|5.003007||Viu
IFMATCH_A|5.009005||Viu
IFMATCH_A_fail|5.009005||Viu
IFMATCH_A_fail_t8|5.035004||Viu
IFMATCH_A_fail_t8_p8|5.033003||Viu
IFMATCH_A_fail_t8_pb|5.033003||Viu
IFMATCH_A_fail_tb|5.035004||Viu
IFMATCH_A_fail_tb_p8|5.033003||Viu
IFMATCH_A_fail_tb_pb|5.033003||Viu
IFMATCH_A_t8|5.035004||Viu
IFMATCH_A_t8_p8|5.033003||Viu
IFMATCH_A_t8_pb|5.033003||Viu
IFMATCH_A_tb|5.035004||Viu
IFMATCH_A_tb_p8|5.033003||Viu
IFMATCH_A_tb_pb|5.033003||Viu
IFMATCH_t8|5.035004||Viu
IFMATCH_t8_p8|5.033003||Viu
IFMATCH_t8_pb|5.033003||Viu
IFMATCH_tb|5.035004||Viu
IFMATCH_tb_p8|5.033003||Viu
IFMATCH_tb_pb|5.033003||Viu
IFTHEN|5.005000||Viu
IFTHEN_t8|5.035004||Viu
IFTHEN_t8_p8|5.033003||Viu
IFTHEN_t8_pb|5.033003||Viu
IFTHEN_tb|5.035004||Viu
IFTHEN_tb_p8|5.033003||Viu
IFTHEN_tb_pb|5.033003||Viu
I_GDBM|5.021007|5.021007|Vn
I_GDBMNDBM|5.021007|5.021007|Vn
IGNORE_PAT_MOD|5.009005||Viu
I_GRP|5.003007|5.003007|Vn
I_INTTYPES|5.006000|5.006000|Vn
I_LANGINFO|5.007002|5.007002|Vn
I_LIMITS|5.003007||Viu
ILLEGAL_UTF8_BYTE|5.019004||Viu
I_LOCALE|5.003007|5.003007|Vn
I_MNTENT|5.023005|5.023005|Vn
IN_BYTES|5.007002||Viu
incline|5.005000||Viu
INCLUDE_PROTOTYPES|5.007001||Viu
INCMARK|5.023005||Viu
incpush|5.005000||Viu
INCPUSH_APPLLIB_EXP|5.027006||Viu
INCPUSH_APPLLIB_OLD_EXP|5.027006||Viu
INCPUSH_ARCHLIB_EXP|5.027006||Viu
incpush_if_exists|5.009003||Viu
INCPUSH_PERL5LIB|5.027006||Viu
INCPUSH_PERL_OTHERLIBDIRS|5.027006||Viu
INCPUSH_PERL_OTHERLIBDIRS_ARCHONLY|5.027006||Viu
INCPUSH_PERL_VENDORARCH_EXP|5.027006||Viu
INCPUSH_PERL_VENDORLIB_EXP|5.027006||Viu
INCPUSH_PERL_VENDORLIB_STEM|5.027006||Viu
INCPUSH_PRIVLIB_EXP|5.027006||Viu
INCPUSH_SITEARCH_EXP|5.027006||Viu
INCPUSH_SITELIB_EXP|5.027006||Viu
INCPUSH_SITELIB_STEM|5.027006||Viu
incpush_use_sep|5.011000||Viu
I_NDBM|5.032001|5.032001|Vn
inet_addr|5.005000||Viu
I_NETDB|5.005000|5.005000|Vn
I_NETINET_IN|5.003007|5.003007|Vn
I_NETINET_TCP|5.006000|5.006000|Vn
inet_ntoa|5.005000||Viu
INFNAN_NV_U8_DECL|5.023000||Viu
INFNAN_U8_NV_DECL|5.023000||Viu
ingroup|5.003007||Viu
INIT|5.003007||Viu
init_argv_symbols|5.007003||Viu
init_constants|5.017003||Viu
init_dbargs|||iu
init_debugger|5.005000||Viu
init_i18nl10n|5.006000||cVu
init_i18nl14n|5.006000||dcVu
initialize_invlist_guts|5.029002||Viu
init_ids|5.005000||Viu
init_interp|5.005000||Viu
init_main_stash|5.005000||Viu
init_named_cv|5.027010||cViu
init_os_extras|5.005000||Viu
init_perllib|5.005000||Viu
init_postdump_symbols|5.005000||Viu
init_predump_symbols|5.005000||Viu
init_stacks|5.005000|5.005000|u
INIT_THREADS|5.005000||Viu
init_tm|5.007002|5.007002|u
INIT_TRACK_MEMPOOL|5.009004||Viu
init_uniprops|5.027011||Viu
IN_LC|5.021001||Viu
IN_LC_ALL_COMPILETIME|5.021001||Viu
IN_LC_ALL_RUNTIME|5.021001||Viu
IN_LC_COMPILETIME|5.021001||Viu
IN_LC_PARTIAL_COMPILETIME|5.021001||Viu
IN_LC_PARTIAL_RUNTIME|5.021001||Viu
IN_LC_RUNTIME|5.021001||Viu
IN_LOCALE|5.007002|5.004000|p
IN_LOCALE_COMPILETIME|5.007002|5.004000|p
IN_LOCALE_RUNTIME|5.007002|5.004000|p
IN_PERL_COMPILETIME|5.008001|5.003007|p
IN_PERL_RUNTIME|5.008001|5.008001|
inplace_aassign|5.015003||Viu
inRANGE|5.029010||Viu
inRANGE_helper|5.033005||Viu
IN_SOME_LOCALE_FORM|5.015008||Viu
IN_SOME_LOCALE_FORM_COMPILETIME|5.015008||Viu
IN_SOME_LOCALE_FORM_RUNTIME|5.015008||Viu
instr|5.003007|5.003007|n
INSUBP|5.009005||Viu
INSUBP_t8|5.035004||Viu
INSUBP_t8_p8|5.033003||Viu
INSUBP_t8_pb|5.033003||Viu
INSUBP_tb|5.035004||Viu
INSUBP_tb_p8|5.033003||Viu
INSUBP_tb_pb|5.033003||Viu
INT16_C|5.003007|5.003007|
INT2PTR|5.006000|5.003007|p
INT32_C|5.003007|5.003007|
INT32_MIN|5.007002||Viu
INT64_C|5.023002|5.023002|
INT64_MIN|5.007002||Viu
INT_64_T|5.011000||Viu
INTMAX_C|5.003007|5.003007|
INT_PAT_MODS|5.009005||Viu
intro_my|5.021006|5.021006|
INTSIZE|5.003007|5.003007|Vn
intuit_method|5.005000||Viu
intuit_more|5.003007||Viu
IN_UNI_8_BIT|5.011002||Viu
IN_UTF8_CTYPE_LOCALE|5.019009||Viu
_inverse_folds|5.027011||cViu
invert|5.003007||Viu
invlist_array|5.013010||Vniu
_invlist_array_init|5.015001||Vniu
invlist_clear|5.023009||Viu
invlist_clone|5.015001||cViu
_invlist_contains_cp|5.017003||Vniu
invlist_contents|5.023008||Viu
_invlist_dump|5.019003||cViu
_invlistEQ|5.023006||cViu
invlist_extend|5.013010||Viu
invlist_highest|5.017002||Vniu
_invlist_intersection|5.015001||Viu
_invlist_intersection_maybe_complement_2nd|5.015008||cViu
_invlist_invert|5.015001||cViu
invlist_is_iterating|5.017008||Vniu
invlist_iterfinish|5.017008||Vniu
invlist_iterinit|5.015001||Vniu
invlist_iternext|5.015001||Vniu
_invlist_len|5.017004||Vniu
invlist_lowest|5.031007||xVniu
invlist_max|5.013010||Vniu
invlist_previous_index|5.017004||Vniu
invlist_replace_list_destroys_src|5.023009||Viu
_invlist_search|5.017003||cVniu
invlist_set_len|5.013010||Viu
invlist_set_previous_index|5.017004||Vniu
_invlist_subtract|5.015001||Viu
invlist_trim|5.013010||Vniu
_invlist_union|5.015001||cVu
_invlist_union_maybe_complement_2nd|5.015008||cViu
invmap_dump|5.031006||Viu
invoke_exception_hook|5.013001||Viu
IoANY|5.006001||Viu
IoBOTTOM_GV|5.003007||Viu
IoBOTTOM_NAME|5.003007||Viu
io_close|5.003007||Viu
IOCPARM_LEN|5.003007||Viu
ioctl|5.005000||Viu
IoDIRP|5.003007||Viu
IOf_ARGV|5.003007||Viu
IOf_DIDTOP|5.003007||Viu
IOf_FAKE_DIRP|5.006000||Viu
IOf_FLUSH|5.003007||Viu
IoFLAGS|5.003007||Viu
IoFMT_GV|5.003007||Viu
IoFMT_NAME|5.003007||Viu
IOf_NOLINE|5.005003||Viu
IOf_START|5.003007||Viu
IOf_UNTAINT|5.003007||Viu
IoIFP|5.003007||Viu
IoLINES|5.003007||Viu
IoLINES_LEFT|5.003007||Viu
IoOFP|5.003007||Viu
IoPAGE|5.003007||Viu
IoPAGE_LEN|5.003007||Viu
IoTOP_GV|5.003007||Viu
IoTOP_NAME|5.003007||Viu
IoTYPE|5.003007||Viu
IoTYPE_APPEND|5.006001||Viu
IoTYPE_CLOSED|5.006001||Viu
IoTYPE_IMPLICIT|5.008001||Viu
IoTYPE_NUMERIC|5.008001||Viu
IoTYPE_PIPE|5.006001||Viu
IoTYPE_RDONLY|5.006001||Viu
IoTYPE_RDWR|5.006001||Viu
IoTYPE_SOCKET|5.006001||Viu
IoTYPE_STD|5.006001||Viu
IoTYPE_WRONLY|5.006001||Viu
I_POLL|5.006000|5.006000|Vn
I_PTHREAD|5.005003|5.005003|Vn
I_PWD|5.003007|5.003007|Vn
isALNUM|5.003007|5.003007|p
isALNUM_A|5.031003|5.003007|p
isALNUMC|5.006000|5.003007|p
isALNUMC_A|5.013006|5.003007|p
isALNUMC_L1|5.013006|5.003007|p
isALNUMC_LC|5.006000|5.006000|
isALNUMC_LC_utf8_safe|5.031007||Viu
isALNUMC_LC_uvchr|5.017007|5.017007|
isALNUMC_uni|5.017007||Viu
isALNUMC_utf8|5.017007||Viu
isALNUMC_utf8_safe|5.031007||Viu
isALNUM_lazy_if_safe|5.031007||Viu
isALNUM_LC|5.004000|5.004000|
isALNUM_LC_utf8|5.006000||Viu
isALNUM_LC_utf8_safe|5.031007||Viu
isALNUM_LC_uvchr|5.007001|5.007001|
isALNUMU|5.011005||Viu
isALNUM_uni|5.006000||Viu
isALNUM_utf8|5.006000||Viu
isALNUM_utf8_safe|5.031007||Viu
isa_lookup|5.005000||Viu
isALPHA|5.003007|5.003007|p
isALPHA_A|5.013006|5.003007|p
isALPHA_FOLD_EQ|5.021004||Viu
isALPHA_FOLD_NE|5.021004||Viu
isALPHA_L1|5.013006|5.003007|p
isALPHA_LC|5.004000|5.004000|
isALPHA_LC_utf8|5.006000||Viu
isALPHA_LC_utf8_safe|5.025009|5.006000|p
isALPHA_LC_uvchr|5.007001|5.007001|
isALPHANUMERIC|5.017008|5.003007|p
isALPHANUMERIC_A|5.017008|5.003007|p
isALPHANUMERIC_L1|5.017008|5.003007|p
isALPHANUMERIC_LC|5.017008|5.004000|p
isALPHANUMERIC_LC_utf8|5.017008||Viu
isALPHANUMERIC_LC_utf8_safe|5.025009|5.006000|p
isALPHANUMERIC_LC_uvchr|5.017008|5.017008|
isALPHANUMERIC_uni|5.017008||Viu
isALPHANUMERIC_utf8|5.031005|5.031005|
isALPHANUMERIC_utf8_safe|5.025009|5.006000|p
isALPHANUMERIC_uvchr|5.023009|5.006000|p
isALPHAU|5.011005||Viu
isALPHA_uni|5.006000||Viu
isALPHA_utf8|5.031005|5.031005|
isALPHA_utf8_safe|5.025009|5.006000|p
isALPHA_uvchr|5.023009|5.006000|p
is_an_int|5.005000||Viu
is_ANYOF_SYNTHETIC|5.019009||Viu
IS_ANYOF_TRIE|5.009005||Viu
isASCII|5.006000|5.003007|p
isASCII_A|5.013006|5.003007|p
isASCII_L1|5.015004|5.003007|p
isASCII_LC|5.015008|5.003007|p
isASCII_LC_utf8|5.017007||Viu
isASCII_LC_utf8_safe|5.025009|5.025009|
isASCII_LC_uvchr|5.017007|5.017007|
is_ascii_string|5.011000|5.011000|n
isASCII_uni|5.006000||Viu
isASCII_utf8|5.031005|5.031005|
isASCII_utf8_safe|5.025009|5.003007|p
isASCII_uvchr|5.023009|5.003007|p
isatty|5.005000||Viu
ISA_VERSION_OBJ|5.019008||Viu
isBLANK|5.006001|5.003007|p
isBLANK_A|5.013006|5.003007|p
isBLANK_L1|5.013006|5.003007|p
isBLANK_LC|5.006001|5.003007|p
isBLANK_LC_uni|5.006001||Viu
isBLANK_LC_utf8|5.006001||Viu
isBLANK_LC_utf8_safe|5.025009|5.006000|p
isBLANK_LC_uvchr|5.017007|5.017007|
isBLANK_uni|5.006001||Viu
isBLANK_utf8|5.031005|5.031005|
isBLANK_utf8_safe|5.025009|5.006000|p
isBLANK_uvchr|5.023009|5.006000|p
isC9_STRICT_UTF8_CHAR|5.025005|5.025005|n
is_c9strict_utf8_string|5.025006|5.025006|n
is_c9strict_utf8_string_loc|5.025006|5.025006|n
is_c9strict_utf8_string_loclen|5.025006|5.025006|n
isCHARNAME_CONT|5.011005||Viu
isCNTRL|5.006000|5.003007|p
isCNTRL_A|5.013006|5.003007|p
isCNTRL_L1|5.013006|5.003007|p
isCNTRL_LC|5.006000|5.006000|
isCNTRL_LC_utf8|5.006000||Viu
isCNTRL_LC_utf8_safe|5.025009|5.006000|p
isCNTRL_LC_uvchr|5.007001|5.007001|
isCNTRL_uni|5.006000||Viu
isCNTRL_utf8|5.031005|5.031005|
isCNTRL_utf8_safe|5.025009|5.006000|p
isCNTRL_uvchr|5.023009|5.006000|p
_is_cur_LC_category_utf8|5.021001||cVu
isDEBUG_WILDCARD|5.031011||Viu
isDIGIT|5.003007|5.003007|p
isDIGIT_A|5.013006|5.003007|p
isDIGIT_L1|5.013006|5.003007|p
isDIGIT_LC|5.004000|5.004000|
isDIGIT_LC_utf8|5.006000||Viu
isDIGIT_LC_utf8_safe|5.025009|5.006000|p
isDIGIT_LC_uvchr|5.007001|5.007001|
isDIGIT_uni|5.006000||Viu
isDIGIT_utf8|5.031005|5.031005|
isDIGIT_utf8_safe|5.025009|5.006000|p
isDIGIT_uvchr|5.023009|5.006000|p
isEXACTFish|5.033003||Viu
isEXACT_REQ8|5.033003||Viu
isFF_overlong|5.035004||Vniu
is_FOLDS_TO_MULTI_utf8|5.019009||Viu
isFOO_lc|5.017007||Viu
isFOO_utf8_lc|5.017008||Viu
isGCB|5.021009||Viu
isGRAPH|5.006000|5.003007|p
isGRAPH_A|5.013006|5.003007|p
is_grapheme|5.031007||Viu
isGRAPH_L1|5.013006|5.003007|p
isGRAPH_LC|5.006000|5.006000|
isGRAPH_LC_utf8|5.006000||Viu
isGRAPH_LC_utf8_safe|5.025009|5.006000|p
isGRAPH_LC_uvchr|5.007001|5.007001|
isGRAPH_uni|5.006000||Viu
isGRAPH_utf8|5.031005|5.031005|
isGRAPH_utf8_safe|5.025009|5.006000|p
isGRAPH_uvchr|5.023009|5.006000|p
isGV|5.003007||Viu
isGV_or_RVCV|5.027005||Viu
isGV_with_GP|5.009004|5.003007|p
isGV_with_GP_off|5.009005||Viu
isGV_with_GP_on|5.009005||Viu
I_SHADOW|5.006000|5.006000|Vn
is_handle_constructor|5.006000||Vniu
is_HANGUL_ED_utf8_safe|5.029001||Viu
is_HORIZWS_cp_high|5.017006||Viu
is_HORIZWS_high|5.017006||Viu
isIDCONT|5.017008|5.003007|p
isIDCONT_A|5.017008|5.003007|p
isIDCONT_L1|5.017008|5.003007|p
isIDCONT_LC|5.017008|5.004000|p
isIDCONT_LC_utf8|5.017008||Viu
isIDCONT_LC_utf8_safe|5.025009|5.006000|p
isIDCONT_LC_uvchr|5.017008|5.017008|
isIDCONT_uni|5.017008||Viu
isIDCONT_utf8|5.031005|5.031005|
isIDCONT_utf8_safe|5.025009|5.006000|p
isIDCONT_uvchr|5.023009|5.006000|p
isIDFIRST|5.003007|5.003007|p
isIDFIRST_A|5.013006|5.003007|p
isIDFIRST_L1|5.013006|5.003007|p
isIDFIRST_lazy_if_safe|5.025009||Viu
isIDFIRST_LC|5.004000|5.004000|p
isIDFIRST_LC_utf8|5.006000||Viu
isIDFIRST_LC_utf8_safe|5.025009|5.006000|p
isIDFIRST_LC_uvchr|5.007001|5.007001|
isIDFIRST_uni|5.006000||Viu
isIDFIRST_utf8|5.031005|5.031005|
isIDFIRST_utf8_safe|5.025009|5.006000|p
isIDFIRST_uvchr|5.023009|5.006000|p
isinfnan|5.021004|5.021004|n
isinfnansv|5.021005||Vi
_is_in_locale_category|5.021001||cViu
IS_IN_SOME_FOLD_L1|5.033005||Viu
is_invariant_string|5.021007|5.011000|pn
is_invlist|5.029002||Vniu
is_LARGER_NON_CHARS_utf8|5.035003||Viu
is_LAX_VERSION|5.011004||Viu
isLB|5.023007||Viu
isLEXWARN_off|5.006000||Viu
isLEXWARN_on|5.006000||Viu
is_LNBREAK_latin1_safe|5.009005||Viu
is_LNBREAK_safe|5.009005||Viu
is_LNBREAK_utf8_safe|5.009005||Viu
isLOWER|5.003007|5.003007|p
isLOWER_A|5.013006|5.003007|p
isLOWER_L1|5.013006|5.003007|p
isLOWER_LC|5.004000|5.004000|
isLOWER_LC_utf8|5.006000||Viu
isLOWER_LC_utf8_safe|5.025009|5.006000|p
isLOWER_LC_uvchr|5.007001|5.007001|
isLOWER_uni|5.006000||Viu
isLOWER_utf8|5.031005|5.031005|
isLOWER_utf8_safe|5.025009|5.006000|p
isLOWER_uvchr|5.023009|5.006000|p
is_lvalue_sub|5.007001|5.007001|u
isMNEMONIC_CNTRL|5.031009||Viu
is_MULTI_CHAR_FOLD_latin1_safe|5.019010||Viu
is_MULTI_CHAR_FOLD_utf8_safe|5.019010||Viu
is_MULTI_CHAR_FOLD_utf8_safe_part0|5.019010||Viu
is_MULTI_CHAR_FOLD_utf8_safe_part1|5.019010||Viu
is_MULTI_CHAR_FOLD_utf8_safe_part2|5.025008||Viu
is_MULTI_CHAR_FOLD_utf8_safe_part3|5.025008||Viu
is_NONCHAR_utf8_safe|5.025005||Viu
IS_NON_FINAL_FOLD|5.033005||Viu
isnormal|5.021004||Viu
IS_NUMBER_GREATER_THAN_UV_MAX|5.007002|5.003007|p
IS_NUMBER_INFINITY|5.007002|5.003007|p
IS_NUMBER_IN_UV|5.007002|5.003007|p
IS_NUMBER_NAN|5.007003|5.003007|p
IS_NUMBER_NEG|5.007002|5.003007|p
IS_NUMBER_NOT_INT|5.007002|5.003007|p
IS_NUMBER_TRAILING|5.021002||Viu
IS_NUMERIC_RADIX|5.006000||Viu
isOCTAL|5.013005|5.003007|p
isOCTAL_A|5.013006|5.003007|p
isOCTAL_L1|5.013006|5.003007|p
IS_PADCONST|5.006000||Viu
IS_PADGV|5.006000||Viu
is_PATWS_safe|5.017008||Viu
isPOWER_OF_2|5.029006||Viu
isPRINT|5.004000|5.003007|p
isPRINT_A|5.013006|5.003007|p
isPRINT_L1|5.013006|5.003007|p
isPRINT_LC|5.004000|5.004000|
isPRINT_LC_utf8|5.006000||Viu
isPRINT_LC_utf8_safe|5.025009|5.006000|p
isPRINT_LC_uvchr|5.007001|5.007001|
isPRINT_uni|5.006000||Viu
isPRINT_utf8|5.031005|5.031005|
isPRINT_utf8_safe|5.025009|5.006000|p
isPRINT_uvchr|5.023009|5.006000|p
is_PROBLEMATIC_LOCALE_FOLD_cp|5.019009||Viu
is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp|5.019009||Viu
is_PROBLEMATIC_LOCALE_FOLDEDS_START_utf8|5.019009||Viu
is_PROBLEMATIC_LOCALE_FOLD_utf8|5.019009||Viu
isPSXSPC|5.006001|5.003007|p
isPSXSPC_A|5.013006|5.003007|p
isPSXSPC_L1|5.013006|5.003007|p
isPSXSPC_LC|5.006001|5.006001|
isPSXSPC_LC_utf8|5.006001||Viu
isPSXSPC_LC_utf8_safe|5.025009|5.006000|p
isPSXSPC_LC_uvchr|5.017007|5.017007|
isPSXSPC_uni|5.006001||Viu
isPSXSPC_utf8|5.031005|5.031005|
isPSXSPC_utf8_safe|5.025009|5.006000|p
isPSXSPC_uvchr|5.023009|5.006000|p
isPUNCT|5.006000|5.003007|p
isPUNCT_A|5.013006|5.003007|p
isPUNCT_L1|5.013006|5.003007|p
isPUNCT_LC|5.006000|5.006000|
isPUNCT_LC_utf8|5.006000||Viu
isPUNCT_LC_utf8_safe|5.025009|5.006000|p
isPUNCT_LC_uvchr|5.007001|5.007001|
isPUNCT_uni|5.006000||Viu
isPUNCT_utf8|5.031005|5.031005|
isPUNCT_utf8_safe|5.025009|5.006000|p
isPUNCT_uvchr|5.023009|5.006000|p
is_QUOTEMETA_high|5.017004||Viu
isREGEXP|5.017006||Viu
IS_SAFE_PATHNAME|5.019004||Viu
IS_SAFE_SYSCALL|5.019004|5.019004|
is_safe_syscall|5.019004|5.019004|
isSB|5.021009||Viu
isSCRIPT_RUN|5.027008||cVi
is_SHORTER_NON_CHARS_utf8|5.035003||Viu
isSPACE|5.003007|5.003007|p
isSPACE_A|5.013006|5.003007|p
isSPACE_L1|5.013006|5.003007|p
isSPACE_LC|5.004000|5.004000|
isSPACE_LC_utf8|5.006000||Viu
isSPACE_LC_utf8_safe|5.025009|5.006000|p
isSPACE_LC_uvchr|5.007001|5.007001|
isSPACE_uni|5.006000||Viu
isSPACE_utf8|5.031005|5.031005|
isSPACE_utf8_safe|5.025009|5.006000|p
isSPACE_uvchr|5.023009|5.006000|p
is_ssc_worth_it|5.021005||Vniu
isSTRICT_UTF8_CHAR|5.025005|5.025005|n
is_strict_utf8_string|5.025006|5.025006|n
is_strict_utf8_string_loc|5.025006|5.025006|n
is_strict_utf8_string_loclen|5.025006|5.025006|n
is_STRICT_VERSION|5.011004||Viu
is_SURROGATE_utf8|5.035004||Viu
is_SURROGATE_utf8_safe|5.025005||Viu
I_STDARG|5.003007||Viu
I_STDBOOL|5.015003|5.015003|Vn
I_STDINT|5.021004|5.021004|Vn
is_THREE_CHAR_FOLD_HEAD_latin1_safe|5.031007||Viu
is_THREE_CHAR_FOLD_HEAD_utf8_safe|5.031007||Viu
is_THREE_CHAR_FOLD_latin1_safe|5.031007||Viu
is_THREE_CHAR_FOLD_utf8_safe|5.031007||Viu
IS_TRIE_AC|5.009005||Viu
isUNICODE_POSSIBLY_PROBLEMATIC|5.035004||Viu
_is_uni_FOO|5.017008||cVu
_is_uni_perl_idcont|5.017008||cVu
_is_uni_perl_idstart|5.017007||cVu
isUPPER|5.003007|5.003007|p
isUPPER_A|5.013006|5.003007|p
isUPPER_L1|5.013006|5.003007|p
isUPPER_LC|5.004000|5.004000|
isUPPER_LC_utf8|5.006000||Viu
isUPPER_LC_utf8_safe|5.025009|5.006000|p
isUPPER_LC_uvchr|5.007001|5.007001|
isUPPER_uni|5.006000||Viu
isUPPER_utf8|5.031005|5.031005|
isUPPER_utf8_safe|5.025009|5.006000|p
isUPPER_uvchr|5.023009|5.006000|p
is_utf8_char|5.006000|5.006000|dn
IS_UTF8_CHAR|5.009003||Viu
isUTF8_CHAR|5.021001|5.006001|pn
is_utf8_char_buf|5.015008|5.015008|n
isUTF8_CHAR_flags|5.025005|5.025005|n
is_utf8_char_helper_|5.035004||cVnu
is_utf8_common|5.009003||Viu
is_utf8_FF_helper_|5.035004||cVnu
is_utf8_fixed_width_buf_flags|5.025006|5.025006|n
is_utf8_fixed_width_buf_loc_flags|5.025006|5.025006|n
is_utf8_fixed_width_buf_loclen_flags|5.025006|5.025006|n
_is_utf8_FOO|5.031006||cVu
is_utf8_invariant_string|5.025005|5.011000|pn
is_utf8_invariant_string_loc|5.027001|5.027001|n
is_utf8_non_invariant_string|5.027007||cVni
is_utf8_overlong|5.035004||Vniu
_is_utf8_perl_idcont|5.031006||cVu
_is_utf8_perl_idstart|5.031006||cVu
isUTF8_POSSIBLY_PROBLEMATIC|5.023003||Viu
is_utf8_string|5.006001|5.006001|n
is_utf8_string_flags|5.025006|5.025006|n
is_utf8_string_loc|5.008001|5.008001|n
is_utf8_string_loc_flags|5.025006|5.025006|n
is_utf8_string_loclen|5.009003|5.009003|n
is_utf8_string_loclen_flags|5.025006|5.025006|n
is_utf8_valid_partial_char|5.025005|5.025005|n
is_utf8_valid_partial_char_flags|5.025005|5.025005|n
is_VERTWS_cp_high|5.017006||Viu
is_VERTWS_high|5.017006||Viu
isVERTWS_uni|5.017006||Viu
isVERTWS_utf8|5.017006||Viu
isVERTWS_utf8_safe|5.025009||Viu
isVERTWS_uvchr|5.023009||Viu
isWARNf_on|5.006001||Viu
isWARN_on|5.006000||Viu
isWARN_ONCE|5.006000||Viu
isWB|5.021009||Viu
isWORDCHAR|5.013006|5.003007|p
isWORDCHAR_A|5.013006|5.003007|p
isWORDCHAR_L1|5.013006|5.003007|p
isWORDCHAR_lazy_if_safe|5.025009||Viu
isWORDCHAR_LC|5.017007|5.004000|p
isWORDCHAR_LC_utf8|5.017007||Viu
isWORDCHAR_LC_utf8_safe|5.025009|5.006000|p
isWORDCHAR_LC_uvchr|5.017007|5.017007|
isWORDCHAR_uni|5.017006||Viu
isWORDCHAR_utf8|5.031005|5.031005|
isWORDCHAR_utf8_safe|5.025009|5.006000|p
isWORDCHAR_uvchr|5.023009|5.006000|p
isXDIGIT|5.006000|5.003007|p
isXDIGIT_A|5.013006|5.003007|p
is_XDIGIT_cp_high|5.017006||Viu
is_XDIGIT_high|5.017006||Viu
isXDIGIT_L1|5.013006|5.003007|p
isXDIGIT_LC|5.017007|5.003007|p
isXDIGIT_LC_utf8|5.017007||Viu
isXDIGIT_LC_utf8_safe|5.025009|5.006000|p
isXDIGIT_LC_uvchr|5.017007|5.017007|
isXDIGIT_uni|5.006000||Viu
isXDIGIT_utf8|5.031005|5.031005|
isXDIGIT_utf8_safe|5.025009|5.006000|p
isXDIGIT_uvchr|5.023009|5.006000|p
is_XPERLSPACE_cp_high|5.017006||Viu
is_XPERLSPACE_high|5.017006||Viu
I_SYS_DIR|5.003007|5.003007|Vn
I_SYS_FILE|5.003007|5.003007|Vn
I_SYS_IOCTL|5.003007|5.003007|Vn
I_SYSLOG|5.006000|5.006000|Vn
I_SYS_MOUNT|5.023005|5.023005|Vn
I_SYS_PARAM|5.003007|5.003007|Vn
I_SYS_POLL|5.010001|5.010001|Vn
I_SYS_RESOURCE|5.003007|5.003007|Vn
I_SYS_SELECT|5.003007|5.003007|Vn
I_SYS_STAT|5.003007|5.003007|Vn
I_SYS_STATFS|5.023005|5.023005|Vn
I_SYS_STATVFS|5.023005|5.023005|Vn
I_SYS_TIME|5.003007|5.003007|Vn
I_SYS_TIMES|5.003007|5.003007|Vn
I_SYS_TYPES|5.003007|5.003007|Vn
I_SYSUIO|5.006000|5.006000|Vn
I_SYS_UN|5.003007|5.003007|Vn
I_SYSUTSNAME|5.006000|5.006000|Vn
I_SYS_VFS|5.023005|5.023005|Vn
I_SYS_WAIT|5.003007|5.003007|Vn
items||5.003007|
I_TERMIOS|5.003007|5.003007|Vn
I_TIME|5.003007|5.003007|Vn
I_UNISTD|5.003007|5.003007|Vn
I_USTAT|5.023005|5.023005|Vn
I_UTIME|5.003007|5.003007|Vn
I_V|5.006000|5.003007|
IVdf|5.006000|5.003007|poVn
IV_DIG|5.006000||Viu
IV_IS_QUAD|5.006000||Viu
IV_MAX|5.003007|5.003007|
IV_MAX_P1|5.007002||Viu
IV_MIN|5.003007|5.003007|
IVSIZE|5.006000|5.003007|poVn
IVTYPE|5.006000|5.003007|poVn
I_WCHAR|5.027006|5.027006|Vn
I_WCTYPE|5.029009|5.029009|Vn
ix||5.003007|
I_XLOCALE|5.025004|5.025004|Vn
JE_OLD_STACK_HWM_restore|5.027002||Viu
JE_OLD_STACK_HWM_save|5.027002||Viu
JE_OLD_STACK_HWM_zero|5.027002||Viu
jmaybe|5.003007||Viu
JMPENV_BOOTSTRAP|5.006000||Viu
JMPENV_JUMP|5.004000|5.004000|
JMPENV_POP|5.004000||Viu
JMPENV_PUSH|5.004000||Viu
JOIN|5.005000||Viu
join_exact|5.009004||Viu
kBINOP|5.003007||Viu
kCOP|5.003007||Viu
KEEPCOPY_PAT_MOD|5.009005||Viu
KEEPCOPY_PAT_MODS|5.009005||Viu
KEEPS|5.009005||Viu
KEEPS_next|5.009005||Viu
KEEPS_next_fail|5.009005||Viu
KEEPS_next_fail_t8|5.035004||Viu
KEEPS_next_fail_t8_p8|5.033003||Viu
KEEPS_next_fail_t8_pb|5.033003||Viu
KEEPS_next_fail_tb|5.035004||Viu
KEEPS_next_fail_tb_p8|5.033003||Viu
KEEPS_next_fail_tb_pb|5.033003||Viu
KEEPS_next_t8|5.035004||Viu
KEEPS_next_t8_p8|5.033003||Viu
KEEPS_next_t8_pb|5.033003||Viu
KEEPS_next_tb|5.035004||Viu
KEEPS_next_tb_p8|5.033003||Viu
KEEPS_next_tb_pb|5.033003||Viu
KEEPS_t8|5.035004||Viu
KEEPS_t8_p8|5.033003||Viu
KEEPS_t8_pb|5.033003||Viu
KEEPS_tb|5.035004||Viu
KEEPS_tb_p8|5.033003||Viu
KEEPS_tb_pb|5.033003||Viu
KELVIN_SIGN|5.017003||Viu
KERNEL|5.003007||Viu
KEY_abs|5.003007||Viu
KEY_accept|5.003007||Viu
KEY_alarm|5.003007||Viu
KEY_and|5.003007||Viu
KEY_atan2|5.003007||Viu
KEY_AUTOLOAD|5.003007||Viu
KEY_BEGIN|5.003007||Viu
KEY_bind|5.003007||Viu
KEY_binmode|5.003007||Viu
KEY_bless|5.003007||Viu
KEY_break|5.027008||Viu
KEY_caller|5.003007||Viu
KEY_catch|5.033007||Viu
KEY_chdir|5.003007||Viu
KEY_CHECK|5.006000||Viu
KEY_chmod|5.003007||Viu
KEY_chomp|5.003007||Viu
KEY_chop|5.003007||Viu
KEY_chown|5.003007||Viu
KEY_chr|5.003007||Viu
KEY_chroot|5.003007||Viu
KEY_close|5.003007||Viu
KEY_closedir|5.003007||Viu
KEY_cmp|5.003007||Viu
KEY_connect|5.003007||Viu
KEY_continue|5.003007||Viu
KEY_cos|5.003007||Viu
KEY_crypt|5.003007||Viu
KEY___DATA|5.003007||Viu
KEY_dbmclose|5.003007||Viu
KEY_dbmopen|5.003007||Viu
KEY_default|5.027008||Viu
KEY_defer|5.035004||Viu
KEY_defined|5.003007||Viu
KEY_delete|5.003007||Viu
KEY_DESTROY|5.003007||Viu
KEY_die|5.003007||Viu
KEY_do|5.003007||Viu
KEY_dump|5.003007||Viu
KEY_each|5.003007||Viu
KEY_else|5.003007||Viu
KEY_elsif|5.003007||Viu
KEY___END|5.003007||Viu
KEY_END|5.003007||Viu
KEY_endgrent|5.003007||Viu
KEY_endhostent|5.003007||Viu
KEY_endnetent|5.003007||Viu
KEY_endprotoent|5.003007||Viu
KEY_endpwent|5.003007||Viu
KEY_endservent|5.003007||Viu
KEY_eof|5.003007||Viu
KEY_eq|5.003007||Viu
KEY_eval|5.003007||Viu
KEY_evalbytes|5.015005||Viu
KEY_exec|5.003007||Viu
KEY_exists|5.003007||Viu
KEY_exit|5.003007||Viu
KEY_exp|5.003007||Viu
KEY_fc|5.015008||Viu
KEY_fcntl|5.003007||Viu
KEY___FILE|5.003007||Viu
KEY_fileno|5.003007||Viu
KEY_finally|5.035008||Viu
KEY_flock|5.003007||Viu
KEY_for|5.003007||Viu
KEY_foreach|5.003007||Viu
KEY_fork|5.003007||Viu
KEY_format|5.003007||Viu
KEY_formline|5.003007||Viu
KEY_ge|5.003007||Viu
KEY_getc|5.003007||Viu
KEY_getgrent|5.003007||Viu
KEY_getgrgid|5.003007||Viu
KEY_getgrnam|5.003007||Viu
KEY_gethostbyaddr|5.003007||Viu
KEY_gethostbyname|5.003007||Viu
KEY_gethostent|5.003007||Viu
KEY_getlogin|5.003007||Viu
KEY_getnetbyaddr|5.003007||Viu
KEY_getnetbyname|5.003007||Viu
KEY_getnetent|5.003007||Viu
KEY_getpeername|5.003007||Viu
KEY_getpgrp|5.003007||Viu
KEY_getppid|5.003007||Viu
KEY_getpriority|5.003007||Viu
KEY_getprotobyname|5.003007||Viu
KEY_getprotobynumber|5.003007||Viu
KEY_getprotoent|5.003007||Viu
KEY_getpwent|5.003007||Viu
KEY_getpwnam|5.003007||Viu
KEY_getpwuid|5.003007||Viu
KEY_getservbyname|5.003007||Viu
KEY_getservbyport|5.003007||Viu
KEY_getservent|5.003007||Viu
KEY_getsockname|5.003007||Viu
KEY_getsockopt|5.003007||Viu
KEY_getspnam|5.031011||Viu
KEY_given|5.009003||Viu
KEY_glob|5.003007||Viu
KEY_gmtime|5.003007||Viu
KEY_goto|5.003007||Viu
KEY_grep|5.003007||Viu
KEY_gt|5.003007||Viu
KEY_hex|5.003007||Viu
KEY_if|5.003007||Viu
KEY_index|5.003007||Viu
KEY_INIT|5.005000||Viu
KEY_int|5.003007||Viu
KEY_ioctl|5.003007||Viu
KEY_isa|5.031007||Viu
KEY_join|5.003007||Viu
KEY_keys|5.003007||Viu
KEY_kill|5.003007||Viu
KEY_last|5.003007||Viu
KEY_lc|5.003007||Viu
KEY_lcfirst|5.003007||Viu
KEY_le|5.003007||Viu
KEY_length|5.003007||Viu
KEY___LINE|5.003007||Viu
KEY_link|5.003007||Viu
KEY_listen|5.003007||Viu
KEY_local|5.003007||Viu
KEY_localtime|5.003007||Viu
KEY_lock|5.005000||Viu
KEY_log|5.003007||Viu
KEY_lstat|5.003007||Viu
KEY_lt|5.003007||Viu
KEY_m|5.003007||Viu
KEY_map|5.003007||Viu
KEY_mkdir|5.003007||Viu
KEY_msgctl|5.003007||Viu
KEY_msgget|5.003007||Viu
KEY_msgrcv|5.003007||Viu
KEY_msgsnd|5.003007||Viu
KEY_my|5.003007||Viu
KEY_ne|5.003007||Viu
KEY_next|5.003007||Viu
KEY_no|5.003007||Viu
KEY_not|5.003007||Viu
KEY_NULL|5.003007||Viu
KEY_oct|5.003007||Viu
KEY_open|5.003007||Viu
KEY_opendir|5.003007||Viu
KEY_or|5.003007||Viu
KEY_ord|5.003007||Viu
KEY_our|5.006000||Viu
KEY_pack|5.003007||Viu
KEY_package|5.003007||Viu
KEY___PACKAGE|5.004000||Viu
KEY_pipe|5.003007||Viu
KEY_pop|5.003007||Viu
KEY_pos|5.003007||Viu
KEY_print|5.003007||Viu
KEY_printf|5.003007||Viu
KEY_prototype|5.003007||Viu
KEY_push|5.003007||Viu
KEY_q|5.003007||Viu
KEY_qq|5.003007||Viu
KEY_qr|5.005000||Viu
KEY_quotemeta|5.003007||Viu
KEY_qw|5.003007||Viu
KEY_qx|5.003007||Viu
KEY_rand|5.003007||Viu
KEY_read|5.003007||Viu
KEY_readdir|5.003007||Viu
KEY_readline|5.003007||Viu
KEY_readlink|5.003007||Viu
KEY_readpipe|5.003007||Viu
KEY_recv|5.003007||Viu
KEY_redo|5.003007||Viu
KEY_ref|5.003007||Viu
KEY_rename|5.003007||Viu
KEY_require|5.003007||Viu
KEY_reset|5.003007||Viu
KEY_return|5.003007||Viu
KEY_reverse|5.003007||Viu
KEY_rewinddir|5.003007||Viu
KEY_rindex|5.003007||Viu
KEY_rmdir|5.003007||Viu
KEY_s|5.003007||Viu
KEY_say|5.009003||Viu
KEY_scalar|5.003007||Viu
KEY_seek|5.003007||Viu
KEY_seekdir|5.003007||Viu
KEY_select|5.003007||Viu
KEY_semctl|5.003007||Viu
KEY_semget|5.003007||Viu
KEY_semop|5.003007||Viu
KEY_send|5.003007||Viu
KEY_setgrent|5.003007||Viu
KEY_sethostent|5.003007||Viu
KEY_setnetent|5.003007||Viu
KEY_setpgrp|5.003007||Viu
KEY_setpriority|5.003007||Viu
KEY_setprotoent|5.003007||Viu
KEY_setpwent|5.003007||Viu
KEY_setservent|5.003007||Viu
KEY_setsockopt|5.003007||Viu
KEY_shift|5.003007||Viu
KEY_shmctl|5.003007||Viu
KEY_shmget|5.003007||Viu
KEY_shmread|5.003007||Viu
KEY_shmwrite|5.003007||Viu
KEY_shutdown|5.003007||Viu
KEY_sigvar|5.025004||Viu
KEY_sin|5.003007||Viu
KEY_sleep|5.003007||Viu
KEY_socket|5.003007||Viu
KEY_socketpair|5.003007||Viu
KEY_sort|5.003007||Viu
KEY_splice|5.003007||Viu
KEY_split|5.003007||Viu
KEY_sprintf|5.003007||Viu
KEY_sqrt|5.003007||Viu
KEY_srand|5.003007||Viu
KEY_stat|5.003007||Viu
KEY_state|5.009004||Viu
KEY_study|5.003007||Viu
KEY_sub|5.003007||Viu
KEY___SUB|5.015006||Viu
KEY_substr|5.003007||Viu
KEY_symlink|5.003007||Viu
KEY_syscall|5.003007||Viu
KEY_sysopen|5.003007||Viu
KEY_sysread|5.003007||Viu
KEY_sysseek|5.004000||Viu
KEY_system|5.003007||Viu
KEY_syswrite|5.003007||Viu
KEY_tell|5.003007||Viu
KEY_telldir|5.003007||Viu
KEY_tie|5.003007||Viu
KEY_tied|5.003007||Viu
KEY_time|5.003007||Viu
KEY_times|5.003007||Viu
KEY_tr|5.003007||Viu
KEY_truncate|5.003007||Viu
KEY_try|5.033007||Viu
KEY_uc|5.003007||Viu
KEY_ucfirst|5.003007||Viu
KEY_umask|5.003007||Viu
KEY_undef|5.003007||Viu
KEY_UNITCHECK|5.009005||Viu
KEY_unless|5.003007||Viu
KEY_unlink|5.003007||Viu
KEY_unpack|5.003007||Viu
KEY_unshift|5.003007||Viu
KEY_untie|5.003007||Viu
KEY_until|5.003007||Viu
KEY_use|5.003007||Viu
KEY_utime|5.003007||Viu
KEY_values|5.003007||Viu
KEY_vec|5.003007||Viu
KEY_wait|5.003007||Viu
KEY_waitpid|5.003007||Viu
KEY_wantarray|5.003007||Viu
KEY_warn|5.003007||Viu
KEY_when|5.027008||Viu
KEY_while|5.003007||Viu
keyword|5.003007||Viu
KEYWORD_PLUGIN_DECLINE|5.011002||Viu
KEYWORD_PLUGIN_EXPR|5.011002||Viu
KEYWORD_PLUGIN_MUTEX_INIT|5.027006||Viu
KEYWORD_PLUGIN_MUTEX_LOCK|5.027006||Viu
KEYWORD_PLUGIN_MUTEX_TERM|5.027006||Viu
KEYWORD_PLUGIN_MUTEX_UNLOCK|5.027006||Viu
keyword_plugin_standard|||iu
KEYWORD_PLUGIN_STMT|5.011002||Viu
KEY_write|5.003007||Viu
KEY_x|5.003007||Viu
KEY_xor|5.003007||Viu
KEY_y|5.003007||Viu
kGVOP_gv|5.006000||Viu
kill|5.005000||Viu
killpg|5.005000||Viu
kLISTOP|5.003007||Viu
kLOGOP|5.003007||Viu
kLOOP|5.003007||Viu
kPADOP|5.006000||Viu
kPMOP|5.003007||Viu
kPVOP|5.003007||Viu
kSVOP|5.003007||Viu
kSVOP_sv|5.006000||Viu
kUNOP|5.003007||Viu
kUNOP_AUX|5.021007||Viu
LATIN1_TO_NATIVE|5.019004|5.003007|p
LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE|5.013011||Viu
LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE_NATIVE|5.017004||Viu
LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE|5.023002||Viu
LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE_UTF8|5.023002||Viu
LATIN_CAPITAL_LETTER_SHARP_S|5.014000||Viu
LATIN_CAPITAL_LETTER_SHARP_S_UTF8|5.019001||Viu
LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS|5.013011||Viu
LATIN_SMALL_LETTER_A_WITH_RING_ABOVE|5.013011||Viu
LATIN_SMALL_LETTER_A_WITH_RING_ABOVE_NATIVE|5.017004||Viu
LATIN_SMALL_LETTER_DOTLESS_I|5.023002||Viu
LATIN_SMALL_LETTER_DOTLESS_I_UTF8|5.023002||Viu
LATIN_SMALL_LETTER_LONG_S|5.017003||Viu
LATIN_SMALL_LETTER_LONG_S_UTF8|5.019001||Viu
LATIN_SMALL_LETTER_SHARP_S|5.011002||Viu
LATIN_SMALL_LETTER_SHARP_S_NATIVE|5.017004||Viu
LATIN_SMALL_LETTER_SHARP_S_UTF8|5.033003||Viu
LATIN_SMALL_LETTER_Y_WITH_DIAERESIS|5.011002||Viu
LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE|5.017004||Viu
LATIN_SMALL_LIGATURE_LONG_S_T|5.019004||Viu
LATIN_SMALL_LIGATURE_LONG_S_T_UTF8|5.019004||Viu
LATIN_SMALL_LIGATURE_ST|5.019004||Viu
LATIN_SMALL_LIGATURE_ST_UTF8|5.019004||Viu
LB_BREAKABLE|5.023007||Viu
LB_CM_ZWJ_foo|5.025003||Viu
LB_HY_or_BA_then_foo|5.023007||Viu
LB_NOBREAK|5.023007||Viu
LB_NOBREAK_EVEN_WITH_SP_BETWEEN|5.023007||Viu
LB_PR_or_PO_then_OP_or_HY|5.023007||Viu
LB_RI_then_RI|5.025003||Viu
LB_SP_foo|5.023007||Viu
LB_SY_or_IS_then_various|5.023007||Viu
LB_various_then_PO_or_PR|5.023007||Viu
LC_NUMERIC_LOCK|5.027009||pVu
LC_NUMERIC_UNLOCK|5.027009||pVu
LDBL_DIG|5.006000||Viu
LEAVE|5.003007|5.003007|
leave_adjust_stacks|5.023008|5.023008|xu
leave_scope|5.003007|5.003007|u
LEAVE_SCOPE|5.003007||Viu
LEAVE_with_name|5.011002|5.011002|
LEXACT|5.031005||Viu
LEXACT_REQ8|5.031006||Viu
LEXACT_REQ8_t8|5.035004||Viu
LEXACT_REQ8_t8_p8|5.033003||Viu
LEXACT_REQ8_t8_pb|5.033003||Viu
LEXACT_REQ8_tb|5.035004||Viu
LEXACT_REQ8_tb_p8|5.033003||Viu
LEXACT_REQ8_tb_pb|5.033003||Viu
LEXACT_t8|5.035004||Viu
LEXACT_t8_p8|5.033003||Viu
LEXACT_t8_pb|5.033003||Viu
LEXACT_tb|5.035004||Viu
LEXACT_tb_p8|5.033003||Viu
LEXACT_tb_pb|5.033003||Viu
lex_bufutf8|5.011002|5.011002|x
lex_discard_to|5.011002|5.011002|x
LEX_DONT_CLOSE_RSFP|5.015009||Viu
LEX_EVALBYTES|5.015005||Viu
lex_grow_linestr|5.011002|5.011002|x
LEX_IGNORE_UTF8_HINTS|5.015005||Viu
LEX_KEEP_PREVIOUS|5.011002|5.011002|
lex_next_chunk|5.011002|5.011002|x
LEX_NOTPARSING|5.004004||Viu
lex_peek_unichar|5.011002|5.011002|x
lex_read_space|5.011002|5.011002|x
lex_read_to|5.011002|5.011002|x
lex_read_unichar|5.011002|5.011002|x
lex_start|5.013007|5.013007|x
LEX_START_COPIED|5.015005||Viu
LEX_START_FLAGS|5.015005||Viu
LEX_START_SAME_FILTER|5.014000||Viu
lex_stuff_pv|5.013006|5.013006|x
lex_stuff_pvn|5.011002|5.011002|x
lex_stuff_pvs|5.013005|5.013005|x
lex_stuff_sv|5.011002|5.011002|x
LEX_STUFF_UTF8|5.011002|5.011002|
lex_unstuff|5.011002|5.011002|x
LF_NATIVE|5.019004||Viu
LIB_INVARG|5.008001||Viu
LIBM_LIB_VERSION|5.009003|5.009003|Vn
LIKELY|5.009004|5.003007|p
link|5.006000||Viu
LINKLIST|5.013006|5.013006|
list|5.003007||Viu
listen|5.005000||Viu
listkids|5.003007||Viu
LNBREAK|5.009005||Viu
LNBREAK_t8|5.035004||Viu
LNBREAK_t8_p8|5.033003||Viu
LNBREAK_t8_pb|5.033003||Viu
LNBREAK_tb|5.035004||Viu
LNBREAK_tb_p8|5.033003||Viu
LNBREAK_tb_pb|5.033003||Viu
load_charnames|5.031010||cViu
load_module|5.006000|5.003007|pv
load_module_nocontext|5.013006|5.013006|vn
LOCALECONV_LOCK|5.033005||Viu
LOCALECONV_UNLOCK|5.033005||Viu
LOCALE_INIT|5.024000||Viu
LOCALE_INIT_LC_NUMERIC|5.033005||Viu
LOCALE_LOCK|5.024000||Viu
LOCALE_PAT_MOD|5.013006||Viu
LOCALE_PAT_MODS|5.013006||Viu
LOCALE_READ_LOCK|5.033005||Viu
LOCALE_READ_UNLOCK|5.033005||Viu
LOCALE_TERM|5.024000||Viu
LOCALE_TERM_LC_NUMERIC|5.033005||Viu
LOCALE_TERM_POSIX_2008|5.033005||Viu
LOCALE_UNLOCK|5.024000||Viu
localize|5.003007||Viu
LOCAL_PATCH_COUNT|5.003007||Viu
localtime|5.031011||Viu
LOCALTIME_MAX|5.010001|5.010001|Vn
LOCALTIME_MIN|5.010001|5.010001|Vn
LOCALTIME_R_NEEDS_TZSET|5.010000|5.010000|Vn
LOCALTIME_R_PROTO|5.008000|5.008000|Vn
LOCK_DOLLARZERO_MUTEX|5.008001||Viu
lockf|5.006000||Viu
LOCK_LC_NUMERIC_STANDARD|5.021010||poVnu
LOCK_NUMERIC_STANDARD|||piu
LOC_SED|5.003007|5.003007|Vn
LOGICAL|5.005000||Viu
LOGICAL_t8|5.035004||Viu
LOGICAL_t8_p8|5.033003||Viu
LOGICAL_t8_pb|5.033003||Viu
LOGICAL_tb|5.035004||Viu
LOGICAL_tb_p8|5.033003||Viu
LOGICAL_tb_pb|5.033003||Viu
LONGDBLINFBYTES|5.023000|5.023000|Vn
LONGDBLMANTBITS|5.023000|5.023000|Vn
LONGDBLNANBYTES|5.023000|5.023000|Vn
LONGDOUBLE_BIG_ENDIAN|5.021009||Viu
LONGDOUBLE_DOUBLEDOUBLE|5.021009||Viu
LONG_DOUBLE_EQUALS_DOUBLE|5.007001||Viu
LONG_DOUBLE_IS_DOUBLE|5.021003|5.021003|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_UNKNOWN_FORMAT|5.021003|5.021003|Vn
LONG_DOUBLE_IS_VAX_H_FLOAT|5.025004|5.025004|Vn
LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLEKIND|5.021003|5.021003|Vn
LONGDOUBLE_LITTLE_ENDIAN|5.021009||Viu
LONGDOUBLE_MIX_ENDIAN|5.023006||Viu
LONG_DOUBLESIZE|5.005000|5.005000|Vn
LONG_DOUBLE_STYLE_IEEE|5.025007|5.025007|Vn
LONG_DOUBLE_STYLE_IEEE_EXTENDED|5.025007|5.025007|Vn
LONGDOUBLE_VAX_ENDIAN|5.025004||Viu
LONGDOUBLE_X86_80_BIT|5.021009||Viu
LONGJMP|5.005000||Viu
longjmp|5.005000||Viu
LONGJMP_t8|5.035004||Viu
LONGJMP_t8_p8|5.033003||Viu
LONGJMP_t8_pb|5.033003||Viu
LONGJMP_tb|5.035004||Viu
LONGJMP_tb_p8|5.033003||Viu
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
LSEEKSIZE|5.006000|5.006000|Vn
lstat|5.005000||Viu
LvFLAGS|5.015006||Viu
LVf_NEG_LEN|5.027001||Viu
LVf_NEG_OFF|5.027001||Viu
LVf_OUT_OF_RANGE|5.027001||Viu
LVRET|5.007001||Vi
LvSTARGOFF|5.019004||Viu
LvTARG|5.003007||Viu
LvTARGLEN|5.003007||Viu
LvTARGOFF|5.003007||Viu
LvTYPE|5.003007||Viu
LZC_TO_MSBIT_POS|5.035003||Viu
magic_clear_all_env|5.004001||Viu
magic_cleararylen_p|5.017002||Viu
magic_clearenv|5.003007||Viu
magic_clearhint|5.009004||Vi
magic_clearhints|5.011000||Vi
magic_clearisa|5.010001||Viu
magic_clearpack|5.003007||Viu
magic_clearsig|5.003007||Viu
magic_copycallchecker|5.017000||Viu
magic_dump|5.006000|5.006000|u
magic_existspack|5.003007||Viu
magic_freearylen_p|5.009003||Viu
magic_freecollxfrm|5.033004||Viu
magic_freemglob|5.033004||Viu
magic_freeovrld|5.007001||Viu
magic_freeutf8|5.033004||Viu
magic_get|5.003007||Viu
magic_getarylen|5.003007||Viu
magic_getdebugvar|5.021005||Viu
magic_getdefelem|5.004000||Viu
magic_getnkeys|5.004005||Viu
magic_getpack|5.003007||Viu
magic_getpos|5.003007||Viu
magic_getsig|5.003007||Viu
magic_getsubstr|5.004005||Viu
magic_gettaint|5.003007||Viu
magic_getuvar|5.003007||Viu
magic_getvec|5.004005||Viu
magic_killbackrefs|5.006000||Viu
magic_methcall1|5.013001||Viu
magic_methcall|||vi
magic_methpack|5.005000||Viu
magic_nextpack|5.003007||Viu
magic_regdata_cnt|5.006000||Viu
magic_regdatum_get|5.006000||Viu
magic_regdatum_set|5.006001||Viu
magic_scalarpack|5.009001||Viu
magic_set|5.003007||Viu
magic_set_all_env|5.004004||Viu
magic_setarylen|5.003007||Viu
magic_setcollxfrm|5.004000||Viu
magic_setdbline|5.003007||Viu
magic_setdebugvar|5.021005||Viu
magic_setdefelem|5.004000||Viu
magic_setenv|5.003007||Viu
magic_sethint|5.009004||Vi
magic_sethint_feature|5.031007||Viu
magic_setisa|5.003007||Viu
magic_setlvref|5.021005||Viu
magic_setmglob|5.003007||Viu
magic_setnkeys|5.003007||Viu
magic_setnonelem|5.027009||Viu
magic_setpack|5.003007||Viu
magic_setpos|5.003007||Viu
magic_setregexp|5.008001||Viu
magic_setsig|5.003007||Viu
magic_setsigall|5.035001||Viu
magic_setsubstr|5.003007||Viu
magic_settaint|5.003007||Viu
magic_setutf8|5.008001||Viu
magic_setuvar|5.003007||Viu
magic_setvec|5.003007||Viu
magic_sizepack|5.005000||Viu
magic_wipepack|5.003007||Viu
make_exactf_invlist|5.031006||Viu
make_matcher|5.027008||Viu
make_trie|5.009002||Viu
malloc|5.003007||Vn
MALLOC_CHECK_TAINT2|5.008001||Viu
MALLOC_CHECK_TAINT|5.008001||Viu
malloced_size|5.005000||Vniu
malloc_good_size|5.010001||Vniu
MALLOC_INIT|5.005000||Viu
MALLOC_OVERHEAD|5.006000||Viu
Malloc_t|5.003007|5.003007|Vn
MALLOC_TERM|5.005000||Viu
MALLOC_TOO_LATE_FOR|5.008001||Viu
MARK|5.003007|5.003007|
MARKPOINT|5.009005||Viu
MARKPOINT_next|5.009005||Viu
MARKPOINT_next_fail|5.009005||Viu
MARKPOINT_next_fail_t8|5.035004||Viu
MARKPOINT_next_fail_t8_p8|5.033003||Viu
MARKPOINT_next_fail_t8_pb|5.033003||Viu
MARKPOINT_next_fail_tb|5.035004||Viu
MARKPOINT_next_fail_tb_p8|5.033003||Viu
MARKPOINT_next_fail_tb_pb|5.033003||Viu
MARKPOINT_next_t8|5.035004||Viu
MARKPOINT_next_t8_p8|5.033003||Viu
MARKPOINT_next_t8_pb|5.033003||Viu
MARKPOINT_next_tb|5.035004||Viu
MARKPOINT_next_tb_p8|5.033003||Viu
MARKPOINT_next_tb_pb|5.033003||Viu
MARKPOINT_t8|5.035004||Viu
MARKPOINT_t8_p8|5.033003||Viu
MARKPOINT_t8_pb|5.033003||Viu
MARKPOINT_tb|5.035004||Viu
MARKPOINT_tb_p8|5.033003||Viu
MARKPOINT_tb_pb|5.033003||Viu
markstack_grow|5.021001|5.021001|u
matcher_matches_sv|5.027008||Viu
MAX|5.025006||Viu
MAX_ANYOF_HRx_BYTE|5.031002||Viu
MAXARG|5.003007||Viu
MAX_CHARSET_NAME_LENGTH|5.013009||Viu
MAX_FEATURE_LEN|5.013010||Viu
MAX_FOLD_FROMS|5.029006||Viu
MAX_LEGAL_CP|5.029002||Viu
MAX_MATCHES|5.033005||Viu
MAXO|5.003007||Viu
MAXPATHLEN|5.006000||Viu
MAX_PORTABLE_UTF8_TWO_BYTE|5.011002||Viu
MAX_PRINT_A|5.033005||Viu
MAX_RECURSE_EVAL_NOCHANGE_DEPTH|5.009005||Viu
MAXSYSFD|5.003007||Viu
MAX_UNICODE_UTF8|5.027006||Viu
MAX_UNI_KEYWORD_INDEX|5.027011||Viu
MAX_UTF8_TWO_BYTE|5.019004||Viu
MAYBE_DEREF_GV|5.015003||Viu
MAYBE_DEREF_GV_flags|5.015003||Viu
MAYBE_DEREF_GV_nomg|5.015003||Viu
maybe_multimagic_gv|5.019004||Viu
mayberelocate|5.015006||Viu
MBLEN_LOCK|5.033005||Viu
MBLEN_UNLOCK|5.033005||Viu
MBOL|5.003007||Viu
MBOL_t8|5.035004||Viu
MBOL_t8_p8|5.033003||Viu
MBOL_t8_pb|5.033003||Viu
MBOL_tb|5.035004||Viu
MBOL_tb_p8|5.033003||Viu
MBOL_tb_pb|5.033003||Viu
MBTOWC_LOCK|5.033005||Viu
MBTOWC_UNLOCK|5.033005||Viu
MDEREF_ACTION_MASK|5.021007||Viu
MDEREF_AV_gvav_aelem|5.021007||Viu
MDEREF_AV_gvsv_vivify_rv2av_aelem|5.021007||Viu
MDEREF_AV_padav_aelem|5.021007||Viu
MDEREF_AV_padsv_vivify_rv2av_aelem|5.021007||Viu
MDEREF_AV_pop_rv2av_aelem|5.021007||Viu
MDEREF_AV_vivify_rv2av_aelem|5.021007||Viu
MDEREF_FLAG_last|5.021007||Viu
MDEREF_HV_gvhv_helem|5.021007||Viu
MDEREF_HV_gvsv_vivify_rv2hv_helem|5.021007||Viu
MDEREF_HV_padhv_helem|5.021007||Viu
MDEREF_HV_padsv_vivify_rv2hv_helem|5.021007||Viu
MDEREF_HV_pop_rv2hv_helem|5.021007||Viu
MDEREF_HV_vivify_rv2hv_helem|5.021007||Viu
MDEREF_INDEX_const|5.021007||Viu
MDEREF_INDEX_gvsv|5.021007||Viu
MDEREF_INDEX_MASK|5.021007||Viu
MDEREF_INDEX_none|5.021007||Viu
MDEREF_INDEX_padsv|5.021007||Viu
MDEREF_MASK|5.021007||Viu
MDEREF_reload|5.021007||Viu
MDEREF_SHIFT|5.021007||Viu
measure_struct|5.007003||Viu
MEM_ALIGNBYTES|5.003007|5.003007|Vn
memBEGINPs|5.027006||Viu
memBEGINs|5.027006||Viu
MEMBER_TO_FPTR|5.006000||Viu
memCHRs|5.031008|5.003007|p
mem_collxfrm|5.003007||dViu
_mem_collxfrm|5.025002||Viu
memENDPs|5.027006||Viu
memENDs|5.027006||Viu
memEQ|5.004000|5.003007|p
memEQs|5.009005|5.003007|p
memGE|5.025005||Viu
memGT|5.025005||Viu
memLE|5.025005||Viu
MEM_LOG_ALLOC|5.009003||Viu
mem_log_alloc|5.024000||Vniu
mem_log_common|5.010001||Vniu
MEM_LOG_DEL_SV|||Viu
MEM_LOG_FREE|5.009003||Viu
mem_log_free|5.024000||Vniu
MEM_LOG_NEW_SV|||Viu
MEM_LOG_REALLOC|5.009003||Viu
mem_log_realloc|5.024000||Vniu
memLT|5.025005||Viu
memNE|5.004000|5.003007|p
memNEs|5.009005|5.003007|p
MEM_SIZE|5.003007||Viu
MEM_SIZE_MAX|5.009005||Viu
MEM_WRAP_CHECK_1|5.009002||Viu
MEM_WRAP_CHECK|5.009002||Viu
MEM_WRAP_CHECK_s|5.027010||Viu
memzero|5.003007|5.003007|
MEOL|5.003007||Viu
MEOL_t8|5.035004||Viu
MEOL_t8_p8|5.033003||Viu
MEOL_t8_pb|5.033003||Viu
MEOL_tb|5.035004||Viu
MEOL_tb_p8|5.033003||Viu
MEOL_tb_pb|5.033003||Viu
mess|5.003007||pvV
mess_alloc|5.005000||Viu
mess_nocontext|5.006000||pvVn
mess_sv|5.013001|5.004000|p
MEXTEND|5.003007||Viu
mfree|||nu
MgBYTEPOS|5.019004||Viu
MgBYTEPOS_set|5.019004||Viu
mg_clear|5.003007|5.003007|
mg_copy|5.003007|5.003007|
mg_dup|5.007003|5.007003|u
MGf_BYTES|5.019004||Viu
MGf_COPY|5.007003||Viu
MGf_DUP|5.007003||Viu
MGf_GSKIP|5.003007||Viu
mg_find|5.003007|5.003007|n
mg_findext|5.013008|5.003007|pn
mg_find_mglob|5.019002||cViu
MGf_LOCAL|5.009003||Viu
MGf_MINMATCH|5.003007||Viu
MGf_PERSIST|5.021005||Viu
mg_free|5.003007|5.003007|
mg_freeext|5.027004|5.027004|
mg_free_type|5.013006|5.013006|
MGf_REFCOUNTED|5.003007||Viu
MGf_REQUIRE_GV|5.021004||Viu
MGf_TAINTEDDIR|5.003007||Viu
mg_get|5.003007|5.003007|
mg_length|5.005000|5.005000|d
mg_localize|5.009003||Vi
mg_magical|5.003007|5.003007|n
MgPV|5.003007||Viu
MgPV_const|5.009003||Viu
MgPV_nolen_const|5.009003||Viu
mg_set|5.003007|5.003007|
mg_size|5.005000|5.005000|u
MgSV|5.033009||Viu
MgTAINTEDDIR|5.003007||Viu
MgTAINTEDDIR_off|5.004000||Viu
MgTAINTEDDIR_on|5.003007||Viu
MICRO_SIGN|5.011002||Viu
MICRO_SIGN_NATIVE|5.017004||Viu
MICRO_SIGN_UTF8|5.033003||Viu
MIN|5.025006||Viu
mini_mktime|5.007002|5.007002|n
MINMOD|5.003007||Viu
MINMOD_t8|5.035004||Viu
MINMOD_t8_p8|5.033003||Viu
MINMOD_t8_pb|5.033003||Viu
MINMOD_tb|5.035004||Viu
MINMOD_tb_p8|5.033003||Viu
MINMOD_tb_pb|5.033003||Viu
minus_v|5.015006||Viu
missingterm|5.005000||Viu
Mkdir|5.004000||Viu
mkdir|5.005000||Viu
mktemp|5.005000||Viu
Mmap_t|5.006000|5.006000|Vn
mode_from_discipline|5.006000||Viu
Mode_t|5.003007|5.003007|Vn
modkids|5.003007||Viu
MON_10|5.027010||Viu
MON_11|5.027010||Viu
MON_12|5.027010||Viu
MON_1|5.027010||Viu
MON_2|5.027010||Viu
MON_3|5.027010||Viu
MON_4|5.027010||Viu
MON_5|5.027010||Viu
MON_6|5.027010||Viu
MON_7|5.027010||Viu
MON_8|5.027010||Viu
MON_9|5.027010||Viu
more_bodies|||cu
more_sv|5.009004||cVu
moreswitches|5.003007||cVu
mortal_getenv|5.031011||cVnu
Move|5.003007|5.003007|
MoveD|5.009002|5.003007|p
move_proto_attr|5.019005||Viu
M_PAT_MODS|5.009005||Viu
MPH_BUCKETS|5.027011||Viu
MPH_RSHIFT|5.027011||Viu
MPH_VALt|5.027011||Viu
mPUSHi|5.009002|5.003007|p
mPUSHn|5.009002|5.003007|p
mPUSHp|5.009002|5.003007|p
mPUSHs|5.010001|5.003007|p
mPUSHu|5.009002|5.003007|p
mro_clean_isarev|5.013007||Viu
mro_gather_and_rename|5.013007||Viu
mro_get_from_name|||u
mro_get_linear_isa|5.009005|5.009005|
mro_get_linear_isa_c3|||i
mro_get_linear_isa_dfs|5.009005||Vi
MRO_GET_PRIVATE_DATA|5.010001|5.010001|
mro_get_private_data|||cu
mro_isa_changed_in|5.009005||Vi
mro_meta_dup|5.009005||Viu
mro_meta_init|||ciu
mro_method_changed_in|5.009005|5.009005|
mro_package_moved|5.013006||Vi
mro_register|||
mro_set_mro|||u
mro_set_private_data|||
msbit_pos32|5.035003||cVnu
msbit_pos|5.035004||Viu
msbit_pos64|5.035003||cVnu
msbit_pos_uintmax|5.035003||Viu
MSPAGAIN|5.003007||Viu
MSVC_DIAG_IGNORE|5.029010||Viu
MSVC_DIAG_IGNORE_DECL|5.029010||Viu
MSVC_DIAG_IGNORE_STMT|5.029010||Viu
MSVC_DIAG_RESTORE|5.029010||Viu
MSVC_DIAG_RESTORE_DECL|5.029010||Viu
MSVC_DIAG_RESTORE_STMT|5.029010||Viu
mul128|5.005000||Viu
MULTICALL|5.009003|5.009003|
multiconcat_stringify|5.027006||cViu
multideref_stringify|5.021009||cViu
MULTILINE_PAT_MOD|5.009005||Viu
MULTIPLICITY|5.006000|5.006000|Vn
MUTABLE_AV|5.010001|5.003007|p
MUTABLE_CV|5.010001|5.003007|p
MUTABLE_GV|5.010001|5.003007|p
MUTABLE_HV|5.010001|5.003007|p
MUTABLE_IO|5.010001|5.003007|p
MUTABLE_PTR|5.010001|5.003007|p
MUTABLE_SV|5.010001|5.003007|p
MUTEX_DESTROY|5.005000||Viu
MUTEX_INIT|5.005000||Viu
MUTEX_INIT_NEEDS_MUTEX_ZEROED|5.005003||Viu
MUTEX_LOCK|5.005000||Viu
MUTEX_UNLOCK|5.005000||Viu
mXPUSHi|5.009002|5.003007|p
mXPUSHn|5.009002|5.003007|p
mXPUSHp|5.009002|5.003007|p
mXPUSHs|5.010001|5.003007|p
mXPUSHu|5.009002|5.003007|p
my|5.011000||Viu
my_atof2|5.029000||cVu
my_atof3|5.029000||cVu
my_atof|5.006000|5.006000|
my_attrs|5.006000||Viu
my_binmode|5.006000||Viu
my_bytes_to_utf8|5.021009||Vniu
my_chsize|5.003007||Vu
my_clearenv|5.009003||Viu
MY_CXT|5.009000|5.009000|p
MY_CXT_CLONE|5.009002|5.009000|p
MY_CXT_INDEX|5.009005||Viu
MY_CXT_INIT|5.009000|5.009000|p
MY_CXT_INIT_ARG|5.013005||Viu
MY_CXT_INIT_INTERP|5.009003||Viu
my_cxt_init|||u
my_dirfd|5.009005|5.009005|nu
my_exit|5.003007|5.003007|
my_exit_jump|5.005000||Viu
my_failure_exit|5.004000|5.004000|u
my_fflush_all|5.006000|5.006000|u
my_fork|5.007003|5.007003|nu
my_kid|5.006000||Viu
my_lstat|5.013003||Viu
my_lstat_flags|5.013003||cViu
my_memrchr|5.027006||Vniu
my_mkostemp_cloexec|||niu
my_mkostemp|||niu
my_mkstemp_cloexec|||niu
my_mkstemp|||niu
my_nl_langinfo|5.027006||Vniu
my_pclose|5.003007|5.003007|u
my_popen|5.003007|5.003007|u
my_popen_list|5.007001|5.007001|u
my_setenv|5.003007|5.003007|
my_snprintf|5.009004||pvVn
my_socketpair|5.007003|5.007003|nu
my_sprintf|5.009003|5.003007|pdn
my_stat|5.013003||Viu
my_stat_flags|5.013003||cViu
my_strerror|5.021001||Viu
my_strftime|5.007002||V
my_strlcat|5.009004|5.003007|pn
my_strlcpy|5.009004|5.003007|pn
my_strnlen|5.027006|5.003007|pn
my_strtod|5.029010|5.029010|n
my_unexec|5.003007||Viu
my_vsnprintf|5.009004|5.009004|n
N0|5.029001||Viu
N10|5.029001||Viu
N11|5.029001||Viu
N1|5.029001||Viu
N2|5.029001||Viu
N3|5.029001||Viu
N4|5.029001||Viu
N5|5.029001||Viu
N6|5.029001||Viu
N7|5.029001||Viu
N8|5.029001||Viu
N9|5.029001||Viu
NAN_COMPARE_BROKEN|5.021005||Viu
NANYOFM|5.029005||Viu
NANYOFM_t8|5.035004||Viu
NANYOFM_t8_p8|5.033003||Viu
NANYOFM_t8_pb|5.033003||Viu
NANYOFM_tb|5.035004||Viu
NANYOFM_tb_p8|5.033003||Viu
NANYOFM_tb_pb|5.033003||Viu
NATIVE8_TO_UNI|5.011000||Viu
NATIVE_BYTE_IS_INVARIANT|5.019004||Viu
NATIVE_SKIP|5.019004||Viu
NATIVE_TO_ASCII|5.007001||Viu
NATIVE_TO_I8|5.015006||Viu
NATIVE_TO_LATIN1|5.019004|5.003007|p
NATIVE_TO_NEED|5.019004||dcVnu
NATIVE_TO_UNI|5.007001|5.003007|p
NATIVE_TO_UTF|5.007001||Viu
NATIVE_UTF8_TO_I8|5.019004||Viu
nBIT_MASK|5.033001||Viu
nBIT_UMAX|5.033001||Viu
NBOUND|5.003007||Viu
NBOUNDA|5.013009||Viu
NBOUNDA_t8|5.035004||Viu
NBOUNDA_t8_p8|5.033003||Viu
NBOUNDA_t8_pb|5.033003||Viu
NBOUNDA_tb|5.035004||Viu
NBOUNDA_tb_p8|5.033003||Viu
NBOUNDA_tb_pb|5.033003||Viu
NBOUNDL|5.004000||Viu
NBOUNDL_t8|5.035004||Viu
NBOUNDL_t8_p8|5.033003||Viu
NBOUNDL_t8_pb|5.033003||Viu
NBOUNDL_tb|5.035004||Viu
NBOUNDL_tb_p8|5.033003||Viu
NBOUNDL_tb_pb|5.033003||Viu
NBOUND_t8|5.035004||Viu
NBOUND_t8_p8|5.033003||Viu
NBOUND_t8_pb|5.033003||Viu
NBOUND_tb|5.035004||Viu
NBOUND_tb_p8|5.033003||Viu
NBOUND_tb_pb|5.033003||Viu
NBOUNDU|5.013009||Viu
NBOUNDU_t8|5.035004||Viu
NBOUNDU_t8_p8|5.033003||Viu
NBOUNDU_t8_pb|5.033003||Viu
NBOUNDU_tb|5.035004||Viu
NBOUNDU_tb_p8|5.033003||Viu
NBOUNDU_tb_pb|5.033003||Viu
NBSP_NATIVE|5.021001||Viu
NBSP_UTF8|5.021001||Viu
NDBM_H_USES_PROTOTYPES|5.032001|5.032001|Vn
NDEBUG|5.021007||Viu
need_utf8|5.009003||Vniu
NEED_VA_COPY|5.007001|5.007001|Vn
NEGATIVE_INDICES_VAR|5.008001||Viu
Netdb_hlen_t|5.005000|5.005000|Vn
Netdb_host_t|5.005000|5.005000|Vn
Netdb_name_t|5.005000|5.005000|Vn
Netdb_net_t|5.005000|5.005000|Vn
NETDB_R_OBSOLETE|5.008000||Viu
New|5.003007||Viu
newANONATTRSUB|5.006000|5.006000|u
newANONHASH|5.003007|5.003007|u
newANONLIST|5.003007|5.003007|u
newANONSUB|5.003007|5.003007|u
newASSIGNOP|5.003007|5.003007|
newATTRSUB|5.006000|5.006000|
newATTRSUB_x|5.019008||cVi
newAV|5.003007|5.003007|
newAV_alloc_x|5.035001|5.035001|
newAV_alloc_xz|5.035001|5.035001|
newAVREF|5.003007|5.003007|u
newBINOP|5.003007|5.003007|
new_body_allocated|||Viu
new_body_from_arena|||Viu
Newc|5.003007||Viu
new_collate|5.006000||Viu
newCONDOP|5.003007|5.003007|
new_constant|||iu
newCONSTSUB|5.004005|5.003007|p
newCONSTSUB_flags|5.015006|5.015006|
new_ctype|5.006000||Viu
newCVREF|5.003007|5.003007|u
newDEFEROP|5.035004|5.035004|x
newDEFSVOP|5.021006|5.021006|
newFORM|5.003007|5.003007|u
newFOROP|5.013007|5.013007|
newGIVENOP|5.009003|5.009003|
newGIVWHENOP|5.027008||Viu
newGP|||xiu
newGVgen|5.003007|5.003007|u
newGVgen_flags|5.015004|5.015004|u
newGVOP|5.003007|5.003007|
newGVREF|5.003007|5.003007|u
new_he|5.005000||Viu
newHV|5.003007|5.003007|
newHVhv|5.005000|5.005000|u
newHVREF|5.003007|5.003007|u
_new_invlist|5.013010||cViu
_new_invlist_C_array|5.015008||cViu
newIO|5.003007|5.003007|u
newLISTOP|5.003007|5.003007|
newLOGOP|5.003007|5.003007|
new_logop|5.005000||Viu
newLOOPEX|5.003007|5.003007|
newLOOPOP|5.003007|5.003007|
newMETHOP|5.021005|5.021005|
newMETHOP_internal|5.021005||Viu
newMETHOP_named|5.021005|5.021005|
new_msg_hv|5.027009||Viu
newMYSUB|5.017004|5.017004|u
new_NOARENA|||Viu
new_NOARENAZ|||Viu
newNULLLIST|5.003007|5.003007|
new_numeric|5.006000||Viu
newOP|5.003007|5.003007|
NewOp|5.008001||Viu
newPADNAMELIST|5.021007|5.021007|xn
newPADNAMEouter|5.021007|5.021007|xn
newPADNAMEpvn|5.021007|5.021007|xn
newPADOP|5.006000||V
newPMOP|5.003007|5.003007|
newPROG|5.003007|5.003007|u
newPVOP|5.003007|5.003007|
newRANGE|5.003007|5.003007|
newRV|5.003007|5.003007|
newRV_inc|5.004000|5.003007|p
newRV_noinc|5.004000|5.003007|p
newSLICEOP|5.003007|5.003007|
new_stackinfo|5.005000|5.005000|u
newSTATEOP|5.003007|5.003007|
newSTUB|5.017001||Viu
newSUB|5.003007|5.003007|
newSV|5.003007|5.003007|
NEWSV|5.003007||Viu
newSVavdefelem|5.019004||Viu
newSVhek|5.009003|5.009003|
newSViv|5.003007|5.003007|
newSVnv|5.006000|5.003007|
newSVOP|5.003007|5.003007|
newSVpadname|5.017004|5.017004|x
newSVpv|5.003007|5.003007|
newSVpvf|5.004000||vV
newSVpvf_nocontext|5.006000||vVn
newSVpvn|5.004005|5.003007|p
newSVpvn_flags|5.010001|5.003007|p
newSVpvn_share|5.007001|5.003007|p
newSVpvn_utf8|5.010001|5.003007|p
newSVpvs|5.009003|5.003007|p
newSVpvs_flags|5.010001|5.003007|p
newSVpv_share|5.013006|5.013006|
newSVpvs_share|5.009003|5.003007|p
newSVREF|5.003007|5.003007|u
newSVrv|5.003007|5.003007|
newSVsv|5.003007|5.003007|
newSVsv_flags|5.029009|5.003007|p
newSVsv_nomg|5.029009|5.003007|p
newSV_type|5.009005|5.003007|p
newSV_type_mortal|||
newSVuv|5.006000|5.003007|p
new_SV|||Viu
newTRYCATCHOP|5.033007|5.033007|x
newUNOP|5.003007|5.003007|
newUNOP_AUX|5.021007|5.021007|
new_version|5.009000|5.009000|
NEW_VERSION|5.019008||Viu
new_warnings_bitfield|||xciu
newWHENOP|5.027008|5.027008|
newWHILEOP|5.013007|5.013007|
Newx|5.009003|5.003007|p
Newxc|5.009003|5.003007|p
new_XNV|||Viu
new_XPVMG|||Viu
new_XPVNV|||Viu
newXS|5.006000|5.006000|
newXS_deffile|5.021006||cViu
newXS_flags|5.009004|5.009004|xu
newXS_len_flags|5.015006||Vi
newXSproto|5.006000|5.006000|
Newxz|5.009003|5.003007|p
Newz|5.003007||Viu
nextargv|5.003007||Viu
nextchar|5.005000||Viu
NEXT_LINE_CHAR|5.007003||Viu
NEXT_OFF|5.005000||Viu
next_symbol|5.007003||Viu
ninstr|5.003007|5.003007|n
NL_LANGINFO_LOCK|5.033005||Viu
NL_LANGINFO_UNLOCK|5.033005||Viu
NOARENA|||Viu
no_bareword_allowed|5.005004||Viu
no_bareword_filehandle|5.033006||Viu
NOCAPTURE_PAT_MOD|5.021008||Viu
NOCAPTURE_PAT_MODS|5.021008||Viu
NODE_ALIGN|5.005000||Viu
NODE_ALIGN_FILL|5.005000||Viu
NODE_STEP_REGNODE|5.005000||Viu
NODE_SZ_STR|5.006000||Viu
NO_ENV_ARRAY_IN_MAIN|5.009004||Viu
NOEXPR|5.027010||Viu
NofAMmeth|5.003007||Viu
no_fh_allowed|5.003007||Viu
NOLINE|5.003007||Viu
NO_LOCALE|5.007000||Viu
NONDESTRUCT_PAT_MOD|5.013002||Viu
NONDESTRUCT_PAT_MODS|5.013002||Viu
NON_OTHER_COUNT|5.033005||Viu
NONV|||Viu
no_op|5.003007||Viu
NOOP|5.005000|5.003007|p
noperl_die|5.021006||vVniu
NORETURN_FUNCTION_END|5.009003||Viu
NORMAL|5.003007||Viu
NOSTR|5.027010||Viu
NO_TAINT_SUPPORT|5.017006||Viu
not_a_number|5.005000||Viu
NOTE3|5.027001||Viu
NOTHING|5.003007||Viu
NOTHING_t8|5.035004||Viu
NOTHING_t8_p8|5.033003||Viu
NOTHING_t8_pb|5.033003||Viu
NOTHING_tb|5.035004||Viu
NOTHING_tb_p8|5.033003||Viu
NOTHING_tb_pb|5.033003||Viu
nothreadhook|5.008000|5.008000|
notify_parser_that_changed_to_utf8|5.025010||Viu
not_incrementable|5.021002||Viu
NOT_IN_PAD|5.005000||Viu
NOT_REACHED|5.019006|5.003007|poVnu
NPOSIXA|5.017003||Viu
NPOSIXA_t8|5.035004||Viu
NPOSIXA_t8_p8|5.033003||Viu
NPOSIXA_t8_pb|5.033003||Viu
NPOSIXA_tb|5.035004||Viu
NPOSIXA_tb_p8|5.033003||Viu
NPOSIXA_tb_pb|5.033003||Viu
NPOSIXD|5.017003||Viu
NPOSIXD_t8|5.035004||Viu
NPOSIXD_t8_p8|5.033003||Viu
NPOSIXD_t8_pb|5.033003||Viu
NPOSIXD_tb|5.035004||Viu
NPOSIXD_tb_p8|5.033003||Viu
NPOSIXD_tb_pb|5.033003||Viu
NPOSIXL|5.017003||Viu
NPOSIXL_t8|5.035004||Viu
NPOSIXL_t8_p8|5.033003||Viu
NPOSIXL_t8_pb|5.033003||Viu
NPOSIXL_tb|5.035004||Viu
NPOSIXL_tb_p8|5.033003||Viu
NPOSIXL_tb_pb|5.033003||Viu
NPOSIXU|5.017003||Viu
NPOSIXU_t8|5.035004||Viu
NPOSIXU_t8_p8|5.033003||Viu
NPOSIXU_t8_pb|5.033003||Viu
NPOSIXU_tb|5.035004||Viu
NPOSIXU_tb_p8|5.033003||Viu
NPOSIXU_tb_pb|5.033003||Viu
NSIG|5.009003||Viu
ntohi|5.003007||Viu
ntohl|5.003007||Viu
ntohs|5.003007||Viu
nuke_stacks|5.005000||Viu
Null|5.003007||Viu
Nullav|5.003007|5.003007|d
Nullch|5.003007|5.003007|
Nullcv|5.003007|5.003007|d
Nullfp|5.003007||Viu
Nullgv|5.003007||Viu
Nullhe|5.003007||Viu
Nullhek|5.004000||Viu
Nullhv|5.003007|5.003007|d
Nullop|5.003007||Viu
Nullsv|5.003007|5.003007|
NUM2PTR|5.006000||pVu
NUM_ANYOF_CODE_POINTS|5.021004||Viu
NUM_CLASSES|5.029001||Viu
num_overflow|5.009001||Vniu
NV_BIG_ENDIAN|5.021009||Viu
NV_DIG|5.006000||Viu
NVef|5.006001|5.003007|poVn
NV_EPSILON|5.007003||Viu
NVff|5.006001|5.003007|poVn
NVgf|5.006001|5.003007|poVn
NV_IMPLICIT_BIT|5.021009||Viu
NV_INF|5.007003||Viu
NV_LITTLE_ENDIAN|5.021009||Viu
NVMANTBITS|5.023000|5.023000|Vn
NV_MANT_DIG|5.006001||Viu
NV_MAX_10_EXP|5.007003||Viu
NV_MAX|5.006001||Viu
NV_MAX_EXP|5.021003||Viu
NV_MIN_10_EXP|5.007003||Viu
NV_MIN|5.006001||Viu
NV_MIN_EXP|5.021003||Viu
NV_MIX_ENDIAN|5.021009||Viu
NV_NAN|5.007003||Viu
NV_NAN_BITS|5.023000||Viu
NV_NAN_IS_QUIET|5.023000||Viu
NV_NAN_IS_SIGNALING|5.023000||Viu
NV_NAN_PAYLOAD_MASK|5.023000||Viu
NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE|5.023000||Viu
NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE|5.023000||Viu
NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE|5.023000||Viu
NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE|5.023000||Viu
NV_NAN_PAYLOAD_MASK_SKIP_EIGHT|5.023006||Viu
NV_NAN_PAYLOAD_PERM_0_TO_7|5.023000||Viu
NV_NAN_PAYLOAD_PERM|5.023000||Viu
NV_NAN_PAYLOAD_PERM_7_TO_0|5.023000||Viu
NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE|5.023000||Viu
NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE|5.023000||Viu
NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE|5.023000||Viu
NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE|5.023000||Viu
NV_NAN_PAYLOAD_PERM_SKIP_EIGHT|5.023006||Viu
NV_NAN_QS_BIT|5.023000||Viu
NV_NAN_QS_BIT_OFFSET|5.023000||Viu
NV_NAN_QS_BIT_SHIFT|5.023000||Viu
NV_NAN_QS_BYTE|5.023000||Viu
NV_NAN_QS_BYTE_OFFSET|5.023000||Viu
NV_NAN_QS_QUIET|5.023000||Viu
NV_NAN_QS_SIGNALING|5.023000||Viu
NV_NAN_QS_TEST|5.023000||Viu
NV_NAN_QS_XOR|5.023000||Viu
NV_NAN_SET_QUIET|5.023000||Viu
NV_NAN_SET_SIGNALING|5.023000||Viu
NV_OVERFLOWS_INTEGERS_AT|5.010001|5.010001|Vn
NV_PRESERVES_UV_BITS|5.006001|5.006001|Vn
NVSIZE|5.006001|5.006001|Vn
NVTYPE|5.006000|5.003007|poVn
NV_VAX_ENDIAN|5.025003||Viu
NV_WITHIN_IV|5.006000||Viu
NV_WITHIN_UV|5.006000||Viu
NV_X86_80_BIT|5.025004||Viu
NV_ZERO_IS_ALLBITS_ZERO|5.035009|5.035009|Vn
OA_AVREF|5.003007||Viu
OA_BASEOP|5.005000||Viu
OA_BASEOP_OR_UNOP|5.005000||Viu
OA_BINOP|5.005000||Viu
OA_CLASS_MASK|5.005000||Viu
OA_COP|5.005000||Viu
OA_CVREF|5.003007||Viu
OA_DANGEROUS|5.003007||Viu
OA_DEFGV|5.003007||Viu
OA_FILEREF|5.003007||Viu
OA_FILESTATOP|5.005000||Viu
OA_FOLDCONST|5.003007||Viu
OA_HVREF|5.003007||Viu
OA_LIST|5.003007||Viu
OA_LISTOP|5.005000||Viu
OA_LOGOP|5.005000||Viu
OA_LOOP|5.005000||Viu
OA_LOOPEXOP|5.005000||Viu
OA_MARK|5.003007||Viu
OA_METHOP|5.021005||Viu
OA_OPTIONAL|5.003007||Viu
OA_OTHERINT|5.003007||Viu
OA_PADOP|5.006000||Viu
OA_PMOP|5.005000||Viu
OA_PVOP_OR_SVOP|5.006000||Viu
OA_RETSCALAR|5.003007||Viu
OA_SCALAR|5.003007||Viu
OA_SCALARREF|5.003007||Viu
OASHIFT|5.003007||Viu
OA_SVOP|5.005000||Viu
OA_TARGET|5.003007||Viu
OA_TARGLEX|5.006000||Viu
OA_UNOP|5.005000||Viu
OA_UNOP_AUX|5.021007||Viu
O_BINARY|5.006000||Viu
O_CREAT|5.006000||Viu
OCSHIFT|5.006000||Viu
OCTAL_VALUE|5.019008||Viu
Off_t|5.003007|5.003007|Vn
Off_t_size|5.006000|5.006000|Vn
OFFUNI_IS_INVARIANT|5.023003||Viu
OFFUNISKIP|5.019004||Viu
OFFUNISKIP_helper|5.035004||Viu
ONCE_PAT_MOD|5.009005||Viu
ONCE_PAT_MODS|5.009005||Viu
ONE_IF_EBCDIC_ZERO_IF_NOT|5.035004||Viu
oopsAV|5.003007||Viu
oopsHV|5.003007||Viu
OP|5.003007||Viu
op_append_elem|5.013006|5.013006|
op_append_list|5.013006|5.013006|
opASSIGN|5.003007||Viu
OP_CHECK_MUTEX_INIT|5.015008||Viu
OP_CHECK_MUTEX_LOCK|5.015008||Viu
OP_CHECK_MUTEX_TERM|5.015008||Viu
OP_CHECK_MUTEX_UNLOCK|5.015008||Viu
OP_CLASS|5.013007|5.013007|
op_class|5.025010|5.025010|
op_clear|5.006000||cViu
OPCODE|5.003007||Viu
op_contextualize|5.013006|5.013006|
op_convert_list|5.021006|5.021006|
OP_DESC|5.007003|5.007003|
op_dump|5.006000|5.006000|
OPEN|5.003007||Viu
open|5.005000||Viu
opendir|5.005000||Viu
openn_cleanup|5.019010||Viu
openn_setup|5.019010||Viu
open_script|5.005000||Viu
OPEN_t8|5.035004||Viu
OPEN_t8_p8|5.033003||Viu
OPEN_t8_pb|5.033003||Viu
OPEN_tb|5.035004||Viu
OPEN_tb_p8|5.033003||Viu
OPEN_tb_pb|5.033003||Viu
OPERAND|5.003007||Viu
OPERANDl|5.031005||Viu
OPERANDs|5.031005||Viu
OPFAIL|5.009005||Viu
OPFAIL_t8|5.035004||Viu
OPFAIL_t8_p8|5.033003||Viu
OPFAIL_t8_pb|5.033003||Viu
OPFAIL_tb|5.035004||Viu
OPFAIL_tb_p8|5.033003||Viu
OPFAIL_tb_pb|5.033003||Viu
OPf_FOLDED|5.021007||Viu
OPf_KIDS|5.003007|5.003007|
OPf_KNOW|5.003007||Viu
OPf_LIST|5.003007||Viu
OPf_MOD|5.003007||Viu
OPf_PARENS|5.003007||Viu
op_free|5.003007|5.003007|
OP_FREED|5.017002||Viu
OPf_REF|5.003007||Viu
OPf_SPECIAL|5.003007||Viu
OPf_STACKED|5.003007||Viu
OPf_WANT|5.004000||Viu
OPf_WANT_LIST|5.004000||Viu
OPf_WANT_SCALAR|5.004000||Viu
OPf_WANT_VOID|5.004000||Viu
OP_GIMME|5.004000||Viu
OP_GIMME_REVERSE|5.010001||Viu
OpHAS_SIBLING|5.021007|5.003007|p
op_integerize|5.015003||Viu
OP_IS_DIRHOP|5.015003||Viu
OP_IS_FILETEST|5.006001||Viu
OP_IS_FILETEST_ACCESS|5.008001||Viu
OP_IS_INFIX_BIT|5.021009||Viu
OP_IS_NUMCOMPARE|5.015003||Viu
OP_IS_SOCKET|5.006001||Viu
OP_IS_STAT|5.031001||Viu
OpLASTSIB_set|5.021011|5.003007|p
op_linklist|5.013006|5.013006|
op_lvalue|5.013007|5.013007|x
op_lvalue_flags|||ciu
OP_LVALUE_NO_CROAK|5.015001||Viu
OpMAYBESIB_set|5.021011|5.003007|p
opmethod_stash|5.021007||Viu
OpMORESIB_set|5.021011|5.003007|p
OP_NAME|5.007003|5.007003|
op_null|5.007002|5.007002|
OPpALLOW_FAKE|5.015006||Viu
op_parent|5.025001|5.025001|n
OPpARG1_MASK|5.021004||Viu
OPpARG2_MASK|5.021004||Viu
OPpARG3_MASK|5.021004||Viu
OPpARG4_MASK|5.021004||Viu
OPpARGELEM_AV|5.025004||Viu
OPpARGELEM_HV|5.025004||Viu
OPpARGELEM_MASK|5.025004||Viu
OPpARGELEM_SV|5.025004||Viu
OPpASSIGN_BACKWARDS|5.003007||Viu
OPpASSIGN_COMMON_AGG|5.023002||Viu
OPpASSIGN_COMMON_RC1|5.023002||Viu
OPpASSIGN_COMMON_SCALAR|5.023002||Viu
OPpASSIGN_CV_TO_GV|5.009003||Viu
OPpASSIGN_TRUEBOOL|5.027003||Viu
OPpAVHVSWITCH_MASK|5.025006||Viu
OPpCONCAT_NESTED|5.027007||Viu
OPpCONST_BARE|5.003007||Viu
OPpCONST_ENTERED|5.003007||Viu
OPpCONST_NOVER|5.009003||Viu
OPpCONST_SHORTCIRCUIT|5.009001||Viu
OPpCONST_STRICT|5.005004||Viu
OPpCOREARGS_DEREF1|5.015003||Viu
OPpCOREARGS_DEREF2|5.015003||Viu
OPpCOREARGS_PUSHMARK|5.015003||Viu
OPpCOREARGS_SCALARMOD|5.015003||Viu
OPpDEFER_FINALLY|5.035008||Viu
OPpDEREF|5.004000||Viu
OPpDEREF_AV|5.003007||Viu
OPpDEREF_HV|5.003007||Viu
OPpDEREF_SV|5.004000||Viu
OPpDONT_INIT_GV|5.009003||Viu
OPpEARLY_CV|5.006000|5.006000|
OPpENTERSUB_AMPER|5.003007|5.003007|
OPpENTERSUB_DB|5.003007||Viu
OPpENTERSUB_HASTARG|5.006000||Viu
OPpENTERSUB_INARGS|5.006000||Viu
OPpENTERSUB_LVAL_MASK|5.015001||Viu
OPpENTERSUB_NOPAREN|5.005004||Viu
OPpEVAL_BYTES|5.015005||Viu
OPpEVAL_COPHH|5.015005||Viu
OPpEVAL_HAS_HH|5.009003||Viu
OPpEVAL_RE_REPARSING|5.017011||Viu
OPpEVAL_UNICODE|5.015005||Viu
OPpEXISTS_SUB|5.006000||Viu
OPpFLIP_LINENUM|5.003007||Viu
OPpFT_ACCESS|5.008001||Viu
OPpFT_AFTER_t|5.015008||Viu
OPpFT_STACKED|5.009001||Viu
OPpFT_STACKING|5.015001||Viu
OPpHINT_STRICT_REFS|5.021004||Viu
OPpHUSH_VMSISH|5.007003||Viu
OPpINDEX_BOOLNEG|5.027003||Viu
OPpITER_DEF|5.027008||Viu
OPpITER_REVERSED|5.009002||Viu
OPpKVSLICE|5.027001||Viu
OPpLIST_GUESSED|5.003007||Viu
OPpLVAL_DEFER|5.004000||Viu
OPpLVAL_INTRO|5.003007||Viu
OPpLVALUE|5.019006||Viu
OPpLVREF_AV|5.021005||Viu
OPpLVREF_CV|5.021005||Viu
OPpLVREF_ELEM|5.021005||Viu
OPpLVREF_HV|5.021005||Viu
OPpLVREF_ITER|5.021005||Viu
OPpLVREF_SV|5.021005||Viu
OPpLVREF_TYPE|5.021005||Viu
OPpMAYBE_LVSUB|5.007001||Viu
OPpMAYBE_TRUEBOOL|5.017004||Viu
OPpMAY_RETURN_CONSTANT|5.009003||Viu
OPpMULTICONCAT_APPEND|5.027006||Viu
OPpMULTICONCAT_FAKE|5.027006||Viu
OPpMULTICONCAT_STRINGIFY|5.027006||Viu
OPpMULTIDEREF_DELETE|5.021007||Viu
OPpMULTIDEREF_EXISTS|5.021007||Viu
OPpOFFBYONE|5.015002||Viu
OPpOPEN_IN_CRLF|5.006000||Viu
OPpOPEN_IN_RAW|5.006000||Viu
OPpOPEN_OUT_CRLF|5.006000||Viu
OPpOPEN_OUT_RAW|5.006000||Viu
OPpOUR_INTRO|5.006000||Viu
OPpPADHV_ISKEYS|5.027003||Viu
OPpPADRANGE_COUNTMASK|5.017006||Viu
OPpPADRANGE_COUNTSHIFT|5.017006||Viu
OPpPAD_STATE|5.009004||Viu
OPpPV_IS_UTF8|5.016000||Viu
OPpREFCOUNTED|5.006000||Viu
OPpREPEAT_DOLIST|5.003007||Viu
op_prepend_elem|5.013006|5.013006|
OPpREVERSE_INPLACE|5.011002||Viu
OPpRV2HV_ISKEYS|5.027003||Viu
OPpSLICE|5.004000||Viu
OPpSLICEWARNING|5.019004||Viu
OPpSORT_DESCEND|5.009002||Viu
OPpSORT_INPLACE|5.009001||Viu
OPpSORT_INTEGER|5.006000||Viu
OPpSORT_NUMERIC|5.006000||Viu
OPpSORT_REVERSE|5.006000||Viu
OPpSPLIT_ASSIGN|5.025006||Viu
OPpSPLIT_IMPLIM|5.019002||Viu
OPpSPLIT_LEX|5.025006||Viu
OPpSUBSTR_REPL_FIRST|5.015006||Viu
OPpTARGET_MY|5.006000||Viu
OPpTRANS_ALL|5.009001||Viu
OPpTRANS_CAN_FORCE_UTF8|5.031006||Viu
OPpTRANS_COMPLEMENT|5.003007||Viu
OPpTRANS_DELETE|5.003007||Viu
OPpTRANS_FROM_UTF|5.006000||Viu
OPpTRANS_GROWS|5.006000||Viu
OPpTRANS_IDENTICAL|5.006000||Viu
OPpTRANS_SQUASH|5.003007||Viu
OPpTRANS_TO_UTF|5.006000||Viu
OPpTRANS_USE_SVOP|5.031006||Viu
OPpTRUEBOOL|5.017004||Viu
OPpUSEINT|5.035005||Viu
OpREFCNT_dec|5.006000||Viu
op_refcnt_dec|||xiu
OpREFCNT_inc|5.006000||Viu
op_refcnt_inc|||xiu
OP_REFCNT_INIT|5.006000||Viu
OP_REFCNT_LOCK|5.006000||Viu
op_refcnt_lock|5.009002|5.009002|u
OpREFCNT_set|5.006000||Viu
OP_REFCNT_TERM|5.006000||Viu
OP_REFCNT_UNLOCK|5.006000||Viu
op_refcnt_unlock|5.009002|5.009002|u
op_relocate_sv|5.021005||Viu
op_scope|5.013007|5.013007|x
OP_SIBLING|5.021002||Viu
OpSIBLING|5.021007|5.003007|p
op_sibling_splice|5.021002|5.021002|n
OpSLAB|5.017002||Viu
opslab_force_free|5.017002||Viu
opslab_free|5.017002||Viu
opslab_free_nopad|5.017002||Viu
OpslabREFCNT_dec|5.017002||Viu
OpslabREFCNT_dec_padok|5.017002||Viu
OpSLOT|5.017002||Viu
OPSLOT_HEADER|5.017002||Viu
OpSLOToff|5.033001||Viu
op_std_init|5.015003||Viu
OPTIMIZED|5.005000||Viu
OPTIMIZED_t8|5.035004||Viu
OPTIMIZED_t8_p8|5.033003||Viu
OPTIMIZED_t8_pb|5.033003||Viu
OPTIMIZED_tb|5.035004||Viu
OPTIMIZED_tb_p8|5.033003||Viu
OPTIMIZED_tb_pb|5.033003||Viu
optimize_op|5.027006||Viu
optimize_optree|5.027006||Vi
optimize_regclass|5.035001||Viu
OP_TYPE_IS|5.019007|5.019007|
OP_TYPE_IS_NN|5.019010||Viu
OP_TYPE_ISNT|5.019010||Viu
OP_TYPE_ISNT_AND_WASNT|5.019010||Viu
OP_TYPE_ISNT_AND_WASNT_NN|5.019010||Viu
OP_TYPE_ISNT_NN|5.019010||Viu
OP_TYPE_IS_OR_WAS|5.019010|5.019010|
OP_TYPE_IS_OR_WAS_NN|5.019010||Viu
op_unscope|5.017003||xViu
op_wrap_finally|5.035008|5.035008|x
O_RDONLY|5.006000||Viu
O_RDWR|5.006000||Viu
ORIGMARK|5.003007|5.003007|
OSNAME|5.003007|5.003007|Vn
OSVERS|5.007002|5.007002|Vn
O_TEXT|5.006000||Viu
OutCopFILE|5.007003||Viu
output_non_portable|5.031008||Viu
output_posix_warnings|5.029005||Viu
O_VMS_DELETEONCLOSE|5.031002||Viu
O_WRONLY|5.006000||Viu
package|5.003007||Viu
package_version|5.011001||Viu
pack_cat|5.033002|5.033002|d
packlist|5.008001|5.008001|
pack_rec|5.008001||Viu
packWARN2|5.007003|5.003007|p
packWARN3|5.007003|5.003007|p
packWARN4|5.007003|5.003007|p
packWARN|5.007003|5.003007|p
pad_add_anon|5.015001|5.015001|
pad_add_name_pv|5.015001|5.015001|
pad_add_name_pvn|5.015001|5.015001|
pad_add_name_pvs|5.015001|5.015001|
pad_add_name_sv|5.015001|5.015001|
padadd_NO_DUP_CHECK|5.011002||Viu
padadd_OUR|5.011002||Viu
padadd_STALEOK|5.017003||Viu
padadd_STATE|5.011002||Viu
pad_add_weakref|5.021007||Viu
pad_alloc|5.015001|5.015001|x
pad_alloc_name|5.015001||Vi
PadARRAY|5.017004|5.017004|x
PAD_BASE_SV|5.008001||Vi
pad_block_start|5.008001||Vi
pad_check_dup|5.008001||Vi
PAD_CLONE_VARS|5.008001||Vi
PAD_COMPNAME|5.017004||Viu
PAD_COMPNAME_FLAGS|5.008001||Vi
PAD_COMPNAME_FLAGS_isOUR|5.009004||Viu
PAD_COMPNAME_GEN|5.008001||Vi
PAD_COMPNAME_GEN_set|5.009003||Vi
PAD_COMPNAME_OURSTASH|5.008001||Vi
PAD_COMPNAME_PV|5.008001||Vi
PAD_COMPNAME_SV|5.009005||Viu
PAD_COMPNAME_TYPE|5.008001||Vi
pad_compname_type|5.033005|5.033005|d
PAD_FAKELEX_ANON|5.009005||Viu
PAD_FAKELEX_MULTI|5.009005||Viu
pad_findlex|5.005000||Vi
pad_findmy_pv|5.015001|5.015001|
pad_findmy_pvn|5.015001|5.015001|
pad_findmy_pvs|5.015001|5.015001|
pad_findmy_sv|5.015001|5.015001|
pad_fixup_inner_anons|5.008001||Vi
pad_free|5.003007||Vi
pad_leavemy|5.003007||Vi
PadlistARRAY|5.017004|5.017004|x
padlist_dup|5.013002||Vi
PadlistMAX|5.017004|5.017004|x
PadlistNAMES|5.017004|5.017004|x
PadlistNAMESARRAY|5.017004|5.017004|x
PadlistNAMESMAX|5.017004|5.017004|x
PadlistREFCNT|5.017004|5.017004|x
padlist_store|5.017004||Viu
PadMAX|5.017004|5.017004|x
padname_dup|5.021007||Vi
PadnameFLAGS|5.021007||Viu
padname_free|||ciu
PADNAME_FROM_PV|5.021007||Viu
PadnameIN_SCOPE|5.031004||Vniu
PadnameIsOUR|5.017004||Vi
PadnameIsSTATE|5.017004||Vi
PadnameIsSTATE_on|5.021007||Viu
PadnameLEN|5.017004|5.017004|x
PadnamelistARRAY|5.017004|5.017004|x
padnamelist_dup|5.021007||Vi
padnamelist_fetch|5.021007|5.021007|xn
padnamelist_free|||ciu
PadnamelistMAX|5.017004|5.017004|x
PadnamelistMAXNAMED|5.019003||Viu
PadnamelistREFCNT|5.021007|5.021007|x
PadnamelistREFCNT_dec|5.021007|5.021007|x
padnamelist_store|5.021007|5.021007|x
PadnameLVALUE|5.021006||Viu
PadnameLVALUE_on|5.021006||Viu
PadnameOURSTASH|5.017004||Vi
PadnameOURSTASH_set|5.021007||Viu
PadnameOUTER|5.017004||Vi
PadnamePROTOCV|5.021007||Viu
PadnamePV|5.017004|5.017004|x
PadnameREFCNT|5.021007|5.021007|x
PadnameREFCNT_dec|5.021007|5.021007|x
PadnameSV|5.017004|5.017004|x
PADNAMEt_LVALUE|5.021007||Viu
PADNAMEt_OUR|5.021007||Viu
PADNAMEt_OUTER|5.021007|5.021007|
PADNAMEt_STATE|5.021007||Viu
PADNAMEt_TYPED|5.021007||Viu
PadnameTYPE|5.017004||Vi
PadnameTYPE_set|5.021007||Viu
PadnameUTF8|5.017004|5.017004|x
pad_new|5.015001|5.015001|
padnew_CLONE|5.008001||Viu
padnew_SAVE|5.008001||Viu
padnew_SAVESUB|5.008001||Viu
pad_peg|5.009004||Viu
pad_push|5.008001||cVi
pad_reset|5.003007||Vi
PAD_RESTORE_LOCAL|5.008001||Vi
PAD_SAVE_LOCAL|5.008001||Vi
PAD_SAVE_SETNULLPAD|5.008001||Vi
PAD_SET_CUR|5.008001||Vi
PAD_SET_CUR_NOSAVE|5.008002||Vi
pad_setsv|5.008001||cV
PAD_SETSV|5.008001||Vi
pad_sv|5.003007||cV
PAD_SV|5.003007||Vi
PAD_SVl|5.008001||Vi
pad_swipe|5.003007||Vi
pad_tidy|5.015001|5.015001|x
panic_write2|5.008001||Viu
PARENT_FAKELEX_FLAGS|5.009005||Viu
PARENT_PAD_INDEX|5.009005||Viu
parse_arithexpr|5.013008|5.013008|x
parse_barestmt|5.013007|5.013007|x
parse_block|5.013007|5.013007|x
parse_body|5.006000||Viu
parse_fullexpr|5.013008|5.013008|x
parse_fullstmt|5.013005|5.013005|x
parse_gv_stash_name|5.019004||Viu
parse_ident|5.017010||Viu
parse_label|5.013007|5.013007|x
parse_listexpr|5.013008|5.013008|x
parse_lparen_question_flags|5.017009||Viu
PARSE_OPTIONAL|5.013007|5.013007|
parser_dup|5.009000|5.009000|u
parser_free|5.009005||Viu
parser_free_nexttoke_ops|5.017006||Viu
parse_stmtseq|5.013006|5.013006|x
parse_subsignature|5.031003|5.031003|x
parse_termexpr|5.013008|5.013008|x
parse_unicode_opts|5.008001||Viu
parse_uniprop_string|5.027011||Viu
PATCHLEVEL|5.003007||Viu
path_is_searchable|5.019001||Vniu
Pause|5.003007||Viu
pause|5.005000||Viu
pclose|5.003007||Viu
peep|5.003007||Viu
pending_ident|5.017004||Viu
PERL_ABS|5.008001|5.003007|p
Perl_acos|5.021004|5.021004|n
perl_alloc|5.003007|5.003007|n
PERL_ALLOC_CHECK|5.006000||Viu
perl_alloc_using|5.006000||Vnu
PERL_ANY_COW|5.017007||Viu
PERL_API_REVISION|5.006000||Viu
PERL_API_SUBVERSION|5.006000||Viu
PERL_API_VERSION|5.006000||Viu
PERL_API_VERSION_STRING|5.013004||Viu
PERL_ARENA_ROOTS_SIZE|5.009004||Viu
PERL_ARENA_SIZE|5.009003||Viu
PERL_ARGS_ASSERT_CROAK_XS_USAGE|||ponu
Perl_asin|5.021004|5.021004|n
Perl_assert|5.011000||Viu
perl_assert_ptr|5.027004||Viu
PERL_ASYNC_CHECK|5.006000|5.006000|
Perl_atan2|5.006000|5.006000|n
Perl_atan|5.021004|5.021004|n
Perl_atof2|5.006001||Viu
Perl_atof|5.006000||Viu
PERL_BCDVERSION||5.003007|onu
PERL_BISON_VERSION|5.023008||Viu
PERL_BITFIELD16|5.010001||Viu
PERL_BITFIELD32|5.010001||Viu
PERL_BITFIELD8|5.010001||Viu
PERL_CALLCONV|5.005002||Viu
PERL_CALLCONV_NO_RET|5.017002||Viu
Perl_ceil|5.009001|5.009001|n
PERL_CKDEF|5.006000||Viu
perl_clone|5.006000||Vn
perl_clone_using|5.006000||Vnu
PERL_CLZ_32|5.035003||Viu
PERL_CLZ_64|5.035003||Viu
perl_construct|5.003007|5.003007|n
PERL_COP_SEQMAX|5.013010||Viu
PERL_COPY_ON_WRITE|5.023001||Viu
Perl_cos|5.006000|5.006000|n
Perl_cosh|5.021004|5.021004|n
PERL_COUNT_MULTIPLIER|5.027007||Viu
PERL_CTZ_32|5.035003||Viu
PERL_CTZ_64|5.035003||Viu
Perl_custom_op_xop|5.019006||V
PERLDB_ALL|5.004002||Viu
PERLDBf_GOTO|5.004005||Viu
PERLDBf_INTER|5.004002||Viu
PERLDBf_LINE|5.004002||Viu
PERLDBf_NAMEANON|5.006000||Viu
PERLDBf_NAMEEVAL|5.006000||Viu
PERLDBf_NONAME|5.004005||Viu
PERLDBf_NOOPT|5.004002||Viu
PERLDBf_SAVESRC|5.010001||Viu
PERLDBf_SAVESRC_INVALID|5.010001||Viu
PERLDBf_SAVESRC_NOSUBS|5.010001||Viu
PERLDBf_SINGLE|5.004002||Viu
PERLDBf_SUB|5.004002||Viu
PERLDBf_SUBLINE|5.004002||Viu
PERLDB_GOTO|5.004005||Viu
PERLDB_INTER|5.004002||Viu
PERLDB_LINE|5.004002||Viu
PERLDB_LINE_OR_SAVESRC|5.023002||Viu
PERLDB_NAMEANON|5.006000||Viu
PERLDB_NAMEEVAL|5.006000||Viu
PERLDB_NOOPT|5.004002||Viu
PERLDB_SAVESRC|5.010001||Viu
PERLDB_SAVESRC_INVALID|5.010001||Viu
PERLDB_SAVESRC_NOSUBS|5.010001||Viu
PERLDB_SINGLE|5.004002||Viu
PERLDB_SUB|5.004002||Viu
PERLDB_SUBLINE|5.004002||Viu
PERLDB_SUB_NN|5.004005||Viu
PERL_DEB2|5.021007||Viu
PERL_DEB|5.008001||Viu
PERL_deBruijnMagic32|5.035003||Viu
PERL_deBruijnMagic64|5.035003||Viu
PERL_deBruijnShift32|5.035003||Viu
PERL_deBruijnShift64|5.035003||Viu
PERL_DEBUG|5.008001||Viu
Perl_debug_log|5.003007||Viu
PERL_DEBUG_PAD|5.007003||Viu
PERL_DEBUG_PAD_ZERO|5.007003||Viu
PERL_DECIMAL_VERSION|5.019008||Viu
PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION|5.009003||Viu
perl_destruct|5.007003|5.007003|n
PerlDir_chdir|5.005000||Viu
PerlDir_close|5.005000||Viu
PerlDir_mapA|5.006000||Viu
PerlDir_mapW|5.006000||Viu
PerlDir_mkdir|5.005000||Viu
PerlDir_open|5.005000||Viu
PerlDir_read|5.005000||Viu
PerlDir_rewind|5.005000||Viu
PerlDir_rmdir|5.005000||Viu
PerlDir_seek|5.005000||Viu
PerlDir_tell|5.005000||Viu
PERL_DONT_CREATE_GVSV|5.009003||Viu
Perl_drand48|5.019004||Viu
Perl_drand48_init|5.019004||Viu
PERL_DRAND48_QUAD|5.019004||Viu
PERL_DTRACE_PROBE_ENTRY|5.023009||Viu
PERL_DTRACE_PROBE_FILE_LOADED|5.023009||Viu
PERL_DTRACE_PROBE_FILE_LOADING|5.023009||Viu
PERL_DTRACE_PROBE_OP|5.023009||Viu
PERL_DTRACE_PROBE_PHASE|5.023009||Viu
PERL_DTRACE_PROBE_RETURN|5.023009||Viu
PERL_EBCDIC_TABLES_H|5.027001||Viu
PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS|5.009004||Viu
PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION|5.009004||Viu
PERL_ENABLE_POSITIVE_ASSERTION_STUDY|5.009005||Viu
PERL_ENABLE_TRIE_OPTIMISATION|5.009004||Viu
PerlEnv_clearenv|5.006000||Viu
PerlEnv_ENVgetenv|5.006000||Viu
PerlEnv_ENVgetenv_len|5.006000||Viu
PerlEnv_free_childdir|5.006000||Viu
PerlEnv_free_childenv|5.006000||Viu
PerlEnv_get_childdir|5.006000||Viu
PerlEnv_get_childenv|5.006000||Viu
PerlEnv_get_child_IO|5.006000||Viu
PerlEnv_getenv|5.005000||Viu
PerlEnv_getenv_len|5.006000||Viu
PerlEnv_lib_path|5.005000||Viu
PerlEnv_os_id|5.006000||Viu
PerlEnv_putenv|5.005000||Viu
PerlEnv_sitelib_path|5.005000||Viu
PerlEnv_uname|5.005004||Viu
PerlEnv_vendorlib_path|5.006000||Viu
Perl_error_log|5.006000||Viu
Perl_eval_pv||5.003007|onu
Perl_eval_sv||5.003007|onu
PERL_EXIT_ABORT|5.019003|5.019003|
PERL_EXIT_DESTRUCT_END|5.007003|5.007003|
PERL_EXIT_EXPECTED|5.006000|5.006000|
PERL_EXIT_WARN|5.019003|5.019003|
Perl_exp|5.006000|5.006000|n
Perl_fabs|5.035005||Viu
PERL_FEATURE_H|5.029006||Viu
PERL_FILE_IS_ABSOLUTE|5.006000||Viu
PERL_FILTER_EXISTS|5.009005||Viu
Perl_floor|5.006000|5.006000|n
PERL_FLUSHALL_FOR_CHILD|5.006000||Viu
Perl_fmod|5.006000|5.006000|n
Perl_fp_class|5.007003||Viu
Perl_fp_class_denorm|5.007003||Viu
Perl_fp_class_inf|5.007003||Viu
Perl_fp_class_nan|5.007003||Viu
Perl_fp_class_ndenorm|5.007003||Viu
Perl_fp_class_ninf|5.007003||Viu
Perl_fp_class_nnorm|5.007003||Viu
Perl_fp_class_norm|5.007003||Viu
Perl_fp_class_nzero|5.007003||Viu
Perl_fp_class_pdenorm|5.007003||Viu
Perl_fp_class_pinf|5.007003||Viu
Perl_fp_class_pnorm|5.007003||Viu
Perl_fp_class_pzero|5.007003||Viu
Perl_fp_class_qnan|5.007003||Viu
Perl_fp_class_snan|5.007003||Viu
Perl_fp_class_zero|5.007003||Viu
PERL_FPU_INIT|5.007002||Viu
PERL_FPU_POST_EXEC|5.008001||Viu
PERL_FPU_PRE_EXEC|5.008001||Viu
perl_free|5.003007|5.003007|n
Perl_free_c_backtrace|5.021001||Viu
Perl_frexp|5.006000|5.006000|n
PERL_FS_VER_FMT|5.006000||Viu
PERL_FS_VERSION|5.010001||Viu
PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||Viu
PERL_GCC_VERSION_GE|5.035003||Viu
PERL_GCC_VERSION_GT|5.035003||Viu
PERL_GCC_VERSION_LE|5.035003||Viu
PERL_GCC_VERSION_LT|5.035003||Viu
PERL_GET_CONTEXT|5.006000||Viu
PERL_GET_INTERP|5.006000||Viu
PERL_GET_THX|5.006000||Viu
PERL_GIT_UNPUSHED_COMMITS|5.010001||Viu
PERL_GPROF_MONCONTROL|5.007002||Viu
PERL_HANDY_H|5.027001||Viu
PERL_HAS_FAST_GET_LSB_POS32|5.035003||Viu
PERL_HAS_FAST_GET_LSB_POS64|5.035003||Viu
PERL_HAS_FAST_GET_MSB_POS32|5.035003||Viu
PERL_HAS_FAST_GET_MSB_POS64|5.035003||Viu
PERL_HASH|5.003007|5.003007|p
PERL_HASH_DEFAULT_HvMAX|5.017011||Viu
PERL_HASH_FUNC|5.017006||Viu
PERL_HASH_FUNC_SIPHASH13|5.033007||Viu
PERL_HASH_FUNC_ZAPHOD32|5.027001||Viu
PERL_HASH_INTERNAL|5.008002||Viu
PERL_HASH_ITER_BUCKET|5.018000||Viu
PERL_HASH_RANDOMIZE_KEYS|5.018000||Viu
PERL_HASH_SEED|5.008001||Viu
PERL_HASH_SEED_BYTES|5.017006||Viu
PERL_HASH_SEED_STATE|5.027001||Viu
PERL_HASH_SEED_WORDS|5.033007||Viu
PERL_HASH_STATE_BYTES|5.027001||Viu
PERL_HASH_STATE_WORDS|5.033007||Viu
PERL_HASH_USE_SBOX32_ALSO|5.027001||Viu
PERL_HASH_WITH_SEED|5.021001||Viu
PERL_HASH_WITH_STATE|5.027001||Viu
PERL_HV_ARRAY_ALLOC_BYTES|5.006000||Viu
PERL___I|5.009005||Viu
PERL_IMPLICIT_CONTEXT|5.006000||Viu
PERL_INC_VERSION_LIST|5.035009|5.035009|Vn
Perl_internal_drand48|5.027004||Viu
PERL_INTERPRETER_SIZE_UPTO_MEMBER|5.010000||Viu
PERL_INT_MAX|5.003007|5.003007|p
PERL_INT_MIN|5.003007|5.003007|p
PERL_INVLIST_INLINE_H|5.029006||Viu
PerlIO|5.003007||Viu
PerlIO_apply_layers|5.007001|5.007001|
PerlIOArg|5.007001||Viu
PerlIOBase|5.007001||Viu
PerlIO_binmode|5.007001|5.007001|
PERLIOBUF_DEFAULT_BUFSIZ|5.013007||Viu
PerlIO_canset_cnt|5.003007|5.003007|n
PerlIO_clearerr|5.007003|5.007003|
PerlIO_close|5.007003|5.007003|
PerlIO_context_layers|||u
PerlIO_debug|5.007001|5.007001|
PERLIO_DUP_CLONE|5.007003||Viu
PERLIO_DUP_FD|5.007003||Viu
PerlIO_eof|5.007003|5.007003|
PerlIO_error|5.007003|5.007003|
PerlIO_exportFILE|5.003007|5.003007|n
PERLIO_F_APPEND|5.007001|5.007001|
PerlIO_fast_gets|5.003007|5.003007|n
PERLIO_F_CANREAD|5.007001|5.007001|
PERLIO_F_CANWRITE|5.007001|5.007001|
PERLIO_F_CLEARED|5.013008||Viu
PERLIO_F_CRLF|5.007001|5.007001|
PerlIO_fdopen|5.003007|5.003007|n
PERLIO_F_EOF|5.007001|5.007001|
PERLIO_F_ERROR|5.007001|5.007001|
PERLIO_F_FASTGETS|5.007001|5.007001|
PerlIO_fileno|5.007003|5.007003|
PerlIO_fill|5.007000|5.007000|u
PerlIO_findFILE|5.003007|5.003007|n
PERLIO_F_LINEBUF|5.007001|5.007001|
PerlIO_flush|5.007003|5.007003|
PERLIO_F_NOTREG|5.008001||Viu
PERLIO_F_OPEN|5.007001|5.007001|
PERLIO_F_RDBUF|5.007001|5.007001|
PERLIO_F_TEMP|5.007001|5.007001|
PERLIO_F_TRUNCATE|5.007001|5.007001|
PERLIO_F_TTY|5.007001||Viu
PERLIO_F_UNBUF|5.007001|5.007001|
PERLIO_FUNCS_CAST|5.009003||pVu
PERLIO_FUNCS_DECL|5.009003|5.009003|pVu
PERLIO_F_UTF8|5.007001|5.007001|
PERLIO_F_WRBUF|5.007001|5.007001|
PerlIO_get_base|5.007003|5.007003|
PerlIO_get_bufsiz|5.007003|5.007003|
PerlIO_getc|5.003007|5.003007|n
PerlIO_get_cnt|5.007003|5.007003|
PerlIO_getpos|5.003007|5.003007|n
PerlIO_get_ptr|5.007003|5.007003|
PERLIO_H|5.027001||Viu
PerlIO_has_base|5.003007|5.003007|n
PerlIO_has_cntptr|5.003007|5.003007|n
PerlIO_importFILE|5.003007|5.003007|n
PERLIO_INIT|5.009005||Viu
PERLIO_K_BUFFERED|5.007001|5.007001|
PERLIO_K_CANCRLF|5.007001|5.007001|
PERLIO_K_DESTRUCT|5.007001||Viu
PERLIO_K_DUMMY|5.007001||Viu
PERLIO_K_FASTGETS|5.007001|5.007001|
PERLIO_K_MULTIARG|5.007003|5.007003|
PERLIO_K_RAW|5.007001|5.007001|
PERLIO_K_UTF8|5.007001||Viu
PERLIO_LAYERS|5.007001||Viu
PERLIOL_H|5.027001||Viu
PerlIONext|5.007001||Viu
PERLIO_NOT_STDIO|5.003007||Viu
PerlIO_open|5.003007|5.003007|n
PerlIO_printf|5.006000|5.003007|
PerlIO_putc|5.003007|5.003007|n
PerlIO_puts|5.003007|5.003007|n
PerlIO_read|5.007003|5.007003|
PerlIO_releaseFILE|5.003007|5.003007|n
PerlIO_reopen|5.003007|5.003007|n
PerlIO_restore_errno|5.021006||cViu
PerlIO_rewind|5.003007|5.003007|n
PerlIO_save_errno|5.021006||cViu
PerlIO_seek|5.007003|5.007003|
PerlIOSelf|5.007001||Viu
PerlIO_set_cnt|5.007003|5.007003|
PerlIO_setlinebuf|5.007003|5.007003|
PerlIO_setpos|5.003007|5.003007|n
PerlIO_set_ptrcnt|5.007003|5.007003|
PerlIO_stderr|5.007003|5.007003|
PerlIO_stdin|5.007003|5.007003|
PerlIO_stdout|5.007003|5.007003|
PerlIO_stdoutf|5.006000|5.003007|
PERLIO_STDTEXT|5.007001||Viu
PerlIO_tell|5.007003|5.007003|
PERLIO_TERM|5.009005||Viu
PerlIO_ungetc|5.003007|5.003007|n
PerlIO_unread|5.007003|5.007003|u
PERLIO_USING_CRLF|5.007003||Viu
PerlIOValid|5.007003||Viu
PerlIO_vprintf|5.003007|5.003007|n
PerlIO_write|5.007003|5.007003|
Perl_isfinite|5.007003|5.007003|n
Perl_isfinitel|5.021004||Viu
PERL_IS_GCC|5.032001||Viu
Perl_isinf|5.007003|5.007003|n
Perl_isnan|5.006001|5.006001|n
PERL_IS_SUBWORD_ADDR|5.027007||Viu
PERL_IS_UTF8_CHAR_DFA|5.035004||Viu
PERL_JNP_TO_DECIMAL|5.033001||Viu
Perl_langinfo|5.027004|5.027004|n
PERL_LANGINFO_H|5.027004||Viu
PERL_LAST_5_18_0_INTERP_MEMBER|5.017009||Viu
Perl_ldexp|5.021003|5.021003|n
PerlLIO_access|5.005000||Viu
PerlLIO_chmod|5.005000||Viu
PerlLIO_chown|5.005000||Viu
PerlLIO_chsize|5.005000||Viu
PerlLIO_close|5.005000||Viu
PerlLIO_dup2|5.005000||Viu
PerlLIO_dup2_cloexec|5.027008||Viu
PerlLIO_dup|5.005000||Viu
PerlLIO_dup_cloexec|5.027008||Viu
PerlLIO_flock|5.005000||Viu
PerlLIO_fstat|5.005000||Viu
PerlLIO_ioctl|5.005000||Viu
PerlLIO_isatty|5.005000||Viu
PerlLIO_link|5.006000||Viu
PerlLIO_lseek|5.005000||Viu
PerlLIO_lstat|5.005000||Viu
PerlLIO_mktemp|5.005000||Viu
PerlLIO_open3|5.005000||Viu
PerlLIO_open3_cloexec|5.027008||Viu
PerlLIO_open|5.005000||Viu
PerlLIO_open_cloexec|5.027008||Viu
PerlLIO_read|5.005000||Viu
PerlLIO_readlink|5.033005||Viu
PerlLIO_rename|5.005000||Viu
PerlLIO_setmode|5.005000||Viu
PerlLIO_stat|5.005000||Viu
PerlLIO_symlink|5.033005||Viu
PerlLIO_tmpnam|5.005000||Viu
PerlLIO_umask|5.005000||Viu
PerlLIO_unlink|5.005000||Viu
PerlLIO_utime|5.005000||Viu
PerlLIO_write|5.005000||Viu
PERL_LOADMOD_DENY|5.006000|5.003007|
PERL_LOADMOD_IMPORT_OPS|5.006000|5.003007|
PERL_LOADMOD_NOIMPORT|5.006000|5.003007|
Perl_log10|5.021004|5.021004|n
Perl_log|5.006000|5.006000|n
PERL_LONG_MAX|5.003007|5.003007|p
PERL_LONG_MIN|5.003007|5.003007|p
PERL_MAGIC_arylen|5.007002|5.003007|p
PERL_MAGIC_arylen_p|5.009003|5.009003|
PERL_MAGIC_backref|5.007002|5.003007|p
PERL_MAGIC_bm|5.007002|5.003007|p
PERL_MAGIC_checkcall|5.013006|5.013006|
PERL_MAGIC_collxfrm|5.007002|5.003007|p
PERL_MAGIC_dbfile|5.007002|5.003007|p
PERL_MAGIC_dbline|5.007002|5.003007|p
PERL_MAGIC_debugvar|5.021005|5.021005|
PERL_MAGIC_defelem|5.007002|5.003007|p
PERL_MAGIC_env|5.007002|5.003007|p
PERL_MAGIC_envelem|5.007002|5.003007|p
PERL_MAGIC_ext|5.007002|5.003007|p
PERL_MAGIC_fm|5.007002|5.003007|p
PERL_MAGIC_glob||5.003007|ponu
PERL_MAGIC_hints|5.009004|5.009004|
PERL_MAGIC_hintselem|5.009004|5.009004|
PERL_MAGIC_isa|5.007002|5.003007|p
PERL_MAGIC_isaelem|5.007002|5.003007|p
PERL_MAGIC_lvref|5.021005|5.021005|
PERL_MAGIC_mutex||5.003007|ponu
PERL_MAGIC_nkeys|5.007002|5.003007|p
PERL_MAGIC_nonelem|5.027009|5.027009|
PERL_MAGIC_overload||5.003007|ponu
PERL_MAGIC_overload_elem||5.003007|ponu
PERL_MAGIC_overload_table|5.007002|5.003007|p
PERL_MAGIC_pos|5.007002|5.003007|p
PERL_MAGIC_qr|5.007002|5.003007|p
PERL_MAGIC_READONLY_ACCEPTABLE|5.015000||Viu
PERL_MAGIC_regdata|5.007002|5.003007|p
PERL_MAGIC_regdatum|5.007002|5.003007|p
PERL_MAGIC_regex_global|5.007002|5.003007|p
PERL_MAGIC_rhash|5.009003|5.009003|
PERL_MAGIC_shared|5.007003|5.003007|p
PERL_MAGIC_shared_scalar|5.007003|5.003007|p
PERL_MAGIC_sig|5.007002|5.003007|p
PERL_MAGIC_sigelem|5.007002|5.003007|p
PERL_MAGIC_substr|5.007002|5.003007|p
PERL_MAGIC_sv|5.007002|5.003007|p
PERL_MAGIC_symtab|5.009003|5.009003|
PERL_MAGIC_taint|5.007002|5.003007|p
PERL_MAGIC_tied|5.007002|5.003007|p
PERL_MAGIC_tiedelem|5.007002|5.003007|p
PERL_MAGIC_tiedscalar|5.007002|5.003007|p
PERL_MAGIC_TYPE_IS_VALUE_MAGIC|5.015000||Viu
PERL_MAGIC_TYPE_READONLY_ACCEPTABLE|5.015000||Viu
PERL_MAGIC_utf8|5.008001|5.003007|p
PERL_MAGIC_UTF8_CACHESIZE|5.008001||Viu
PERL_MAGIC_uvar|5.007002|5.003007|p
PERL_MAGIC_uvar_elem|5.007003|5.003007|p
PERL_MAGIC_VALUE_MAGIC|5.015000||Viu
PERL_MAGIC_vec|5.007002|5.003007|p
PERL_MAGIC_vstring|5.008001|5.003007|p
PERL_MAGIC_VTABLE_MASK|5.015000||Viu
PERL_MALLOC_CTL_H|5.027001||Viu
Perl_malloc_good_size|5.010001||Viu
PERL_MALLOC_WRAP|5.009002|5.009002|Vn
PerlMem_calloc|5.006000||Viu
PerlMem_free|5.005000||Viu
PerlMem_free_lock|5.006000||Viu
PerlMem_get_lock|5.006000||Viu
PerlMem_is_locked|5.006000||Viu
PerlMem_malloc|5.005000||Viu
PERL_MEMORY_DEBUG_HEADER_SIZE|5.019009||Viu
PerlMemParse_calloc|5.006000||Viu
PerlMemParse_free|5.006000||Viu
PerlMemParse_free_lock|5.006000||Viu
PerlMemParse_get_lock|5.006000||Viu
PerlMemParse_is_locked|5.006000||Viu
PerlMemParse_malloc|5.006000||Viu
PerlMemParse_realloc|5.006000||Viu
PerlMem_realloc|5.005000||Viu
PerlMemShared_calloc|5.006000||Viu
PerlMemShared_free|5.006000||Viu
PerlMemShared_free_lock|5.006000||Viu
PerlMemShared_get_lock|5.006000||Viu
PerlMemShared_is_locked|5.006000||Viu
PerlMemShared_malloc|5.006000||Viu
PerlMemShared_realloc|5.006000||Viu
PERL_MG_UFUNC|5.007001||Viu
Perl_modf|5.006000|5.006000|n
PERL_MULTICONCAT_HEADER_SIZE|5.027006||Viu
PERL_MULTICONCAT_IX_LENGTHS|5.027006||Viu
PERL_MULTICONCAT_IX_NARGS|5.027006||Viu
PERL_MULTICONCAT_IX_PLAIN_LEN|5.027006||Viu
PERL_MULTICONCAT_IX_PLAIN_PV|5.027006||Viu
PERL_MULTICONCAT_IX_UTF8_LEN|5.027006||Viu
PERL_MULTICONCAT_IX_UTF8_PV|5.027006||Viu
PERL_MULTICONCAT_MAXARG|5.027006||Viu
Perl_my_mkostemp|5.027008||Viu
Perl_my_mkstemp|5.027004||Viu
PERL_MY_SNPRINTF_GUARDED|5.009004||Viu
PERL_MY_SNPRINTF_POST_GUARD|5.021002||Viu
PERL_MY_VSNPRINTF_GUARDED|5.009004||Viu
PERL_MY_VSNPRINTF_POST_GUARD|5.021002||Viu
PERL_NO_DEV_RANDOM|5.009004||Viu
PERL_NON_CORE_CHECK_EMPTY|5.035004||Viu
PERL_OBJECT_THIS|5.005000||Viu
PERL_OP_PARENT|5.025001||Viu
PERL_PADNAME_MINIMAL|5.021007||Viu
PERL_PADSEQ_INTRO|5.013010||Viu
perl_parse|5.006000|5.006000|n
PERL_PATCHLEVEL_H_IMPLICIT|5.006000||Viu
PERL_PATCHNUM|5.010001||Viu
PERL_POISON_EXPR|5.019006||Viu
Perl_pow|5.006000|5.006000|n
Perl_pp_accept|5.013009||Viu
Perl_pp_aelemfast_lex|5.015000||Viu
Perl_pp_andassign|5.013009||Viu
Perl_pp_avalues|5.013009||Viu
Perl_pp_bind|5.013009||Viu
Perl_pp_bit_xor|5.013009||Viu
Perl_pp_chmod|5.013009||Viu
Perl_pp_chomp|5.013009||Viu
Perl_pp_connect|5.013009||Viu
Perl_pp_cos|5.013009||Viu
Perl_pp_custom|5.013009||Viu
Perl_pp_dbmclose|5.013009||Viu
PERL_PPDEF|5.006000||Viu
Perl_pp_dofile|5.013009||Viu
Perl_pp_dor|5.013009||Viu
Perl_pp_dorassign|5.013009||Viu
Perl_pp_dump|5.013009||Viu
Perl_pp_egrent|5.013009||Viu
Perl_pp_enetent|5.013009||Viu
Perl_pp_eprotoent|5.013009||Viu
Perl_pp_epwent|5.013009||Viu
Perl_pp_eservent|5.013009||Viu
Perl_pp_exp|5.013009||Viu
Perl_pp_fcntl|5.013009||Viu
Perl_pp_ftatime|5.013009||Viu
Perl_pp_ftbinary|5.013009||Viu
Perl_pp_ftblk|5.013009||Viu
Perl_pp_ftchr|5.013009||Viu
Perl_pp_ftctime|5.013009||Viu
Perl_pp_ftdir|5.013009||Viu
Perl_pp_fteexec|5.013009||Viu
Perl_pp_fteowned|5.013009||Viu
Perl_pp_fteread|5.013009||Viu
Perl_pp_ftewrite|5.013009||Viu
Perl_pp_ftfile|5.013009||Viu
Perl_pp_ftmtime|5.013009||Viu
Perl_pp_ftpipe|5.013009||Viu
Perl_pp_ftrexec|5.013009||Viu
Perl_pp_ftrwrite|5.013009||Viu
Perl_pp_ftsgid|5.013009||Viu
Perl_pp_ftsize|5.013009||Viu
Perl_pp_ftsock|5.013009||Viu
Perl_pp_ftsuid|5.013009||Viu
Perl_pp_ftsvtx|5.013009||Viu
Perl_pp_ftzero|5.013009||Viu
Perl_pp_getpeername|5.013009||Viu
Perl_pp_getsockname|5.013009||Viu
Perl_pp_ggrgid|5.013009||Viu
Perl_pp_ggrnam|5.013009||Viu
Perl_pp_ghbyaddr|5.013009||Viu
Perl_pp_ghbyname|5.013009||Viu
Perl_pp_gnbyaddr|5.013009||Viu
Perl_pp_gnbyname|5.013009||Viu
Perl_pp_gpbyname|5.013009||Viu
Perl_pp_gpbynumber|5.013009||Viu
Perl_pp_gpwnam|5.013009||Viu
Perl_pp_gpwuid|5.013009||Viu
Perl_pp_gsbyname|5.013009||Viu
Perl_pp_gsbyport|5.013009||Viu
Perl_pp_gsockopt|5.013009||Viu
Perl_pp_hex|5.013009||Viu
Perl_pp_i_postdec|5.006000||Viu
Perl_pp_i_postinc|5.006000||Viu
Perl_pp_i_predec|5.006000||Viu
Perl_pp_i_preinc|5.006000||Viu
Perl_pp_keys|5.013009||Viu
Perl_pp_kill|5.013009||Viu
Perl_pp_lcfirst|5.013009||Viu
Perl_pp_lineseq|5.013009||Viu
Perl_pp_listen|5.013009||Viu
Perl_pp_localtime|5.013009||Viu
Perl_pp_log|5.013009||Viu
Perl_pp_lstat|5.013009||Viu
Perl_pp_mapstart|5.013009||Viu
Perl_pp_msgctl|5.013009||Viu
Perl_pp_msgget|5.013009||Viu
Perl_pp_msgrcv|5.013009||Viu
Perl_pp_msgsnd|5.013009||Viu
Perl_pp_nbit_xor|5.021009||Viu
Perl_pp_orassign|5.013009||Viu
Perl_pp_padany|5.013009||Viu
Perl_pp_pop|5.013009||Viu
Perl_pp_read|5.013009||Viu
Perl_pp_recv|5.013009||Viu
Perl_pp_regcmaybe|5.013009||Viu
Perl_pp_rindex|5.013009||Viu
Perl_pp_rv2hv|5.013009||Viu
Perl_pp_say|5.013009||Viu
Perl_pp_sbit_xor|5.021009||Viu
Perl_pp_scalar|5.013009||Viu
Perl_pp_schomp|5.013009||Viu
Perl_pp_scope|5.013009||Viu
Perl_pp_seek|5.013009||Viu
Perl_pp_semop|5.013009||Viu
Perl_pp_send|5.013009||Viu
Perl_pp_sge|5.013009||Viu
Perl_pp_sgrent|5.013009||Viu
Perl_pp_sgt|5.013009||Viu
Perl_pp_shmctl|5.013009||Viu
Perl_pp_shmget|5.013009||Viu
Perl_pp_shmread|5.013009||Viu
Perl_pp_shutdown|5.013009||Viu
Perl_pp_slt|5.013009||Viu
Perl_pp_snetent|5.013009||Viu
Perl_pp_socket|5.013009||Viu
Perl_pp_sprotoent|5.013009||Viu
Perl_pp_spwent|5.013009||Viu
Perl_pp_sqrt|5.013009||Viu
Perl_pp_sservent|5.013009||Viu
Perl_pp_ssockopt|5.013009||Viu
Perl_pp_symlink|5.013009||Viu
Perl_pp_transr|5.013009||Viu
Perl_pp_unlink|5.013009||Viu
Perl_pp_utime|5.013009||Viu
Perl_pp_values|5.013009||Viu
PERL_PRESERVE_IVUV|5.007001||Viu
PERL_PRIeldbl|5.006001|5.006001|Vn
PERL_PRIfldbl|5.006000|5.006000|Vn
PERL_PRIgldbl|5.006000|5.006000|Vn
PerlProc_abort|5.005000||Viu
PerlProc_crypt|5.005000||Viu
PerlProc_DynaLoad|5.006000||Viu
PerlProc_execl|5.005000||Viu
PerlProc_execv|5.005000||Viu
PerlProc_execvp|5.005000||Viu
PerlProc__exit|5.005000||Viu
PerlProc_exit|5.005000||Viu
PerlProc_fork|5.006000||Viu
PerlProc_getegid|5.005000||Viu
PerlProc_geteuid|5.005000||Viu
PerlProc_getgid|5.005000||Viu
PerlProc_getlogin|5.005000||Viu
PerlProc_GetOSError|5.006000||Viu
PerlProc_getpid|5.006000||Viu
PerlProc_gettimeofday|5.008000||Viu
PerlProc_getuid|5.005000||Viu
PerlProc_kill|5.005000||Viu
PerlProc_killpg|5.005000||Viu
PerlProc_lasthost|5.007001||Viu
PerlProc_longjmp|5.005000||Viu
PerlProc_pause|5.005000||Viu
PerlProc_pclose|5.005000||Viu
PerlProc_pipe|5.005000||Viu
PerlProc_pipe_cloexec|5.027008||Viu
PerlProc_popen|5.005000||Viu
PerlProc_popen_list|5.007001||Viu
PerlProc_setgid|5.005000||Viu
PerlProc_setjmp|5.005000||Viu
PerlProc_setuid|5.005000||Viu
PerlProc_signal|5.005000||Viu
PerlProc_sleep|5.005000||Viu
PerlProc_spawnvp|5.008000||Viu
PerlProc_times|5.005000||Viu
PerlProc_wait|5.005000||Viu
PerlProc_waitpid|5.005000||Viu
perl_pthread_mutex_lock|5.023006||Viu
perl_pthread_mutex_unlock|5.023006||Viu
PERL_PV_ESCAPE_ALL|5.009004|5.003007|p
PERL_PV_ESCAPE_DWIM|5.019008||Viu
PERL_PV_ESCAPE_DWIM_ALL_HEX|||Viu
PERL_PV_ESCAPE_FIRSTCHAR|5.009004|5.003007|p
PERL_PV_ESCAPE_NOBACKSLASH|5.009004|5.003007|p
PERL_PV_ESCAPE_NOCLEAR|5.009004|5.003007|p
PERL_PV_ESCAPE_NONASCII|5.013009|5.013009|
PERL_PV_ESCAPE_QUOTE|5.009004|5.003007|p
PERL_PV_ESCAPE_RE|5.009005|5.003007|p
PERL_PV_ESCAPE_UNI|5.009004|5.003007|p
PERL_PV_ESCAPE_UNI_DETECT|5.009004|5.003007|p
PERL_PV_PRETTY_DUMP|5.009004||pcV
PERL_PV_PRETTY_ELLIPSES|5.010000|5.003007|p
PERL_PV_PRETTY_EXACTSIZE|5.021005||Viu
PERL_PV_PRETTY_LTGT|5.009004|5.003007|p
PERL_PV_PRETTY_NOCLEAR|5.010000||pcV
PERL_PV_PRETTY_QUOTE|5.009004|5.003007|p
PERL_PV_PRETTY_REGPROP|5.009004||pcV
PERL_QUAD_MAX|5.003007|5.003007|p
PERL_QUAD_MIN|5.003007|5.003007|p
PERL_READ_LOCK|5.033005||Viu
PERL_READ_UNLOCK|5.033005||Viu
PERL_REENTR_API|5.009005||Viu
PERL_REENTR_H|5.027001||Viu
PERL_REENTR_USING_ASCTIME_R|5.031011||Viu
PERL_REENTR_USING_CRYPT_R|5.031011||Viu
PERL_REENTR_USING_CTERMID_R|5.031011||Viu
PERL_REENTR_USING_CTIME_R|5.031011||Viu
PERL_REENTR_USING_ENDGRENT_R|5.031011||Viu
PERL_REENTR_USING_ENDHOSTENT_R|5.031011||Viu
PERL_REENTR_USING_ENDNETENT_R|5.031011||Viu
PERL_REENTR_USING_ENDPROTOENT_R|5.031011||Viu
PERL_REENTR_USING_ENDPWENT_R|5.031011||Viu
PERL_REENTR_USING_ENDSERVENT_R|5.031011||Viu
PERL_REENTR_USING_GETGRENT_R|5.031011||Viu
PERL_REENTR_USING_GETGRGID_R|5.031011||Viu
PERL_REENTR_USING_GETGRNAM_R|5.031011||Viu
PERL_REENTR_USING_GETHOSTBYADDR_R|5.031011||Viu
PERL_REENTR_USING_GETHOSTBYNAME_R|5.031011||Viu
PERL_REENTR_USING_GETHOSTENT_R|5.031011||Viu
PERL_REENTR_USING_GETLOGIN_R|5.031011||Viu
PERL_REENTR_USING_GETNETBYADDR_R|5.031011||Viu
PERL_REENTR_USING_GETNETBYNAME_R|5.031011||Viu
PERL_REENTR_USING_GETNETENT_R|5.031011||Viu
PERL_REENTR_USING_GETPROTOBYNAME_R|5.031011||Viu
PERL_REENTR_USING_GETPROTOBYNUMBER_R|5.031011||Viu
PERL_REENTR_USING_GETPROTOENT_R|5.031011||Viu
PERL_REENTR_USING_GETPWENT_R|5.031011||Viu
PERL_REENTR_USING_GETPWNAM_R|5.031011||Viu
PERL_REENTR_USING_GETPWUID_R|5.031011||Viu
PERL_REENTR_USING_GETSERVBYNAME_R|5.031011||Viu
PERL_REENTR_USING_GETSERVBYPORT_R|5.031011||Viu
PERL_REENTR_USING_GETSERVENT_R|5.031011||Viu
PERL_REENTR_USING_GETSPNAM_R|5.031011||Viu
PERL_REENTR_USING_GMTIME_R|5.031011||Viu
PERL_REENTR_USING_LOCALTIME_R|5.031011||Viu
PERL_REENTR_USING_READDIR64_R|5.031011||Viu
PERL_REENTR_USING_READDIR_R|5.031011||Viu
PERL_REENTR_USING_SETGRENT_R|5.031011||Viu
PERL_REENTR_USING_SETHOSTENT_R|5.031011||Viu
PERL_REENTR_USING_SETLOCALE_R|5.031011||Viu
PERL_REENTR_USING_SETNETENT_R|5.031011||Viu
PERL_REENTR_USING_SETPROTOENT_R|5.031011||Viu
PERL_REENTR_USING_SETPWENT_R|5.031011||Viu
PERL_REENTR_USING_SETSERVENT_R|5.031011||Viu
PERL_REENTR_USING_STRERROR_R|5.031011||Viu
PERL_REENTR_USING_TMPNAM_R|5.031011||Viu
PERL_REENTR_USING_TTYNAME_R|5.031011||Viu
PERL_REGCHARCLASS_H|5.027001||Viu
PERL_REGCOMP_H|5.029006||Viu
PERL_REGMATCH_SLAB_SLOTS|5.009004||Viu
PERL_RELOCATABLE_INC|5.017002|5.017002|Vn
PERL_REVISION|5.006000|5.006000|d
perl_run|5.003007|5.003007|n
PERL_RW_MUTEX_DESTROY|5.033005||Viu
PERL_RW_MUTEX_INIT|5.033005||Viu
Perl_safesysmalloc_size|5.010001||Viu
PERL_SAWAMPERSAND|5.017010||Viu
PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES|5.031009||Viu
PERL_SCAN_ALLOW_UNDERSCORES|5.007003|5.003007|p
PERL_SCAN_DISALLOW_PREFIX|5.007003|5.003007|p
PERL_SCAN_GREATER_THAN_UV_MAX|5.007003|5.003007|p
PERL_SCAN_NOTIFY_ILLDIGIT|5.031008||Viu
PERL_SCAN_SILENT_ILLDIGIT|5.008001|5.003007|p
PERL_SCAN_SILENT_NON_PORTABLE|5.015001||Viu
PERL_SCAN_SILENT_OVERFLOW|5.031009||Viu
PERL_SCAN_TRAILING|5.021002|5.021002|
PERL_SCNfldbl|5.006001|5.006001|Vn
PERL_SCRIPT_MODE|5.004005||Viu
PERL_SEEN_HV_FUNC_H|5.017010||Viu
PERL_SEEN_HV_MACRO_H|5.027001||Viu
PERL_SET_CONTEXT|5.006000||Viu
PERL_SET_INTERP|5.006000||Viu
Perl_setlocale|5.027002|5.027002|n
PERL_SET_PHASE|5.015001||Viu
PERL_SET_THX|5.006000||Viu
Perl_sharepvn|5.006000||Viu
PERL_SHORT_MAX|5.003007|5.003007|p
PERL_SHORT_MIN|5.003007|5.003007|p
PERLSI_DESTROY|5.005000||Viu
PERLSI_DIEHOOK|5.005000||Viu
PERL_SIGNALS_UNSAFE_FLAG|5.008001|5.003007|p
Perl_signbit|5.009005|5.009005|xn
PERLSI_MAGIC|5.005000||Viu
PERLSI_MAIN|5.005000||Viu
PERLSI_MULTICALL|5.023000||Viu
Perl_sin|5.006000|5.006000|n
Perl_sinh|5.021004|5.021004|n
PerlSIO_canset_cnt|5.007001||Viu
PerlSIO_clearerr|5.007001||Viu
PerlSIO_fast_gets|5.007001||Viu
PerlSIO_fclose|5.007001||Viu
PerlSIO_fdopen|5.007001||Viu
PerlSIO_fdupopen|5.007001||Viu
PerlSIO_feof|5.007001||Viu
PerlSIO_ferror|5.007001||Viu
PerlSIO_fflush|5.007001||Viu
PerlSIO_fgetc|5.007001||Viu
PerlSIO_fgetpos|5.007001||Viu
PerlSIO_fgets|5.007001||Viu
PerlSIO_fileno|5.007001||Viu
PerlSIO_fopen|5.007001||Viu
PerlSIO_fputc|5.007001||Viu
PerlSIO_fputs|5.007001||Viu
PerlSIO_fread|5.007001||Viu
PerlSIO_freopen|5.007001||Viu
PerlSIO_fseek|5.007001||Viu
PerlSIO_fsetpos|5.007001||Viu
PerlSIO_ftell|5.007001||Viu
PerlSIO_fwrite|5.007001||Viu
PerlSIO_get_base|5.007001||Viu
PerlSIO_get_bufsiz|5.007001||Viu
PerlSIO_get_cnt|5.007001||Viu
PerlSIO_get_ptr|5.007001||Viu
PerlSIO_has_base|5.007001||Viu
PerlSIO_has_cntptr|5.007001||Viu
PerlSIO_init|5.007001||Viu
PerlSIO_printf|5.007001||Viu
PerlSIO_rewind|5.007001||Viu
PerlSIO_setbuf|5.007001||Viu
PerlSIO_set_cnt|5.007001||Viu
PerlSIO_setlinebuf|5.007001||Viu
PerlSIO_set_ptr|5.007001||Viu
PerlSIO_setvbuf|5.007001||Viu
PerlSIO_stderr|5.007001||Viu
PerlSIO_stdin|5.007001||Viu
PerlSIO_stdout|5.007001||Viu
PerlSIO_stdoutf|5.007001||Viu
PerlSIO_tmpfile|5.007001||Viu
PerlSIO_ungetc|5.007001||Viu
PERLSI_OVERLOAD|5.005000||Viu
PerlSIO_vprintf|5.007001||Viu
PERL_SIPHASH_FNC|5.025008||Viu
PERLSI_REGCOMP|5.031011||Viu
PERLSI_REQUIRE|5.005000||Viu
PERLSI_SIGNAL|5.005000||Viu
PERLSI_SORT|5.005000||Viu
PERLSI_UNDEF|5.005000||Viu
PERLSI_UNKNOWN|5.005000||Viu
PERLSI_WARNHOOK|5.005000||Viu
PERL_SNPRINTF_CHECK|5.021002||Viu
PerlSock_accept|5.005000||Viu
PerlSock_accept_cloexec|5.027008||Viu
PerlSock_bind|5.005000||Viu
PerlSock_closesocket|5.006000||Viu
PerlSock_connect|5.005000||Viu
PerlSock_endhostent|5.005000||Viu
PerlSock_endnetent|5.005000||Viu
PerlSock_endprotoent|5.005000||Viu
PerlSock_endservent|5.005000||Viu
PerlSock_gethostbyaddr|5.005000||Viu
PerlSock_gethostbyname|5.005000||Viu
PerlSock_gethostent|5.005000||Viu
PerlSock_gethostname|5.005000||Viu
PerlSock_getnetbyaddr|5.005000||Viu
PerlSock_getnetbyname|5.005000||Viu
PerlSock_getnetent|5.005000||Viu
PerlSock_getpeername|5.005000||Viu
PerlSock_getprotobyname|5.005000||Viu
PerlSock_getprotobynumber|5.005000||Viu
PerlSock_getprotoent|5.005000||Viu
PerlSock_getservbyname|5.005000||Viu
PerlSock_getservbyport|5.005000||Viu
PerlSock_getservent|5.005000||Viu
PerlSock_getsockname|5.005000||Viu
PerlSock_getsockopt|5.005000||Viu
PerlSock_htonl|5.005000||Viu
PerlSock_htons|5.005000||Viu
PerlSock_inet_addr|5.005000||Viu
PerlSock_inet_ntoa|5.005000||Viu
PerlSock_listen|5.005000||Viu
PerlSock_ntohl|5.005000||Viu
PerlSock_ntohs|5.005000||Viu
PerlSock_recv|5.005000||Viu
PerlSock_recvfrom|5.005000||Viu
PerlSock_select|5.005000||Viu
PerlSock_send|5.005000||Viu
PerlSock_sendto|5.005000||Viu
PerlSock_sethostent|5.005000||Viu
PerlSock_setnetent|5.005000||Viu
PerlSock_setprotoent|5.005000||Viu
PerlSock_setservent|5.005000||Viu
PerlSock_setsockopt|5.005000||Viu
PerlSock_shutdown|5.005000||Viu
PERL_SOCKS_NEED_PROTOTYPES|5.007001||Viu
PerlSock_socket|5.005000||Viu
PerlSock_socket_cloexec|5.027008||Viu
PerlSock_socketpair|5.005000||Viu
PerlSock_socketpair_cloexec|5.027008||Viu
Perl_sqrt|5.006000|5.006000|n
PERL_STACK_OFFSET_DEFINED|||piu
PERL_STACK_OVERFLOW_CHECK|5.006000||Viu
PERL_STACK_REALIGN|||piu
PERL_STATIC_FORCE_INLINE|5.031011||Viu
PERL_STATIC_FORCE_INLINE_NO_RET|5.031011||Viu
PERL_STATIC_INLINE|5.013004|5.013004|poVn
PERL_STATIC_INLINE_NO_RET|5.017005||Viu
PERL_STATIC_NO_RET|5.017005||Viu
PERL_STRLEN_EXPAND_SHIFT|5.013004||Viu
PERL_STRLEN_ROUNDUP|5.009003||Viu
PERL_STRLEN_ROUNDUP_QUANTUM|5.009003||Viu
Perl_strtod|5.021004||Viu
PERL_SUB_DEPTH_WARN|5.010001||Viu
PERL_SUBVERSION|5.006000|5.003007|d
PERL_SYS_FPU_INIT|5.021005||Viu
PERL_SYS_INIT3|5.006000|5.006000|
PERL_SYS_INIT3_BODY|5.010000||Viu
PERL_SYS_INIT|5.003007|5.003007|
PERL_SYS_INIT_BODY|5.010000||Viu
PERL_SYS_TERM|5.003007|5.003007|
PERL_SYS_TERM_BODY|5.010000||Viu
Perl_tan|5.021004|5.021004|n
Perl_tanh|5.021004|5.021004|n
PERL_TARGETARCH|5.007002|5.007002|Vn
PERL_THREAD_LOCAL|5.035004|5.035004|Vn
PERL_TIME64_CONFIG_H|5.027001||Viu
PERL_TIME64_H|5.027001||Viu
PERL_TRACK_MEMPOOL|5.009003||Viu
PERL_TSA|5.023006||Viu
PERL_TSA_ACQUIRE|5.023006||Viu
PERL_TSA_ACTIVE|5.023006||Viu
PERL_TSA_CAPABILITY|5.023006||Viu
PERL_TSA_EXCLUDES|5.023006||Viu
PERL_TSA_GUARDED_BY|5.023006||Viu
PERL_TSA_NO_TSA|5.023006||Viu
PERL_TSA_PT_GUARDED_BY|5.023006||Viu
PERL_TSA_RELEASE|5.023006||Viu
PERL_TSA_REQUIRES|5.023006||Viu
PERL_UCHAR_MAX|5.003007|5.003007|p
PERL_UCHAR_MIN|5.003007|5.003007|p
PERL_UINT_MAX|5.003007|5.003007|p
PERL_UINT_MIN|5.003007|5.003007|p
PERL_ULONG_MAX|5.003007|5.003007|p
PERL_ULONG_MIN|5.003007|5.003007|p
PERL_UNICODE_ALL_FLAGS|5.008001||Viu
PERL_UNICODE_ARGV|5.008001||Viu
PERL_UNICODE_ARGV_FLAG|5.008001||Viu
PERL_UNICODE_CONSTANTS_H|5.027001||Viu
PERL_UNICODE_DEFAULT_FLAGS|5.008001||Viu
PERL_UNICODE_IN|5.008001||Viu
PERL_UNICODE_IN_FLAG|5.008001||Viu
PERL_UNICODE_INOUT|5.008001||Viu
PERL_UNICODE_INOUT_FLAG|5.008001||Viu
PERL_UNICODE_LOCALE|5.008001||Viu
PERL_UNICODE_LOCALE_FLAG|5.008001||Viu
PERL_UNICODE_MAX|5.007003||Viu
PERL_UNICODE_OUT|5.008001||Viu
PERL_UNICODE_OUT_FLAG|5.008001||Viu
PERL_UNICODE_STD|5.008001||Viu
PERL_UNICODE_STDERR|5.008001||Viu
PERL_UNICODE_STDERR_FLAG|5.008001||Viu
PERL_UNICODE_STD_FLAG|5.008001||Viu
PERL_UNICODE_STDIN|5.008001||Viu
PERL_UNICODE_STDIN_FLAG|5.008001||Viu
PERL_UNICODE_STDOUT|5.008001||Viu
PERL_UNICODE_STDOUT_FLAG|5.008001||Viu
PERL_UNICODE_UTF8CACHEASSERT|5.009004||Viu
PERL_UNICODE_UTF8CACHEASSERT_FLAG|5.009004||Viu
PERL_UNICODE_WIDESYSCALLS|5.008001||Viu
PERL_UNICODE_WIDESYSCALLS_FLAG|5.008001||Viu
PERL_UNLOCK_HOOK|5.009004||Viu
PERL_UNUSED_ARG|5.009003|5.003007|p
PERL_UNUSED_CONTEXT|5.009004|5.003007|p
PERL_UNUSED_DECL|5.007002|5.003007|p
PERL_UNUSED_RESULT|5.021001|5.003007|p
PERL_UNUSED_VAR|5.007002|5.003007|p
PERL_UQUAD_MAX|5.003007|5.003007|p
PERL_UQUAD_MIN|5.003007|5.003007|p
PERL_USE_DEVEL|5.010001|5.010001|Vn
PERL_USE_GCC_BRACE_GROUPS|5.009004|5.003007|pV
PERL_USES_PL_PIDSTATUS|5.009003||Viu
PERL_USE_THREAD_LOCAL|5.035004||Viu
PERL_USHORT_MAX|5.003007|5.003007|p
PERL_USHORT_MIN|5.003007|5.003007|p
PERL_UTF8_H|5.027001||Viu
PERL_UTIL_H|5.025012||Viu
Perl_va_copy|5.007001||Viu
PERLVAR|5.005000||Viu
PERLVARA|5.006000||Viu
PERLVARI|5.005000||Viu
PERL_VARIANTS_WORD_MASK|5.027007||Viu
PERLVARIC|5.005000||Viu
PERL_VERSION|5.006000|5.003007|d
PERL_VERSION_EQ|5.033001||p
PERL_VERSION_GE|5.033001|5.003007|p
PERL_VERSION_GT|5.033001|5.003007|p
PERL_VERSION_LE|5.033001|5.003007|p
PERL_VERSION_LT|5.033001|5.003007|p
PERL_VERSION_MAJOR|5.033001||Viu
PERL_VERSION_MINOR|5.033001||Viu
PERL_VERSION_NE|5.033001||p
PERL_VERSION_PATCH|5.033001||Viu
PERL_VERSION_STRING|5.010001||Viu
PERL_WAIT_FOR_CHILDREN|5.006000||Viu
Perl_Warn_Bit|5.033003||Viu
Perl_warner_nocontext||5.004000|ponu
PERL_WARNHOOK_FATAL|5.009004||Viu
Perl_Warn_Off|5.033003||Viu
PERL_WORD_BOUNDARY_MASK|5.027007||Viu
PERL_WORDSIZE|5.027007||Viu
PERL_WRITE_LOCK|5.033005||Viu
PERL_WRITE_MSG_TO_CONSOLE|5.007003||Viu
PERL_WRITE_UNLOCK|5.033005||Viu
PERL_XSUB_H|5.027001||Viu
perly_sighandler|5.031007||cVnu
phase_name|5.035007|5.035007|
PHOSTNAME|5.006000|5.006000|Vn
pidgone|5.003007||Viu
Pid_t|5.005000|5.005000|Vn
pipe|5.005000||Viu
PIPE_OPEN_MODE|5.008002||Viu
PIPESOCK_MODE|5.008001||Viu
PL_AboveLatin1|5.015008||Viu
PL_amagic_generation|5.005000||Viu
PL_an|5.005000||Viu
PL_argvgv|5.005000||Viu
PL_argvoutgv|5.005000||Viu
PL_argvout_stack|5.006000||Viu
PL_Assigned_invlist|5.025009||Viu
PL_basetime|5.005000||Viu
PL_beginav|5.005000||Viu
PL_beginav_save|5.006001||Viu
PL_blockhooks|5.013003||Viu
PL_body_arenas|5.009004||Viu
PL_body_roots|5.009003||Viu
PL_bodytarget|5.005000||Viu
PL_breakable_sub_gen|5.010001||Viu
PL_bufend||5.003007|ponu
PL_bufptr||5.003007|ponu
PL_CCC_non0_non230|5.029008||Viu
PL_check|5.009003|5.006000|
PL_checkav|5.006000||Viu
PL_checkav_save|5.008001||Viu
PL_chopset|5.005000||Viu
PL_clocktick|5.008001||Viu
PL_collation_ix|5.005000||Viu
PL_collation_name|5.005000||Viu
PL_collation_standard|5.005000||Viu
PL_collxfrm_base|5.005000||Viu
PL_collxfrm_mult|5.005000||Viu
PL_colors|5.005000||Viu
PL_colorset|5.005000||Viu
PL_compcv|5.005000||Viu
PL_compiling|5.005000|5.003007|poVnu
PL_comppad|5.008001|5.008001|x
PL_comppad_name|5.017004|5.017004|x
PL_comppad_name_fill|5.005000||Viu
PL_comppad_name_floor|5.005000||Viu
PL_constpadix|5.021004||Viu
PL_copline||5.003007|ponu
PL_cop_seqmax|5.005000||Viu
PL_cshlen|5.005000||Viu
PL_curcop|5.004005|5.003007|p
PL_curcopdb|5.005000||Viu
PL_curlocales|5.027009||Viu
PL_curpad|5.005000|5.005000|x
PL_curpm|5.005000||Viu
PL_curpm_under|5.025007||Viu
PL_curstack|5.005000||Viu
PL_curstackinfo|5.005000||Viu
PL_curstash|5.004005|5.003007|p
PL_curstname|5.005000||Viu
PL_custom_op_descs|5.007003||Viu
PL_custom_op_names|5.007003||Viu
PL_custom_ops|5.013007||Viu
PL_cv_has_eval|5.009000||Viu
PL_dbargs|5.005000||Viu
PL_DBcontrol|5.021005||Viu
PL_DBcv|5.005000||Viu
PL_DBgv|5.005000||Viu
PL_DBline|5.005000||Viu
PL_DBsignal|5.005000|5.003007|poVnu
PL_DBsignal_iv|5.021005||Viu
PL_DBsingle|5.005000||pV
PL_DBsingle_iv|5.021005||Viu
PL_DBsub|5.005000||pV
PL_DBtrace|5.005000||pV
PL_DBtrace_iv|5.021005||Viu
PL_debstash|5.005000|5.003007|poVnu
PL_debug|5.005000||Viu
PL_debug_pad|5.007003||Viu
PL_defgv|5.004005|5.003007|p
PL_def_layerlist|5.007003||Viu
PL_defoutgv|5.005000||Viu
PL_defstash|5.005000||Viu
PL_delaymagic|5.005000||Viu
PL_delaymagic_egid|5.015008||Viu
PL_delaymagic_euid|5.015008||Viu
PL_delaymagic_gid|5.015008||Viu
PL_delaymagic_uid|5.015008||Viu
PL_destroyhook|5.010000||Viu
PL_diehook|5.005000|5.003007|poVnu
PL_Dir|5.006000||Viu
PL_dirty|5.005000|5.003007|poVnu
PL_doswitches|5.005000||Viu
PL_dowarn|5.005000||pV
PL_dumper_fd|5.009003||Viu
PL_dumpindent|5.006000||Viu
PL_dump_re_max_len|5.023008||Viu
PL_efloatbuf|5.006000||Viu
PL_efloatsize|5.006000||Viu
PL_E_FORMAT_PRECISION|5.029000||Viu
PL_encoding|5.007003||Viu
PL_endav|5.005000||Viu
PL_Env|5.006000||Viu
PL_envgv|5.005000||Viu
PL_errgv|5.004005|5.003007|p
PL_error_count||5.003007|ponu
PL_errors|5.006000||Viu
PL_e_script|5.005000||Viu
PL_eval_root|5.005000||Viu
PL_evalseq|5.005000||Viu
PL_eval_start|5.005000||Viu
PL_exit_flags|5.006000|5.006000|
PL_exitlist|5.005000||Viu
PL_exitlistlen|5.005000||Viu
PL_expect||5.003007|ponu
PL_fdpid|5.005000||Viu
PL_filemode|5.005000||Viu
PL_firstgv|5.005000||Viu
PL_forkprocess|5.005000||Viu
PL_formtarget|5.005000||Viu
PL_GCB_invlist|5.021009||Viu
PL_generation|5.005000||Viu
PL_gensym|5.005000||Viu
PL_globalstash|5.005000||Viu
PL_globhook|5.015005||Viu
PL_hash_rand_bits|5.017010||Viu
PL_HASH_RAND_BITS_ENABLED|5.018000||Viu
PL_hash_rand_bits_enabled|5.018000||Viu
PL_hash_seed|5.033007||Viu
PL_hash_state|5.033007||Viu
PL_HasMultiCharFold|5.017005||Viu
PL_hexdigit||5.003007|pn
PL_hintgv|5.005000||Viu
PL_hints|5.005000|5.003007|poVnu
PL_hv_fetch_ent_mh|5.005000||Viu
PL_incgv|5.005000||Viu
PL_in_clean_all|5.005000||Viu
PL_in_clean_objs|5.005000||Viu
PL_in_eval|5.005000||Viu
PL_initav|5.005000||Viu
PL_in_load_module|5.008001||Viu
PL_in_my||5.003007|ponu
PL_in_my_stash||5.005000|ponu
PL_inplace|5.005000||Viu
PL_in_some_fold|5.029007||Viu
PL_internal_random_state|5.027004||Viu
PL_in_utf8_COLLATE_locale|5.025002||Viu
PL_in_utf8_CTYPE_locale|5.019009||Viu
PL_in_utf8_turkic_locale|5.029008||Viu
PL_isarev|5.009005||Viu
PL_keyword_plugin|5.011002|5.011002|x
PL_known_layers|5.007003||Viu
PL_langinfo_buf|5.027004||Viu
PL_langinfo_bufsize|5.027004||Viu
PL_lastfd|5.005000||Viu
PL_lastgotoprobe|5.005000||Viu
PL_last_in_gv|5.005000||Vi
PL_laststatval|5.005000|5.003007|poVnu
PL_laststype|5.005000||Viu
PL_Latin1|5.015008||Viu
PL_LB_invlist|5.023007||Viu
PL_lc_numeric_mutex_depth|5.027009||Viu
PL_lex_state||5.003007|ponu
PL_lex_stuff||5.003007|ponu
PL_linestr||5.003007|ponu
PL_LIO|5.006000||Viu
PL_locale_utf8ness|5.027009||Viu
PL_localizing|5.005000||Viu
PL_localpatches|5.005000||Viu
PL_lockhook|5.007003||Viu
PL_main_cv|5.005000||Viu
PL_main_root|5.005000||Viu
PL_mainstack|5.005000||Viu
PL_main_start|5.005000||Viu
PL_markstack|5.005000||Viu
PL_markstack_max|5.005000||Viu
PL_markstack_ptr|5.005000||Viu
PL_max_intro_pending|5.005000||Viu
PL_maxo|5.005000||Viu
PL_maxsysfd|5.005000|5.005000|
PL_mbrlen_ps|5.031010||Viu
PL_mbrtowc_ps|5.031010||Viu
PL_Mem|5.006000||Viu
PL_mem_log|5.033005||Viu
PL_memory_debug_header|5.009004||Viu
PL_MemParse|5.006000||Viu
PL_MemShared|5.006000||Viu
PL_mess_sv|5.005000|5.004000|poVnu
PL_min_intro_pending|5.005000||Viu
PL_minus_a|5.005000||Viu
PL_minus_c|5.005000||Viu
PL_minus_E|5.009003||Viu
PL_minus_F|5.005000||Viu
PL_minus_l|5.005000||Viu
PL_minus_n|5.005000||Viu
PL_minus_p|5.005000||Viu
PL_modcount|5.005000||Viu
PL_modglobal|5.005000|5.005000|
PL_multideref_pc|5.021007||Viu
PL_my_cxt_list|5.009003||Viu
PL_my_cxt_size|5.009003||Viu
PL_na|5.004005|5.003007|p
PL_nomemok|5.005000||Viu
PL_no_modify||5.003007|ponu
PL_numeric_name|5.005000||Viu
PL_numeric_radix_sv|5.007002||Viu
PL_numeric_standard|5.005000||Viu
PL_numeric_underlying|5.027006||Viu
PL_numeric_underlying_is_standard|5.027009||Viu
PL_ofsgv|5.011000||Vi
PL_oldname|5.005000||Viu
PL_op|5.005000||Viu
PL_op_exec_cnt|5.019002||Viu
PL_opfreehook|5.011000|5.011000|
PL_op_mask|5.005000||Viu
PL_origalen|5.005000||Viu
PL_origargc|5.005000||Viu
PL_origargv|5.005000||Viu
PL_origenviron|5.005000||Viu
PL_origfilename|5.005000||Viu
PL_ors_sv|5.007001||Viu
PL_osname|5.005000||Viu
PL_padix|5.005000||Viu
PL_padix_floor|5.005000||Viu
PL_padlist_generation|5.021007||Viu
PL_padname_const|5.021007||Viu
PL_padname_undef|5.021007||Viu
PL_pad_reset_pending|5.005000||Viu
PL_parser|5.009005|5.003007|p
PL_patchlevel|5.005000||Viu
PL_peepp|5.007003|5.007003|
PL_perldb|5.005000|5.003007|poVnu
PL_perl_destruct_level|5.004005|5.003007|p
PL_perlio|5.007003||Viu
PL_phase|5.013007|5.013007|
PL_pidstatus|5.005000||Viu
PL_Posix_ptrs|5.029000||Viu
PL_ppaddr||5.003007|ponu
PL_preambleav|5.005000||Viu
PL_prevailing_version|5.035009||Viu
PL_Private_Use|5.029009||Viu
PL_Proc|5.006000||Viu
PL_profiledata|5.005000||Viu
PL_psig_name|5.006000||Viu
PL_psig_pend|5.007001||Viu
PL_psig_ptr|5.006000||Viu
PL_ptr_table|5.006000||Viu
PL_random_state|5.019004||Viu
PL_RANDOM_STATE_TYPE|5.019004||Viu
PL_reentrant_buffer|5.007002||Viu
PL_reentrant_retint|5.008001||Viu
PL_reg_curpm|5.006000||Viu
PL_regex_pad|5.007002||Viu
PL_regex_padav|5.007002||Viu
PL_registered_mros|5.010001||Viu
PL_regmatch_slab|5.009004||Viu
PL_regmatch_state|5.009004||Viu
PL_replgv|5.005000||Viu
PL_restartjmpenv|5.013001||Viu
PL_restartop|5.005000|5.005000|
PL_rpeepp|5.013005|5.013005|
PL_rs|5.005000||Vi
PL_rsfp||5.003007|ponu
PL_rsfp_filters||5.003007|ponu
PL_runops|5.006000|5.006000|
PL_savebegin|5.007003||Viu
PL_savestack|5.005000||Viu
PL_savestack_ix|5.005000||Viu
PL_savestack_max|5.005000||Viu
PL_sawampersand|5.005000||Viu
PL_SB_invlist|5.021009||Viu
PL_scopestack|5.005000||Viu
PL_scopestack_ix|5.005000||Viu
PL_scopestack_max|5.005000||Viu
PL_scopestack_name|5.011002||Viu
PL_SCX_invlist|5.027008||Viu
PL_secondgv|5.005000||Viu
PL_setlocale_buf|5.027009||Viu
PL_setlocale_bufsize|5.027009||Viu
PL_sharehook|5.007003||Viu
PL_sighandler1p|5.031007||Viu
PL_sighandler3p|5.031007||Viu
PL_sighandlerp|5.005000||Viu
PL_signalhook|5.013002||Viu
PL_signals|5.008001|5.003007|poVnu
PL_sig_pending|5.007001||Viu
PL_Sock|5.006000||Viu
PL_sortcop|5.005000||Viu
PL_sortstash|5.005000||Viu
PL_splitstr|5.005000||Viu
PL_srand_called|5.006000||Viu
PL_stack_base|5.005000|5.003007|poVnu
PL_stack_max|5.005000||Viu
PL_stack_sp|5.005000|5.003007|poVnu
PL_start_env|5.005000||Viu
PL_stashcache|5.008001||Viu
PL_stashpad|5.017001||Viu
PL_stashpadix|5.017001||Viu
PL_stashpadmax|5.017001||Viu
PL_statcache|5.005000|5.003007|poVnu
PL_statgv|5.005000||Viu
PL_statname|5.005000||Viu
PL_statusvalue|5.005000||Viu
PL_statusvalue_posix|5.009003||Viu
PL_statusvalue_vms|5.005000||Viu
PL_stderrgv|5.006000||Viu
PL_stdingv|5.005000|5.003007|poVnu
PL_StdIO|5.006000||Viu
PL_strtab|5.005000||Viu
PL_strxfrm_is_behaved|5.025002||Viu
PL_strxfrm_max_cp|5.025002||Viu
PL_strxfrm_NUL_replacement|5.025008||Viu
PL_sub_generation|5.005000||Viu
PL_subline|5.005000||Viu
PL_subname|5.005000||Viu
PL_Sv|5.005000||pcV
PL_sv_arenaroot|5.005000|5.003007|poVnu
PL_sv_consts|5.019002||Viu
PL_sv_count|5.005000||Viu
PL_sv_immortals|5.027003||Viu
PL_sv_no|5.004005|5.003007|p
PL_sv_root|5.005000||Viu
PL_sv_serial|5.010001||Viu
PL_sv_undef|5.004005|5.003007|p
PL_sv_yes|5.004005|5.003007|p
PL_sv_zero|5.027003|5.027003|
PL_sys_intern|5.005000||Viu
PL_tainted|5.005000|5.003007|poVnu
PL_tainting|5.005000|5.003007|poVnu
PL_taint_warn|5.007003||Viu
PL_threadhook|5.008000||Viu
PL_tmps_floor|5.005000||Viu
PL_tmps_ix|5.005000||Viu
PL_tmps_max|5.005000||Viu
PL_tmps_stack|5.005000||Viu
PL_tokenbuf||5.003007|ponu
PL_top_env|5.005000||Viu
PL_toptarget|5.005000||Viu
PL_TR_SPECIAL_HANDLING_UTF8|5.031006||Viu
PL_underlying_numeric_obj|5.027009||Viu
PL_unicode|5.008001||Viu
PL_unitcheckav|5.009005||Viu
PL_unitcheckav_save|5.009005||Viu
PL_unlockhook|5.007003||Viu
PL_unsafe|5.005000||Viu
PL_UpperLatin1|5.019005||Viu
PLUS|5.003007||Viu
PLUS_t8|5.035004||Viu
PLUS_t8_p8|5.033003||Viu
PLUS_t8_pb|5.033003||Viu
PLUS_tb|5.035004||Viu
PLUS_tb_p8|5.033003||Viu
PLUS_tb_pb|5.033003||Viu
PL_utf8cache|5.009004||Viu
PL_utf8_charname_begin|5.017006||Viu
PL_utf8_charname_continue|5.017006||Viu
PL_utf8_foldclosures|5.013007||Viu
PL_utf8_idcont|5.008000||Viu
PL_utf8_idstart|5.008000||Viu
PL_utf8locale|5.008001||Viu
PL_utf8_mark|5.006000||Viu
PL_utf8_perl_idcont|5.017008||Viu
PL_utf8_perl_idstart|5.015004||Viu
PL_utf8_tofold|5.007003||Viu
PL_utf8_tolower|5.006000||Viu
PL_utf8_tosimplefold|5.027011||Viu
PL_utf8_totitle|5.006000||Viu
PL_utf8_toupper|5.006000||Viu
PL_utf8_xidcont|5.013010||Viu
PL_utf8_xidstart|5.013010||Viu
PL_vtbl_arylen|5.015000||Viu
PL_vtbl_arylen_p|5.015000||Viu
PL_vtbl_backref|5.015000||Viu
PL_vtbl_bm|5.015000||Viu
PL_vtbl_checkcall|5.017000||Viu
PL_vtbl_collxfrm|5.015000||Viu
PL_vtbl_dbline|5.015000||Viu
PL_vtbl_debugvar|5.021005||Viu
PL_vtbl_defelem|5.015000||Viu
PL_vtbl_env|5.015000||Viu
PL_vtbl_envelem|5.015000||Viu
PL_vtbl_fm|5.015000||Viu
PL_vtbl_hints|5.015000||Viu
PL_vtbl_hintselem|5.015000||Viu
PL_vtbl_isa|5.015000||Viu
PL_vtbl_isaelem|5.015000||Viu
PL_vtbl_lvref|5.021005||Viu
PL_vtbl_mglob|5.015000||Viu
PL_vtbl_nkeys|5.015000||Viu
PL_vtbl_nonelem|5.027009||Viu
PL_vtbl_ovrld|5.015000||Viu
PL_vtbl_pack|5.015000||Viu
PL_vtbl_packelem|5.015000||Viu
PL_vtbl_pos|5.015000||Viu
PL_vtbl_regdata|5.015000||Viu
PL_vtbl_regdatum|5.015000||Viu
PL_vtbl_regexp|5.015000||Viu
PL_vtbl_sig|5.035001||Viu
PL_vtbl_sigelem|5.015000||Viu
PL_vtbl_substr|5.015000||Viu
PL_vtbl_sv|5.015000||Viu
PL_vtbl_taint|5.015000||Viu
PL_vtbl_utf8|5.015000||Viu
PL_vtbl_uvar|5.015000||Viu
PL_vtbl_vec|5.015000||Viu
PL_warnhook|5.005000||Viu
PL_warn_locale|5.021008||Viu
PL_watchaddr|5.006000||Viu
PL_watchok|5.006000||Viu
PL_WB_invlist|5.021009||Viu
PL_wcrtomb_ps|5.031010||Viu
PL_XPosix_ptrs|5.017008||Viu
PL_Xpv|5.005000|5.003007|poVnu
PL_xsubfilename|5.021006||Viu
pm_description|5.009004||Viu
PMf_BASE_SHIFT|5.013004||Viu
PMf_CHARSET|5.017011||Viu
PMf_CODELIST_PRIVATE|5.017001||Viu
PMf_CONST|5.003007||Viu
PMf_CONTINUE|5.004000||Viu
PMf_EVAL|5.003007||Viu
PMf_EXTENDED|5.003007||Viu
PMf_EXTENDED_MORE|5.021005||Viu
PMf_FOLD|5.003007||Viu
PMf_GLOBAL|5.003007||Viu
PMf_HAS_CV|5.017001||Viu
PMf_HAS_ERROR|5.025010||Viu
PMf_IS_QR|5.017001||Viu
PMf_KEEP|5.003007||Viu
PMf_KEEPCOPY|5.009005||Viu
PMf_MULTILINE|5.003007||Viu
PMf_NOCAPTURE|5.021008||Viu
PMf_NONDESTRUCT|5.013002||Viu
PMf_ONCE|5.003007||Viu
PMf_RETAINT|5.004005||Viu
PMf_SINGLELINE|5.003007||Viu
PMf_SPLIT|5.017011||Viu
PMf_STRICT|5.021008||Viu
PMf_USED|5.009005||Viu
PMf_USE_RE_EVAL|5.017001||Viu
PMf_WILDCARD|5.031010||Viu
PM_GETRE|5.007002||Viu
pmop_dump|5.006000|5.006000|u
PmopSTASH|5.007001||Viu
PmopSTASHPV|5.007001||Viu
PmopSTASHPV_set|5.007001||Viu
PmopSTASH_set|5.007001||Viu
pmruntime|5.003007||Viu
PM_SETRE|5.007002||Viu
PM_STR|5.027010||Viu
pmtrans|5.003007||Viu
pMY_CXT|5.009000|5.009000|p
_pMY_CXT||5.009000|p
pMY_CXT_||5.009000|p
PNf|5.021007||Viu
PNfARG|5.021007||Viu
Poison|5.008000|5.003007|p
PoisonFree|5.009004|5.003007|p
PoisonNew|5.009004|5.003007|p
PoisonPADLIST|5.021006||Viu
POISON_SV_HEAD|||Viu
PoisonWith|5.009004|5.003007|p
popen|5.003007||Viu
POPi|5.003007|5.003007|
POPl|5.003007|5.003007|
POPMARK|5.003007||cViu
POP_MULTICALL|5.009003|5.009003|
POPn|5.006000|5.003007|
POPp|5.003007|5.003007|
POPpbytex|5.007001|5.007001|
POPpconstx|5.009003||Viu
POPpx|5.005003|5.005003|
POPs|5.003007|5.003007|
pop_scope|5.003007|5.003007|u
POPSTACK|5.005000||Viu
POPSTACK_TO|5.005000||Viu
POPu|5.004000|5.004000|
POPul|5.006000|5.006000|
populate_ANYOF_from_invlist|5.019005||Viu
populate_isa|||viu
POSIXA|5.017003||Viu
POSIXA_t8|5.035004||Viu
POSIXA_t8_p8|5.033003||Viu
POSIXA_t8_pb|5.033003||Viu
POSIXA_tb|5.035004||Viu
POSIXA_tb_p8|5.033003||Viu
POSIXA_tb_pb|5.033003||Viu
POSIX_CC_COUNT|5.017008||Viu
POSIXD|5.017003||Viu
POSIXD_t8|5.035004||Viu
POSIXD_t8_p8|5.033003||Viu
POSIXD_t8_pb|5.033003||Viu
POSIXD_tb|5.035004||Viu
POSIXD_tb_p8|5.033003||Viu
POSIXD_tb_pb|5.033003||Viu
POSIXL|5.017003||Viu
POSIXL_CLEAR|5.029004||Viu
POSIXL_SET|5.029004||Viu
POSIXL_t8|5.035004||Viu
POSIXL_t8_p8|5.033003||Viu
POSIXL_t8_pb|5.033003||Viu
POSIXL_tb|5.035004||Viu
POSIXL_tb_p8|5.033003||Viu
POSIXL_tb_pb|5.033003||Viu
POSIXL_TEST|5.029004||Viu
POSIXL_ZERO|5.029004||Viu
POSIXU|5.017003||Viu
POSIXU_t8|5.035004||Viu
POSIXU_t8_p8|5.033003||Viu
POSIXU_t8_pb|5.033003||Viu
POSIXU_tb|5.035004||Viu
POSIXU_tb_p8|5.033003||Viu
POSIXU_tb_pb|5.033003||Viu
PP|5.003007||Viu
pregcomp|5.009005|5.009005|
pregexec|5.003007|5.003007|
PREGf_ANCH|5.019009||Viu
PREGf_ANCH_GPOS|5.019009||Viu
PREGf_ANCH_MBOL|5.019009||Viu
PREGf_ANCH_SBOL|5.019009||Viu
PREGf_CUTGROUP_SEEN|5.009005||Viu
PREGf_GPOS_FLOAT|5.019009||Viu
PREGf_GPOS_SEEN|5.019009||Viu
PREGf_IMPLICIT|5.009005||Viu
PREGf_NAUGHTY|5.009005||Viu
PREGf_NOSCAN|5.019009||Viu
PREGf_RECURSE_SEEN|5.023009||Viu
pregfree2|5.011000||cVu
pregfree|5.003007|5.003007|u
PREGf_SKIP|5.009005||Viu
PREGf_USE_RE_EVAL|5.017001||Viu
PREGf_VERBARG_SEEN|5.009005||Viu
prepare_SV_for_RV|5.010001||Viu
prescan_version|5.011004|5.011004|
PRESCAN_VERSION|5.019008||Viu
PREV_RANGE_MATCHES_INVLIST|5.023002||Viu
printbuf|5.009004||Viu
print_bytes_for_locale|5.027002||Viu
print_collxfrm_input_and_return|5.025004||Viu
printf|5.003007||Viu
PRINTF_FORMAT_NULL_OK|5.009005|5.009005|Vn
printf_nocontext|5.007001||vdVnu
PRIVLIB|5.003007|5.003007|Vn
PRIVLIB_EXP|5.003007|5.003007|Vn
PRIVSHIFT|5.003007||Viu
process_special_blocks|5.009005||Viu
PROCSELFEXE_PATH|5.007003|5.007003|Vn
PRUNE|5.009005||Viu
PRUNE_t8|5.035004||Viu
PRUNE_t8_p8|5.033003||Viu
PRUNE_t8_pb|5.033003||Viu
PRUNE_tb|5.035004||Viu
PRUNE_tb_p8|5.033003||Viu
PRUNE_tb_pb|5.033003||Viu
PSEUDO|5.009004||Viu
PSEUDO_t8|5.035004||Viu
PSEUDO_t8_p8|5.033003||Viu
PSEUDO_t8_pb|5.033003||Viu
PSEUDO_tb|5.035004||Viu
PSEUDO_tb_p8|5.033003||Viu
PSEUDO_tb_pb|5.033003||Viu
pthread_addr_t|5.005000||Viu
PTHREAD_ATFORK|5.007002||Viu
pthread_attr_init|5.006000||Viu
PTHREAD_ATTR_SETDETACHSTATE|5.006000||Viu
pthread_condattr_default|5.005000||Viu
PTHREAD_CREATE|5.006000||Viu
pthread_create|5.008001||Viu
PTHREAD_CREATE_JOINABLE|5.005000||Viu
PTHREAD_GETSPECIFIC|5.007002||Viu
PTHREAD_GETSPECIFIC_INT|5.006000||Viu
pthread_key_create|5.005000||Viu
pthread_keycreate|5.008001||Viu
pthread_mutexattr_default|5.005000||Viu
pthread_mutexattr_init|5.005000||Viu
pthread_mutexattr_settype|5.005000||Viu
pTHX_12|5.019010||Viu
pTHX_1|5.006000||Viu
pTHX_2|5.006000||Viu
pTHX_3|5.006000||Viu
pTHX_4|5.006000||Viu
pTHX|5.006000|5.003007|p
pTHX_5|5.009003||Viu
pTHX_6|5.009003||Viu
pTHX_7|5.009003||Viu
pTHX_8|5.009003||Viu
pTHX_9|5.009003||Viu
pTHX_||5.003007|p
pTHX__FORMAT|5.009002||Viu
pTHX_FORMAT|5.009002||Viu
pTHXo|5.006000||Viu
pTHX__VALUE|5.009002||Viu
pTHX_VALUE|5.009002||Viu
pTHXx|5.006000||Viu
PTR2IV|5.006000|5.003007|p
PTR2nat|5.009003|5.003007|p
PTR2NV|5.006000|5.003007|p
PTR2ul|5.007001|5.003007|p
PTR2UV|5.006000|5.003007|p
Ptrdiff_t|5.029003||Viu
ptr_hash|5.017010||Vniu
PTRSIZE|5.005000|5.005000|Vn
ptr_table_fetch|5.009005|5.009005|u
ptr_table_find|5.009004||Vniu
ptr_table_free|5.009005|5.009005|u
ptr_table_new|5.009005|5.009005|u
ptr_table_split|5.009005|5.009005|u
ptr_table_store|5.009005|5.009005|u
PTRV|5.006000|5.003007|poVnu
PUSHi|5.003007|5.003007|
PUSHMARK|5.003007|5.003007|
PUSHmortal|5.009002|5.003007|p
PUSH_MULTICALL|5.011000|5.011000|
PUSH_MULTICALL_FLAGS|5.018000||Viu
PUSHn|5.006000|5.003007|
PUSHp|5.003007|5.003007|
PUSHs|5.003007|5.003007|
push_scope|5.003007|5.003007|u
PUSHSTACK|5.005000||Viu
PUSHSTACKi|5.005000||Viu
PUSHSTACK_INIT_HWM|5.027002||Viu
PUSHTARG|5.003007||Viu
PUSHu|5.004000|5.003007|p
PUTBACK|5.003007|5.003007|
putc|5.003007||Viu
put_charclass_bitmap_innards|5.021004||Viu
put_charclass_bitmap_innards_common|5.023008||Viu
put_charclass_bitmap_innards_invlist|5.023008||Viu
put_code_point|5.021004||Viu
putc_unlocked|5.003007||Viu
putenv|5.005000||Viu
put_range|5.019009||Viu
putw|5.003007||Viu
pv_display|5.006000|5.003007|p
pv_escape|5.009004|5.003007|p
pv_pretty|5.009004|5.003007|p
pv_uni_display|5.007003|5.007003|
pWARN_ALL|5.006000||Viu
pWARN_NONE|5.006000||Viu
pWARN_STD|5.006000||Viu
PWGECOS|5.004005|5.004005|Vn
PWPASSWD|5.005000|5.005000|Vn
qerror|5.006000||cViu
QR_PAT_MODS|5.009005||Viu
QUAD_IS_INT|5.006000|5.006000|Vn
QUAD_IS___INT64|5.015003|5.015003|Vn
QUAD_IS_INT64_T|5.006000|5.006000|Vn
QUAD_IS_LONG|5.006000|5.006000|Vn
QUAD_IS_LONG_LONG|5.006000|5.006000|Vn
QUADKIND|5.006000|5.006000|Vn
quadmath_format_needed|5.021004||Vni
quadmath_format_valid|5.031007||Vni
Quad_t|5.003007|5.003007|Vn
QUESTION_MARK_CTRL|5.021001||Viu
RADIXCHAR|5.027010||Viu
RANDBITS|5.003007|5.003007|Vn
RANDOM_R_PROTO|5.008000|5.008000|Vn
Rand_seed_t|5.006000|5.006000|Vn
RANGE_INDICATOR|5.031006||Viu
rck_elide_nothing|5.032001||Viu
RD_NODATA|5.003007|5.003007|Vn
read|5.005000||Viu
readdir|5.005000||Viu
readdir64|5.009000||Viu
READDIR64_R_PROTO|5.008000|5.008000|Vn
READDIR_R_PROTO|5.008000|5.008000|Vn
READ_XDIGIT|5.017006|5.017006|
realloc|5.003007||Vn
ReANY|5.017006||cVnu
re_compile|5.009005|5.009005|u
RE_COMPILE_RECURSION_INIT|5.029009||Viu
RE_COMPILE_RECURSION_LIMIT|5.029009||Viu
re_croak|||iu
recv|5.006000||Viu
recvfrom|5.005000||Viu
RE_DEBUG_COMPILE_DUMP|5.009004||Viu
RE_DEBUG_COMPILE_FLAGS|5.009005||Viu
RE_DEBUG_COMPILE_MASK|5.009004||Viu
RE_DEBUG_COMPILE_OPTIMISE|5.009004||Viu
RE_DEBUG_COMPILE_PARSE|5.009004||Viu
RE_DEBUG_COMPILE_TEST|5.021005||Viu
RE_DEBUG_COMPILE_TRIE|5.009004||Viu
RE_DEBUG_EXECUTE_INTUIT|5.009004||Viu
RE_DEBUG_EXECUTE_MASK|5.009004||Viu
RE_DEBUG_EXECUTE_MATCH|5.009004||Viu
RE_DEBUG_EXECUTE_TRIE|5.009004||Viu
RE_DEBUG_EXTRA_BUFFERS|5.009005||Viu
RE_DEBUG_EXTRA_DUMP_PRE_OPTIMIZE|5.031004||Viu
RE_DEBUG_EXTRA_GPOS|5.011000||Viu
RE_DEBUG_EXTRA_MASK|5.009004||Viu
RE_DEBUG_EXTRA_OPTIMISE|5.009005||Viu
RE_DEBUG_EXTRA_STACK|5.009005||Viu
RE_DEBUG_EXTRA_STATE|5.009004||Viu
RE_DEBUG_EXTRA_TRIE|5.009004||Viu
RE_DEBUG_EXTRA_WILDCARD|5.031011||Viu
RE_DEBUG_FLAG|5.009004||Viu
RE_DEBUG_FLAGS|5.009002||Viu
re_dup_guts|5.011000|5.011000|
reentrant_free|5.008000||cVu
reentrant_init|5.008000||cVu
REENTRANT_PROTO_B_B|5.008000||Viu
REENTRANT_PROTO_B_BI|5.008000||Viu
REENTRANT_PROTO_B_BW|5.008000||Viu
REENTRANT_PROTO_B_CCD|5.008000||Viu
REENTRANT_PROTO_B_CCS|5.008000||Viu
REENTRANT_PROTO_B_IBI|5.008000||Viu
REENTRANT_PROTO_B_IBW|5.008000||Viu
REENTRANT_PROTO_B_SB|5.008000||Viu
REENTRANT_PROTO_B_SBI|5.008000||Viu
REENTRANT_PROTO_I_BI|5.008000||Viu
REENTRANT_PROTO_I_BW|5.008000||Viu
REENTRANT_PROTO_I_CCSBWR|5.008000||Viu
REENTRANT_PROTO_I_CCSD|5.008000||Viu
REENTRANT_PROTO_I_CII|5.008000||Viu
REENTRANT_PROTO_I_CIISD|5.008000||Viu
REENTRANT_PROTO_I_CSBI|5.008000||Viu
REENTRANT_PROTO_I_CSBIR|5.008000||Viu
REENTRANT_PROTO_I_CSBWR|5.008000||Viu
REENTRANT_PROTO_I_CSBWRE|5.008000||Viu
REENTRANT_PROTO_I_CSD|5.008000||Viu
REENTRANT_PROTO_I_CWISBWRE|5.008000||Viu
REENTRANT_PROTO_I_CWISD|5.008000||Viu
REENTRANT_PROTO_I_D|5.008000||Viu
REENTRANT_PROTO_I_H|5.008000||Viu
REENTRANT_PROTO_I_IBI|5.008000||Viu
REENTRANT_PROTO_I_IBW|5.008000||Viu
REENTRANT_PROTO_I_ICBI|5.008000||Viu
REENTRANT_PROTO_I_ICSBWR|5.008000||Viu
REENTRANT_PROTO_I_ICSD|5.008000||Viu
REENTRANT_PROTO_I_ID|5.008000||Viu
REENTRANT_PROTO_I_IISD|5.008000||Viu
REENTRANT_PROTO_I_ISBWR|5.008000||Viu
REENTRANT_PROTO_I_ISD|5.008000||Viu
REENTRANT_PROTO_I_LISBI|5.008000||Viu
REENTRANT_PROTO_I_LISD|5.008000||Viu
REENTRANT_PROTO_I_SB|5.008000||Viu
REENTRANT_PROTO_I_SBI|5.008000||Viu
REENTRANT_PROTO_I_SBIE|5.008000||Viu
REENTRANT_PROTO_I_SBIH|5.008000||Viu
REENTRANT_PROTO_I_SBIR|5.008000||Viu
REENTRANT_PROTO_I_SBWR|5.008000||Viu
REENTRANT_PROTO_I_SBWRE|5.008000||Viu
REENTRANT_PROTO_I_SD|5.008000||Viu
REENTRANT_PROTO_I_TISD|5.008000||Viu
REENTRANT_PROTO_I_TS|5.008000||Viu
REENTRANT_PROTO_I_TSBI|5.008000||Viu
REENTRANT_PROTO_I_TSBIR|5.008000||Viu
REENTRANT_PROTO_I_TSBWR|5.008000||Viu
REENTRANT_PROTO_I_TsISBWRE|5.008001||Viu
REENTRANT_PROTO_I_TSR|5.008000||Viu
REENTRANT_PROTO_I_UISBWRE|5.008000||Viu
REENTRANT_PROTO_I_uISBWRE|5.008001||Viu
REENTRANT_PROTO_S_CBI|5.008000||Viu
REENTRANT_PROTO_S_CCSBI|5.008000||Viu
REENTRANT_PROTO_S_CIISBIE|5.008000||Viu
REENTRANT_PROTO_S_CSBI|5.008000||Viu
REENTRANT_PROTO_S_CSBIE|5.008000||Viu
REENTRANT_PROTO_S_CWISBIE|5.008000||Viu
REENTRANT_PROTO_S_CWISBWIE|5.008000||Viu
REENTRANT_PROTO_S_ICSBI|5.008000||Viu
REENTRANT_PROTO_S_ISBI|5.008000||Viu
REENTRANT_PROTO_S_LISBI|5.008000||Viu
REENTRANT_PROTO_S_SBI|5.008000||Viu
REENTRANT_PROTO_S_SBIE|5.008000||Viu
REENTRANT_PROTO_S_SBW|5.008000||Viu
REENTRANT_PROTO_S_TISBI|5.008000||Viu
REENTRANT_PROTO_S_TS|5.031011||Viu
REENTRANT_PROTO_S_TSBI|5.008000||Viu
REENTRANT_PROTO_S_TSBIE|5.008000||Viu
REENTRANT_PROTO_S_TWISBIE|5.008000||Viu
REENTRANT_PROTO_V_D|5.008000||Viu
REENTRANT_PROTO_V_H|5.008000||Viu
REENTRANT_PROTO_V_ID|5.008000||Viu
reentrant_retry|5.008000||vcVnu
reentrant_size|5.008000||cVu
REENTR_MEMZERO|5.009003||Viu
re_exec_indentf|5.023009||vViu
REF|5.003007||Viu
ref|5.009003||Viu
ref_array_or_hash|5.027008||Viu
refcounted_he_chain_2hv|5.013007||cVi
REFCOUNTED_HE_EXISTS|5.015007||Viu
refcounted_he_fetch_pv|5.013007||cVi
refcounted_he_fetch_pvn|5.013007||cVi
refcounted_he_fetch_pvs|5.013007||Vi
refcounted_he_fetch_sv|5.013007||cVi
refcounted_he_free|5.013007||cVi
refcounted_he_inc|5.013007||cVi
REFCOUNTED_HE_KEY_UTF8|5.013007||Viu
refcounted_he_new_pv|5.013007||cVi
refcounted_he_new_pvn|5.013007||cVi
refcounted_he_new_pvs|5.013007||Vi
refcounted_he_new_sv|5.013007||cVi
refcounted_he_value|5.009004||Viu
REFF|5.004001||Viu
REFFA|5.013010||Viu
REFFAN|5.031001||Viu
REFFAN_t8|5.035004||Viu
REFFAN_t8_p8|5.033003||Viu
REFFAN_t8_pb|5.033003||Viu
REFFAN_tb|5.035004||Viu
REFFAN_tb_p8|5.033003||Viu
REFFAN_tb_pb|5.033003||Viu
REFFA_t8|5.035004||Viu
REFFA_t8_p8|5.033003||Viu
REFFA_t8_pb|5.033003||Viu
REFFA_tb|5.035004||Viu
REFFA_tb_p8|5.033003||Viu
REFFA_tb_pb|5.033003||Viu
REFFL|5.004001||Viu
REFFLN|5.031001||Viu
REFFLN_t8|5.035004||Viu
REFFLN_t8_p8|5.033003||Viu
REFFLN_t8_pb|5.033003||Viu
REFFLN_tb|5.035004||Viu
REFFLN_tb_p8|5.033003||Viu
REFFLN_tb_pb|5.033003||Viu
REFFL_t8|5.035004||Viu
REFFL_t8_p8|5.033003||Viu
REFFL_t8_pb|5.033003||Viu
REFFL_tb|5.035004||Viu
REFFL_tb_p8|5.033003||Viu
REFFL_tb_pb|5.033003||Viu
REFFN|5.031001||Viu
REFFN_t8|5.035004||Viu
REFFN_t8_p8|5.033003||Viu
REFFN_t8_pb|5.033003||Viu
REFFN_tb|5.035004||Viu
REFFN_tb_p8|5.033003||Viu
REFFN_tb_pb|5.033003||Viu
REFF_t8|5.035004||Viu
REFF_t8_p8|5.033003||Viu
REFF_t8_pb|5.033003||Viu
REFF_tb|5.035004||Viu
REFF_tb_p8|5.033003||Viu
REFF_tb_pb|5.033003||Viu
REFFU|5.013008||Viu
REFFUN|5.031001||Viu
REFFUN_t8|5.035004||Viu
REFFUN_t8_p8|5.033003||Viu
REFFUN_t8_pb|5.033003||Viu
REFFUN_tb|5.035004||Viu
REFFUN_tb_p8|5.033003||Viu
REFFUN_tb_pb|5.033003||Viu
REFFU_t8|5.035004||Viu
REFFU_t8_p8|5.033003||Viu
REFFU_t8_pb|5.033003||Viu
REFFU_tb|5.035004||Viu
REFFU_tb_p8|5.033003||Viu
REFFU_tb_pb|5.033003||Viu
REF_HE_KEY|5.009005||Viu
refkids|5.003007||Viu
REFN|5.031001||Viu
REFN_t8|5.035004||Viu
REFN_t8_p8|5.033003||Viu
REFN_t8_pb|5.033003||Viu
REFN_tb|5.035004||Viu
REFN_tb_p8|5.033003||Viu
REFN_tb_pb|5.033003||Viu
REF_t8|5.035004||Viu
REF_t8_p8|5.033003||Viu
REF_t8_pb|5.033003||Viu
REF_tb|5.035004||Viu
REF_tb_p8|5.033003||Viu
REF_tb_pb|5.033003||Viu
refto|5.005000||Viu
reg2Lanode|5.021005||Viu
reg|5.005000||Viu
reganode|5.005000||Viu
REG_ANY|5.006000||Viu
REG_ANY_t8|5.035004||Viu
REG_ANY_t8_p8|5.033003||Viu
REG_ANY_t8_pb|5.033003||Viu
REG_ANY_tb|5.035004||Viu
REG_ANY_tb_p8|5.033003||Viu
REG_ANY_tb_pb|5.033003||Viu
regatom|5.005000||Viu
regbranch|5.005000||Viu
reg_check_named_buff_matched|5.009005||Vniu
regclass|5.005000||Viu
regcppop|5.005000||Viu
regcppush|5.005000||Viu
regcp_restore|5.025006||Viu
regcurly|5.013010||cVniu
REG_CUTGROUP_SEEN|5.019009||Viu
regdump|5.005000|5.005000|u
regdump_extflags|5.009005||Viu
regdump_intflags|5.019002||Viu
regdupe_internal|5.009005||cVu
regexec_flags|5.005000||cVu
REGEX_SET|5.031010||Viu
regex_set_precedence|5.021010||Vniu
REGEX_SET_t8|5.035004||Viu
REGEX_SET_t8_p8|5.033003||Viu
REGEX_SET_t8_pb|5.033003||Viu
REGEX_SET_tb|5.035004||Viu
REGEX_SET_tb_p8|5.033003||Viu
REGEX_SET_tb_pb|5.033003||Viu
REG_EXTFLAGS_NAME_SIZE|5.020000||Viu
regfree_internal|5.009005||cVu
REG_GPOS_SEEN|5.019009||Viu
reghop3|5.007001||Vniu
reghop4|5.009005||Vniu
reghopmaybe3|5.007001||Vniu
reginclass|5.005000||Viu
REG_INFTY|5.004005||Viu
reginitcolors|5.006000||cVu
reginsert|5.005000||Viu
REG_INTFLAGS_NAME_SIZE|5.020000||Viu
register|5.003007||Viu
reg_la_NOTHING|||Viu
reg_la_OPFAIL|||Viu
REG_LB_SEEN|||Viu
REG_LOOKBEHIND_SEEN|5.019009||Viu
REG_MAGIC|5.006000||Viu
regmatch|5.005000||Viu
REGMATCH_STATE_MAX|5.009005||Viu
reg_named_buff|5.009005||cViu
reg_named_buff_all|5.009005||cVu
reg_named_buff_exists|5.009005||cVu
reg_named_buff_fetch|5.009005||cVu
reg_named_buff_firstkey|5.009005||cVu
reg_named_buff_iter|5.009005||cViu
reg_named_buff_nextkey|5.009005||cVu
reg_named_buff_scalar|5.009005||cVu
regnext|5.003007||cVu
reg_node|5.005000||Viu
REGNODE_AFTER|5.003007||Viu
REGNODE_BEFORE|5.003007||Viu
regnode_guts|5.021005||Viu
regnode_guts_debug|||Viu
REGNODE_MAX|5.009004||Viu
REGNODE_SIMPLE|5.013002||Viu
REGNODE_VARIES|5.013002||Viu
reg_numbered_buff_fetch|5.009005||cViu
reg_numbered_buff_length|5.009005||cViu
reg_numbered_buff_store|5.009005||cViu
regpiece|5.005000||Viu
regpnode|5.031010||Viu
regprop|5.003007||Viu
reg_qr_package|5.009005||cViu
REG_RECURSE_SEEN|5.019009||Viu
regrepeat|5.005000||Viu
REG_RUN_ON_COMMENT_SEEN|5.019009||Viu
reg_scan_name|5.009005||Viu
reg_skipcomment|5.009005||Vniu
regtail|5.005000||Viu
regtail_study|5.009004||Viu
reg_temp_copy|5.009005||cViu
REG_TOP_LEVEL_BRANCHES_SEEN|5.019009||Viu
regtry|5.005000||Viu
REG_UNBOUNDED_QUANTIFIER_SEEN|5.019009||Viu
REG_UNFOLDED_MULTI_SEEN|5.019009||Viu
REG_VERBARG_SEEN|5.019009||Viu
REG_ZERO_LEN_SEEN|5.019009||Viu
re_indentf|5.023009||vViu
re_intuit_start|5.006000||cVu
re_intuit_string|5.006000||cVu
rename|5.005000||Viu
Renew|5.003007|5.003007|
Renewc|5.003007|5.003007|
RENUM|5.005000||Viu
RENUM_t8|5.035004||Viu
RENUM_t8_p8|5.033003||Viu
RENUM_t8_pb|5.033003||Viu
RENUM_tb|5.035004||Viu
RENUM_tb_p8|5.033003||Viu
RENUM_tb_pb|5.033003||Viu
re_op_compile|5.017001||Viu
repeatcpy|5.003007|5.003007|nu
REPLACEMENT_CHARACTER_UTF8|5.025005|5.003007|p
report_evil_fh|5.006001||Viu
report_redefined_cv|5.015006||Viu
report_uninit|5.006000||cVi
report_wrongway_fh|5.013009||Viu
re_printf|5.023009||vViu
RE_PV_COLOR_DECL|5.009004||Viu
RE_PV_QUOTED_DECL|5.009004||Viu
require_pv|5.006000|5.006000|
require_tie_mod|5.009005||Viu
ReREFCNT_dec|5.005000||Viu
ReREFCNT_inc|5.005000||Viu
RESTORE_ERRNO|5.010001||Vi
RESTORE_LC_NUMERIC|5.021010|5.021010|p
restore_magic|5.009003||Viu
restore_switched_locale|5.027009||Viu
RE_SV_DUMPLEN|5.009004||Viu
RE_SV_ESCAPE|5.009004||Viu
RE_SV_TAIL|5.009004||Viu
RETPUSHNO|5.003007||Viu
RETPUSHUNDEF|5.003007||Viu
RETPUSHYES|5.003007||Viu
RE_TRIE_MAXBUF_INIT|5.009002||Viu
RE_TRIE_MAXBUF_NAME|5.009002||Viu
RETSETNO|5.003007||Viu
RETSETTARG|5.021009||Viu
RETSETUNDEF|5.003007||Viu
RETSETYES|5.003007||Viu
RETURN|5.003007||Viu
RETURNOP|5.003007||Viu
RETURNX|5.003007||Viu
RETVAL|5.003007|5.003007|V
rewind|5.003007||Viu
rewinddir|5.005000||Viu
REXEC_CHECKED|5.005000||Viu
REXEC_COPY_SKIP_POST|5.017004||Viu
REXEC_COPY_SKIP_PRE|5.017004||Viu
REXEC_COPY_STR|5.005000||Viu
REXEC_FAIL_ON_UNDERFLOW|5.019003||Viu
REXEC_IGNOREPOS|5.006000||Viu
REXEC_NOT_FIRST|5.006000||Viu
REXEC_SCREAM|5.006000||Viu
rmdir|5.005000||Viu
RMS_DIR|5.008001||Viu
RMS_FAC|5.008001||Viu
RMS_FEX|5.008001||Viu
RMS_FNF|5.008001||Viu
RMS_IFI|5.008001||Viu
RMS_ISI|5.008001||Viu
RMS_PRV|5.008001||Viu
rninstr|5.003007|5.003007|n
ROTL32|5.017010||Viu
ROTL64|5.017010||Viu
ROTL_UV|5.017010||Viu
ROTR32|5.027001||Viu
ROTR64|5.027001||Viu
ROTR_UV|5.027001||Viu
rpeep|5.013005||Viu
rsignal|5.004000|5.004000|
rsignal_restore|5.004000||Viu
rsignal_save|5.004000||Viu
rsignal_state|5.004000|5.004000|u
RsPARA|5.003007||Viu
RsRECORD|5.005000||Viu
RsSIMPLE|5.003007||Viu
RsSNARF|5.003007||Viu
run_body|5.006000||Viu
runops_debug|5.005000||cVu
RUNOPS_DEFAULT|5.005000||Viu
runops_standard|5.005000||cVu
run_user_filter|5.009003||Viu
rv2cv_op_cv|5.013006|5.013006|
RV2CVOPCV_FLAG_MASK|5.021004||Viu
RV2CVOPCV_MARK_EARLY|5.013006|5.013006|
RV2CVOPCV_MAYBE_NAME_GV|5.021004||Viu
RV2CVOPCV_RETURN_NAME_GV|5.013006|5.013006|
RV2CVOPCV_RETURN_STUB|5.021004||Viu
rvpv_dup|5.008008|5.008008|u
RX_ANCHORED_SUBSTR|5.010001||Viu
RX_ANCHORED_UTF8|5.010001||Viu
RXapif_ALL|5.009005||Viu
RXapif_CLEAR|5.009005||Viu
RXapif_DELETE|5.009005||Viu
RXapif_EXISTS|5.009005||Viu
RXapif_FETCH|5.009005||Viu
RXapif_FIRSTKEY|5.009005||Viu
RXapif_NEXTKEY|5.009005||Viu
RXapif_ONE|5.009005||Viu
RXapif_REGNAME|5.009005||Viu
RXapif_REGNAMES|5.009005||Viu
RXapif_REGNAMES_COUNT|5.009005||Viu
RXapif_SCALAR|5.009005||Viu
RXapif_STORE|5.009005||Viu
RX_BUFF_IDX_CARET_FULLMATCH|5.017004||Viu
RX_BUFF_IDX_CARET_POSTMATCH|5.017004||Viu
RX_BUFF_IDX_CARET_PREMATCH|5.017004||Viu
RX_BUFF_IDX_FULLMATCH|5.009005||Viu
RX_BUFF_IDX_POSTMATCH|5.009005||Viu
RX_BUFF_IDX_PREMATCH|5.009005||Viu
RX_CHECK_SUBSTR|5.010001||Viu
RX_COMPFLAGS|5.017011||Viu
RX_ENGINE|5.010001||Viu
RX_EXTFLAGS|5.010001||Viu
RXf_BASE_SHIFT|5.013004||Viu
RXf_CHECK_ALL|5.009005||Viu
RXf_COPY_DONE|5.009005||Viu
RXf_EVAL_SEEN|5.009005||Viu
RXf_INTUIT_TAIL|5.009005||Viu
RXf_IS_ANCHORED|5.019009||Viu
RX_FLOAT_SUBSTR|5.010001||Viu
RX_FLOAT_UTF8|5.010001||Viu
RXf_MATCH_UTF8|5.009005||Viu
RXf_NO_INPLACE_SUBST|5.017011||Viu
RXf_NULL|5.010000||Viu
RXf_PMf_CHARSET|5.013009||Viu
RXf_PMf_COMPILETIME|5.009005||Viu
RXf_PMf_EXTENDED|5.009005||Viu
RXf_PMf_EXTENDED_MORE|5.021005||Viu
RXf_PMf_FLAGCOPYMASK|5.017011||Viu
RXf_PMf_FOLD|5.009005||Viu
RXf_PMf_KEEPCOPY|5.009005||Viu
RXf_PMf_MULTILINE|5.009005||Viu
RXf_PMf_NOCAPTURE|5.021008||Viu
RXf_PMf_SINGLELINE|5.009005||Viu
RXf_PMf_SPLIT|5.017011||Viu
RXf_PMf_STD_PMMOD|5.009005||Viu
RXf_PMf_STD_PMMOD_SHIFT|5.010001||Viu
RXf_PMf_STRICT|5.021008||Viu
RXf_SKIPWHITE|5.009005||Viu
RXf_SPLIT|5.009005||Viu
RXf_START_ONLY|5.009005||Viu
RXf_TAINTED|5.009005||Viu
RXf_TAINTED_SEEN|5.009005||Viu
RXf_UNBOUNDED_QUANTIFIER_SEEN|5.019009||Viu
RXf_USE_INTUIT|5.009005||Viu
RXf_USE_INTUIT_ML|5.009005||Viu
RXf_USE_INTUIT_NOML|5.009005||Viu
RXf_WHITE|5.009005||Viu
RX_GOFS|5.010001||Viu
RXi_GET|5.009005||Viu
RXi_GET_DECL|5.009005||Viu
RX_INTFLAGS|5.019009||Viu
RXi_SET|5.009005||Viu
RX_ISTAINTED|5.017006||Viu
RX_LASTCLOSEPAREN|5.010001||Viu
RX_LASTPAREN|5.010001||Viu
RX_MATCH_COPIED|5.006000||Viu
RX_MATCH_COPIED_off|5.006000||Viu
RX_MATCH_COPIED_on|5.006000||Viu
RX_MATCH_COPIED_set|5.006000||Viu
RX_MATCH_COPY_FREE|5.009000||Viu
RX_MATCH_TAINTED|5.005000||Viu
RX_MATCH_TAINTED_off|5.005000||Viu
RX_MATCH_TAINTED_on|5.005000||Viu
RX_MATCH_TAINTED_set|5.005000||Viu
RX_MATCH_UTF8|5.008001||Viu
RX_MATCH_UTF8_off|5.008001||Viu
RX_MATCH_UTF8_on|5.008001||Viu
RX_MATCH_UTF8_set|5.008001||Viu
RX_MINLEN|5.010001||Viu
RX_MINLENRET|5.010001||Viu
RX_NPARENS|5.010001||Viu
RX_OFFS|5.010001||Viu
RXp_COMPFLAGS|5.017011||Viu
RXp_ENGINE|5.027003||Viu
RXp_EXTFLAGS|5.010001||Viu
RXp_GOFS|5.027003||Viu
RXp_HAS_CUTGROUP|5.027003||Viu
RXp_INTFLAGS|5.019009||Viu
RXp_ISTAINTED|5.027003||Viu
RXp_MATCH_COPIED|5.010001||Viu
RXp_MATCH_COPIED_off|5.010001||Viu
RXp_MATCH_COPIED_on|5.010001||Viu
RXp_MATCH_COPY_FREE|5.027003||Viu
RXp_MATCH_TAINTED|5.010001||Viu
RXp_MATCH_TAINTED_off|5.027003||Viu
RXp_MATCH_TAINTED_on|5.017008||Viu
RXp_MATCH_UTF8|5.010001||Viu
RXp_MATCH_UTF8_off|5.027003||Viu
RXp_MATCH_UTF8_on|5.027003||Viu
RXp_MATCH_UTF8_set|5.027003||Viu
RXp_MINLEN|5.027003||Viu
RXp_MINLENRET|5.027003||Viu
RXp_NPARENS|5.027003||Viu
RXp_OFFS|5.027003||Viu
RXp_PAREN_NAMES|5.010001||Viu
RX_PRECOMP|5.010001||Viu
RX_PRECOMP_const|5.010001||Viu
RX_PRELEN|5.010001||Viu
RXp_SAVED_COPY|5.027003||Viu
RXp_SUBBEG|5.027003||Viu
RXp_SUBOFFSET|5.027003||Viu
RXp_ZERO_LEN|5.027003||Viu
RX_REFCNT|5.010001||Viu
rxres_free|5.004000||Viu
rxres_restore|5.004000||Viu
rxres_save|5.004000||Viu
RX_SAVED_COPY|5.011000||Viu
RX_SUBBEG|5.010001||Viu
RX_SUBCOFFSET|5.017004||Viu
RX_SUBLEN|5.010001||Viu
RX_SUBOFFSET|5.017004||Viu
RX_TAINT_on|5.017006||Viu
RX_UTF8|5.010001||Viu
RX_WRAPLEN|5.010001||Viu
RX_WRAPPED|5.010001||Viu
RX_WRAPPED_const|5.011000||Viu
RX_ZERO_LEN|5.019003||Viu
safecalloc|5.003007||Viu
Safefree|5.003007|5.003007|
safefree|5.003007||Viu
safemalloc|5.003007||Viu
saferealloc|5.003007||Viu
safesyscalloc|5.006000|5.006000|n
safesysfree|5.006000|5.006000|n
safesysmalloc|5.006000|5.006000|n
safesysrealloc|5.006000|5.006000|n
SAFE_TRIE_NODENUM|5.009002||Viu
same_dirent|5.003007||Viu
SANE_ERRSV|5.031003|5.031003|
SANY|5.003007||Viu
SANY_t8|5.035004||Viu
SANY_t8_p8|5.033003||Viu
SANY_t8_pb|5.033003||Viu
SANY_tb|5.035004||Viu
SANY_tb_p8|5.033003||Viu
SANY_tb_pb|5.033003||Viu
save_adelete|5.011000|5.011000|u
SAVEADELETE|5.011000||Viu
save_aelem|5.004005|5.004005|u
save_aelem_flags|5.011000|5.011000|u
save_alloc|5.006000|5.006000|u
save_aptr|5.003007|5.003007|
save_ary|5.003007|5.003007|
SAVEBOOL|5.008001|5.008001|
save_bool|5.008001||cVu
save_clearsv|5.003007||cVu
SAVECLEARSV|5.003007||Vi
SAVECOMPILEWARNINGS|5.009004||Viu
SAVECOMPPAD|5.006000||Vi
SAVECOPFILE|5.006000||Viu
SAVECOPFILE_FREE|5.006001||Viu
SAVECOPLINE|5.006000||Viu
SAVECOPSTASH_FREE|5.006001||Viu
SAVE_DEFSV|5.004005|5.003007|p
SAVEDELETE|5.003007|5.003007|
save_delete|5.003007||cVu
save_destructor|5.003007||cVu
SAVEDESTRUCTOR|5.006000|5.006000|
SAVEDESTRUCTOR_X|5.006000|5.006000|
save_destructor_x|5.006000||cVu
SAVE_ERRNO|5.010001||Vi
SAVEFEATUREBITS|5.031006||Viu
SAVEf_KEEPOLDELEM|5.011000||Viu
SAVEFREECOPHH|5.013007||Viu
SAVEFREEOP|5.010001|5.010001|
save_freeop|5.010001||cVu
SAVEFREEPADNAME|5.021007||Viu
SAVEFREEPV|5.003007|5.003007|
save_freepv|5.010001||cVu
SAVEFREESV|5.003007|5.003007|
save_freesv|5.010001||cVu
SAVEf_SETMAGIC|5.011000||Viu
SAVEGENERICPV|5.006001||Viu
save_generic_pvref|5.006001|5.006001|u
SAVEGENERICSV|5.005003||Viu
save_generic_svref|5.005003|5.005003|u
save_gp|5.004000|5.004000|
save_hash|5.003007|5.003007|
save_hdelete|5.011000|5.011000|u
SAVEHDELETE|5.011000||Viu
save_hek_flags|5.008000||Vniu
save_helem|5.004005|5.004005|u
save_helem_flags|5.011000|5.011000|u
SAVEHINTS|5.005000||Viu
save_hints|5.013005|5.013005|u
save_hptr|5.003007|5.003007|
SAVEI16|5.004000|5.004000|
save_I16|5.004000||cVu
SAVEI32|5.003007|5.003007|
save_I32|5.003007||cVu
SAVEI8|5.006000|5.006000|
save_I8|5.006000||cVu
SAVEINT|5.003007|5.003007|
save_int|5.003007||cVu
save_item|5.003007|5.003007|
SAVEIV|5.003007|5.003007|
save_iv|5.004000||cVu
save_lines|5.005000||Viu
save_list|5.003007|5.003007|d
SAVELONG|5.003007|5.003007|
save_long|5.003007||dcVu
save_magic_flags|5.019002||Viu
SAVE_MASK|5.013001||Viu
SAVEMORTALIZESV|5.007001|5.007001|
save_mortalizesv|5.010001||cVu
save_nogv|5.003007|5.003007|du
SAVEOP|5.005000||Viu
save_op|5.010001|5.010001|u
save_padsv_and_mortalize|5.010001|5.010001|u
SAVEPADSVANDMORTALIZE|5.010001||Viu
SAVEPADSV|||i
SAVEPARSER|5.009005||Viu
SAVEPPTR|5.003007|5.003007|
save_pptr|5.003007||cVu
save_pushi32ptr|5.013006|5.013006|u
save_pushptr|5.010001|5.010001|u
save_pushptri32ptr|5.010001||Viu
save_pushptrptr|5.013006|5.013006|u
savepv|5.003007|5.003007|
savepvn|5.003007|5.003007|
savepvs|5.009003|5.009003|
save_re_context|5.006000||cVu
save_scalar|5.003007|5.003007|
save_scalar_at|5.005000||Viu
save_set_svflags|5.009000|5.009000|u
SAVESETSVFLAGS|5.009000||Viu
savesharedpv|5.007003|5.007003|
SAVESHAREDPV|5.007003||Viu
savesharedpvn|5.009005|5.009005|
save_shared_pvref|5.007003|5.007003|u
savesharedpvs|5.013006|5.013006|
savesharedsvpv|5.013006|5.013006|
SAVESPTR|5.003007|5.003007|
save_sptr|5.003007||cVu
savestack_grow|5.003007|5.003007|u
savestack_grow_cnt|5.008001|5.008001|u
SAVESTACK_POS|5.004000|5.004000|
save_strlen|5.019004||cViu
SAVESTRLEN|5.035005|5.035005|
savesvpv|5.009002|5.009002|
save_svref|5.003007|5.003007|
SAVESWITCHSTACK|5.009002||Viu
SAVEt_ADELETE|5.011000||Viu
SAVEt_AELEM|5.004005||Viu
SAVEt_ALLOC|5.006000||Viu
SAVEt_APTR|5.003007||Viu
SAVEt_AV|5.003007||Viu
SAVEt_BOOL|5.008001||Viu
SAVEt_CLEARPADRANGE|5.017006||Viu
SAVEt_CLEARSV|5.003007||Viu
SAVEt_COMPILE_WARNINGS|5.009004||Viu
SAVEt_COMPPAD|5.006000||Viu
SAVEt_DELETE|5.003007||Viu
SAVEt_DESTRUCTOR|5.003007||Viu
SAVEt_DESTRUCTOR_X|5.006000||Viu
SAVEt_FREECOPHH|5.013007||Viu
SAVEt_FREEOP|5.003007||Viu
SAVEt_FREEPADNAME|5.021007||Viu
SAVEt_FREEPV|5.003007||Viu
SAVEt_FREESV|5.003007||Viu
SAVEt_GENERIC_PVREF|5.006001||Viu
SAVEt_GENERIC_SVREF|5.005003||Viu
SAVEt_GP|5.003007||Viu
SAVEt_GVSLOT|5.017007||Viu
SAVEt_GVSV|5.013005||Viu
SAVEt_HELEM|5.004005||Viu
SAVEt_HINTS|5.005000||Viu
SAVEt_HINTS_HH|5.033001||Viu
SAVEt_HPTR|5.003007||Viu
SAVEt_HV|5.003007||Viu
SAVEt_I16|5.004000||Viu
SAVEt_I32|5.003007||Viu
SAVEt_I32_SMALL|5.013001||Viu
SAVEt_I8|5.006000||Viu
SAVE_TIGHT_SHIFT|5.013001||Viu
SAVEt_INT|5.003007||Viu
SAVEt_INT_SMALL|5.013001||Viu
SAVEt_ITEM|5.003007||Viu
SAVEt_IV|5.003007||Viu
SAVEt_LONG|5.003007||Viu
SAVEt_MORTALIZESV|5.007001||Viu
SAVETMPS|5.003007|5.003007|
savetmps|||xu
SAVEt_NSTAB|5.003007||Viu
save_to_buffer|5.027004||Vniu
SAVEt_OP|5.005000||Viu
SAVEt_PADSV_AND_MORTALIZE|5.010001||Viu
SAVEt_PARSER|5.009005||Viu
SAVEt_PPTR|5.003007||Viu
SAVEt_READONLY_OFF|5.019002||Viu
SAVEt_REGCONTEXT|5.003007||Viu
SAVEt_SAVESWITCHSTACK|5.009002||Viu
SAVEt_SET_SVFLAGS|5.009000||Viu
SAVEt_SHARED_PVREF|5.007003||Viu
SAVEt_SPTR|5.003007||Viu
SAVEt_STACK_POS|5.004000||Viu
SAVEt_STRLEN|5.019004||Viu
SAVEt_STRLEN_SMALL|5.033005||Viu
SAVEt_SV|5.003007||Viu
SAVEt_SVREF|5.003007||Viu
SAVEt_TMPSFLOOR|5.023008||Viu
SAVEt_VPTR|5.006000||Viu
save_vptr|5.006000|5.006000|u
SAVEVPTR|5.006000||Viu
SAWAMPERSAND_LEFT|5.017004||Viu
SAWAMPERSAND_MIDDLE|5.017004||Viu
SAWAMPERSAND_RIGHT|5.017004||Viu
sawparens|5.003007||Viu
sb_dstr|5.003007||Viu
sb_iters|5.003007||Viu
sb_m|5.003007||Viu
sb_maxiters|5.003007||Viu
SBOL|5.003007||Viu
SBOL_t8|5.035004||Viu
SBOL_t8_p8|5.033003||Viu
SBOL_t8_pb|5.033003||Viu
SBOL_tb|5.035004||Viu
SBOL_tb_p8|5.033003||Viu
SBOL_tb_pb|5.033003||Viu
sb_orig|5.003007||Viu
SBOX32_CHURN_ROUNDS|5.027001||Viu
SBOX32_MAX_LEN|5.027001||Viu
SBOX32_MIX3|5.027001||Viu
SBOX32_MIX4|5.027001||Viu
SBOX32_SCRAMBLE32|5.027001||Viu
SBOX32_SKIP_MASK|5.027001||Viu
SBOX32_STATE_BITS|5.027001||Viu
SBOX32_STATE_BYTES|5.027001||Viu
SBOX32_STATE_WORDS|5.027001||Viu
SBOX32_STATIC_INLINE|5.027001||Viu
SBOX32_WARN2|5.027001||Viu
SBOX32_WARN3|5.027001||Viu
SBOX32_WARN4|5.027001||Viu
SBOX32_WARN5|5.027001||Viu
SBOX32_WARN6|5.027001||Viu
sb_rflags|5.006000||Viu
sb_rx|5.003007||Viu
sb_rxres|5.004000||Viu
sb_rxtainted|5.004000||Viu
sb_s|5.003007||Viu
sb_strend|5.003007||Viu
sb_targ|5.003007||Viu
scalar|5.003007||Viu
scalarboolean|5.005000||Viu
scalarkids|5.003007||Viu
scalar_mod_type|5.006000||Vniu
scalarvoid|5.003007||Viu
scan_bin|5.006000|5.006000|
scan_commit|5.005000||Viu
scan_const|5.003007||Viu
SCAN_DEF|5.003007||Viu
scan_formline|5.003007||Viu
scan_heredoc|5.003007||Viu
scan_hex|5.006000|5.003007|
scan_ident|5.003007||Viu
scan_inputsymbol|5.003007||Viu
scan_num|5.003007||cVu
scan_oct|5.006000|5.003007|
scan_pat|5.003007||Viu
SCAN_REPL|5.003007||Viu
scan_str|5.003007||xcViu
scan_subst|5.003007||Viu
SCAN_TR|5.003007||Viu
scan_trans|5.003007||Viu
scan_version|5.009001|5.009001|
SCAN_VERSION|5.019008||Viu
scan_vstring|5.009005|5.009005|u
scan_word|5.003007||xcViu
SCHED_YIELD|5.006000|5.006000|Vn
SCOPE_SAVES_SIGNAL_MASK|5.007001||Viu
search_const|5.010001||Viu
seed|5.009003|5.009003|u
seedDrand01|5.006000|5.006000|
SEEK_CUR|5.003007||Viu
seekdir|5.005000||Viu
SEEK_END|5.003007||Viu
SEEK_SET|5.003007||Viu
select|5.005000||Viu
Select_fd_set_t|5.003007|5.003007|Vn
SELECT_MIN_BITS|5.005003|5.005003|Vn
Semctl|5.004005||Viu
semun|5.006000||Viu
send|5.005000||Viu
sendto|5.005000||Viu
SEOL|5.003007||Viu
SEOL_t8|5.035004||Viu
SEOL_t8_p8|5.033003||Viu
SEOL_t8_pb|5.033003||Viu
SEOL_tb|5.035004||Viu
SEOL_tb_p8|5.033003||Viu
SEOL_tb_pb|5.033003||Viu
sequence_num|5.009003||Viu
set_ANYOF_arg|5.019005||Viu
set_ANYOF_SYNTHETIC|5.019009||Viu
setbuf|5.003007||Viu
set_caret_X|5.019006||Viu
set_context|5.006000|5.006000|nu
setdefout|5.011000|5.011000|
SETERRNO|5.003007||Vi
setfd_cloexec|5.027008||Vniu
setfd_cloexec_for_nonsysfd|5.027008||Viu
setfd_cloexec_or_inhexec_by_sysfdness|5.027008||Viu
setfd_inhexec|5.027008||Vniu
setfd_inhexec_for_sysfd|5.027008||Viu
setgid|5.005000||Viu
setgrent|5.009000||Viu
SETGRENT_R_HAS_FPTR|5.008000||Viu
SETGRENT_R_PROTO|5.008000|5.008000|Vn
sethostent|5.005000||Viu
SETHOSTENT_R_PROTO|5.008000|5.008000|Vn
SETi|5.003007||Viu
setjmp|5.005000||Viu
setlinebuf|5.005000||Viu
setlocale|5.009000||Viu
setlocale_debug_string|5.027002||Vniu
SETLOCALE_LOCK|5.033005||Viu
SETLOCALE_R_PROTO|5.008000|5.008000|Vn
SETLOCALE_UNLOCK|5.033005||Viu
SET_MARK_OFFSET|5.006000||Viu
setmode|5.005000||Viu
SETn|5.003007||Viu
setnetent|5.005000||Viu
SETNETENT_R_PROTO|5.008000|5.008000|Vn
set_numeric_radix|5.006000||Viu
SET_NUMERIC_STANDARD|5.004000||Viu
set_numeric_standard|5.006000||cViu
SET_NUMERIC_UNDERLYING|5.021010||Viu
set_numeric_underlying|5.027006||cViu
SETp|5.003007||Viu
set_padlist|5.021006||cVniu
setprotoent|5.005000||Viu
SETPROTOENT_R_PROTO|5.008000|5.008000|Vn
setpwent|5.009000||Viu
SETPWENT_R_HAS_FPTR|5.008000||Viu
SETPWENT_R_PROTO|5.008000|5.008000|Vn
set_regex_pv|5.029004||Viu
setregid|5.003007||Viu
setreuid|5.003007||Viu
SETs|5.003007||Viu
setservent|5.005000||Viu
SETSERVENT_R_PROTO|5.008000|5.008000|Vn
setsockopt|5.005000||Viu
setSTR_LEN|5.031005||Viu
SET_SVANY_FOR_BODYLESS_IV|5.023008||Viu
SET_SVANY_FOR_BODYLESS_NV|5.023008||Viu
SETTARG|5.003007||Viu
SET_THR|5.005000||Viu
SET_THREAD_SELF|5.005003||Viu
SETu|5.004000||Viu
setuid|5.005000||Viu
_setup_canned_invlist|5.019008||cViu
setvbuf|5.003007||Viu
share_hek|5.009003|5.009003|u
share_hek_flags|5.008000||Viu
share_hek_hek|5.009003||Viu
sharepvn|5.005000||Viu
SHARP_S_SKIP|5.007003||Viu
Shmat_t|5.003007|5.003007|Vn
SHORTSIZE|5.004000|5.004000|Vn
should_warn_nl|5.021001||Vniu
should_we_output_Debug_r|5.031011||Viu
SH_PATH|5.003007|5.003007|Vn
shutdown|5.005000||Viu
si_dup|5.007003|5.007003|u
S_IEXEC|5.006000||Viu
S_IFIFO|5.011000||Viu
S_IFMT|5.003007||Viu
SIGABRT|5.003007||Viu
sighandler1|5.031007||Vniu
sighandler3|5.031007||Vniu
sighandler|5.003007||Vniu
SIGILL|5.003007||Viu
Sigjmp_buf|5.003007|5.003007|Vn
Siglongjmp|5.003007|5.003007|
signal|5.005000||Viu
Signal_t|5.003007|5.003007|Vn
SIG_NAME|5.003007|5.003007|Vn
SIG_NUM|5.003007|5.003007|Vn
Sigsetjmp|5.003007|5.003007|
SIG_SIZE|5.007001|5.007001|Vn
simplify_sort|5.006000||Viu
single_1bit_pos32|5.035003||cVnu
single_1bit_pos64|5.035003||cVnu
SINGLE_PAT_MOD|5.009005||Viu
SIPHASH_SEED_STATE|5.027001||Viu
SIPROUND|5.017006||Viu
S_IREAD|5.006000||Viu
S_IRGRP|5.003007||Viu
S_IROTH|5.003007||Viu
S_IRUSR|5.003007||Viu
S_IRWXG|5.006000||Viu
S_IRWXO|5.006000||Viu
S_IRWXU|5.006000||Viu
S_ISBLK|5.003007||Viu
S_ISCHR|5.003007||Viu
S_ISDIR|5.003007||Viu
S_ISFIFO|5.003007||Viu
S_ISGID|5.003007||Viu
S_ISLNK|5.003007||Viu
S_ISREG|5.003007||Viu
S_ISSOCK|5.003007||Viu
S_ISUID|5.003007||Viu
SITEARCH|5.003007|5.003007|Vn
SITEARCH_EXP|5.003007|5.003007|Vn
SITELIB|5.003007|5.003007|Vn
SITELIB_EXP|5.003007|5.003007|Vn
SITELIB_STEM|5.006000|5.006000|Vn
S_IWGRP|5.003007||Viu
S_IWOTH|5.003007||Viu
S_IWRITE|5.006000||Viu
S_IWUSR|5.003007||Viu
S_IXGRP|5.003007||Viu
S_IXOTH|5.003007||Viu
S_IXUSR|5.003007||Viu
SIZE_ALIGN|5.005000||Viu
Size_t|5.003007|5.003007|Vn
Size_t_MAX|5.021003||Viu
Size_t_size|5.006000|5.006000|Vn
SKIP|5.009005||Viu
SKIP_next|5.009005||Viu
SKIP_next_fail|5.009005||Viu
SKIP_next_fail_t8|5.035004||Viu
SKIP_next_fail_t8_p8|5.033003||Viu
SKIP_next_fail_t8_pb|5.033003||Viu
SKIP_next_fail_tb|5.035004||Viu
SKIP_next_fail_tb_p8|5.033003||Viu
SKIP_next_fail_tb_pb|5.033003||Viu
SKIP_next_t8|5.035004||Viu
SKIP_next_t8_p8|5.033003||Viu
SKIP_next_t8_pb|5.033003||Viu
SKIP_next_tb|5.035004||Viu
SKIP_next_tb_p8|5.033003||Viu
SKIP_next_tb_pb|5.033003||Viu
skipspace_flags|5.019002||xcViu
SKIP_t8|5.035004||Viu
SKIP_t8_p8|5.033003||Viu
SKIP_t8_pb|5.033003||Viu
SKIP_tb|5.035004||Viu
SKIP_tb_p8|5.033003||Viu
SKIP_tb_pb|5.033003||Viu
skip_to_be_ignored_text|5.023004||Viu
Slab_Alloc|5.006000||cViu
Slab_Free|5.007003||cViu
Slab_to_ro|5.017002||Viu
Slab_to_rw|5.009005||Viu
sleep|5.005000||Viu
SLOPPYDIVIDE|5.003007||Viu
socket|5.005000||Viu
SOCKET_OPEN_MODE|5.008002||Viu
socketpair|5.005000||Viu
Sock_size_t|5.006000|5.006000|Vn
softref2xv|||iu
sortcv|5.009003||Viu
sortcv_stacked|5.009003||Viu
sortcv_xsub|5.009003||Viu
sortsv|5.007003|5.007003|
sortsv_flags|5.009003|5.009003|
sortsv_flags_impl|5.031011||Viu
SP|5.003007|5.003007|
space_join_names_mortal|5.009004||Viu
SPAGAIN|5.003007|5.003007|
S_PAT_MODS|5.009005||Viu
specialWARN|5.006000||Viu
SRAND48_R_PROTO|5.008000|5.008000|Vn
SRANDOM_R_PROTO|5.008000|5.008000|Vn
SRCLOSE|5.027008||Viu
SRCLOSE_t8|5.035004||Viu
SRCLOSE_t8_p8|5.033003||Viu
SRCLOSE_t8_pb|5.033003||Viu
SRCLOSE_tb|5.035004||Viu
SRCLOSE_tb_p8|5.033003||Viu
SRCLOSE_tb_pb|5.033003||Viu
SROPEN|5.027008||Viu
SROPEN_t8|5.035004||Viu
SROPEN_t8_p8|5.033003||Viu
SROPEN_t8_pb|5.033003||Viu
SROPEN_tb|5.035004||Viu
SROPEN_tb_p8|5.033003||Viu
SROPEN_tb_pb|5.033003||Viu
SS_ACCVIO|5.008001||Viu
SS_ADD_BOOL|5.017007||Viu
SS_ADD_DPTR|5.017007||Viu
SS_ADD_DXPTR|5.017007||Viu
SS_ADD_END|5.017007||Viu
SS_ADD_INT|5.017007||Viu
SS_ADD_IV|5.017007||Viu
SS_ADD_LONG|5.017007||Viu
SS_ADD_PTR|5.017007||Viu
SS_ADD_UV|5.017007||Viu
SS_BUFFEROVF|5.021009||Viu
ssc_add_range|5.019005||Viu
ssc_and|5.019005||Viu
ssc_anything|5.019005||Viu
ssc_clear_locale|5.019005||Vniu
ssc_cp_and|5.019005||Viu
ssc_finalize|5.019005||Viu
SSCHECK|5.003007||Viu
ssc_init|5.019005||Viu
ssc_intersection|5.019005||Viu
ssc_is_anything|5.019005||Vniu
ssc_is_cp_posixl_init|5.019005||Vniu
SSC_MATCHES_EMPTY_STRING|5.021004||Viu
ssc_or|5.019005||Viu
ssc_union|5.019005||Viu
SS_DEVOFFLINE|5.008001||Viu
ss_dup|5.007003|5.007003|u
SSGROW|5.008001||Viu
SS_IVCHAN|5.008001||Viu
SSize_t|5.003007|5.003007|Vn
SSize_t_MAX|5.019004||Viu
SS_MAXPUSH|5.017007||Viu
SSNEW|5.006000||Viu
SSNEWa|5.006000||Viu
SSNEWat|5.007001||Viu
SSNEWt|5.007001||Viu
SS_NOPRIV|5.021001||Viu
SS_NORMAL|5.008001||Viu
SSPOPBOOL|5.008001||Viu
SSPOPDPTR|5.003007||Viu
SSPOPDXPTR|5.006000||Viu
SSPOPINT|5.003007||Viu
SSPOPIV|5.003007||Viu
SSPOPLONG|5.003007||Viu
SSPOPPTR|5.003007||Viu
SSPOPUV|5.013001||Viu
SSPTR|5.006000||Viu
SSPTRt|5.007001||Viu
SSPUSHBOOL|5.008001||Viu
SSPUSHDPTR|5.003007||Viu
SSPUSHDXPTR|5.006000||Viu
SSPUSHINT|5.003007||Viu
SSPUSHIV|5.003007||Viu
SSPUSHLONG|5.003007||Viu
SSPUSHPTR|5.003007||Viu
SSPUSHUV|5.013001||Viu
ST|5.003007|5.003007|
stack_grow|5.003007||cVu
Stack_off_t_MAX|||piu
Stack_off_t|||piu
STANDARD_C|5.003007||Viu
STAR|5.003007||Viu
STAR_t8|5.035004||Viu
STAR_t8_p8|5.033003||Viu
STAR_t8_pb|5.033003||Viu
STAR_tb|5.035004||Viu
STAR_tb_p8|5.033003||Viu
STAR_tb_pb|5.033003||Viu
START_EXTERN_C|5.005000|5.003007|pV
start_glob|||xi
START_MY_CXT|5.010000|5.010000|p
STARTPERL|5.003007|5.003007|Vn
start_subparse|5.004000|5.003007|pu
StashHANDLER|5.007001||Viu
Stat|5.003007||Viu
stat|5.005000||Viu
STATIC|5.005000||Viu
STATIC_ASSERT_1|5.021007||Viu
STATIC_ASSERT_2|5.021007||Viu
STATIC_ASSERT_DECL|5.027001||Viu
STATIC_ASSERT_STMT|5.021007||Viu
Stat_t|5.004005||Viu
STATUS_ALL_FAILURE|5.004000||Viu
STATUS_ALL_SUCCESS|5.004000||Viu
STATUS_CURRENT|5.004000||Viu
STATUS_EXIT|5.009003||Viu
STATUS_EXIT_SET|5.009003||Viu
STATUS_NATIVE|5.004000||Viu
STATUS_NATIVE_CHILD_SET|5.009003||Viu
STATUS_UNIX|5.009003||Viu
STATUS_UNIX_EXIT_SET|5.009003||Viu
STATUS_UNIX_SET|5.009003||Viu
STDCHAR|5.003007|5.003007|Vn
stderr|5.003007||Viu
ST_DEV_SIGN|5.035004|5.035004|Vn
ST_DEV_SIZE|5.035004|5.035004|Vn
stdin|5.003007||Viu
STDIO_PTR_LVAL_SETS_CNT|5.007001|5.007001|Vn
STDIO_PTR_LVALUE|5.006000|5.006000|Vn
STDIO_STREAM_ARRAY|5.006000|5.006000|Vn
stdize_locale|5.007001||Viu
stdout|5.003007||Viu
stdoutf|5.005000||Viu
STD_PAT_MODS|5.009005||Viu
STD_PMMOD_FLAGS_CLEAR|5.013006||Viu
ST_INO_SIGN|5.015002|5.015002|Vn
ST_INO_SIZE|5.015002|5.015002|Vn
STMT_END|5.003007|5.003007|pV
STMT_START|5.003007|5.003007|pV
STOREFEATUREBITSHH|5.031006||Viu
STORE_LC_NUMERIC_FORCE_TO_UNDERLYING|5.021010|5.021010|
STORE_LC_NUMERIC_SET_STANDARD|5.027009||pVu
STORE_LC_NUMERIC_SET_TO_NEEDED|5.021010|5.021010|
STORE_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003|
STORE_NUMERIC_SET_STANDARD|||piu
strBEGINs|5.027006||Viu
strEQ|5.003007|5.003007|
Strerror|5.003007||Viu
strerror|5.009000||Viu
STRERROR_R_PROTO|5.008000|5.008000|Vn
strGE|5.003007|5.003007|
strGT|5.003007|5.003007|
STRING|5.006000||Viu
STRINGIFY|5.003007|5.003007|Vn
STRINGl|5.031005||Viu
STRINGs|5.031005||Viu
strip_return|5.009003||Viu
strLE|5.003007|5.003007|
STR_LEN|5.006000||Viu
STRLEN|5.027001||Viu
STR_LENl|5.031005||Viu
STR_LENs|5.031005||Viu
strLT|5.003007|5.003007|
strNE|5.003007|5.003007|
strnEQ|5.003007|5.003007|
strnNE|5.003007|5.003007|
STR_SZ|5.006000||Viu
Strtod|5.029010|5.029010|n
Strtol|5.006000|5.006000|n
strtoll|5.006000||Viu
Strtoul|5.006000|5.006000|n
strtoull|5.006000||Viu
str_to_version|5.006000||cVu
StructCopy|5.003007|5.003007|V
STRUCT_OFFSET|5.004000||Viu
STRUCT_SV|5.007001||Viu
STR_WITH_LEN|5.009003|5.003007|pV
study_chunk|5.005000||Viu
sub_crush_depth|5.004000||Viu
sublex_done|5.005000||Viu
sublex_push|5.005000||Viu
sublex_start|5.005000||Viu
SUBST_TAINT_BOOLRET|5.013010||Viu
SUBST_TAINT_PAT|5.013010||Viu
SUBST_TAINT_REPL|5.013010||Viu
SUBST_TAINT_RETAINT|5.013010||Viu
SUBST_TAINT_STR|5.013010||Viu
SUBVERSION|5.003007||Viu
SUCCEED|5.003007||Viu
SUCCEED_t8|5.035004||Viu
SUCCEED_t8_p8|5.033003||Viu
SUCCEED_t8_pb|5.033003||Viu
SUCCEED_tb|5.035004||Viu
SUCCEED_tb_p8|5.033003||Viu
SUCCEED_tb_pb|5.033003||Viu
SUSPEND|5.005000||Viu
SUSPEND_t8|5.035004||Viu
SUSPEND_t8_p8|5.033003||Viu
SUSPEND_t8_pb|5.033003||Viu
SUSPEND_tb|5.035004||Viu
SUSPEND_tb_p8|5.033003||Viu
SUSPEND_tb_pb|5.033003||Viu
sv_2bool|5.013006||cV
sv_2bool_flags|5.013006||cV
sv_2bool_nomg|5.017002||Viu
sv_2cv|5.003007|5.003007|
sv_2io|5.003007|5.003007|
sv_2iuv_common|5.009004||Viu
sv_2iuv_non_preserve|5.007001||Viu
sv_2iv|5.009001||cVu
sv_2iv_flags|5.009001|5.009001|
sv_2mortal|5.003007|5.003007|
sv_2num|5.010000||xVi
sv_2nv|5.013001||Viu
sv_2nv_flags|5.013001|5.013001|
sv_2pv|5.005000||pcVu
sv_2pvbyte|5.006000|5.003007|p
sv_2pvbyte_flags|5.031004|5.031004|u
sv_2pvbyte_nolen|5.009003||pcV
sv_2pv_flags|5.007002||pcV
sv_2pv_nolen|5.009003||pcV
sv_2pv_nomg|5.007002||Viu
sv_2pvutf8|5.006000|5.006000|
sv_2pvutf8_flags|5.031004|5.031004|u
sv_2pvutf8_nolen|5.009003||cV
sv_2uv|5.009001||pcVu
sv_2uv_flags|5.009001|5.009001|
sv_add_arena|5.003007||Vi
sv_add_backref|||iu
SvAMAGIC|5.003007||Viu
SvAMAGIC_off|5.003007|5.003007|nu
SvAMAGIC_on|5.003007|5.003007|nu
SvANY|5.003007||Viu
SvARENA_CHAIN_SET|||Viu
SvARENA_CHAIN|||Viu
sv_backoff|5.003007|5.003007|n
sv_bless|5.003007|5.003007|
sv_buf_to_ro|5.019008||Viu
sv_buf_to_rw|5.019008||Viu
SvCANCOW|5.017007||Viu
SvCANEXISTDELETE|5.011000||Viu
SV_CATBYTES|5.021005|5.021005|
sv_cat_decode|5.008001|5.008001|
sv_cathek|5.021004||Viu
sv_catpv|5.003007|5.003007|
sv_catpvf|5.004000||vV
sv_catpv_flags|5.013006|5.013006|
sv_catpvf_mg|5.004005||pvV
sv_catpvf_mg_nocontext|5.006000||pvVn
sv_catpvf_nocontext|5.006000||vVn
sv_catpv_mg|5.004005|5.003007|p
sv_catpvn|5.003007|5.003007|
sv_catpvn_flags|5.007002|5.007002|
sv_catpvn_mg|5.004005|5.003007|p
sv_catpvn_nomg|5.007002|5.003007|p
sv_catpvn_nomg_maybeutf8|5.017005||Viu
sv_catpvn_nomg_utf8_upgrade|5.017002||Viu
sv_catpv_nomg|5.013006|5.013006|
sv_catpvs|5.009003|5.003007|p
sv_catpvs_flags|5.013006|5.013006|
sv_catpvs_mg|5.013006|5.013006|
sv_catpvs_nomg|5.013006|5.013006|
sv_catsv|5.003007|5.003007|
sv_catsv_flags|5.007002|5.007002|
sv_catsv_mg|5.004005|5.003007|p
sv_catsv_nomg|5.007002|5.003007|p
SV_CATUTF8|5.021005|5.021005|
sv_catxmlpvs|5.013006||Viu
SV_CHECK_THINKFIRST|5.008001||Viu
SV_CHECK_THINKFIRST_COW_DROP|5.009000||Viu
sv_chop|5.003007|5.003007|
sv_clean_all|5.003007||Vi
sv_clean_objs|5.003007||Vi
sv_clear|5.003007|5.003007|
sv_cmp|5.003007|5.003007|
sv_cmp_flags|5.013006|5.013006|
sv_cmp_locale|5.004000|5.004000|
sv_cmp_locale_flags|5.013006|5.013006|
sv_collxfrm|5.013006||V
sv_collxfrm_flags|5.013006|5.013006|
SvCOMPILED|5.003007||Viu
SvCOMPILED_off|5.003007||Viu
SvCOMPILED_on|5.003007||Viu
SV_CONST|5.019002||Viu
SV_CONST_BINMODE|5.019002||Viu
SV_CONST_CLEAR|5.019002||Viu
SV_CONST_CLOSE|5.019002||Viu
SV_CONST_DELETE|5.019002||Viu
SV_CONST_DESTROY|5.019002||Viu
SV_CONST_EOF|5.019002||Viu
SV_CONST_EXISTS|5.019002||Viu
SV_CONST_EXTEND|5.019002||Viu
SV_CONST_FETCH|5.019002||Viu
SV_CONST_FETCHSIZE|5.019002||Viu
SV_CONST_FILENO|5.019002||Viu
SV_CONST_FIRSTKEY|5.019002||Viu
SV_CONST_GETC|5.019002||Viu
SV_CONST_NEXTKEY|5.019002||Viu
SV_CONST_OPEN|5.019002||Viu
SV_CONST_POP|5.019002||Viu
SV_CONST_PRINT|5.019002||Viu
SV_CONST_PRINTF|5.019002||Viu
SV_CONST_PUSH|5.019002||Viu
SV_CONST_READ|5.019002||Viu
SV_CONST_READLINE|5.019002||Viu
SV_CONST_RETURN|5.009003|5.003007|poVnu
SV_CONST_SCALAR|5.019002||Viu
SV_CONSTS_COUNT|5.019002||Viu
SV_CONST_SEEK|5.019002||Viu
SV_CONST_SHIFT|5.019002||Viu
SV_CONST_SPLICE|5.019002||Viu
SV_CONST_STORE|5.019002||Viu
SV_CONST_STORESIZE|5.019002||Viu
SV_CONST_TELL|5.019002||Viu
SV_CONST_TIEARRAY|5.019002||Viu
SV_CONST_TIEHANDLE|5.019002||Viu
SV_CONST_TIEHASH|5.019002||Viu
SV_CONST_TIESCALAR|5.019002||Viu
SV_CONST_UNSHIFT|5.019002||Viu
SV_CONST_UNTIE|5.019002||Viu
SV_CONST_WRITE|5.019002||Viu
sv_copypv|5.007003|5.007003|
sv_copypv_flags|5.017002|5.017002|
sv_copypv_nomg|5.017002|5.017002|
SV_COW_DROP_PV|5.008001|5.003007|p
SV_COW_OTHER_PVS|5.009005||Viu
SV_COW_REFCNT_MAX|5.017007||Viu
SV_COW_SHARED_HASH_KEYS|5.009005|5.003007|poVnu
SvCUR|5.003007|5.003007|
SvCUR_set|5.003007|5.003007|
sv_dec|5.003007|5.003007|
sv_dec_nomg|5.013002|5.013002|
sv_del_backref|5.006000||cViu
sv_derived_from|5.004000|5.004000|
sv_derived_from_pv|5.015004|5.015004|
sv_derived_from_pvn|5.015004|5.015004|
sv_derived_from_sv|5.015004|5.015004|
sv_derived_from_svpvn|5.031006||Viu
sv_destroyable|5.010000|5.010000|
SvDESTROYABLE|5.010000||Viu
sv_display|5.021002||Viu
SV_DO_COW_SVSETSV|5.009005||Viu
sv_does|5.009004|5.009004|
sv_does_pv|5.015004|5.015004|
sv_does_pvn|5.015004|5.015004|
sv_does_sv|5.015004|5.015004|
sv_dump|5.003007|5.003007|
sv_dup|5.007003|5.007003|u
sv_dup_common|5.013002||Viu
sv_dup_inc|5.013002|5.013002|u
sv_dup_inc_multiple|5.011000||Viu
SvEND|5.003007|5.003007|
SvEND_set|5.003007||Viu
SvENDx|5.003007||Viu
sv_eq|5.003007|5.003007|
sv_eq_flags|5.013006|5.013006|
sv_exp_grow|5.009003||Viu
SVf256|5.008001||Viu
SVf32|5.009002||Viu
SVf|5.006000|5.003007|p
SvFAKE|5.003007||Viu
SvFAKE_off|5.003007||Viu
SvFAKE_on|5.003007||Viu
SVf_AMAGIC|5.003007||Viu
SVfARG|5.009005|5.003007|p
SVf_BREAK|5.003007||Viu
SVf_FAKE|5.003007||Viu
SVf_IOK|5.003007||Viu
SVf_IsCOW|5.017006||Viu
SVf_IVisUV|5.006000||Viu
SvFLAGS|5.003007||Viu
SVf_NOK|5.003007||Viu
SVf_OK|5.003007||Viu
SVf_OOK|5.003007||Viu
sv_force_normal|5.006000|5.006000|
sv_force_normal_flags|5.007001|5.007001|
SV_FORCE_UTF8_UPGRADE|5.011000|5.011000|
SVf_POK|5.003007||Viu
SVf_PROTECT|5.021005||Viu
SVf_READONLY|5.003007||Viu
sv_free2|||xciu
sv_free|5.003007|5.003007|
sv_free_arenas|5.003007||Vi
SVf_ROK|5.003007||Viu
SVf_THINKFIRST|5.003007||Viu
SVf_UTF8|5.006000|5.003007|p
SvGAMAGIC|5.006001|5.006001|
sv_get_backrefs|5.021008|5.021008|xn
SvGETMAGIC|5.004005|5.003007|p
sv_gets|5.003007|5.003007|
SvGID|5.019001||Viu
SV_GMAGIC|5.007002|5.003007|p
SvGMAGICAL|5.003007||Viu
SvGMAGICAL_off|5.003007||Viu
SvGMAGICAL_on|5.003007||Viu
SvGROW|5.003007|5.003007|
sv_grow|5.003007||cV
Sv_Grow|5.003007||Viu
sv_grow_fresh|5.035006||cV
SvGROW_mutable|5.009003||Viu
SV_HAS_TRAILING_NUL|5.009004|5.003007|p
SV_IMMEDIATE_UNREF|5.007001|5.003007|p
SvIMMORTAL|5.004000||Viu
SvIMMORTAL_INTERP|5.027003||Viu
SvIMMORTAL_TRUE|5.027003||Viu
sv_inc|5.003007|5.003007|
sv_i_ncmp|5.009003||Viu
sv_i_ncmp_desc|5.031011||Viu
sv_inc_nomg|5.013002|5.013002|
sv_insert|5.003007|5.003007|
sv_insert_flags|5.010001|5.010001|
SvIOK|5.003007|5.003007|
SvIOK_nog|5.017002||Viu
SvIOK_nogthink|5.017002||Viu
SvIOK_notUV|5.006000|5.006000|
SvIOK_off|5.003007|5.003007|
SvIOK_on|5.003007|5.003007|
SvIOK_only|5.003007|5.003007|
SvIOK_only_UV|5.006000|5.006000|
SvIOKp|5.003007|5.003007|
SvIOKp_on|5.003007||Viu
SvIOK_UV|5.006000|5.006000|
sv_isa|5.003007|5.003007|
sv_isa_sv|5.031007|5.031007|x
SvIsBOOL|5.035004|5.035004|
SvIsCOW|5.008003|5.008003|
SvIsCOW_shared_hash|5.008003|5.008003|
SvIS_FREED|5.009003||Viu
sv_isobject|5.003007|5.003007|
SvIV|5.003007|5.003007|
sv_iv|5.005000||dcV
SvIV_nomg|5.009001|5.003007|p
SvIV_please|5.007001||Viu
SvIV_please_nomg|5.013002||Viu
SvIV_set|5.003007|5.003007|
SvIVX|5.003007|5.003007|
SvIVx|5.003007|5.003007|
SvIVXx|5.003007||Viu
sv_kill_backrefs|||xiu
sv_len|5.003007|5.003007|
SvLEN|5.003007|5.003007|
SvLEN_set|5.003007|5.003007|
sv_len_utf8|5.006000|5.006000|p
sv_len_utf8_nomg||5.006000|p
SvLENx|5.003007||Viu
SvLOCK|5.007003|5.007003|
sv_magic|5.003007|5.003007|
SvMAGIC|5.003007||Viu
SvMAGICAL|5.003007||Viu
SvMAGICAL_off|5.003007||Viu
SvMAGICAL_on|5.003007||Viu
sv_magicext|5.007003|5.007003|
sv_magicext_mglob|5.019002||cViu
sv_magic_portable||5.004000|pou
SvMAGIC_set|5.009003|5.003007|p
sv_mortalcopy|5.003007|5.003007|
sv_mortalcopy_flags|5.031001|5.003007|p
SV_MUTABLE_RETURN|5.009003|5.003007|poVnu
sv_ncmp|5.009003||Viu
sv_ncmp_desc|5.031011||Viu
sv_newmortal|5.003007|5.003007|
sv_newref|5.003007||cV
SvNIOK|5.003007|5.003007|
SvNIOK_nog|5.017002||Viu
SvNIOK_nogthink|5.017002||Viu
SvNIOK_off|5.003007|5.003007|
SvNIOKp|5.003007|5.003007|
SvNOK|5.003007|5.003007|
SvNOK_nog|5.017002||Viu
SvNOK_nogthink|5.017002||Viu
SvNOK_off|5.003007|5.003007|
SvNOK_on|5.003007|5.003007|
SvNOK_only|5.003007|5.003007|
SvNOKp|5.003007|5.003007|
SvNOKp_on|5.003007||Viu
sv_nolocking|5.031004|5.031004|d
sv_nosharing|5.007003|5.007003|
SV_NOSTEAL|5.009002|5.003007|p
sv_nounlocking|5.009004|5.009004|d
sv_numeq|5.035009|5.035009|
sv_numeq_flags|5.035009|5.035009|
sv_nv|5.005000||dcV
SvNV|5.006000|5.003007|
SvNV_nomg|5.013002|5.003007|p
SvNV_set|5.006000|5.003007|
SvNVX|5.006000|5.003007|
SvNVx|5.006000|5.003007|
SvNVXx|5.003007||Viu
SvOBJECT|5.003007||Viu
SvOBJECT_off|5.003007||Viu
SvOBJECT_on|5.003007||Viu
SvOK|5.003007|5.003007|
SvOK_off|5.003007||Viu
SvOK_off_exc_UV|5.006000||Viu
SvOKp|5.003007||Viu
sv_only_taint_gmagic|5.021010||Vniu
SvOOK|5.003007|5.003007|
SvOOK_off|5.003007|5.003007|
SvOOK_offset|5.011000|5.011000|
SvOOK_on|5.003007||Viu
sv_or_pv_len_utf8|5.017005||Viu
sv_or_pv_pos_u2b|5.019004||Viu
SvOURSTASH|5.009005||Viu
SvOURSTASH_set|5.009005||Viu
SvPADMY|5.003007||Viu
SvPADMY_on|5.003007||Viu
SVpad_OUR|5.006000||Viu
SvPAD_OUR|5.009004||Viu
SvPAD_OUR_on|5.009004||Viu
SvPADSTALE|5.009000||Viu
SvPADSTALE_off|5.009000||Viu
SvPADSTALE_on|5.009000||Viu
SVpad_STATE|5.009004||Viu
SvPAD_STATE|5.009004||Viu
SvPAD_STATE_on|5.009004||Viu
SvPADTMP|5.003007||Viu
SvPADTMP_off|5.003007||Viu
SvPADTMP_on|5.003007||Viu
SVpad_TYPED|5.007002||Viu
SvPAD_TYPED|5.009004||Viu
SvPAD_TYPED_on|5.009004||Viu
SVpav_REAL|5.009003||Viu
SVpav_REIFY|5.009003||Viu
SvPCS_IMPORTED|5.009005||Viu
SvPCS_IMPORTED_off|5.009005||Viu
SvPCS_IMPORTED_on|5.009005||Viu
SvPEEK|5.003007||Viu
sv_peek|5.005000|5.005000|u
SVpgv_GP|5.009005||Viu
SVphv_CLONEABLE|5.009003||Viu
SVphv_HASKFLAGS|5.008000||Viu
SVphv_LAZYDEL|5.003007||Viu
SVphv_SHAREKEYS|5.003007||Viu
SVp_IOK|5.003007||Viu
SVp_NOK|5.003007||Viu
SvPOK|5.003007|5.003007|
SvPOK_byte_nog|5.017002||Viu
SvPOK_byte_nogthink|5.017002||Viu
SvPOK_byte_pure_nogthink|5.017003||Viu
SvPOK_nog|5.017002||Viu
SvPOK_nogthink|5.017002||Viu
SvPOK_off|5.003007|5.003007|
SvPOK_on|5.003007|5.003007|
SvPOK_only|5.003007|5.003007|
SvPOK_only_UTF8|5.006000|5.006000|
SvPOK_or_cached_IV|||Viu
SvPOKp|5.003007|5.003007|
SvPOKp_on|5.003007||Viu
SvPOK_pure_nogthink|5.017003||Viu
SvPOK_utf8_nog|5.017002||Viu
SvPOK_utf8_nogthink|5.017002||Viu
SvPOK_utf8_pure_nogthink|5.017003||Viu
sv_pos_b2u|5.006000|5.006000|
sv_pos_b2u_flags|5.019003|5.019003|
sv_pos_b2u_midway|5.009004||Viu
sv_pos_u2b|5.006000|5.006000|
sv_pos_u2b_cached|5.009004||Viu
sv_pos_u2b_flags|5.011005|5.011005|
sv_pos_u2b_forwards|5.009004||Vniu
sv_pos_u2b_midway|5.009004||Vniu
SVp_POK|5.003007||Viu
SVppv_STATIC|5.035004||Viu
SVprv_PCS_IMPORTED|5.009005||Viu
SVprv_WEAKREF|5.006000||Viu
SVp_SCREAM|5.003007||Viu
SvPV|5.003007|5.003007|
sv_pv|5.008000||cV
SvPVbyte|5.006000|5.003007|p
sv_pvbyte|5.008000||cV
SvPVbyte_force|5.009002|5.009002|
sv_pvbyten|5.006000||dcV
sv_pvbyten_force|5.006000||cV
SvPVbyte_nolen|5.006000|5.006000|
SvPVbyte_nomg|5.031004|5.031004|
SvPVbyte_or_null|5.031004|5.031004|
SvPVbyte_or_null_nomg|5.031004|5.031004|
SvPVbytex|5.006000|5.006000|
SvPVbytex_force|5.006000|5.006000|
SvPVbytex_nolen|5.009003|5.009003|
SvPVCLEAR|5.025006|5.025006|p
SvPV_const|5.009003|5.003007|p
SvPV_flags|5.007002|5.003007|p
SvPV_flags_const|5.009003|5.003007|p
SvPV_flags_const_nolen|5.009003||pVu
SvPV_flags_mutable|5.009003|5.003007|p
SvPV_force|5.003007|5.003007|p
SvPV_force_flags|5.007002|5.003007|p
SvPV_force_flags_mutable|5.009003|5.003007|p
SvPV_force_flags_nolen|5.009003|5.003007|p
SvPV_force_mutable|5.009003|5.003007|p
SvPV_force_nolen|5.009003|5.003007|p
SvPV_force_nomg|5.007002|5.003007|p
SvPV_force_nomg_nolen|5.009003|5.003007|p
SvPV_free|5.009003|5.009003|
SvPV_mutable|5.009003|5.003007|p
sv_pvn|5.004000||dcV
sv_pvn_force|5.005000||cV
sv_pvn_force_flags|5.007002|5.003007|p
sv_pvn_force_nomg|5.007002||Viu
sv_pvn_nomg|5.007003|5.005000|pdu
SvPV_nolen|5.006000|5.003007|p
SvPV_nolen_const|5.009003|5.003007|p
SvPV_nomg|5.007002|5.003007|p
SvPV_nomg_const|5.009003|5.003007|p
SvPV_nomg_const_nolen|5.009003|5.003007|p
SvPV_nomg_nolen|5.013007|5.003007|p
SvPV_renew|5.009003|5.003007|p
SvPV_set|5.003007|5.003007|
SvPV_shrink_to_cur|5.009003||Viu
SvPVutf8|5.006000|5.006000|
sv_pvutf8|5.008000||cV
SvPVutf8_force|5.006000|5.006000|
sv_pvutf8n|5.006000||dcV
sv_pvutf8n_force|5.006000||cV
SvPVutf8_nolen|5.006000|5.006000|
SvPVutf8_nomg|5.031004|5.031004|
SvPVutf8_or_null|5.031004|5.031004|
SvPVutf8_or_null_nomg|5.031004|5.031004|
SvPVutf8x|5.006000|5.006000|
SvPVutf8x_force|5.006000|5.006000|
SvPVX|5.003007|5.003007|
SvPVx|5.003007|5.003007|
SvPVX_const|5.009003|5.003007|p
SvPVx_const|5.009003|5.009003|
SvPVx_force|5.005000|5.005000|
SvPVX_mutable|5.009003|5.003007|p
SvPVx_nolen|5.009003|5.009003|
SvPVx_nolen_const|5.009003|5.003007|p
SvPVXtrue|5.017002||Viu
SvPVXx|5.003007|5.003007|
SvREADONLY|5.003007|5.003007|
SvREADONLY_off|5.003007|5.003007|
SvREADONLY_on|5.003007|5.003007|
sv_recode_to_utf8|5.007003|5.007003|
sv_ref|5.023005|5.023005|
SvREFCNT|5.003007|5.003007|
SvREFCNT_dec|5.003007|5.003007|
SvREFCNT_dec_NN|5.017007|5.017007|p
SvREFCNT_IMMORTAL|5.017008||Viu
SvREFCNT_inc|5.003007|5.003007|pn
SvREFCNT_inc_NN|5.009004|5.003007|pn
SvREFCNT_inc_simple|5.009004|5.003007|pn
SvREFCNT_inc_simple_NN|5.009004|5.003007|pn
SvREFCNT_inc_simple_void|5.009004|5.003007|pn
SvREFCNT_inc_simple_void_NN|5.009004|5.003007|pn
SvREFCNT_inc_void|5.009004|5.003007|pn
SvREFCNT_inc_void_NN|5.009004|5.003007|pn
sv_reftype|5.003007|5.003007|
sv_replace|5.003007|5.003007|
sv_report_used|5.003007|5.003007|
sv_reset|5.003007|5.003007|
sv_resetpvn|5.017005||Viu
SvRMAGICAL|5.003007||Viu
SvRMAGICAL_off|5.003007||Viu
SvRMAGICAL_on|5.003007||Viu
SvROK|5.003007|5.003007|
SvROK_off|5.003007|5.003007|
SvROK_on|5.003007|5.003007|
SvRV|5.003007|5.003007|
SvRV_const|5.010001||Viu
SvRV_set|5.009003|5.003007|p
sv_rvunweaken|5.027004|5.027004|
sv_rvweaken|5.006000|5.006000|
SvRVx|5.003007||Viu
SvRX|5.009005|5.003007|p
SvRXOK|5.009005|5.003007|p
SV_SAVED_COPY|5.009005||Viu
SvSCREAM|5.003007||Viu
SvSCREAM_off|5.003007||Viu
SvSCREAM_on|5.003007||Viu
sv_setbool|5.035004|5.035004|
sv_setbool_mg|5.035004|5.035004|
sv_setgid|5.019001||Viu
sv_sethek|5.015004||cViu
sv_setiv|5.003007|5.003007|
sv_setiv_mg|5.004005|5.003007|p
SvSETMAGIC|5.003007|5.003007|
SvSetMagicSV|5.004000|5.004000|
SvSetMagicSV_nosteal|5.004000|5.004000|
sv_setnv|5.006000|5.003007|
sv_setnv_mg|5.006000|5.003007|p
sv_setpv|5.003007|5.003007|
sv_setpv_bufsize|5.025006|5.025006|
sv_setpvf|5.004000||vV
sv_setpvf_mg|5.004005||pvV
sv_setpvf_mg_nocontext|5.006000||pvVn
sv_setpvf_nocontext|5.006000||vVn
sv_setpviv|5.008001|5.008001|d
sv_setpviv_mg|5.008001|5.008001|d
sv_setpv_mg|5.004005|5.003007|p
sv_setpvn|5.003007|5.003007|
sv_setpvn_fresh|5.035006|5.035006|
sv_setpvn_mg|5.004005|5.003007|p
sv_setpvs|5.009004|5.003007|p
sv_setpvs_mg|5.013006|5.013006|
sv_setref_iv|5.003007|5.003007|
sv_setref_nv|5.006000|5.003007|
sv_setref_pv|5.003007|5.003007|
sv_setref_pvn|5.003007|5.003007|
sv_setref_pvs|5.013006|5.013006|
sv_setref_uv|5.007001|5.007001|
sv_setrv_inc|5.035004|5.035004|
sv_setrv_inc_mg|5.035004|5.035004|
sv_setrv_noinc|5.035004|5.035004|
sv_setrv_noinc_mg|5.035004|5.035004|
sv_setsv|5.003007|5.003007|
SvSetSV|5.003007|5.003007|
sv_setsv_cow|5.009000||xcViu
sv_setsv_flags|5.007002|5.003007|p
sv_setsv_mg|5.004005|5.003007|p
sv_setsv_nomg|5.007002|5.003007|p
SvSetSV_nosteal|5.004000|5.004000|
sv_setuid|5.019001||Viu
sv_set_undef|5.025008|5.025008|
sv_setuv|5.004000|5.003007|p
sv_setuv_mg|5.004005|5.003007|p
SVs_GMG|5.003007||Viu
SvSHARE|5.007003|5.007003|
SvSHARED_HASH|5.009003|5.003007|p
SvSHARED_HEK_FROM_PV|5.009003||Viu
SV_SKIP_OVERLOAD|5.013001||Viu
SV_SMAGIC|5.009003|5.003007|p
SvSMAGICAL|5.003007||Viu
SvSMAGICAL_off|5.003007||Viu
SvSMAGICAL_on|5.003007||Viu
SVs_OBJECT|5.003007||Viu
SVs_PADMY|5.003007||Viu
SVs_PADSTALE|5.009000|5.009000|
SVs_PADTMP|5.003007||Viu
SVs_RMG|5.003007||Viu
SVs_SMG|5.003007||Viu
SvSTASH|5.003007|5.003007|
SvSTASH_set|5.009003|5.003007|p
SVs_TEMP|5.003007|5.003007|
sv_streq|5.035009|5.035009|
sv_streq_flags|5.035009|5.035009|
sv_string_from_errnum|5.027003|5.027003|
SvTAIL|5.003007||Viu
SvTAINT|5.003007|5.003007|
sv_taint|5.009003||cV
SvTAINTED|5.004000|5.004000|
sv_tainted|5.004000||cV
SvTAINTED_off|5.004000|5.004000|
SvTAINTED_on|5.004000|5.004000|
SvTEMP|5.003007||Viu
SvTEMP_off|5.003007||Viu
SvTEMP_on|5.003007||Viu
SVt_FIRST|5.021005||Viu
SvTHINKFIRST|5.003007||Vi
SvTIED_mg|5.005003||Viu
SvTIED_obj|5.005003|5.005003|
SVt_INVLIST|||c
SVt_IV|5.003007|5.003007|
SVt_MASK|5.015001||Viu
SVt_NULL|5.003007|5.003007|
SVt_NV|5.003007|5.003007|
SVt_PV|5.003007|5.003007|
SVt_PVAV|5.003007|5.003007|
SVt_PVBM|5.009005||Viu
SVt_PVCV|5.003007|5.003007|
SVt_PVFM|5.003007|5.003007|
SVt_PVGV|5.003007|5.003007|
SVt_PVHV|5.003007|5.003007|
SVt_PVIO|5.003007|5.003007|
SVt_PVIV|5.003007|5.003007|
SVt_PVLV|5.003007|5.003007|
SVt_PVMG|5.003007|5.003007|
SVt_PVNV|5.003007|5.003007|
SVt_REGEXP|5.011000|5.011000|
SvTRUE|5.003007|5.003007|
sv_true|5.005000||cV
SvTRUE_common|5.033005||cVu
SvTRUE_NN|5.017007|5.017007|
SvTRUE_nomg|5.013006|5.003007|p
SvTRUE_nomg_NN|5.017007|5.017007|
SvTRUEx|5.003007|5.003007|
SvTRUEx_nomg|5.017002||Viu
SVt_RV|5.011000||Viu
SvTYPE|5.003007|5.003007|
SVTYPEMASK|5.003007||Viu
SvUID|5.019001||Viu
SV_UNDEF_RETURNS_NULL|5.011000||Viu
sv_unglob|5.005000||Viu
sv_uni_display|5.007003|5.007003|
SvUNLOCK|5.007003|5.007003|
sv_unmagic|5.003007|5.003007|
sv_unmagicext|5.013008|5.003007|p
sv_unref|5.003007|5.003007|
sv_unref_flags|5.007001|5.007001|
sv_untaint|5.004000||cV
SvUOK|5.007001|5.006000|p
SvUOK_nog|5.017002||Viu
SvUOK_nogthink|5.017002||Viu
sv_upgrade|5.003007|5.003007|
SvUPGRADE|5.003007|5.003007|
sv_usepvn|5.003007|5.003007|
sv_usepvn_flags|5.009004|5.009004|
sv_usepvn_mg|5.004005|5.003007|p
SvUTF8|5.006000|5.003007|p
sv_utf8_decode|5.006000|5.006000|
sv_utf8_downgrade|5.006000|5.006000|
sv_utf8_downgrade_flags|5.031004|5.031004|
sv_utf8_downgrade_nomg|5.031004|5.031004|
sv_utf8_encode|5.006000|5.006000|
SV_UTF8_NO_ENCODING|5.008001|5.003007|pd
SvUTF8_off|5.006000|5.006000|
SvUTF8_on|5.006000|5.006000|
sv_utf8_upgrade|5.007001|5.007001|
sv_utf8_upgrade_flags|5.007002|5.007002|
sv_utf8_upgrade_flags_grow|5.011000|5.011000|
sv_utf8_upgrade_nomg|5.007002|5.007002|
SvUV|5.004000|5.003007|p
sv_uv|5.005000||pdcV
SvUV_nomg|5.009001|5.003007|p
SvUV_set|5.009003|5.003007|p
SvUVX|5.004000|5.003007|p
SvUVx|5.004000|5.003007|p
SvUVXx|5.004000|5.003007|pd
SvVALID|5.003007||Viu
sv_vcatpvf|5.006000|5.004000|p
sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn|5.004000|5.004000|
sv_vcatpvfn_flags|5.017002|5.017002|
SvVOK|5.008001|5.008001|p
sv_vsetpvf|5.006000|5.004000|p
sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn|5.004000|5.004000|
sv_vstring_get|||p
SvVSTRING_mg|5.009004|5.003007|p
SvVSTRING|||piu
SvWEAKREF|5.006000||Viu
SvWEAKREF_off|5.006000||Viu
SvWEAKREF_on|5.006000||Viu
swallow_bom|5.006001||Viu
switch_category_locale_to_template|5.027009||Viu
SWITCHSTACK|5.003007||Viu
switch_to_global_locale|5.027009|5.003007|pn
sync_locale|5.027009|5.003007|pn
sys_init3|||cnu
sys_init|||cnu
sys_intern_clear|5.006001||Vu
sys_intern_dup|5.006000||Vu
sys_intern_init|5.006001||Vu
SYSTEM_GMTIME_MAX|5.011000||Viu
SYSTEM_GMTIME_MIN|5.011000||Viu
SYSTEM_LOCALTIME_MAX|5.011000||Viu
SYSTEM_LOCALTIME_MIN|5.011000||Viu
sys_term|||cnu
TAIL|5.005000||Viu
TAIL_t8|5.035004||Viu
TAIL_t8_p8|5.033003||Viu
TAIL_t8_pb|5.033003||Viu
TAIL_tb|5.035004||Viu
TAIL_tb_p8|5.033003||Viu
TAIL_tb_pb|5.033003||Viu
TAINT|5.004000||Viu
taint_env|5.003007|5.003007|u
TAINT_ENV|5.003007||Viu
TAINT_get|5.017006||Viu
TAINT_IF|5.003007||Viu
TAINTING_get|5.017006||Viu
TAINTING_set|5.017006||Viu
TAINT_NOT|5.003007||Viu
taint_proper|5.003007|5.003007|u
TAINT_PROPER|5.003007||Viu
TAINT_set|5.017006||Viu
TAINT_WARN_get|5.017006||Viu
TAINT_WARN_set|5.017006||Viu
TARG|5.003007|5.003007|
TARGi|5.023005||Viu
TARGn|5.023005||Viu
TARGu|5.023005||Viu
telldir|5.005000||Viu
T_FMT|5.027010||Viu
T_FMT_AMPM|5.027010||Viu
THIS|5.003007|5.003007|V
THOUSEP|5.027010||Viu
THR|5.005000||Viu
THREAD_CREATE_NEEDS_STACK|5.007002||Viu
thread_locale_init|5.027009|5.027009|xnu
thread_locale_term|5.027009|5.027009|xnu
THREAD_RET_TYPE|5.005000||Viu
tied_method|5.013009||vViu
TIED_METHOD_ARGUMENTS_ON_STACK|5.013009||Viu
TIED_METHOD_MORTALIZE_NOT_NEEDED|5.013009||Viu
TIED_METHOD_SAY|5.013009||Viu
times|5.005000||Viu
Time_t|5.003007|5.003007|Vn
Timeval|5.004000|5.004000|Vn
TM|5.011000||Viu
tmpfile|5.003007||Viu
tmpnam|5.005000||Viu
TMPNAM_R_PROTO|5.008000|5.008000|Vn
tmps_grow_p|5.021005||cViu
to_byte_substr|5.008000||Viu
to_case_cp_list|5.035004||Viu
toCTRL|5.004000||Viu
toFOLD|5.019001|5.019001|
toFOLD_A|5.019001|5.019001|
_to_fold_latin1|5.015005||cVniu
toFOLD_LC|5.019001||Viu
toFOLD_uni|5.007003||Viu
toFOLD_utf8|5.031005|5.031005|
toFOLD_utf8_safe|5.025009|5.006000|p
toFOLD_uvchr|5.023009|5.006000|p
TO_INTERNAL_SIZE|5.023002||Viu
tokenize_use|5.009003||Viu
tokeq|5.005000||Viu
tokereport|5.007001||Viu
toLOWER|5.003007|5.003007|
toLOWER_A|5.019001|5.019001|
toLOWER_L1|5.019001|5.019001|
toLOWER_LATIN1|5.013006|5.011002|
to_lower_latin1|5.015005||Vniu
toLOWER_LC|5.004000|5.004000|
toLOWER_uni|5.006000||Viu
toLOWER_utf8|5.031005|5.031005|
toLOWER_utf8_safe|5.025009|5.006000|p
toLOWER_uvchr|5.023009|5.006000|p
too_few_arguments_pv|5.016000||Viu
TOO_LATE_FOR|5.008001||Viu
too_many_arguments_pv|5.016000||Viu
TOPi|5.003007||Viu
TOPl|5.003007||Viu
TOPm1s|5.007001||Viu
TOPMARK|5.003007||cViu
TOPn|5.003007||Viu
TOPp1s|5.007001||Viu
TOPp|5.003007||Viu
TOPpx|5.005003||Viu
TOPs|5.003007||Viu
TOPu|5.004000||Viu
TOPul|5.006000||Viu
toTITLE|5.019001|5.019001|
toTITLE_A|5.019001|5.019001|
toTITLE_uni|5.006000||Viu
toTITLE_utf8|5.031005|5.031005|
toTITLE_utf8_safe|5.025009|5.006000|p
toTITLE_uvchr|5.023009|5.006000|p
to_uni_fold|5.014000||cVu
_to_uni_fold_flags|5.014000||cVu
to_uni_lower|5.006000||cVu
to_uni_title|5.006000||cVu
to_uni_upper|5.006000||cVu
toUPPER|5.003007|5.003007|
toUPPER_A|5.019001|5.019001|
toUPPER_LATIN1_MOD|5.011002||Viu
toUPPER_LC|5.004000||Viu
_to_upper_title_latin1|5.015005||Viu
toUPPER_uni|5.006000||Viu
toUPPER_utf8|5.031005|5.031005|
toUPPER_utf8_safe|5.025009|5.006000|p
toUPPER_uvchr|5.023009|5.006000|p
_to_utf8_case|5.023006||Viu
_to_utf8_fold_flags|5.014000||cVu
_to_utf8_lower_flags|5.015006||cVu
to_utf8_substr|5.008000||Viu
_to_utf8_title_flags|5.015006||cVu
_to_utf8_upper_flags|5.015006||cVu
translate_substr_offsets|5.015006||Vniu
traverse_op_tree|5.029008||Vi
TR_DELETE|5.031006||Viu
TRIE|5.009002||Viu
TRIE_BITMAP|5.009004||Viu
TRIE_BITMAP_BYTE|5.009004||Viu
TRIE_BITMAP_CLEAR|5.009004||Viu
TRIE_BITMAP_SET|5.009004||Viu
TRIE_BITMAP_TEST|5.009004||Viu
TRIEC|5.009004||Viu
TRIE_CHARCOUNT|5.009004||Viu
TRIEC_t8|5.035004||Viu
TRIEC_t8_p8|5.033003||Viu
TRIEC_t8_pb|5.033003||Viu
TRIEC_tb|5.035004||Viu
TRIEC_tb_p8|5.033003||Viu
TRIEC_tb_pb|5.033003||Viu
TRIE_next|5.009005||Viu
TRIE_next_fail|5.009005||Viu
TRIE_next_fail_t8|5.035004||Viu
TRIE_next_fail_t8_p8|5.033003||Viu
TRIE_next_fail_t8_pb|5.033003||Viu
TRIE_next_fail_tb|5.035004||Viu
TRIE_next_fail_tb_p8|5.033003||Viu
TRIE_next_fail_tb_pb|5.033003||Viu
TRIE_next_t8|5.035004||Viu
TRIE_next_t8_p8|5.033003||Viu
TRIE_next_t8_pb|5.033003||Viu
TRIE_next_tb|5.035004||Viu
TRIE_next_tb_p8|5.033003||Viu
TRIE_next_tb_pb|5.033003||Viu
TRIE_NODEIDX|5.009002||Viu
TRIE_NODENUM|5.009002||Viu
TRIE_t8|5.035004||Viu
TRIE_t8_p8|5.033003||Viu
TRIE_t8_pb|5.033003||Viu
TRIE_tb|5.035004||Viu
TRIE_tb_p8|5.033003||Viu
TRIE_tb_pb|5.033003||Viu
TRIE_WORDS_OFFSET|5.009005||Viu
TR_OOB|5.031006||Viu
TR_R_EMPTY|5.031006||Viu
TR_SPECIAL_HANDLING|5.031006||Viu
TRUE|5.003007||Viu
truncate|5.006000||Viu
TR_UNLISTED|5.031006||Viu
TR_UNMAPPED|5.031006||Viu
try_amagic_bin|||ciu
tryAMAGICbin_MG|5.013002||Viu
try_amagic_un|||ciu
tryAMAGICunDEREF|5.006000||Viu
tryAMAGICun_MG|5.013002||Viu
tryAMAGICunTARGETlist|5.017002||Viu
TS_W32_BROKEN_LOCALECONV|5.027010||Viu
tTHX|5.009003||Viu
ttyname|5.009000||Viu
TTYNAME_R_PROTO|5.008000|5.008000|Vn
turkic_fc|5.029008||Viu
turkic_lc|5.029008||Viu
turkic_uc|5.029008||Viu
TWO_BYTE_UTF8_TO_NATIVE|5.019004||Viu
TWO_BYTE_UTF8_TO_UNI|5.013008||Viu
TYPE_CHARS|5.004000||Viu
TYPE_DIGITS|5.004000||Viu
U16|5.027001||Viu
U16_MAX|5.003007||Viu
U16_MIN|5.003007||Viu
U16SIZE|5.006000|5.006000|Vn
U16TYPE|5.006000|5.006000|Vn
U_32|5.007002|5.007002|
U32|5.027001||Viu
U32_ALIGNMENT_REQUIRED|5.007001|5.007001|Vn
U32_MAX|5.003007||Viu
U32_MAX_P1|5.007002||Viu
U32_MAX_P1_HALF|5.007002||Viu
U32_MIN|5.003007||Viu
U32SIZE|5.006000|5.006000|Vn
U32TYPE|5.006000|5.006000|Vn
U64|5.023002||Viu
U64SIZE|5.006000|5.006000|Vn
U64TYPE|5.006000|5.006000|Vn
U8|5.027001||Viu
U8_MAX|5.003007||Viu
U8_MIN|5.003007||Viu
U8SIZE|5.006000|5.006000|Vn
U8TO16_LE|5.017010||Viu
U8TO32_LE|5.017010||Viu
U8TO64_LE|5.017006||Viu
U8TYPE|5.006000|5.006000|Vn
UCHARAT|5.003007||Viu
U_I|5.003007||Viu
Uid_t|5.003007|5.003007|Vn
Uid_t_f|5.006000|5.006000|Vn
Uid_t_sign|5.006000|5.006000|Vn
Uid_t_size|5.006000|5.006000|Vn
UINT16_C|5.003007|5.003007|
UINT32_C|5.003007|5.003007|
UINT32_MIN|5.006000||Viu
UINT64_C|5.023002|5.023002|
UINT64_MIN|5.006000||Viu
UINTMAX_C|5.003007|5.003007|
uiv_2buf|5.009003||Vniu
U_L|5.003007||Viu
umask|5.005000||Viu
uname|5.005004||Viu
UNDERBAR|5.009002|5.003007|p
unexpected_non_continuation_text|5.025006||Viu
ungetc|5.003007||Viu
UNI_age_values_index|5.029009||Viu
UNI_AHEX|5.029002||Viu
UNI_ahex_values_index|5.029009||Viu
UNI_ALNUM|5.029002||Viu
UNI_ALPHA|5.029002||Viu
UNI_ALPHABETIC|5.029002||Viu
UNI_alpha_values_index|5.029009||Viu
UNI_ASCIIHEXDIGIT|5.029002||Viu
UNI_BASICLATIN|5.029002||Viu
UNI_bc_values_index|5.029009||Viu
UNI_bidic_values_index|5.029009||Viu
UNI_bidim_values_index|5.029009||Viu
UNI_BLANK|5.029002||Viu
UNI_blk_values_index|5.029009||Viu
UNI_bpt_values_index|5.029009||Viu
UNI_cased_values_index|5.029009||Viu
UNI_CC|5.029002||Viu
UNI_ccc_values_index|5.029009||Viu
UNI_ce_values_index|5.029009||Viu
UNI_ci_values_index|5.029009||Viu
UNI_CNTRL|5.029002||Viu
UNICODE_ALLOW_ABOVE_IV_MAX|5.031006||Viu
UNICODE_ALLOW_ANY|5.007003||Viu
UNICODE_ALLOW_SUPER|5.007003||Viu
UNICODE_ALLOW_SURROGATE|5.007003||Viu
UNICODE_BYTE_ORDER_MARK|5.008000||Viu
UNICODE_DISALLOW_ABOVE_31_BIT|5.023006|5.023006|
UNICODE_DISALLOW_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005|
UNICODE_DISALLOW_ILLEGAL_INTERCHANGE|5.013009|5.013009|
UNICODE_DISALLOW_NONCHAR|5.013009|5.013009|
UNICODE_DISALLOW_PERL_EXTENDED|5.027002|5.027002|
UNICODE_DISALLOW_SUPER|5.013009|5.013009|
UNICODE_DISALLOW_SURROGATE|5.013009|5.013009|
UNICODE_DOT_DOT_VERSION|5.023002||Viu
UNICODE_DOT_VERSION|5.023002||Viu
UNICODE_GOT_NONCHAR|5.027009||Viu
UNICODE_GOT_PERL_EXTENDED|5.027009||Viu
UNICODE_GOT_SUPER|5.027009||Viu
UNICODE_GOT_SURROGATE|5.027009||Viu
UNICODE_GREEK_CAPITAL_LETTER_SIGMA|5.007003||Viu
UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA|5.007003||Viu
UNICODE_GREEK_SMALL_LETTER_SIGMA|5.007003||Viu
UNICODE_IS_32_CONTIGUOUS_NONCHARS|5.023006||Viu
UNICODE_IS_BYTE_ORDER_MARK|5.007001||Viu
UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER|5.023006||Viu
UNICODE_IS_NONCHAR|5.013009|5.013009|
UNICODE_IS_PERL_EXTENDED|5.027002||Viu
UNICODE_IS_REPLACEMENT|5.007002|5.007002|
UNICODE_IS_SUPER|5.013009|5.013009|
UNICODE_IS_SURROGATE|5.007001|5.007001|
UNICODE_MAJOR_VERSION|5.023002||Viu
UNICODE_PAT_MOD|5.013006||Viu
UNICODE_PAT_MODS|5.013006||Viu
UNICODE_REPLACEMENT|5.007001|5.003007|p
UNICODE_SURROGATE_FIRST|5.007001||Viu
UNICODE_SURROGATE_LAST|5.007001||Viu
UNICODE_WARN_ABOVE_31_BIT|5.023006|5.023006|
UNICODE_WARN_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005|
UNICODE_WARN_ILLEGAL_INTERCHANGE|5.013009|5.013009|
UNICODE_WARN_NONCHAR|5.013009|5.013009|
UNICODE_WARN_PERL_EXTENDED|5.027002|5.027002|
UNICODE_WARN_SUPER|5.013009|5.013009|
UNICODE_WARN_SURROGATE|5.013009|5.013009|
UNI_compex_values_index|5.029009||Viu
UNI_CONTROL|5.029002||Viu
UNI_cwcf_values_index|5.029009||Viu
UNI_cwcm_values_index|5.029009||Viu
UNI_cwkcf_values_index|5.029009||Viu
UNI_cwl_values_index|5.029009||Viu
UNI_cwt_values_index|5.029009||Viu
UNI_cwu_values_index|5.029009||Viu
UNI_dash_values_index|5.029009||Viu
UNI_DECIMALNUMBER|5.029002||Viu
UNI_dep_values_index|5.029009||Viu
UNI_dia_values_index|5.029009||Viu
UNI_DIGIT|5.029002||Viu
UNI_DISPLAY_BACKSLASH|5.007003|5.007003|
UNI_DISPLAY_BACKSPACE|5.031009|5.031009|
UNI_DISPLAY_ISPRINT|5.007003|5.007003|
UNI_DISPLAY_QQ|5.007003|5.007003|
UNI_DISPLAY_REGEX|5.007003|5.007003|
UNI_di_values_index|5.029009||Viu
UNI_dt_values_index|5.029009||Viu
UNI_ea_values_index|5.029009||Viu
UNI_ebase_values_index|5.031010||Viu
UNI_ecomp_values_index|5.031010||Viu
UNI_emod_values_index|5.031010||Viu
UNI_emoji_values_index|5.031010||Viu
UNI_epres_values_index|5.031010||Viu
UNI_extpict_values_index|5.031010||Viu
UNI_ext_values_index|5.029009||Viu
UNI_gcb_values_index|5.029009||Viu
UNI_gc_values_index|5.029009||Viu
UNI_GRAPH|5.029002||Viu
UNI_grbase_values_index|5.029009||Viu
UNI_grext_values_index|5.029009||Viu
UNI_HEX|5.029002||Viu
UNI_HEXDIGIT|5.029002||Viu
UNI_hex_values_index|5.029009||Viu
UNI_HORIZSPACE|5.029002||Viu
UNI_hst_values_index|5.029009||Viu
UNI_HYPHEN|5.029002||Viu
UNI_hyphen_values_index|5.029009||Viu
UNI_idc_values_index|5.029009||Viu
UNI_identifierstatus_values_index|5.031010||Viu
UNI_identifiertype_values_index|5.031010||Viu
UNI_ideo_values_index|5.029009||Viu
UNI_idsb_values_index|5.029009||Viu
UNI_idst_values_index|5.029009||Viu
UNI_ids_values_index|5.029009||Viu
UNI_inpc_values_index|5.029009||Viu
UNI_insc_values_index|5.029009||Viu
UNI_in_values_index|5.029009||Viu
UNI_IS_INVARIANT|5.007001||Viu
UNI_jg_values_index|5.029009||Viu
UNI_joinc_values_index|5.029009||Viu
UNI_jt_values_index|5.029009||Viu
UNI_L|5.029002||Viu
UNI_L_AMP|5.029002||Viu
UNI_LB__SG|5.029002||Viu
UNI_lb_values_index|5.029009||Viu
UNI_LC|5.029002||Viu
UNI_LL|5.029002||Viu
UNI_loe_values_index|5.029009||Viu
UNI_LOWER|5.029002||Viu
UNI_LOWERCASE|5.029002||Viu
UNI_lower_values_index|5.029009||Viu
UNI_LT|5.029002||Viu
UNI_LU|5.029002||Viu
UNI_math_values_index|5.029009||Viu
UNI_nchar_values_index|5.029009||Viu
UNI_ND|5.029002||Viu
UNI_nfcqc_values_index|5.029009||Viu
UNI_nfdqc_values_index|5.029009||Viu
UNI_nfkcqc_values_index|5.029009||Viu
UNI_nfkdqc_values_index|5.029009||Viu
UNI_nt_values_index|5.029009||Viu
UNI_nv_values_index|5.029009||Viu
UNI_patsyn_values_index|5.029009||Viu
UNI_patws_values_index|5.029009||Viu
UNI_pcm_values_index|5.029009||Viu
UNI_PERLSPACE|5.029002||Viu
UNI_PERLWORD|5.029002||Viu
UNI_PRINT|5.029002||Viu
UNI_qmark_values_index|5.029009||Viu
UNI_radical_values_index|5.029009||Viu
UNI_ri_values_index|5.029009||Viu
UNI_sb_values_index|5.029009||Viu
UNI_sc_values_index|5.029009||Viu
UNI_scx_values_index|5.029009||Viu
UNI_sd_values_index|5.029009||Viu
UNISKIP|5.007001||Viu
UNISKIP_BY_MSB|5.035004||Viu
UNI_SPACE|5.029002||Viu
UNI_SPACEPERL|5.029002||Viu
UNI_sterm_values_index|5.029009||Viu
UNI_term_values_index|5.029009||Viu
UNI_TITLECASE|5.029002||Viu
UNI_TITLECASELETTER|5.029002||Viu
UNI_TO_NATIVE|5.007001|5.003007|p
UNI_uideo_values_index|5.029009||Viu
UNI_UPPER|5.029002||Viu
UNI_UPPERCASE|5.029002||Viu
UNI_upper_values_index|5.029009||Viu
UNI_vo_values_index|5.029009||Viu
UNI_vs_values_index|5.029009||Viu
UNI_wb_values_index|5.029009||Viu
UNI_WHITESPACE|5.029002||Viu
UNI_WORD|5.029002||Viu
UNI_WSPACE|5.029002||Viu
UNI_wspace_values_index|5.029009||Viu
UNI_XDIGIT|5.029002||Viu
UNI_xidc_values_index|5.029009||Viu
UNI_xids_values_index|5.029009||Viu
UNI_XPERLSPACE|5.029002||Viu
UNKNOWN_ERRNO_MSG|5.019007||Viu
UNLESSM|5.003007||Viu
UNLESSM_t8|5.035004||Viu
UNLESSM_t8_p8|5.033003||Viu
UNLESSM_t8_pb|5.033003||Viu
UNLESSM_tb|5.035004||Viu
UNLESSM_tb_p8|5.033003||Viu
UNLESSM_tb_pb|5.033003||Viu
UNLIKELY|5.009004|5.003007|p
UNLINK|5.003007||Viu
unlink|5.005000||Viu
unlnk|5.003007||cVu
UNLOCK_DOLLARZERO_MUTEX|5.008001||Viu
UNLOCK_LC_NUMERIC_STANDARD|5.021010||poVnu
UNLOCK_NUMERIC_STANDARD|||piu
UNOP_AUX_item_sv|5.021007||Viu
unpack_rec|5.008001||Viu
unpack_str|5.007003|5.007003|d
unpackstring|5.008001|5.008001|
unpackWARN1|5.007003||Viu
unpackWARN2|5.007003||Viu
unpackWARN3|5.007003||Viu
unpackWARN4|5.007003||Viu
unreferenced_to_tmp_stack|5.013002||Viu
unshare_hek|5.004000||Viu
unshare_hek_or_pvn|5.008000||Viu
unsharepvn|5.003007|5.003007|u
unwind_handler_stack|5.009003||Viu
update_debugger_info|5.009005||Viu
upg_version|5.009005|5.009005|
UPG_VERSION|5.019008||Viu
uproot_SV|||Viu
Uquad_t|5.006000|5.006000|Vn
U_S|5.003007||Viu
usage|5.005000||Viu
USE_64_BIT_ALL|5.006000|5.006000|Vn
USE_64_BIT_INT|5.006000|5.006000|Vn
USE_64_BIT_RAWIO|5.006000||Viu
USE_64_BIT_STDIO|5.006000||Viu
USE_BSDPGRP|5.003007||Viu
USE_C_BACKTRACE|5.035009|5.035009|Vn
USE_DYNAMIC_LOADING|5.003007|5.003007|Vn
USE_ENVIRON_ARRAY|5.007001||Viu
USE_GRENT_BUFFER|5.008000||Viu
USE_GRENT_FPTR|5.008000||Viu
USE_GRENT_PTR|5.008000||Viu
USE_HASH_SEED|5.008001||Viu
USE_HOSTENT_BUFFER|5.008000||Viu
USE_HOSTENT_ERRNO|5.008000||Viu
USE_HOSTENT_PTR|5.008000||Viu
USE_ITHREADS|5.010000|5.010000|Vn
USE_LARGE_FILES|5.006000|5.006000|Vn
USE_LEFT|5.004000||Viu
USE_LOCALE|5.004000||Viu
USE_LOCALE_ADDRESS|5.027009||Viu
USE_LOCALE_COLLATE|5.004000||Viu
USE_LOCALE_CTYPE|5.004000||Viu
USE_LOCALE_IDENTIFICATION|5.027009||Viu
USE_LOCALE_MEASUREMENT|5.027009||Viu
USE_LOCALE_MESSAGES|5.019002||Viu
USE_LOCALE_MONETARY|5.019002||Viu
USE_LOCALE_NUMERIC|5.004000||Viu
USE_LOCALE_PAPER|5.027009||Viu
USE_LOCALE_SYNTAX|5.033001||Viu
USE_LOCALE_TELEPHONE|5.027009||Viu
USE_LOCALE_TIME|5.021002||Viu
USE_LOCALE_TOD|5.033001||Viu
USEMYBINMODE|5.006000||Viu
USE_NETENT_BUFFER|5.008000||Viu
USE_NETENT_ERRNO|5.008000||Viu
USE_NETENT_PTR|5.008000||Viu
USE_PERL_ATOF|5.008000||Viu
USE_PERLIO|5.007001|5.007001|Vn
USE_PERL_PERTURB_KEYS|5.018000||Viu
USE_POSIX_2008_LOCALE|5.027003||Viu
USE_PROTOENT_BUFFER|5.008000||Viu
USE_PROTOENT_PTR|5.008000||Viu
USE_PWENT_BUFFER|5.008000||Viu
USE_PWENT_FPTR|5.008000||Viu
USE_PWENT_PTR|5.008000||Viu
USE_REENTRANT_API|5.007003||Viu
USER_PROP_MUTEX_INIT|5.029008||Viu
USER_PROP_MUTEX_LOCK|5.029008||Viu
USER_PROP_MUTEX_TERM|5.029008||Viu
USER_PROP_MUTEX_UNLOCK|5.029008||Viu
USE_SEMCTL_SEMID_DS|5.004005|5.004005|Vn
USE_SEMCTL_SEMUN|5.004005|5.004005|Vn
USE_SERVENT_BUFFER|5.008000||Viu
USE_SERVENT_PTR|5.008000||Viu
USE_SPENT_BUFFER|5.031011||Viu
USE_SPENT_PTR|5.008000||Viu
USE_STAT_BLOCKS|5.005003|5.005003|Vn
USE_STAT_RDEV|5.003007||Viu
USE_STDIO|5.003007||Viu
USE_STDIO_BASE|5.006000|5.006000|Vn
USE_STDIO_PTR|5.006000|5.006000|Vn
USE_SYSTEM_GMTIME|5.011000||Viu
USE_SYSTEM_LOCALTIME|5.011000||Viu
USE_THREADS|5.006000|5.006000|Vn
USE_THREAD_SAFE_LOCALE|5.025004||Viu
USE_TM64|5.011000||Viu
USE_UTF8_IN_NAMES|5.007003||Viu
utf16_textfilter|5.011001||Viu
utf16_to_utf8|5.035004||cViu
utf16_to_utf8_base|5.035004||cViu
utf16_to_utf8_reversed|5.035004||cViu
UTF8_ACCUMULATE|5.007001||Viu
UTF8_ALLOW_ANY|5.007001||Viu
UTF8_ALLOW_ANYUV|5.007001||Viu
UTF8_ALLOW_CONTINUATION|5.007001||Viu
UTF8_ALLOW_DEFAULT|5.009004||Viu
UTF8_ALLOW_EMPTY|5.007001||Viu
UTF8_ALLOW_FE_FF|5.027009||Viu
UTF8_ALLOW_FFFF|5.007001||Viu
UTF8_ALLOW_LONG|5.007001||Viu
UTF8_ALLOW_LONG_AND_ITS_VALUE|5.025009||Viu
UTF8_ALLOW_NON_CONTINUATION|5.007001||Viu
UTF8_ALLOW_OVERFLOW|5.025009||Viu
UTF8_ALLOW_SHORT|5.007001||Viu
UTF8_ALLOW_SURROGATE|5.007001||Viu
UTF8_CHECK_ONLY|5.007001|5.007001|
UTF8_CHK_SKIP|5.031006|5.006000|p
UTF8_DISALLOW_ABOVE_31_BIT|5.023006||Viu
UTF8_DISALLOW_FE_FF|5.013009||Viu
UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005|
UTF8_DISALLOW_ILLEGAL_INTERCHANGE|5.013009|5.013009|
UTF8_DISALLOW_NONCHAR|5.013009|5.013009|
UTF8_DISALLOW_PERL_EXTENDED|5.027002|5.027002|
UTF8_DISALLOW_SUPER|5.013009|5.013009|
UTF8_DISALLOW_SURROGATE|5.013009|5.013009|
utf8_distance|5.006000|5.006000|
UTF8_EIGHT_BIT_HI|5.007001||Viu
UTF8_EIGHT_BIT_LO|5.007001||Viu
UTF8f|5.019001|5.003007|p
UTF8fARG|5.019002|5.003007|p
UTF8_GOT_ABOVE_31_BIT|5.025006||Viu
UTF8_GOT_CONTINUATION|5.025006|5.025006|
UTF8_GOT_EMPTY|5.025006|5.025006|
UTF8_GOT_LONG|5.025006|5.025006|
UTF8_GOT_NONCHAR|5.025006|5.025006|
UTF8_GOT_NON_CONTINUATION|5.025006|5.025006|
UTF8_GOT_OVERFLOW|5.025006|5.025006|
UTF8_GOT_PERL_EXTENDED|5.027002|5.027002|
UTF8_GOT_SHORT|5.025006|5.025006|
UTF8_GOT_SUPER|5.025006|5.025006|
UTF8_GOT_SURROGATE|5.025006|5.025006|
utf8_hop|5.006000|5.006000|n
utf8_hop_back|5.025007|5.025007|n
utf8_hop_forward|5.025007|5.025007|n
utf8_hop_safe|5.025007|5.025007|n
UTF8_IS_ABOVE_LATIN1|5.017004||Viu
UTF8_IS_ABOVE_LATIN1_START|5.023003||Viu
UTF8_IS_CONTINUATION|5.007001||Viu
UTF8_IS_CONTINUED|5.007001||Viu
UTF8_IS_DOWNGRADEABLE_START|5.007001||Viu
UTF8_IS_INVARIANT|5.007001|5.003007|p
UTF8_IS_NEXT_CHAR_DOWNGRADEABLE|5.017006||Viu
UTF8_IS_NONCHAR|5.023002|5.023002|
UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC|5.013009||Viu
UTF8_IS_PERL_EXTENDED|5.035004||Viu
UTF8_IS_REPLACEMENT|||
UTF8_IS_START|5.007001||Viu
UTF8_IS_START_base|5.031007||Viu
UTF8_IS_SUPER|5.023002|5.023002|
UTF8_IS_SURROGATE|5.023002|5.023002|
utf8_length|5.007001|5.007001|
UTF8_MAXBYTES|5.009002|5.006000|p
UTF8_MAXBYTES_CASE|5.009002|5.003007|p
UTF8_MAX_FOLD_CHAR_EXPAND|5.013009||Viu
UTF8_MAXLEN|5.006000||Viu
utf8_mg_len_cache_update|5.013003||Viu
utf8_mg_pos_cache_update|5.009004||Viu
utf8n_to_uvchr|5.007001|5.007001|n
utf8n_to_uvchr_error|5.025006|5.025006|n
utf8n_to_uvchr_msgs|5.027009|5.027009|n
_utf8n_to_uvchr_msgs_helper|5.029001||cVnu
utf8n_to_uvuni|5.007001||dcV
UTF8_SAFE_SKIP|5.029009|5.006000|p
UTF8SKIP|5.006000|5.006000|
UTF8_SKIP|5.023002|5.006000|p
utf8_to_bytes|5.006001|5.006001|x
utf8_to_utf16|5.035004||Viu
utf8_to_utf16_base|5.035004||xcViu
utf8_to_utf16_reversed|5.035004||Viu
utf8_to_uvchr|5.007001|5.006001|pd
utf8_to_uvchr_buf|5.015009|5.006001|p
utf8_to_uvchr_buf_helper|5.031004||cVu
utf8_to_uvuni|5.007001||dcV
utf8_to_uvuni_buf|5.015009||dcV
UTF8_TWO_BYTE_HI|5.011002||Viu
UTF8_TWO_BYTE_HI_nocast|5.011002||Viu
UTF8_TWO_BYTE_LO|5.011002||Viu
UTF8_TWO_BYTE_LO_nocast|5.011002||Viu
UTF8_WARN_ABOVE_31_BIT|5.023006||Viu
UTF8_WARN_FE_FF|5.013009||Viu
UTF8_WARN_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005|
UTF8_WARN_ILLEGAL_INTERCHANGE|5.013009|5.013009|
UTF8_WARN_NONCHAR|5.013009|5.013009|
UTF8_WARN_PERL_EXTENDED|5.027002|5.027002|
UTF8_WARN_SUPER|5.013009|5.013009|
UTF8_WARN_SURROGATE|5.013009|5.013009|
UTF_ACCUMULATION_SHIFT|5.007001||Viu
UTF_CONTINUATION_BYTE_INFO_BITS|5.035004||Viu
UTF_CONTINUATION_MARK|5.007001||Viu
UTF_CONTINUATION_MASK|5.007001||Viu
UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS|5.035004||Viu
UTF_FIRST_CONT_BYTE_110000|5.035004||Viu
UTF_FIRST_CONT_BYTE|5.035004||Viu
UTF_IS_CONTINUATION_MASK|5.023006||Viu
UTF_MIN_ABOVE_LATIN1_BYTE|5.031006||Viu
UTF_MIN_CONTINUATION_BYTE|5.035004||Viu
UTF_MIN_START_BYTE|5.031006||Viu
UTF_START_BYTE_110000|5.035004||Viu
UTF_START_BYTE|5.035004||Viu
UTF_START_MARK|5.007001||Viu
UTF_START_MASK|5.007001||Viu
UTF_TO_NATIVE|5.007001||Viu
utilize|5.003007||Viu
utime|5.005000||Viu
U_V|5.006000|5.003007|
UVCHR_IS_INVARIANT|5.019004|5.003007|p
UVCHR_SKIP|5.022000|5.003007|p
uvchr_to_utf8|5.007001|5.007001|
uvchr_to_utf8_flags|5.007003|5.007003|
uvchr_to_utf8_flags_msgs|5.027009|5.027009|
UV_DIG|5.006000||Viu
UVf|5.010000|5.010000|d
UV_IS_QUAD|5.006000||Viu
UV_MAX|5.003007|5.003007|
UV_MAX_P1|5.007002||Viu
UV_MAX_P1_HALF|5.007002||Viu
UV_MIN|5.003007|5.003007|
UVof|5.006000|5.003007|poVn
uvoffuni_to_utf8_flags|5.027009||cV
uvoffuni_to_utf8_flags_msgs|5.027009||cVu
UVSIZE|5.006000|5.003007|poVn
UVTYPE|5.006000|5.003007|poVn
UVuf|5.006000|5.003007|poVn
uvuni_to_utf8|5.019004||cVu
uvuni_to_utf8_flags|5.007003||dcV
UVxf|5.006000|5.003007|poVn
UVXf|5.007001|5.007001|poVn
VAL_EAGAIN|5.003007|5.003007|Vn
validate_proto|5.019002||xcVi
validate_suid|||iu
valid_utf8_to_uvchr|5.015009||cVn
valid_utf8_to_uvuni|5.015009||dcVu
VAL_O_NONBLOCK|5.003007|5.003007|Vn
variant_byte_number|5.031004||cVnu
variant_under_utf8_count|5.027007||Vni
varname|5.009003||Viu
vcmp|5.009000|5.009000|
VCMP|5.019008||Viu
vcroak|5.006000|5.006000|
vdeb|5.007003|5.007003|u
VERB|5.009005||Viu
VERB_t8|5.035004||Viu
VERB_t8_p8|5.033003||Viu
VERB_t8_pb|5.033003||Viu
VERB_tb|5.035004||Viu
VERB_tb_p8|5.033003||Viu
VERB_tb_pb|5.033003||Viu
vform|5.006000|5.006000|
vfprintf|5.003007||Viu
visit|5.005000||Viu
vivify_defelem|5.004000||cViu
vivify_ref|5.004000||Viu
vload_module|5.006000|5.003007|p
vmess|5.006000|5.004000|p
vnewSVpvf|5.006000|5.004000|p
vnormal|5.009002|5.009002|
VNORMAL|5.019008||Viu
vnumify|5.009000|5.009000|
VNUMIFY|5.019008||Viu
voidnonfinal|5.035002||Viu
VOL|5.003007||Viu
vstringify|5.009000|5.009000|
VSTRINGIFY|5.019008||Viu
VTBL_amagic|5.005003||Viu
VTBL_amagicelem|5.005003||Viu
VTBL_arylen|5.005003||Viu
VTBL_bm|5.005003||Viu
VTBL_collxfrm|5.005003||Viu
VTBL_dbline|5.005003||Viu
VTBL_defelem|5.005003||Viu
VTBL_env|5.005003||Viu
VTBL_envelem|5.005003||Viu
VTBL_fm|5.005003||Viu
VTBL_glob|5.005003||Viu
VTBL_isa|5.005003||Viu
VTBL_isaelem|5.005003||Viu
VTBL_mglob|5.005003||Viu
VTBL_nkeys|5.005003||Viu
VTBL_pack|5.005003||Viu
VTBL_packelem|5.005003||Viu
VTBL_pos|5.005003||Viu
VTBL_regdata|5.006000||Viu
VTBL_regdatum|5.006000||Viu
VTBL_regexp|5.005003||Viu
VTBL_sigelem|5.005003||Viu
VTBL_substr|5.005003||Viu
VTBL_sv|5.005003||Viu
VTBL_taint|5.005003||Viu
VTBL_uvar|5.005003||Viu
VTBL_vec|5.005003||Viu
vTHX|5.006000||Viu
VT_NATIVE|5.021004||Viu
vtohl|5.003007||Viu
vtohs|5.003007||Viu
VUTIL_REPLACE_CORE|5.019008||Viu
vverify|5.009003|5.009003|
VVERIFY|5.019008||Viu
vwarn|5.006000|5.003007|
vwarner|5.006000|5.004000|p
wait4pid|5.003007||Viu
wait|5.005000||Viu
want_vtbl_bm|5.015000||Viu
want_vtbl_fm|5.015000||Viu
warn|5.003007||vV
WARN_ALL|5.006000|5.003007|p
WARN_ALLstring|5.006000||Viu
WARN_AMBIGUOUS|5.006000|5.003007|p
WARN_ASSERTIONS||5.003007|ponu
WARN_BAREWORD|5.006000|5.003007|p
WARN_CLOSED|5.006000|5.003007|p
WARN_CLOSURE|5.006000|5.003007|p
WARN_DEBUGGING|5.006000|5.003007|p
WARN_DEPRECATED|5.006000|5.003007|p
WARN_DIGIT|5.006000|5.003007|p
warner|5.006000||pvV
warner_nocontext|5.006000||vVn
WARN_EXEC|5.006000|5.003007|p
WARN_EXITING|5.006000|5.003007|p
WARN_EXPERIMENTAL|5.017004|5.017004|
WARN_EXPERIMENTAL__ALPHA_ASSERTIONS|5.027009|5.027009|
WARN_EXPERIMENTAL__ARGS_ARRAY_WITH_SIGNATURES|5.035009|5.035009|
WARN_EXPERIMENTAL__BITWISE|5.021009|5.021009|
WARN_EXPERIMENTAL__BUILTIN|5.035009|5.035009|
WARN_EXPERIMENTAL__CONST_ATTR|5.021008|5.021008|
WARN_EXPERIMENTAL__DECLARED_REFS|5.025003|5.025003|
WARN_EXPERIMENTAL__DEFER|5.035004|5.035004|
WARN_EXPERIMENTAL__FOR_LIST|5.035005|5.035005|
WARN_EXPERIMENTAL__ISA|5.031007|5.031007|
WARN_EXPERIMENTAL__LEXICAL_SUBS|5.017005|5.017005|
WARN_EXPERIMENTAL__POSTDEREF|5.019005|5.019005|
WARN_EXPERIMENTAL__PRIVATE_USE|5.029009|5.029009|
WARN_EXPERIMENTAL__REFALIASING|5.021005|5.021005|
WARN_EXPERIMENTAL__REGEX_SETS|5.017008|5.017008|
WARN_EXPERIMENTAL__RE_STRICT|5.021008|5.021008|
WARN_EXPERIMENTAL__SCRIPT_RUN|5.027008|5.027008|
WARN_EXPERIMENTAL__SIGNATURES|5.019009|5.019009|
WARN_EXPERIMENTAL__SMARTMATCH|5.017011|5.017011|
WARN_EXPERIMENTAL__TRY|5.033007|5.033007|
WARN_EXPERIMENTAL__UNIPROP_WILDCARDS|5.029009|5.029009|
WARN_EXPERIMENTAL__VLB|5.029009|5.029009|
WARN_GLOB|5.006000|5.003007|p
WARN_ILLEGALPROTO|5.011004|5.011004|
WARN_IMPRECISION|5.011000|5.011000|
WARN_INPLACE|5.006000|5.003007|p
WARN_INTERNAL|5.006000|5.003007|p
WARN_IO|5.006000|5.003007|p
WARN_LAYER|5.008000|5.003007|p
WARN_LOCALE|5.021006|5.021006|
WARN_MALLOC|5.006000|5.003007|p
WARN_MISC|5.006000|5.003007|p
WARN_MISSING|5.021002|5.021002|
WARN_NEWLINE|5.006000|5.003007|p
warn_nocontext|5.006000||pvVn
WARN_NONCHAR|5.013010|5.013010|
WARN_NONEstring|5.006000||Viu
WARN_NON_UNICODE|5.013010|5.013010|
WARN_NUMERIC|5.006000|5.003007|p
WARN_ONCE|5.006000|5.003007|p
warn_on_first_deprecated_use|5.025009||Viu
WARN_OVERFLOW|5.006000|5.003007|p
WARN_PACK|5.006000|5.003007|p
WARN_PARENTHESIS|5.006000|5.003007|p
WARN_PIPE|5.006000|5.003007|p
WARN_PORTABLE|5.006000|5.003007|p
WARN_PRECEDENCE|5.006000|5.003007|p
WARN_PRINTF|5.006000|5.003007|p
_warn_problematic_locale|5.021008||cVniu
WARN_PROTOTYPE|5.006000|5.003007|p
WARN_QW|5.006000|5.003007|p
WARN_RECURSION|5.006000|5.003007|p
WARN_REDEFINE|5.006000|5.003007|p
WARN_REDUNDANT|5.021002|5.021002|
WARN_REGEXP|5.006000|5.003007|p
WARN_RESERVED|5.006000|5.003007|p
WARN_SEMICOLON|5.006000|5.003007|p
WARN_SEVERE|5.006000|5.003007|p
WARN_SHADOW|5.027007|5.027007|
WARNshift|5.011001||Viu
WARN_SIGNAL|5.006000|5.003007|p
WARNsize|5.006000||Viu
WARN_SUBSTR|5.006000|5.003007|p
WARN_SURROGATE|5.013010|5.013010|
warn_sv|5.013001|5.003007|p
WARN_SYNTAX|5.006000|5.003007|p
WARN_SYSCALLS|5.019004|5.019004|
WARN_TAINT|5.006000|5.003007|p
WARN_THREADS|5.008000|5.003007|p
WARN_UNINITIALIZED|5.006000|5.003007|p
WARN_UNOPENED|5.006000|5.003007|p
WARN_UNPACK|5.006000|5.003007|p
WARN_UNTIE|5.006000|5.003007|p
WARN_UTF8|5.006000|5.003007|p
WARN_VOID|5.006000|5.003007|p
was_lvalue_sub|||ciu
watch|5.003007||Viu
WB_BREAKABLE|5.023008||Viu
WB_DQ_then_HL|5.023008||Viu
WB_Ex_or_FO_or_ZWJ_then_foo|5.025003||Viu
WB_HL_then_DQ|5.023008||Viu
WB_hs_then_hs|5.023008||Viu
WB_LE_or_HL_then_MB_or_ML_or_SQ|5.023008||Viu
WB_MB_or_ML_or_SQ_then_LE_or_HL|5.023008||Viu
WB_MB_or_MN_or_SQ_then_NU|5.023008||Viu
WB_NOBREAK|5.023008||Viu
WB_NU_then_MB_or_MN_or_SQ|5.023008||Viu
WB_RI_then_RI|5.025003||Viu
WCTOMB_LOCK|5.033005||Viu
WCTOMB_UNLOCK|5.033005||Viu
what_MULTI_CHAR_FOLD_latin1_safe|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part0|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part1|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part2|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part3|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part4|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part5|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part6|5.033005||Viu
what_MULTI_CHAR_FOLD_utf8_safe_part7|5.033005||Viu
whichsig|5.003007|5.003007|
whichsig_pv|5.015004|5.015004|
whichsig_pvn|5.015004|5.015004|
whichsig_sv|5.015004|5.015004|
WHILEM|5.003007||Viu
WHILEM_A_max|5.009005||Viu
WHILEM_A_max_fail|5.009005||Viu
WHILEM_A_max_fail_t8|5.035004||Viu
WHILEM_A_max_fail_t8_p8|5.033003||Viu
WHILEM_A_max_fail_t8_pb|5.033003||Viu
WHILEM_A_max_fail_tb|5.035004||Viu
WHILEM_A_max_fail_tb_p8|5.033003||Viu
WHILEM_A_max_fail_tb_pb|5.033003||Viu
WHILEM_A_max_t8|5.035004||Viu
WHILEM_A_max_t8_p8|5.033003||Viu
WHILEM_A_max_t8_pb|5.033003||Viu
WHILEM_A_max_tb|5.035004||Viu
WHILEM_A_max_tb_p8|5.033003||Viu
WHILEM_A_max_tb_pb|5.033003||Viu
WHILEM_A_min|5.009005||Viu
WHILEM_A_min_fail|5.009005||Viu
WHILEM_A_min_fail_t8|5.035004||Viu
WHILEM_A_min_fail_t8_p8|5.033003||Viu
WHILEM_A_min_fail_t8_pb|5.033003||Viu
WHILEM_A_min_fail_tb|5.035004||Viu
WHILEM_A_min_fail_tb_p8|5.033003||Viu
WHILEM_A_min_fail_tb_pb|5.033003||Viu
WHILEM_A_min_t8|5.035004||Viu
WHILEM_A_min_t8_p8|5.033003||Viu
WHILEM_A_min_t8_pb|5.033003||Viu
WHILEM_A_min_tb|5.035004||Viu
WHILEM_A_min_tb_p8|5.033003||Viu
WHILEM_A_min_tb_pb|5.033003||Viu
WHILEM_A_pre|5.009005||Viu
WHILEM_A_pre_fail|5.009005||Viu
WHILEM_A_pre_fail_t8|5.035004||Viu
WHILEM_A_pre_fail_t8_p8|5.033003||Viu
WHILEM_A_pre_fail_t8_pb|5.033003||Viu
WHILEM_A_pre_fail_tb|5.035004||Viu
WHILEM_A_pre_fail_tb_p8|5.033003||Viu
WHILEM_A_pre_fail_tb_pb|5.033003||Viu
WHILEM_A_pre_t8|5.035004||Viu
WHILEM_A_pre_t8_p8|5.033003||Viu
WHILEM_A_pre_t8_pb|5.033003||Viu
WHILEM_A_pre_tb|5.035004||Viu
WHILEM_A_pre_tb_p8|5.033003||Viu
WHILEM_A_pre_tb_pb|5.033003||Viu
WHILEM_B_max|5.009005||Viu
WHILEM_B_max_fail|5.009005||Viu
WHILEM_B_max_fail_t8|5.035004||Viu
WHILEM_B_max_fail_t8_p8|5.033003||Viu
WHILEM_B_max_fail_t8_pb|5.033003||Viu
WHILEM_B_max_fail_tb|5.035004||Viu
WHILEM_B_max_fail_tb_p8|5.033003||Viu
WHILEM_B_max_fail_tb_pb|5.033003||Viu
WHILEM_B_max_t8|5.035004||Viu
WHILEM_B_max_t8_p8|5.033003||Viu
WHILEM_B_max_t8_pb|5.033003||Viu
WHILEM_B_max_tb|5.035004||Viu
WHILEM_B_max_tb_p8|5.033003||Viu
WHILEM_B_max_tb_pb|5.033003||Viu
WHILEM_B_min|5.009005||Viu
WHILEM_B_min_fail|5.009005||Viu
WHILEM_B_min_fail_t8|5.035004||Viu
WHILEM_B_min_fail_t8_p8|5.033003||Viu
WHILEM_B_min_fail_t8_pb|5.033003||Viu
WHILEM_B_min_fail_tb|5.035004||Viu
WHILEM_B_min_fail_tb_p8|5.033003||Viu
WHILEM_B_min_fail_tb_pb|5.033003||Viu
WHILEM_B_min_t8|5.035004||Viu
WHILEM_B_min_t8_p8|5.033003||Viu
WHILEM_B_min_t8_pb|5.033003||Viu
WHILEM_B_min_tb|5.035004||Viu
WHILEM_B_min_tb_p8|5.033003||Viu
WHILEM_B_min_tb_pb|5.033003||Viu
WHILEM_t8|5.035004||Viu
WHILEM_t8_p8|5.033003||Viu
WHILEM_t8_pb|5.033003||Viu
WHILEM_tb|5.035004||Viu
WHILEM_tb_p8|5.033003||Viu
WHILEM_tb_pb|5.033003||Viu
WIDEST_UTYPE|5.015004|5.003007|poVnu
win32_croak_not_implemented|5.017006||Vniu
WIN32SCK_IS_STDSCK|5.007001||Viu
win32_setlocale|5.027006||Viu
withinCOUNT|5.031004||Viu
withinCOUNT_KNOWN_VALID|5.033005||Viu
WITH_LC_NUMERIC_SET_TO_NEEDED|5.031003|5.031003|
WITH_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003|
with_queued_errors|5.013001||Viu
with_tp_UTF8ness|5.033003||Viu
with_t_UTF8ness|5.035004||Viu
wrap_keyword_plugin|5.027006|5.027006|x
wrap_op_checker|5.015008|5.015008|
write|5.005000||Viu
write_to_stderr|5.008001||Viu
XCPT_CATCH|5.009002|5.003007|p
XCPT_RETHROW|5.009002|5.003007|p
XCPT_TRY_END|5.009002|5.003007|p
XCPT_TRY_START|5.009002|5.003007|p
XDIGIT_VALUE|5.019008||Viu
xio_any|5.006001||Viu
xio_dirp|5.006001||Viu
xiv_iv|5.009003||Viu
xlv_targoff|5.019004||Viu
XopDISABLE|5.013007|5.013007|V
XOPd_xop_class|5.013007||Viu
XOPd_xop_desc|5.013007||Viu
XOPd_xop_name|5.013007||Viu
XOPd_xop_peep|5.013007||Viu
XopENABLE|5.013007|5.013007|V
XopENTRY|5.013007|5.013007|V
XopENTRYCUSTOM|5.019006|5.013007|V
XopENTRY_set|5.013007|5.013007|V
XopFLAGS|5.013007|5.013007|
XOPf_xop_class|5.013007||Viu
XOPf_xop_desc|5.013007||Viu
XOPf_xop_name|5.013007||Viu
XOPf_xop_peep|5.013007||Viu
XORSHIFT128_set|5.027001||Viu
XORSHIFT96_set|5.027001||Viu
XPUSHi|5.003007|5.003007|
XPUSHmortal|5.009002|5.003007|p
XPUSHn|5.006000|5.003007|
XPUSHp|5.003007|5.003007|
XPUSHs|5.003007|5.003007|
XPUSHTARG|5.003007||Viu
XPUSHu|5.004000|5.003007|p
XPUSHundef|5.006000||Viu
xpv_len|5.017006||Viu
XS|5.003007|5.003007|Vu
XSANY|5.003007||Viu
XS_APIVERSION_BOOTCHECK|5.013004|5.013004|
XS_APIVERSION_POPMARK_BOOTCHECK|5.021006||Viu
XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK|5.021006||Viu
xs_boot_epilog|5.021006||cViu
XS_BOTHVERSION_BOOTCHECK|5.021006||Viu
XS_BOTHVERSION_POPMARK_BOOTCHECK|5.021006||Viu
XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK|5.021006||Viu
XS_DYNAMIC_FILENAME|5.009004||Viu
XS_EXTERNAL|5.015002|5.015002|Vu
xs_handshake|||vcniu
XSINTERFACE_CVT|5.005000||Viu
XSINTERFACE_CVT_ANON|5.010000||Viu
XSINTERFACE_FUNC|5.005000||Viu
XSINTERFACE_FUNC_SET|5.005000||Viu
XS_INTERNAL|5.015002|5.015002|Vu
XSprePUSH|5.006000|5.003007|poVnu
XSPROTO|5.010000|5.003007|pVu
XSRETURN|5.003007|5.003007|p
XSRETURN_EMPTY|5.003007|5.003007|
XSRETURN_IV|5.003007|5.003007|
XSRETURN_NO|5.003007|5.003007|
XSRETURN_NV|5.006000|5.003007|
XSRETURN_PV|5.003007|5.003007|
XSRETURN_PVN|5.006000||Viu
XSRETURN_UNDEF|5.003007|5.003007|
XSRETURN_UV|5.008001|5.003007|p
XSRETURN_YES|5.003007|5.003007|
XS_SETXSUBFN_POPMARK|5.021006||Viu
XST_mIV|5.003007|5.003007|
XST_mNO|5.003007|5.003007|
XST_mNV|5.006000|5.003007|
XST_mPV|5.003007|5.003007|
XST_mPVN|5.006000||Viu
XST_mUNDEF|5.003007|5.003007|
XST_mUV|5.008001|5.003007|p
XST_mYES|5.003007|5.003007|
XS_VERSION|5.003007|5.003007|
XS_VERSION_BOOTCHECK|5.003007|5.003007|
xs_version_bootcheck|||iu
XTENDED_PAT_MOD|5.009005||Viu
xuv_uv|5.009003||Viu
YESEXPR|5.027010||Viu
YESSTR|5.027010||Viu
YIELD|5.005000||Viu
YYDEBUG|5.025006||Viu
YYEMPTY|5.009005||Viu
yyerror|5.003007||Viu
yyerror_pv|5.016000||Viu
yyerror_pvn|5.016000||Viu
yylex|5.003007||cViu
yyparse|5.003007||Viu
yyquit|5.025010||Viu
YYSTYPE_IS_DECLARED|5.009001||Viu
YYSTYPE_IS_TRIVIAL|5.009001||Viu
YYTOKENTYPE|5.009001||Viu
yyunlex|5.013005||Viu
yywarn|5.003007||Viu
ZAPHOD32_FINALIZE|5.027001||Viu
ZAPHOD32_MIX|5.027001||Viu
ZAPHOD32_SCRAMBLE32|5.027001||Viu
ZAPHOD32_STATIC_INLINE|5.027001||Viu
ZAPHOD32_WARN2|5.027001||Viu
ZAPHOD32_WARN3|5.027001||Viu
ZAPHOD32_WARN4|5.027001||Viu
ZAPHOD32_WARN5|5.027001||Viu
ZAPHOD32_WARN6|5.027001||Viu
Zero|5.003007|5.003007|
ZeroD|5.009002|5.003007|p
);
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort dictionary_order keys %API) {
next if $API{$f}{core_only};
next if $API{$f}{beyond_depr};
next if $API{$f}{inaccessible};
next if $API{$f}{experimental};
next unless $API{$f}{todo};
next if int_parse_version($API{$f}{todo}) <= $int_min_perl;
my $repeat = 40 - length($f);
$repeat = 0 if $repeat < 0;
print "$f ", '.'x $repeat, " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for hints, possible replacement candidates, etc.
my(%replace, %need, %hints, %warnings, %depends);
my $replace = 0;
my($hint, $define, $function);
sub find_api
{
BEGIN { 'warnings'->unimport('uninitialized') if "$]" > '5.006' }
my $code = shift;
$code =~ s{
/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
| "[^"\\]*(?:\\.[^"\\]*)*"
| '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
grep { exists $API{$_} } $code =~ /(\w+)/mg;
}
while (<DATA>) {
if ($hint) {
# Here, we are in the middle of accumulating a hint or warning.
my $end_of_hint = 0;
# A line containing a comment end marker closes the hint. Remove that
# marker for processing below.
if (s/\s*$rcce(.*?)\s*$//) {
die "Nothing can follow the end of comment in '$_'\n" if length $1 > 0;
$end_of_hint = 1;
}
# Set $h to the hash of which type.
my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
# Ignore any leading and trailing white space, and an optional star comment
# continuation marker, then place the meat of the line into $1
m/^\s*(?:\*\s*)?(.*?)\s*$/;
# Add the meat of this line to the hash value of each API element it
# applies to
for (@{$hint->[1]}) {
$h->{$_} ||= ''; # avoid the warning older perls generate
$h->{$_} .= "$1\n";
}
# If the line had a comment close, we are through with this hint
undef $hint if $end_of_hint;
next;
}
# Set up $hint if this is the beginning of a Hint: or Warning:
# These are from a multi-line C comment in the file, with the first line
# looking like (a space has been inserted because this file can't have C
# comment markers in it):
# / * Warning: PL_expect, PL_copline, PL_rsfp
#
# $hint becomes
# [
# 'Warning',
# [
# 'PL_expect',
# 'PL_copline',
# 'PL_rsfp',
# ],
# ]
if (m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}) {
$hint = [$1, [split /,?\s+/, $2]];
next;
}
if ($define) { # If in the middle of a definition...
# append a continuation line ending with backslash.
if ($define->[1] =~ /\\$/) {
$define->[1] .= $_;
}
else { # Otherwise this line ends the definition, make foo depend on bar
# (and what bar depends on) if its not one of ppp's own constructs
if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
my @n = find_api($define->[1]);
push @{$depends{$define->[0]}}, @n if @n
}
undef $define;
}
}
# For '#define foo bar' or '#define foo(a,b,c) bar', $define becomes a
# reference to [ foo, bar ]
$define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
if ($function) {
if (/^}/) {
if (exists $API{$function->[0]}) {
my @n = find_api($function->[1]);
push @{$depends{$function->[0]}}, @n if @n
}
undef $function;
}
else {
$function->[1] .= $_;
}
}
$function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
# Set $replace to the number given for lines that look like
# / * Replace: \d+ * /
# Thus setting it to 1 starts a region where replacements are automatically
# done, and setting it to 0 ends that region.
$replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
# Add bar => foo to %replace for lines like '#define foo bar in a region
# where $replace is non-zero
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
# Add bar => foo to %replace for lines like '#define foo bar / * Replace * /
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
# Add foo => bar to %replace for lines like / * Replace foo with bar * /
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+.*?)\s+$rcce\s*$};
# For lines like / * foo, bar depends on baz, bat * /
# create a list of the elements on the rhs, and make that list apply to each
# element in the lhs, which becomes a key in \%depends.
if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
my @deps = map { s/\s+//g; $_ } split /,/, $3;
my $d;
for $d (map { s/\s+//g; $_ } split /,/, $1) {
push @{$depends{$d}}, @deps;
}
}
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
}
for (values %depends) {
my %seen;
$_ = [sort dictionary_order grep !$seen{$_}++, @$_];
}
if (exists $opt{'api-info'}) {
my $f;
my $count = 0;
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
# Sort the names, and split into two classes; one for things that are part of
# the API; a second for things that aren't.
my @ok_to_use;
my @shouldnt_use;
for $f (sort dictionary_order keys %API) {
next unless $f =~ /$match/;
my $base = int_parse_version($API{$f}{base}) if $API{$f}{base};
if ($base && ! $API{$f}{inaccessible} && ! $API{$f}{core_only}) {
push @ok_to_use, $f;
}
else {
push @shouldnt_use, $f;
}
}
# We normally suppress non-API items. But if the search matched no API
# items, output the non-ones. This allows someone to get the info for an
# item if they ask for it specifically enough, but doesn't normally clutter
# the output with irrelevant results.
@ok_to_use = @shouldnt_use unless @ok_to_use;
for $f (@ok_to_use) {
print "\n=== $f ===\n";
my $info = 0;
my $base;
$base = int_parse_version($API{$f}{base}) if $API{$f}{base};
my $todo;
$todo = int_parse_version($API{$f}{todo}) if $API{$f}{todo};
# Output information
if ($base) {
my $with_or= "";
if ( $base <= $int_min_perl
|| ( (! $API{$f}{provided} && ! $todo)
|| ($todo && $todo >= $base)))
{
$with_or= " with or";
}
my $Supported = ($API{$f}{undocumented}) ? 'Available' : 'Supported';
print "\n$Supported at least since perl-",
format_version($base), ",$with_or without $ppport.";
if ($API{$f}{unverified}) {
print "\nThis information is based on inspection of the source code",
" and has not been\n",
"verified by successful compilation.";
}
print "\n";
$info++;
}
if ($API{$f}{provided} || $todo) {
print "\nThis is only supported by $ppport, and NOT by perl versions going forward.\n" unless $base;
if ($todo) {
if (! $base || $todo < $base) {
my $additionally = "";
$additionally .= " additionally" if $base;
print "$ppport$additionally provides support at least back to perl-",
format_version($todo),
".\n";
}
}
elsif (! $base || $base > $int_min_perl) {
if (exists $depends{$f}) {
my $max = 0;
for (@{$depends{$f}}) {
$max = int_parse_version($API{$_}{todo}) if $API{$_}{todo} && $API{$_}{todo} > $max;
# XXX What to assume unspecified values are? This effectively makes them MIN_PERL
}
$todo = $max if $max;
}
print "\n$ppport provides support for this, but ironically, does not",
" currently know,\n",
"for this report, the minimum version it supports for this";
if ($API{$f}{undocumented}) {
print " and many things\n",
"it provides that are implemented as macros and aren't",
" documented. You can\n",
"help by submitting a documentation patch";
}
print ".\n";
if ($todo) {
if ($todo <= $int_min_perl) {
print "It may very well be supported all the way back to ",
format_version(5.003_07), ".\n";
}
else {
print "But given the things $f depends on, it's a good",
" guess that it isn't\n",
"supported prior to ", format_version($todo), ".\n";
}
}
}
}
if ($API{$f}{provided}) {
print "Support needs to be explicitly requested by #define NEED_$f\n",
"(or #define NEED_${f}_GLOBAL).\n" if exists $need{$f};
$info++;
}
if ($base || ! $API{$f}{ppport_fnc}) {
my $email = "Send email to perl5-porters\@perl.org if you need to have this functionality.\n";
if ($API{$f}{inaccessible}) {
print "\nThis is not part of the public API, and may not even be accessible to XS code.\n";
$info++;
}
elsif ($API{$f}{core_only}) {
print "\nThis is not part of the public API, and should not be used by XS code.\n";
$info++;
}
elsif ($API{$f}{deprecated}) {
print "\nThis is deprecated and should not be used. Convert existing uses.\n";
$info++;
}
elsif ($API{$f}{experimental}) {
print "\nThe API for this is unstable and should not be used by XS code.\n", $email;
$info++;
}
elsif ($API{$f}{undocumented}) {
print "\nSince this is undocumented, the API should be considered unstable.\n";
if ($API{$f}{provided}) {
print "Consider bringing this up on the list: perl5-porters\@perl.org.\n";
}
else {
print "It may be that this is not intended for XS use, or it may just be\n",
"that no one has gotten around to documenting it.\n", $email;
}
$info++;
}
unless ($info) {
print "No portability information available. Check your spelling; or",
" this could be\na bug in Devel::PPPort. To report an issue:\n",
"https://github.com/Dual-Life/Devel-PPPort/issues/new\n";
}
}
print "\nDepends on: ", join(', ', @{$depends{$f}}), ".\n"
if exists $depends{$f};
if (exists $hints{$f} || exists $warnings{$f}) {
print "\n$hints{$f}" if exists $hints{$f};
print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
$info++;
}
$count++;
}
$count or print "\nFound no API matching '$opt{'api-info'}'.";
print "\n";
exit 0;
}
if (exists $opt{'list-provided'}) {
my $f;
for $f (sort dictionary_order keys %API) {
next unless $API{$f}{provided};
my @flags;
push @flags, 'explicit' if exists $need{$f};
push @flags, 'depend' if exists $depends{$f};
push @flags, 'hint' if exists $hints{$f};
push @flags, 'warning' if exists $warnings{$f};
my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
print "$f$flags\n";
}
exit 0;
}
my @files;
my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
my $srcext = join '|', map { quotemeta $_ } @srcext;
if (@ARGV) {
my %seen;
for (@ARGV) {
if (-e) {
if (-f) {
push @files, $_ unless $seen{$_}++;
}
else { warn "'$_' is not a file.\n" }
}
else {
my @new = grep { -f } glob $_
or warn "'$_' does not exist.\n";
push @files, grep { !$seen{$_}++ } @new;
}
}
}
else {
eval {
require File::Find;
File::Find::find(sub {
$File::Find::name =~ /($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*$_" } @srcext;
}
}
if (!@ARGV || $opt{filter}) {
my(@in, @out);
my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
for (@files) {
my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
push @{ $out ? \@out : \@in }, $_;
}
if (@ARGV && @out) {
warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
}
@files = @in;
}
die "No input files given!\n" unless @files;
my(%files, %global, %revreplace);
%revreplace = reverse %replace;
my $filename;
my $patch_opened = 0;
for $filename (@files) {
unless (open IN, "<$filename") {
warn "Unable to read from $filename: $!\n";
next;
}
info("Scanning $filename ...");
my $c = do { local $/; <IN> };
close IN;
my %file = (orig => $c, changes => 0);
# Temporarily remove C/XS comments and strings from the code
my @ccom;
$c =~ s{
( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
| ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
| ( ^$HS*\#[^\r\n]*
| "[^"\\]*(?:\\.[^"\\]*)*"
| '[^'\\]*(?:\\.[^'\\]*)*'
| / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
}{ defined $2 and push @ccom, $2;
defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
$file{ccom} = \@ccom;
$file{code} = $c;
$file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
my $func;
for $func (keys %API) {
my $match = $func;
$match .= "|$revreplace{$func}" if exists $revreplace{$func};
if ($c =~ /\b(?:Perl_)?($match)\b/) {
$file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
$file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
if (exists $API{$func}{provided}) {
$file{uses_provided}{$func}++;
if ( ! exists $API{$func}{base}
|| int_parse_version($API{$func}{base}) > $opt{'compat-version'})
{
$file{uses}{$func}++;
my @deps = rec_depend($func);
if (@deps) {
$file{uses_deps}{$func} = \@deps;
for (@deps) {
$file{uses}{$_} = 0 unless exists $file{uses}{$_};
}
}
for ($func, @deps) {
$file{needs}{$_} = 'static' if exists $need{$_};
}
}
}
if ( exists $API{$func}{todo}
&& int_parse_version($API{$func}{todo}) > $opt{'compat-version'})
{
if ($c =~ /\b$func\b/) {
$file{uses_todo}{$func}++;
}
}
}
}
while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
if (exists $need{$2}) {
$file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
}
else { warning("Possibly wrong #define $1 in $filename") }
}
for (qw(uses needs uses_todo needed_global needed_static)) {
for $func (keys %{$file{$_}}) {
push @{$global{$_}{$func}}, $filename;
}
}
$files{$filename} = \%file;
}
# Globally resolve NEED_'s
my $need;
for $need (keys %{$global{needs}}) {
if (@{$global{needs}{$need}} > 1) {
my @targets = @{$global{needs}{$need}};
my @t = grep $files{$_}{needed_global}{$need}, @targets;
@targets = @t if @t;
@t = grep /\.xs$/i, @targets;
@targets = @t if @t;
my $target = shift @targets;
$files{$target}{needs}{$need} = 'global';
for (@{$global{needs}{$need}}) {
$files{$_}{needs}{$need} = 'extern' if $_ ne $target;
}
}
}
for $filename (@files) {
exists $files{$filename} or next;
info("=== Analyzing $filename ===");
my %file = %{$files{$filename}};
my $func;
my $c = $file{code};
my $warnings = 0;
for $func (sort dictionary_order keys %{$file{uses_Perl}}) {
if ($API{$func}{varargs}) {
unless ($API{$func}{noTHXarg}) {
my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
{ $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
if ($changes) {
warning("Doesn't pass interpreter argument aTHX to Perl_$func");
$file{changes} += $changes;
}
}
}
else {
warning("Uses Perl_$func instead of $func");
$file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
{$func$1(}g);
}
}
for $func (sort dictionary_order keys %{$file{uses_replace}}) {
warning("Uses $func instead of $replace{$func}");
$file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
}
for $func (sort dictionary_order keys %{$file{uses_provided}}) {
if ($file{uses}{$func}) {
if (exists $file{uses_deps}{$func}) {
diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
}
else {
diag("Uses $func");
}
}
$warnings += (hint($func) || 0);
}
unless ($opt{quiet}) {
for $func (sort dictionary_order keys %{$file{uses_todo}}) {
next if int_parse_version($API{$func}{todo}) <= $int_min_perl;
print "*** WARNING: Uses $func, which may not be portable below perl ",
format_version($API{$func}{todo}), ", even with '$ppport'\n";
$warnings++;
}
}
for $func (sort dictionary_order keys %{$file{needed_static}}) {
my $message = '';
if (not exists $file{uses}{$func}) {
$message = "No need to define NEED_$func if $func is never used";
}
elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
$message = "No need to define NEED_$func when already needed globally";
}
if ($message) {
diag($message);
$file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
}
}
for $func (sort dictionary_order keys %{$file{needed_global}}) {
my $message = '';
if (not exists $global{uses}{$func}) {
$message = "No need to define NEED_${func}_GLOBAL if $func is never used";
}
elsif (exists $file{needs}{$func}) {
if ($file{needs}{$func} eq 'extern') {
$message = "No need to define NEED_${func}_GLOBAL when already needed globally";
}
elsif ($file{needs}{$func} eq 'static') {
$message = "No need to define NEED_${func}_GLOBAL when only used in this file";
}
}
if ($message) {
diag($message);
$file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
}
}
$file{needs_inc_ppport} = keys %{$file{uses}};
if ($file{needs_inc_ppport}) {
my $pp = '';
for $func (sort dictionary_order keys %{$file{needs}}) {
my $type = $file{needs}{$func};
next if $type eq 'extern';
my $suffix = $type eq 'global' ? '_GLOBAL' : '';
unless (exists $file{"needed_$type"}{$func}) {
if ($type eq 'global') {
diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
}
else {
diag("File needs $func, adding static request");
}
$pp .= "#define NEED_$func$suffix\n";
}
}
if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
$pp = '';
$file{changes}++;
}
unless ($file{has_inc_ppport}) {
diag("Needs to include '$ppport'");
$pp .= qq(#include "$ppport"\n)
}
if ($pp) {
$file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
|| ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
|| ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
|| ($c =~ s/^/$pp/);
}
}
else {
if ($file{has_inc_ppport}) {
diag("No need to include '$ppport'");
$file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
}
}
# put back in our C comments
my $ix;
my $cppc = 0;
my @ccom = @{$file{ccom}};
for $ix (0 .. $#ccom) {
if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
$cppc++;
$file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
}
else {
$c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
}
}
if ($cppc) {
my $s = $cppc != 1 ? 's' : '';
warning("Uses $cppc C++ style comment$s, which is not portable");
}
my $s = $warnings != 1 ? 's' : '';
my $warn = $warnings ? " ($warnings warning$s)" : '';
info("Analysis completed$warn");
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
mydiff(\*PATCH, $filename, $c);
}
else {
fallback:
info("Suggested changes:");
mydiff(\*STDOUT, $filename, $c);
}
}
else {
my $s = $file{changes} == 1 ? '' : 's';
info("$file{changes} potentially required change$s detected");
}
}
else {
info("Looks good");
}
}
close PATCH if $patch_opened;
exit 0;
sub try_use { eval "use @_;"; return $@ eq '' }
sub mydiff
{
local *F = shift;
my($file, $str) = @_;
my $diff;
if (exists $opt{diff}) {
$diff = run_diff($opt{diff}, $file, $str);
}
if (!defined $diff and try_use('Text::Diff')) {
$diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
$diff = <<HEADER . $diff;
--- $file
+++ $file.patched
HEADER
}
if (!defined $diff) {
$diff = run_diff('diff -u', $file, $str);
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
sub run_diff
{
my($prog, $file, $str) = @_;
my $tmp = 'dppptemp';
my $suf = 'aaa';
my $diff = '';
local *F;
while (-e "$tmp.$suf") { $suf++ }
$tmp = "$tmp.$suf";
if (open F, ">$tmp") {
print F $str;
close F;
if (open F, "$prog $file $tmp |") {
while (<F>) {
s/\Q$tmp\E/$file.patched/;
$diff .= $_;
}
close F;
unlink $tmp;
return $diff;
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
return () if $seen->{$func}++;
my %s;
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
}
sub info
{
$opt{quiet} and return;
print @_, "\n";
}
sub diag
{
$opt{quiet} and return;
$opt{diag} and print @_, "\n";
}
sub warning
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
my %given_warnings;
sub hint
{
$opt{quiet} and return;
my $func = shift;
my $rv = 0;
if (exists $warnings{$func} && !$given_warnings{$func}++) {
my $warn = $warnings{$func};
$warn =~ s!^!*** !mg;
print "*** WARNING: $func\n", $warn;
$rv++;
}
if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
my $hint = $hints{$func};
$hint =~ s/^/ /mg;
print " --- hint for $func ---\n", $hint;
}
$rv || 0;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
Usage: $usage
See perldoc $0 for details.
ENDUSAGE
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
eval { require Devel::PPPort };
\$@ and die "Cannot require Devel::PPPort, please install.\\n";
if (eval \$Devel::PPPort::VERSION < $VERSION) {
die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
. "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
. "Please install a newer version, or --unstrip will not work.\\n";
}
Devel::PPPort::WriteFile(\$0);
exit 0;
}
print <<END;
Sorry, but this is a stripped version of \$0.
To be able to use its original script and doc functionality,
please try to regenerate this file using:
\$^X \$0 --unstrip
END
/ms;
my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
$c =~ s{
/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
| ( "[^"\\]*(?:\\.[^"\\]*)*"
| '[^'\\]*(?:\\.[^'\\]*)*' )
| ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
$c =~ s!\s+$!!mg;
$c =~ s!^$LF!!mg;
$c =~ s!^\s*#\s*!#!mg;
$c =~ s!^\s+!!mg;
open OUT, ">$0" or die "cannot strip $0: $!\n";
print OUT "$pl$c\n";
exit 0;
}
__DATA__
*/
#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_
#ifndef DPPP_NAMESPACE
# define DPPP_NAMESPACE DPPP_
#endif
#define DPPP_CAT2(x,y) CAT2(x,y)
#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
#define D_PPP_RELEASE_DATE 1693785600 /* 2023-09-04 */
#if ! defined(PERL_REVISION) && ! defined(PERL_VERSION_MAJOR)
# if ! defined(__PATCHLEVEL_H_INCLUDED__) \
&& ! ( defined(PATCHLEVEL) && defined(SUBVERSION))
# define PERL_PATCHLEVEL_H_IMPLICIT
# include <patchlevel.h>
# endif
# if ! defined(PERL_VERSION) \
&& ! defined(PERL_VERSION_MAJOR) \
&& ( ! defined(SUBVERSION) || ! defined(PATCHLEVEL) )
# include <could_not_find_Perl_patchlevel.h>
# endif
#endif
#ifdef PERL_VERSION_MAJOR
# define D_PPP_MAJOR PERL_VERSION_MAJOR
#elif defined(PERL_REVISION)
# define D_PPP_MAJOR PERL_REVISION
#else
# define D_PPP_MAJOR 5
#endif
#ifdef PERL_VERSION_MINOR
# define D_PPP_MINOR PERL_VERSION_MINOR
#elif defined(PERL_VERSION)
# define D_PPP_MINOR PERL_VERSION
#elif defined(PATCHLEVEL)
# define D_PPP_MINOR PATCHLEVEL
# define PERL_VERSION PATCHLEVEL /* back-compat */
#else
# error Could not find a source for PERL_VERSION_MINOR
#endif
#ifdef PERL_VERSION_PATCH
# define D_PPP_PATCH PERL_VERSION_PATCH
#elif defined(PERL_SUBVERSION)
# define D_PPP_PATCH PERL_SUBVERSION
#elif defined(SUBVERSION)
# define D_PPP_PATCH SUBVERSION
# define PERL_SUBVERSION SUBVERSION /* back-compat */
#else
# error Could not find a source for PERL_VERSION_PATCH
#endif
#if D_PPP_MAJOR < 5 || D_PPP_MAJOR == 6
# error Devel::PPPort works only on Perl 5, Perl 7, ...
#elif D_PPP_MAJOR != 5
/* Perl 7 and above: the old forms are deprecated, set up so that they
* assume Perl 5, and will make this look like 5.201.201.
*
* 201 is used so will be well above anything that would come from a 5
* series if we unexpectedly have to continue it, but still gives plenty of
* room, up to 255, of numbers that will fit into a byte in case there is
* something else unforeseen */
# undef PERL_REVISION
# undef PERL_VERSION
# undef PERL_SUBVERSION
# define D_PPP_REVISION 5
# define D_PPP_VERSION 201
# define D_PPP_SUBVERSION 201
# if (defined(__clang__) /* _Pragma here doesn't work with gcc */ \
&& ( (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) \
|| defined(_STDC_C99) \
|| defined(__c99)))
# define D_PPP_STRINGIFY(x) #x
# define D_PPP_deprecate(xyz) _Pragma(D_PPP_STRINGIFY(GCC warning(D_PPP_STRINGIFY(xyz) " is deprecated")))
# define PERL_REVISION (D_PPP_REVISION D_PPP_deprecate(PERL_REVISION))
# define PERL_VERSION (D_PPP_REVISION D_PPP_deprecate(PERL_VERSION))
# define PERL_SUBVERSION (D_PPP_SUBVERSION D_PPP_deprecate(PERL_SUBVERSION))
# else
# define PERL_REVISION D_PPP_REVISION
# define PERL_VERSION D_PPP_REVISION
# define PERL_SUBVERSION D_PPP_SUBVERSION
# endif
#endif
/* Warning: PERL_PATCHLEVEL PATCHLEVEL SUBVERSION PERL_REVISION PERL_VERSION
* PERL_SUBVERSION PERL_BCDVERSION
*
* You should be using PERL_VERSION_xy(maj,min,ptch) instead of this, where xy
* is one of EQ, NE, LE, GT, LT, GE
*/
/* Replace PERL_PATCHLEVEL with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */
/* Replace PATCHLEVEL with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */
/* Replace SUBVERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */
/* Replace PERL_REVISION with PERL_VERSION_xy(a,b,c) (where xy is EQ,LT,GT...) */
/* Replace PERL_VERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */
/* Replace PERL_SUBVERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */
/* Replace PERL_BCDVERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */
#define D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
#define D_PPP_JNP_TO_BCD(j,n,p) ((D_PPP_DEC2BCD(j)<<24)|(D_PPP_DEC2BCD(n)<<12)|D_PPP_DEC2BCD(p))
#define PERL_BCDVERSION D_PPP_JNP_TO_BCD(D_PPP_MAJOR, \
D_PPP_MINOR, \
D_PPP_PATCH)
/* These differ from the versions outside D:P in using PERL_BCDVERSION instead
* of PERL_DECIMAL_VERSION. The formats printing in this module assume BCD, so
* always use it */
#undef PERL_VERSION_EQ
#undef PERL_VERSION_NE
#undef PERL_VERSION_LT
#undef PERL_VERSION_GE
#undef PERL_VERSION_LE
#undef PERL_VERSION_GT
/* N.B. These don't work if the patch number is 42 or 92, as those are what '*'
* is in ASCII and EBCDIC respectively */
#ifndef PERL_VERSION_EQ
# define PERL_VERSION_EQ(j,n,p) \
(((p) == '*') ? ( (j) == D_PPP_MAJOR \
&& (n) == D_PPP_MINOR) \
: (PERL_BCDVERSION == D_PPP_JNP_TO_BCD(j,n,p)))
#endif
#ifndef PERL_VERSION_NE
# define PERL_VERSION_NE(j,n,p) (! PERL_VERSION_EQ(j,n,p))
#endif
#ifndef PERL_VERSION_LT
# define PERL_VERSION_LT(j,n,p) /* p=='*' means _LT(j,n,0) */ \
(PERL_BCDVERSION < D_PPP_JNP_TO_BCD( (j), \
(n), \
(((p) == '*') ? 0 : (p))))
#endif
#ifndef PERL_VERSION_GE
# define PERL_VERSION_GE(j,n,p) (! PERL_VERSION_LT(j,n,p))
#endif
#ifndef PERL_VERSION_LE
# define PERL_VERSION_LE(j,n,p) /* p=='*' means _LE(j,n,999) */ \
(PERL_BCDVERSION <= D_PPP_JNP_TO_BCD( (j), \
(n), \
(((p) == '*') ? 999 : (p))))
#endif
#ifndef PERL_VERSION_GT
# define PERL_VERSION_GT(j,n,p) (! PERL_VERSION_LE(j,n,p))
#endif
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef dTHX
# define dTHX dNOOP
#endif
/* Hint: dTHX
For pre-5.6.0 thread compatibility, instead use dTHXR, available only through
include/ppport.h */
#ifndef dTHXa
# define dTHXa(x) dNOOP
#endif
#ifndef pTHX
# define pTHX void
#endif
#ifndef pTHX_
# define pTHX_
#endif
#ifndef aTHX
# define aTHX
#endif
/* Hint: aTHX
For pre-5.6.0 thread compatibility, instead use aTHXR, available only through
include/ppport.h */
#ifndef aTHX_
# define aTHX_
#endif
/* Hint: aTHX_
For pre-5.6.0 thread compatibility, instead use aTHXR_, available only
through include/ppport.h */
#if (PERL_BCDVERSION < 0x5006000)
# ifdef USE_THREADS
# define aTHXR thr
# define aTHXR_ thr,
# else
# define aTHXR
# define aTHXR_
# endif
# define dTHXR dTHR
#else
# define aTHXR aTHX
# define aTHXR_ aTHX_
# define dTHXR dTHX
#endif
#ifndef dTHXoa
# define dTHXoa(x) dTHXa(x)
#endif
#ifdef I_LIMITS
# include <limits.h>
#endif
#ifndef PERL_UCHAR_MIN
# define PERL_UCHAR_MIN ((unsigned char)0)
#endif
#ifndef PERL_UCHAR_MAX
# ifdef UCHAR_MAX
# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
# else
# ifdef MAXUCHAR
# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
# else
# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
# endif
# endif
#endif
#ifndef PERL_USHORT_MIN
# define PERL_USHORT_MIN ((unsigned short)0)
#endif
#ifndef PERL_USHORT_MAX
# ifdef USHORT_MAX
# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
# else
# ifdef MAXUSHORT
# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
# else
# ifdef USHRT_MAX
# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
# else
# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
# endif
# endif
# endif
#endif
#ifndef PERL_SHORT_MAX
# ifdef SHORT_MAX
# define PERL_SHORT_MAX ((short)SHORT_MAX)
# else
# ifdef MAXSHORT /* Often used in <values.h> */
# define PERL_SHORT_MAX ((short)MAXSHORT)
# else
# ifdef SHRT_MAX
# define PERL_SHORT_MAX ((short)SHRT_MAX)
# else
# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
# endif
# endif
# endif
#endif
#ifndef PERL_SHORT_MIN
# ifdef SHORT_MIN
# define PERL_SHORT_MIN ((short)SHORT_MIN)
# else
# ifdef MINSHORT
# define PERL_SHORT_MIN ((short)MINSHORT)
# else
# ifdef SHRT_MIN
# define PERL_SHORT_MIN ((short)SHRT_MIN)
# else
# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
# endif
# endif
# endif
#endif
#ifndef PERL_UINT_MAX
# ifdef UINT_MAX
# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
# else
# ifdef MAXUINT
# define PERL_UINT_MAX ((unsigned int)MAXUINT)
# else
# define PERL_UINT_MAX (~(unsigned int)0)
# endif
# endif
#endif
#ifndef PERL_UINT_MIN
# define PERL_UINT_MIN ((unsigned int)0)
#endif
#ifndef PERL_INT_MAX
# ifdef INT_MAX
# define PERL_INT_MAX ((int)INT_MAX)
# else
# ifdef MAXINT /* Often used in <values.h> */
# define PERL_INT_MAX ((int)MAXINT)
# else
# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
# endif
# endif
#endif
#ifndef PERL_INT_MIN
# ifdef INT_MIN
# define PERL_INT_MIN ((int)INT_MIN)
# else
# ifdef MININT
# define PERL_INT_MIN ((int)MININT)
# else
# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
# endif
# endif
#endif
#ifndef PERL_ULONG_MAX
# ifdef ULONG_MAX
# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
# else
# ifdef MAXULONG
# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
# else
# define PERL_ULONG_MAX (~(unsigned long)0)
# endif
# endif
#endif
#ifndef PERL_ULONG_MIN
# define PERL_ULONG_MIN ((unsigned long)0L)
#endif
#ifndef PERL_LONG_MAX
# ifdef LONG_MAX
# define PERL_LONG_MAX ((long)LONG_MAX)
# else
# ifdef MAXLONG
# define PERL_LONG_MAX ((long)MAXLONG)
# else
# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
# endif
# endif
#endif
#ifndef PERL_LONG_MIN
# ifdef LONG_MIN
# define PERL_LONG_MIN ((long)LONG_MIN)
# else
# ifdef MINLONG
# define PERL_LONG_MIN ((long)MINLONG)
# else
# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
# endif
# endif
#endif
#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
# ifndef PERL_UQUAD_MAX
# ifdef ULONGLONG_MAX
# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
# else
# ifdef MAXULONGLONG
# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
# else
# define PERL_UQUAD_MAX (~(unsigned long long)0)
# endif
# endif
# endif
# ifndef PERL_UQUAD_MIN
# define PERL_UQUAD_MIN ((unsigned long long)0L)
# endif
# ifndef PERL_QUAD_MAX
# ifdef LONGLONG_MAX
# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
# else
# ifdef MAXLONGLONG
# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
# else
# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
# endif
# endif
# endif
# ifndef PERL_QUAD_MIN
# ifdef LONGLONG_MIN
# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
# else
# ifdef MINLONGLONG
# define PERL_QUAD_MIN ((long long)MINLONGLONG)
# else
# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
# endif
# endif
# endif
#endif
/* This is based on code from 5.003 perl.h */
#ifdef HAS_QUAD
# ifdef cray
#ifndef IVTYPE
# define IVTYPE int
#endif
#ifndef IV_MIN
# define IV_MIN PERL_INT_MIN
#endif
#ifndef IV_MAX
# define IV_MAX PERL_INT_MAX
#endif
#ifndef UV_MIN
# define UV_MIN PERL_UINT_MIN
#endif
#ifndef UV_MAX
# define UV_MAX PERL_UINT_MAX
#endif
# ifdef INTSIZE
#ifndef IVSIZE
# define IVSIZE INTSIZE
#endif
# endif
# else
# if defined(convex) || defined(uts)
#ifndef IVTYPE
# define IVTYPE long long
#endif
#ifndef IV_MIN
# define IV_MIN PERL_QUAD_MIN
#endif
#ifndef IV_MAX
# define IV_MAX PERL_QUAD_MAX
#endif
#ifndef UV_MIN
# define UV_MIN PERL_UQUAD_MIN
#endif
#ifndef UV_MAX
# define UV_MAX PERL_UQUAD_MAX
#endif
# ifdef LONGLONGSIZE
#ifndef IVSIZE
# define IVSIZE LONGLONGSIZE
#endif
# endif
# else
#ifndef IVTYPE
# define IVTYPE long
#endif
#ifndef IV_MIN
# define IV_MIN PERL_LONG_MIN
#endif
#ifndef IV_MAX
# define IV_MAX PERL_LONG_MAX
#endif
#ifndef UV_MIN
# define UV_MIN PERL_ULONG_MIN
#endif
#ifndef UV_MAX
# define UV_MAX PERL_ULONG_MAX
#endif
# ifdef LONGSIZE
#ifndef IVSIZE
# define IVSIZE LONGSIZE
#endif
# endif
# endif
# endif
#ifndef IVSIZE
# define IVSIZE 8
#endif
#ifndef LONGSIZE
# define LONGSIZE 8
#endif
#ifndef PERL_QUAD_MIN
# define PERL_QUAD_MIN IV_MIN
#endif
#ifndef PERL_QUAD_MAX
# define PERL_QUAD_MAX IV_MAX
#endif
#ifndef PERL_UQUAD_MIN
# define PERL_UQUAD_MIN UV_MIN
#endif
#ifndef PERL_UQUAD_MAX
# define PERL_UQUAD_MAX UV_MAX
#endif
#else
#ifndef IVTYPE
# define IVTYPE long
#endif
#ifndef LONGSIZE
# define LONGSIZE 4
#endif
#ifndef IV_MIN
# define IV_MIN PERL_LONG_MIN
#endif
#ifndef IV_MAX
# define IV_MAX PERL_LONG_MAX
#endif
#ifndef UV_MIN
# define UV_MIN PERL_ULONG_MIN
#endif
#ifndef UV_MAX
# define UV_MAX PERL_ULONG_MAX
#endif
#endif
#ifndef IVSIZE
# ifdef LONGSIZE
# define IVSIZE LONGSIZE
# else
# define IVSIZE 4 /* A bold guess, but the best we can make. */
# endif
#endif
#ifndef UVTYPE
# define UVTYPE unsigned IVTYPE
#endif
#ifndef UVSIZE
# define UVSIZE IVSIZE
#endif
#ifndef PERL_SIGNALS_UNSAFE_FLAG
#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
#if (PERL_BCDVERSION < 0x5008000)
# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
#else
# define D_PPP_PERL_SIGNALS_INIT 0
#endif
#if defined(NEED_PL_signals)
static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
#elif defined(NEED_PL_signals_GLOBAL)
U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
#else
extern U32 DPPP_(my_PL_signals);
#endif
#define PL_signals DPPP_(my_PL_signals)
#endif
/* Hint: PL_ppaddr
* Calling an op via PL_ppaddr requires passing a context argument
* for threaded builds. Since the context argument is different for
* 5.005 perls, you can use aTHXR (supplied by include/ppport.h), which will
* automatically be defined as the correct argument.
*/
#if (PERL_BCDVERSION <= 0x5005005)
/* Replace: 1 */
# define PL_ppaddr ppaddr
# define PL_no_modify no_modify
/* Replace: 0 */
#endif
#if (PERL_BCDVERSION <= 0x5004005)
/* Replace: 1 */
# define PL_DBsignal DBsignal
# define PL_DBsingle DBsingle
# define PL_DBsub DBsub
# define PL_DBtrace DBtrace
# define PL_Sv Sv
# define PL_Xpv Xpv
# define PL_bufend bufend
# define PL_bufptr bufptr
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_debstash debstash
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state lex_state
# define PL_lex_stuff lex_stuff
# define PL_linestr linestr
# define PL_na na
# define PL_perl_destruct_level perl_destruct_level
# define PL_perldb perldb
# define PL_rsfp_filters rsfp_filters
# define PL_rsfp rsfp
# define PL_stack_base stack_base
# define PL_stack_sp stack_sp
# define PL_statcache statcache
# define PL_stdingv stdingv
# define PL_sv_arenaroot sv_arenaroot
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
# define PL_tainted tainted
# define PL_tainting tainting
# define PL_tokenbuf tokenbuf
# define PL_mess_sv mess_sv
/* Replace: 0 */
#endif
/* Warning: PL_parser
* For perl versions earlier than 5.9.5, this is an always
* non-NULL dummy. Also, it cannot be dereferenced. Don't
* use it if you can avoid it, and unless you absolutely know
* what you're doing.
* If you always check that PL_parser is non-NULL, you can
* define DPPP_PL_parser_NO_DUMMY to avoid the creation of
* a dummy parser structure.
*/
#if (PERL_BCDVERSION >= 0x5009005)
# ifdef DPPP_PL_parser_NO_DUMMY
# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
(croak("panic: PL_parser == NULL in %s:%d", \
__FILE__, __LINE__), (yy_parser *) NULL))->var)
# else
# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
# define D_PPP_parser_dummy_warning(var)
# else
# define D_PPP_parser_dummy_warning(var) \
warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
# endif
# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
(D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
#if defined(NEED_PL_parser)
static yy_parser DPPP_(dummy_PL_parser);
#elif defined(NEED_PL_parser_GLOBAL)
yy_parser DPPP_(dummy_PL_parser);
#else
extern yy_parser DPPP_(dummy_PL_parser);
#endif
# endif
/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
* Do not use this variable unless you know exactly what you're
* doing. It is internal to the perl parser and may change or even
* be removed in the future. As of perl 5.9.5, you have to check
* for (PL_parser != NULL) for this variable to have any effect.
* An always non-NULL PL_parser dummy is provided for earlier
* perl versions.
* If PL_parser is NULL when you try to access this variable, a
* dummy is being accessed instead and a warning is issued unless
* you define DPPP_PL_parser_NO_DUMMY_WARNING.
* If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
* this variable will croak with a panic message.
*/
# define PL_expect D_PPP_my_PL_parser_var(expect)
# define PL_copline D_PPP_my_PL_parser_var(copline)
# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
# define PL_linestr D_PPP_my_PL_parser_var(linestr)
# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
# define PL_bufend D_PPP_my_PL_parser_var(bufend)
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
/* ensure that PL_parser != NULL and cannot be dereferenced */
# define PL_parser ((void *) 1)
#endif
#if (PERL_BCDVERSION <= 0x5003022)
# undef start_subparse
# if (PERL_BCDVERSION < 0x5003022)
#ifndef start_subparse
# define start_subparse(a, b) Perl_start_subparse()
#endif
# else
#ifndef start_subparse
# define start_subparse(a, b) Perl_start_subparse(b)
#endif
# endif
#if (PERL_BCDVERSION < 0x5003007)
foo
#endif
#endif
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
/* And before that, we need to make sure this gets compiled for the functions
* that rely on it */
#define NEED_newCONSTSUB
#if defined(NEED_newCONSTSUB)
static CV * DPPP_(my_newCONSTSUB)(HV * stash, const char * name, SV * sv);
static
#else
extern CV * DPPP_(my_newCONSTSUB)(HV * stash, const char * name, SV * sv);
#endif
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
#ifdef newCONSTSUB
# undef newCONSTSUB
#endif
#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
#define D_PPP_PL_copline PL_copline
CV *
DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
{
CV *cv;
U32 oldhints = PL_hints;
HV *old_cop_stash = PL_curcop->cop_stash;
HV *old_curstash = PL_curstash;
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = D_PPP_PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
cv = newSUB(
start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
return cv;
}
#endif
#endif
#ifndef PERL_MAGIC_sv
# define PERL_MAGIC_sv '\0'
#endif
#ifndef PERL_MAGIC_overload
# define PERL_MAGIC_overload 'A'
#endif
#ifndef PERL_MAGIC_overload_elem
# define PERL_MAGIC_overload_elem 'a'
#endif
#ifndef PERL_MAGIC_overload_table
# define PERL_MAGIC_overload_table 'c'
#endif
#ifndef PERL_MAGIC_bm
# define PERL_MAGIC_bm 'B'
#endif
#ifndef PERL_MAGIC_regdata
# define PERL_MAGIC_regdata 'D'
#endif
#ifndef PERL_MAGIC_regdatum
# define PERL_MAGIC_regdatum 'd'
#endif
#ifndef PERL_MAGIC_env
# define PERL_MAGIC_env 'E'
#endif
#ifndef PERL_MAGIC_envelem
# define PERL_MAGIC_envelem 'e'
#endif
#ifndef PERL_MAGIC_fm
# define PERL_MAGIC_fm 'f'
#endif
#ifndef PERL_MAGIC_regex_global
# define PERL_MAGIC_regex_global 'g'
#endif
#ifndef PERL_MAGIC_isa
# define PERL_MAGIC_isa 'I'
#endif
#ifndef PERL_MAGIC_isaelem
# define PERL_MAGIC_isaelem 'i'
#endif
#ifndef PERL_MAGIC_nkeys
# define PERL_MAGIC_nkeys 'k'
#endif
#ifndef PERL_MAGIC_dbfile
# define PERL_MAGIC_dbfile 'L'
#endif
#ifndef PERL_MAGIC_dbline
# define PERL_MAGIC_dbline 'l'
#endif
#ifndef PERL_MAGIC_mutex
# define PERL_MAGIC_mutex 'm'
#endif
#ifndef PERL_MAGIC_shared
# define PERL_MAGIC_shared 'N'
#endif
#ifndef PERL_MAGIC_shared_scalar
# define PERL_MAGIC_shared_scalar 'n'
#endif
#ifndef PERL_MAGIC_collxfrm
# define PERL_MAGIC_collxfrm 'o'
#endif
#ifndef PERL_MAGIC_tied
# define PERL_MAGIC_tied 'P'
#endif
#ifndef PERL_MAGIC_tiedelem
# define PERL_MAGIC_tiedelem 'p'
#endif
#ifndef PERL_MAGIC_tiedscalar
# define PERL_MAGIC_tiedscalar 'q'
#endif
#ifndef PERL_MAGIC_qr
# define PERL_MAGIC_qr 'r'
#endif
#ifndef PERL_MAGIC_sig
# define PERL_MAGIC_sig 'S'
#endif
#ifndef PERL_MAGIC_sigelem
# define PERL_MAGIC_sigelem 's'
#endif
#ifndef PERL_MAGIC_taint
# define PERL_MAGIC_taint 't'
#endif
#ifndef PERL_MAGIC_uvar
# define PERL_MAGIC_uvar 'U'
#endif
#ifndef PERL_MAGIC_uvar_elem
# define PERL_MAGIC_uvar_elem 'u'
#endif
#ifndef PERL_MAGIC_vstring
# define PERL_MAGIC_vstring 'V'
#endif
#ifndef PERL_MAGIC_vec
# define PERL_MAGIC_vec 'v'
#endif
#ifndef PERL_MAGIC_utf8
# define PERL_MAGIC_utf8 'w'
#endif
#ifndef PERL_MAGIC_substr
# define PERL_MAGIC_substr 'x'
#endif
#ifndef PERL_MAGIC_defelem
# define PERL_MAGIC_defelem 'y'
#endif
#ifndef PERL_MAGIC_glob
# define PERL_MAGIC_glob '*'
#endif
#ifndef PERL_MAGIC_arylen
# define PERL_MAGIC_arylen '#'
#endif
#ifndef PERL_MAGIC_pos
# define PERL_MAGIC_pos '.'
#endif
#ifndef PERL_MAGIC_backref
# define PERL_MAGIC_backref '<'
#endif
#ifndef PERL_MAGIC_ext
# define PERL_MAGIC_ext '~'
#endif
#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
#ifndef PERL_STATIC_INLINE
# define PERL_STATIC_INLINE static inline
#endif
#else
#ifndef PERL_STATIC_INLINE
# define PERL_STATIC_INLINE static
#endif
#endif
/* work around a stack alignment bug in 32-bit GCC on Windows */
#if defined(WIN32) && !defined(WIN64) && defined(__GNUC__)
#ifndef PERL_STACK_REALIGN
# define PERL_STACK_REALIGN __attribute__((force_align_arg_pointer))
#endif
#else
#ifndef PERL_STACK_REALIGN
# define PERL_STACK_REALIGN
#endif
#endif
#ifndef cBOOL
# define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
#endif
#ifndef OpHAS_SIBLING
# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
#endif
#ifndef OpSIBLING
# define OpSIBLING(o) (0 + (o)->op_sibling)
#endif
#ifndef OpMORESIB_set
# define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
#endif
#ifndef OpLASTSIB_set
# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
#endif
#ifndef OpMAYBESIB_set
# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
#endif
#ifndef HEf_SVKEY
# define HEf_SVKEY -2
#endif
#if defined(DEBUGGING) && !defined(__COVERITY__)
#ifndef __ASSERT_
# define __ASSERT_(statement) assert(statement),
#endif
#else
#ifndef __ASSERT_
# define __ASSERT_(statement)
#endif
#endif
#ifndef __has_builtin
# define __has_builtin(x) 0
#endif
#if __has_builtin(__builtin_unreachable)
# define D_PPP_HAS_BUILTIN_UNREACHABLE
#elif (defined(__GNUC__) && ( __GNUC__ > 4 \
|| __GNUC__ == 4 && __GNUC_MINOR__ >= 5))
# define D_PPP_HAS_BUILTIN_UNREACHABLE
#endif
#ifndef ASSUME
# ifdef DEBUGGING
# define ASSUME(x) assert(x)
# elif defined(_MSC_VER)
# define ASSUME(x) __assume(x)
# elif defined(__ARMCC_VERSION)
# define ASSUME(x) __promise(x)
# elif defined(D_PPP_HAS_BUILTIN_UNREACHABLE)
# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable())
# else
# define ASSUME(x) assert(x)
# endif
#endif
#ifndef NOT_REACHED
# ifdef D_PPP_HAS_BUILTIN_UNREACHABLE
# define NOT_REACHED \
STMT_START { \
ASSUME(!"UNREACHABLE"); __builtin_unreachable(); \
} STMT_END
# elif ! defined(__GNUC__) && (defined(__sun) || defined(__hpux))
# define NOT_REACHED
# else
# define NOT_REACHED ASSUME(!"UNREACHABLE")
# endif
#endif
#ifndef WIDEST_UTYPE
# ifdef QUADKIND
# ifdef U64TYPE
# define WIDEST_UTYPE U64TYPE
# else
# define WIDEST_UTYPE unsigned Quad_t
# endif
# else
# define WIDEST_UTYPE U32
# endif
#endif
/* These could become provided if/when they become part of the public API */
#ifndef withinCOUNT
# define withinCOUNT(c, l, n) \
(((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0))))
#endif
#ifndef inRANGE
# define inRANGE(c, l, u) \
( (sizeof(c) == sizeof(U8)) ? withinCOUNT(((U8) (c)), (l), ((u) - (l))) \
: (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l))) \
: (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l)))))
#endif
/* The '| 0' part ensures a compiler error if c is not integer (like e.g., a
* pointer) */
#undef FITS_IN_8_BITS /* handy.h version uses a core-only constant */
#ifndef FITS_IN_8_BITS
# define FITS_IN_8_BITS(c) ( (sizeof(c) == 1) \
|| !(((WIDEST_UTYPE)((c) | 0)) & ~0xFF))
#endif
/* Create the macro for "is'macro'_utf8_safe(s, e)". For code points below
* 256, it calls the equivalent _L1 macro by converting the UTF-8 to code
* point. That is so that it can automatically get the bug fixes done in this
* file. */
#define D_PPP_IS_GENERIC_UTF8_SAFE(s, e, macro) \
(((e) - (s)) <= 0 \
? 0 \
: UTF8_IS_INVARIANT((s)[0]) \
? is ## macro ## _L1((s)[0]) \
: (((e) - (s)) < UTF8SKIP(s)) \
? 0 \
: UTF8_IS_DOWNGRADEABLE_START((s)[0]) \
/* The cast in the line below is only to silence warnings */ \
? is ## macro ## _L1((WIDEST_UTYPE) LATIN1_TO_NATIVE( \
UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
& UTF_START_MASK(2), \
(s)[1]))) \
: is ## macro ## _utf8(s))
/* Create the macro for "is'macro'_LC_utf8_safe(s, e)". For code points below
* 256, it calls the equivalent _L1 macro by converting the UTF-8 to code
* point. That is so that it can automatically get the bug fixes done in this
* file. */
#define D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, macro) \
(((e) - (s)) <= 0 \
? 0 \
: UTF8_IS_INVARIANT((s)[0]) \
? is ## macro ## _LC((s)[0]) \
: (((e) - (s)) < UTF8SKIP(s)) \
? 0 \
: UTF8_IS_DOWNGRADEABLE_START((s)[0]) \
/* The cast in the line below is only to silence warnings */ \
? is ## macro ## _LC((WIDEST_UTYPE) LATIN1_TO_NATIVE( \
UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
& UTF_START_MASK(2), \
(s)[1]))) \
: is ## macro ## _utf8(s))
/* A few of the early functions are broken. For these and the non-LC case,
* machine generated code is substituted. But that code doesn't work for
* locales. This is just like the above macro, but at the end, we call the
* macro we've generated for the above 255 case, which is correct since locale
* isn't involved. This will generate extra code to handle the 0-255 inputs,
* but hopefully it will be optimized out by the C compiler. But just in case
* it isn't, this macro is only used on the few versions that are broken */
#define D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, macro) \
(((e) - (s)) <= 0 \
? 0 \
: UTF8_IS_INVARIANT((s)[0]) \
? is ## macro ## _LC((s)[0]) \
: (((e) - (s)) < UTF8SKIP(s)) \
? 0 \
: UTF8_IS_DOWNGRADEABLE_START((s)[0]) \
/* The cast in the line below is only to silence warnings */ \
? is ## macro ## _LC((WIDEST_UTYPE) LATIN1_TO_NATIVE( \
UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
& UTF_START_MASK(2), \
(s)[1]))) \
: is ## macro ## _utf8_safe(s, e))
#ifndef SvRX
# define SvRX(rv) (SvROK((rv)) ? (SvMAGICAL(SvRV((rv))) ? (mg_find(SvRV((rv)), PERL_MAGIC_qr) ? mg_find(SvRV((rv)), PERL_MAGIC_qr)->mg_obj : NULL) : NULL) : NULL)
#endif
#ifndef SvRXOK
# define SvRXOK(sv) (!!SvRX(sv))
#endif
#ifndef PERL_UNUSED_DECL
# ifdef HASATTRIBUTE
# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
# define PERL_UNUSED_DECL
# else
# define PERL_UNUSED_DECL __attribute__((unused))
# endif
# else
# define PERL_UNUSED_DECL
# endif
#endif
#ifndef PERL_UNUSED_ARG
# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
# include <note.h>
# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
# else
# define PERL_UNUSED_ARG(x) ((void)x)
# endif
#endif
#ifndef PERL_UNUSED_VAR
# define PERL_UNUSED_VAR(x) ((void)x)
#endif
#ifndef PERL_UNUSED_CONTEXT
# ifdef USE_ITHREADS
# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
# else
# define PERL_UNUSED_CONTEXT
# endif
#endif
#ifndef PERL_UNUSED_RESULT
# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
# else
# define PERL_UNUSED_RESULT(v) ((void)(v))
# endif
#endif
#ifndef NOOP
# define NOOP /*EMPTY*/(void)0
#endif
#if (PERL_BCDVERSION < 0x5006001) && (PERL_BCDVERSION < 0x5027007)
#undef dNOOP
#ifndef dNOOP
# define dNOOP struct Perl___notused_struct
#endif
#endif
#ifndef NVTYPE
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
# define NVTYPE long double
# else
# define NVTYPE double
# endif
typedef NVTYPE NV;
#endif
#ifndef INT2PTR
# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
# define PTRV UV
# define INT2PTR(any,d) (any)(d)
# else
# if PTRSIZE == LONGSIZE
# define PTRV unsigned long
# else
# define PTRV unsigned
# endif
# define INT2PTR(any,d) (any)(PTRV)(d)
# endif
#endif
#ifndef PTR2ul
# if PTRSIZE == LONGSIZE
# define PTR2ul(p) (unsigned long)(p)
# else
# define PTR2ul(p) INT2PTR(unsigned long,p)
# endif
#endif
#ifndef PERL_STACK_OFFSET_DEFINED
typedef I32 Stack_off_t;
# define Stack_off_t_MAX I32_MAX
# define PERL_STACK_OFFSET_DEFINED
#endif
#ifndef PTR2nat
# define PTR2nat(p) (PTRV)(p)
#endif
#ifndef NUM2PTR
# define NUM2PTR(any,d) (any)PTR2nat(d)
#endif
#ifndef PTR2IV
# define PTR2IV(p) INT2PTR(IV,p)
#endif
#ifndef PTR2UV
# define PTR2UV(p) INT2PTR(UV,p)
#endif
#ifndef PTR2NV
# define PTR2NV(p) NUM2PTR(NV,p)
#endif
#ifdef __cplusplus
#undef START_EXTERN_C
#ifndef START_EXTERN_C
# define START_EXTERN_C extern "C" {
#endif
#undef END_EXTERN_C
#ifndef END_EXTERN_C
# define END_EXTERN_C }
#endif
#undef EXTERN_C
#ifndef EXTERN_C
# define EXTERN_C extern "C"
#endif
#else
#undef START_EXTERN_C
#ifndef START_EXTERN_C
# define START_EXTERN_C
#endif
#undef END_EXTERN_C
#ifndef END_EXTERN_C
# define END_EXTERN_C
#endif
#undef EXTERN_C
#ifndef EXTERN_C
# define EXTERN_C extern
#endif
#endif
#if (PERL_BCDVERSION < 0x5004000) || defined(PERL_GCC_PEDANTIC)
# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
#endif
# endif
#endif
#if ! defined(__GNUC__) || defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) || defined(__cplusplus)
# undef PERL_USE_GCC_BRACE_GROUPS
#else
# ifndef PERL_USE_GCC_BRACE_GROUPS
# define PERL_USE_GCC_BRACE_GROUPS
# endif
#endif
#if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
#undef STMT_START
#ifndef STMT_START
# define STMT_START if (1)
#endif
#undef STMT_END
#ifndef STMT_END
# define STMT_END else (void)0
#endif
#else
#undef STMT_START
#ifndef STMT_START
# define STMT_START do
#endif
#undef STMT_END
#ifndef STMT_END
# define STMT_END while (0)
#endif
#endif
#ifndef boolSV
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
# define DEFSV GvSV(PL_defgv)
#endif
#ifndef SAVE_DEFSV
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
#ifndef DEFSV_set
# define DEFSV_set(sv) (DEFSV = (sv))
#endif
/* Older perls (<=5.003) lack AvFILLp */
#ifndef AvFILLp
# define AvFILLp AvFILL
#endif
#ifndef av_tindex
# define av_tindex AvFILL
#endif
#ifndef av_top_index
# define av_top_index AvFILL
#endif
#ifndef av_count
# define av_count(av) (AvFILL(av)+1)
#endif
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
/* Replace: 1 */
#ifndef get_cv
# define get_cv perl_get_cv
#endif
#ifndef get_sv
# define get_sv perl_get_sv
#endif
#ifndef get_av
# define get_av perl_get_av
#endif
#ifndef get_hv
# define get_hv perl_get_hv
#endif
/* Replace: 0 */
#ifndef dUNDERBAR
# define dUNDERBAR dNOOP
#endif
#ifndef UNDERBAR
# define UNDERBAR DEFSV
#endif
#ifndef dAX
# define dAX I32 ax = MARK - PL_stack_base + 1
#endif
#ifndef dITEMS
# define dITEMS I32 items = SP - MARK
#endif
#ifndef dXSTARG
# define dXSTARG SV * targ = sv_newmortal()
#endif
#ifndef dAXMARK
# define dAXMARK I32 ax = POPMARK; \
SV ** const mark = PL_stack_base + ax++
#endif
#ifndef XSprePUSH
# define XSprePUSH (sp = PL_stack_base + ax - 1)
#endif
#if (PERL_BCDVERSION < 0x5005000)
#undef XSRETURN
#ifndef XSRETURN
# define XSRETURN(off) \
STMT_START { \
PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
return; \
} STMT_END
#endif
#endif
#ifndef XSPROTO
# define XSPROTO(name) void name(pTHX_ CV* cv)
#endif
#ifndef SVfARG
# define SVfARG(p) ((void*)(p))
#endif
#ifndef PERL_ABS
# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
#endif
#ifndef dVAR
# define dVAR dNOOP
#endif
#ifndef SVf
# define SVf "_"
#endif
#ifndef CPERLscope
# define CPERLscope(x) x
#endif
#ifndef PERL_HASH
# define PERL_HASH(hash,str,len) \
STMT_START { \
const char *s_PeRlHaSh = str; \
I32 i_PeRlHaSh = len; \
U32 hash_PeRlHaSh = 0; \
while (i_PeRlHaSh--) \
hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
(hash) = hash_PeRlHaSh; \
} STMT_END
#endif
#ifndef PERLIO_FUNCS_DECL
# ifdef PERLIO_FUNCS_CONST
# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
# else
# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
# define PERLIO_FUNCS_CAST(funcs) (funcs)
# endif
#endif
/* provide these typedefs for older perls */
#if (PERL_BCDVERSION < 0x5009003)
# ifdef ARGSproto
typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
# else
typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
# endif
typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
#endif
/* On versions without NATIVE_TO_ASCII, only ASCII is supported */
#if defined(EBCDIC) && defined(NATIVE_TO_ASCI)
#ifndef NATIVE_TO_LATIN1
# define NATIVE_TO_LATIN1(c) NATIVE_TO_ASCII(c)
#endif
#ifndef LATIN1_TO_NATIVE
# define LATIN1_TO_NATIVE(c) ASCII_TO_NATIVE(c)
#endif
#ifndef NATIVE_TO_UNI
# define NATIVE_TO_UNI(c) ((c) > 255 ? (c) : NATIVE_TO_LATIN1(c))
#endif
#ifndef UNI_TO_NATIVE
# define UNI_TO_NATIVE(c) ((c) > 255 ? (c) : LATIN1_TO_NATIVE(c))
#endif
#else
#ifndef NATIVE_TO_LATIN1
# define NATIVE_TO_LATIN1(c) (c)
#endif
#ifndef LATIN1_TO_NATIVE
# define LATIN1_TO_NATIVE(c) (c)
#endif
#ifndef NATIVE_TO_UNI
# define NATIVE_TO_UNI(c) (c)
#endif
#ifndef UNI_TO_NATIVE
# define UNI_TO_NATIVE(c) (c)
#endif
#endif
/* Warning: LATIN1_TO_NATIVE, NATIVE_TO_LATIN1 NATIVE_TO_UNI UNI_TO_NATIVE
EBCDIC is not supported on versions earlier than 5.7.1
*/
/* The meaning of this changed; use the modern version */
#undef isPSXSPC
#undef isPSXSPC_A
#undef isPSXSPC_L1
/* Hint: isPSXSPC, isPSXSPC_A, isPSXSPC_L1, isPSXSPC_utf8_safe
This is equivalent to the corresponding isSPACE-type macro. On perls
before 5.18, this matched a vertical tab and SPACE didn't. But the
include/ppport.h SPACE version does match VT in all perl releases. Since VT's are
extremely rarely found in real-life files, this difference effectively
doesn't matter */
/* Hint: isSPACE, isSPACE_A, isSPACE_L1, isSPACE_utf8_safe
Until Perl 5.18, this did not match the vertical tab (VT). The include/ppport.h
version does match it in all perl releases. Since VT's are extremely rarely
found in real-life files, this difference effectively doesn't matter */
#ifdef EBCDIC
/* This is the first version where these macros are fully correct on EBCDIC
* platforms. Relying on the C library functions, as earlier releases did,
* causes problems with locales */
# if (PERL_BCDVERSION < 0x5022000)
# undef isALNUM
# undef isALNUM_A
# undef isALNUM_L1
# undef isALNUMC
# undef isALNUMC_A
# undef isALNUMC_L1
# undef isALPHA
# undef isALPHA_A
# undef isALPHA_L1
# undef isALPHANUMERIC
# undef isALPHANUMERIC_A
# undef isALPHANUMERIC_L1
# undef isASCII
# undef isASCII_A
# undef isASCII_L1
# undef isBLANK
# undef isBLANK_A
# undef isBLANK_L1
# undef isCNTRL
# undef isCNTRL_A
# undef isCNTRL_L1
# undef isDIGIT
# undef isDIGIT_A
# undef isDIGIT_L1
# undef isGRAPH
# undef isGRAPH_A
# undef isGRAPH_L1
# undef isIDCONT
# undef isIDCONT_A
# undef isIDCONT_L1
# undef isIDFIRST
# undef isIDFIRST_A
# undef isIDFIRST_L1
# undef isLOWER
# undef isLOWER_A
# undef isLOWER_L1
# undef isOCTAL
# undef isOCTAL_A
# undef isOCTAL_L1
# undef isPRINT
# undef isPRINT_A
# undef isPRINT_L1
# undef isPUNCT
# undef isPUNCT_A
# undef isPUNCT_L1
# undef isSPACE
# undef isSPACE_A
# undef isSPACE_L1
# undef isUPPER
# undef isUPPER_A
# undef isUPPER_L1
# undef isWORDCHAR
# undef isWORDCHAR_A
# undef isWORDCHAR_L1
# undef isXDIGIT
# undef isXDIGIT_A
# undef isXDIGIT_L1
# endif
#ifndef isASCII
# define isASCII(c) (isCNTRL(c) || isPRINT(c))
#endif
/* The below is accurate for all EBCDIC code pages supported by
* all the versions of Perl overridden by this */
#ifndef isCNTRL
# define isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \
|| (c) == '\f' || (c) == '\n' || (c) == '\r' \
|| (c) == '\t' || (c) == '\v' \
|| ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \
|| (c) == 7 /* U+7F DEL */ \
|| ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \
/* DLE, DC[1-3] */ \
|| (c) == 0x18 /* U+18 CAN */ \
|| (c) == 0x19 /* U+19 EOM */ \
|| ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \
|| (c) == 0x26 /* U+17 ETB */ \
|| (c) == 0x27 /* U+1B ESC */ \
|| (c) == 0x2D /* U+05 ENQ */ \
|| (c) == 0x2E /* U+06 ACK */ \
|| (c) == 0x32 /* U+16 SYN */ \
|| (c) == 0x37 /* U+04 EOT */ \
|| (c) == 0x3C /* U+14 DC4 */ \
|| (c) == 0x3D /* U+15 NAK */ \
|| (c) == 0x3F /* U+1A SUB */ \
)
#endif
#if '^' == 106 /* EBCDIC POSIX-BC */
# define D_PPP_OUTLIER_CONTROL 0x5F
#else /* EBCDIC 1047 037 */
# define D_PPP_OUTLIER_CONTROL 0xFF
#endif
/* The controls are everything below blank, plus one outlier */
#ifndef isCNTRL_L1
# define isCNTRL_L1(c) ((WIDEST_UTYPE) (c) < ' ' \
|| (WIDEST_UTYPE) (c) == D_PPP_OUTLIER_CONTROL)
#endif
/* The ordering of the tests in this and isUPPER are to exclude most characters
* early */
#ifndef isLOWER
# define isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \
&& ( (c) <= 'i' \
|| ((c) >= 'j' && (c) <= 'r') \
|| (c) >= 's'))
#endif
#ifndef isUPPER
# define isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \
&& ( (c) <= 'I' \
|| ((c) >= 'J' && (c) <= 'R') \
|| (c) >= 'S'))
#endif
#else /* Above is EBCDIC; below is ASCII */
# if (PERL_BCDVERSION < 0x5004000)
/* The implementation of these in older perl versions can give wrong results if
* the C program locale is set to other than the C locale */
# undef isALNUM
# undef isALNUM_A
# undef isALPHA
# undef isALPHA_A
# undef isDIGIT
# undef isDIGIT_A
# undef isIDFIRST
# undef isIDFIRST_A
# undef isLOWER
# undef isLOWER_A
# undef isUPPER
# undef isUPPER_A
# endif
# if (PERL_BCDVERSION == 0x5007000) /* this perl made space GRAPH */
# undef isGRAPH
# endif
# if (PERL_BCDVERSION < 0x5008000) /* earlier perls omitted DEL */
# undef isCNTRL
# endif
# if (PERL_BCDVERSION < 0x5010000)
/* earlier perls included all of the isSPACE() characters, which is wrong. The
* version provided by Devel::PPPort always overrides an existing buggy
* version. */
# undef isPRINT
# undef isPRINT_A
# endif
# if (PERL_BCDVERSION < 0x5014000)
/* earlier perls always returned true if the parameter was a signed char */
# undef isASCII
# undef isASCII_A
# endif
# if (PERL_BCDVERSION < 0x5017008) /* earlier perls didn't include PILCROW, SECTION SIGN */
# undef isPUNCT_L1
# endif
# if (PERL_BCDVERSION < 0x5013007) /* khw didn't investigate why this failed */
# undef isALNUMC_L1
#endif
# if (PERL_BCDVERSION < 0x5020000) /* earlier perls didn't include \v */
# undef isSPACE
# undef isSPACE_A
# undef isSPACE_L1
# endif
#ifndef isASCII
# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
#endif
#ifndef isCNTRL
# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
#endif
#ifndef isCNTRL_L1
# define isCNTRL_L1(c) ( (WIDEST_UTYPE) (c) < ' ' \
|| inRANGE((c), 0x7F, 0x9F))
#endif
#ifndef isLOWER
# define isLOWER(c) inRANGE((c), 'a', 'z')
#endif
#ifndef isUPPER
# define isUPPER(c) inRANGE((c), 'A', 'Z')
#endif
#endif /* Below are definitions common to EBCDIC and ASCII */
#ifndef isASCII_L1
# define isASCII_L1(c) isASCII(c)
#endif
#ifndef isASCII_LC
# define isASCII_LC(c) isASCII(c)
#endif
#ifndef isALNUM
# define isALNUM(c) isWORDCHAR(c)
#endif
#ifndef isALNUMC
# define isALNUMC(c) isALPHANUMERIC(c)
#endif
#ifndef isALNUMC_L1
# define isALNUMC_L1(c) isALPHANUMERIC_L1(c)
#endif
#ifndef isALPHA
# define isALPHA(c) (isUPPER(c) || isLOWER(c))
#endif
#ifndef isALPHA_L1
# define isALPHA_L1(c) (isUPPER_L1(c) || isLOWER_L1(c))
#endif
#ifndef isALPHANUMERIC
# define isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
#endif
#ifndef isALPHANUMERIC_L1
# define isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT(c))
#endif
#ifndef isALPHANUMERIC_LC
# define isALPHANUMERIC_LC(c) (isALPHA_LC(c) || isDIGIT_LC(c))
#endif
#ifndef isBLANK
# define isBLANK(c) ((c) == ' ' || (c) == '\t')
#endif
#ifndef isBLANK_L1
# define isBLANK_L1(c) ( isBLANK(c) \
|| ( FITS_IN_8_BITS(c) \
&& NATIVE_TO_LATIN1((U8) c) == 0xA0))
#endif
#ifndef isBLANK_LC
# define isBLANK_LC(c) isBLANK(c)
#endif
#ifndef isDIGIT
# define isDIGIT(c) inRANGE(c, '0', '9')
#endif
#ifndef isDIGIT_L1
# define isDIGIT_L1(c) isDIGIT(c)
#endif
#ifndef isGRAPH
# define isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c))
#endif
#ifndef isGRAPH_L1
# define isGRAPH_L1(c) ( isPRINT_L1(c) \
&& (c) != ' ' \
&& NATIVE_TO_LATIN1((U8) c) != 0xA0)
#endif
#ifndef isIDCONT
# define isIDCONT(c) isWORDCHAR(c)
#endif
#ifndef isIDCONT_L1
# define isIDCONT_L1(c) isWORDCHAR_L1(c)
#endif
#ifndef isIDCONT_LC
# define isIDCONT_LC(c) isWORDCHAR_LC(c)
#endif
#ifndef isIDFIRST
# define isIDFIRST(c) (isALPHA(c) || (c) == '_')
#endif
#ifndef isIDFIRST_L1
# define isIDFIRST_L1(c) (isALPHA_L1(c) || (U8) (c) == '_')
#endif
#ifndef isIDFIRST_LC
# define isIDFIRST_LC(c) (isALPHA_LC(c) || (U8) (c) == '_')
#endif
#ifndef isLOWER_L1
# define isLOWER_L1(c) ( isLOWER(c) \
|| ( FITS_IN_8_BITS(c) \
&& ( ( NATIVE_TO_LATIN1((U8) c) >= 0xDF \
&& NATIVE_TO_LATIN1((U8) c) != 0xF7) \
|| NATIVE_TO_LATIN1((U8) c) == 0xAA \
|| NATIVE_TO_LATIN1((U8) c) == 0xBA \
|| NATIVE_TO_LATIN1((U8) c) == 0xB5)))
#endif
#ifndef isOCTAL
# define isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0')
#endif
#ifndef isOCTAL_L1
# define isOCTAL_L1(c) isOCTAL(c)
#endif
#ifndef isPRINT
# define isPRINT(c) (isGRAPH(c) || (c) == ' ')
#endif
#ifndef isPRINT_L1
# define isPRINT_L1(c) (FITS_IN_8_BITS(c) && ! isCNTRL_L1(c))
#endif
#ifndef isPSXSPC
# define isPSXSPC(c) isSPACE(c)
#endif
#ifndef isPSXSPC_L1
# define isPSXSPC_L1(c) isSPACE_L1(c)
#endif
#ifndef isPUNCT
# define isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \
|| (c) == '#' || (c) == '$' || (c) == '%' \
|| (c) == '&' || (c) == '\'' || (c) == '(' \
|| (c) == ')' || (c) == '*' || (c) == '+' \
|| (c) == ',' || (c) == '.' || (c) == '/' \
|| (c) == ':' || (c) == ';' || (c) == '<' \
|| (c) == '=' || (c) == '>' || (c) == '?' \
|| (c) == '@' || (c) == '[' || (c) == '\\' \
|| (c) == ']' || (c) == '^' || (c) == '_' \
|| (c) == '`' || (c) == '{' || (c) == '|' \
|| (c) == '}' || (c) == '~')
#endif
#ifndef isPUNCT_L1
# define isPUNCT_L1(c) ( isPUNCT(c) \
|| ( FITS_IN_8_BITS(c) \
&& ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \
|| NATIVE_TO_LATIN1((U8) c) == 0xA7 \
|| NATIVE_TO_LATIN1((U8) c) == 0xAB \
|| NATIVE_TO_LATIN1((U8) c) == 0xB6 \
|| NATIVE_TO_LATIN1((U8) c) == 0xB7 \
|| NATIVE_TO_LATIN1((U8) c) == 0xBB \
|| NATIVE_TO_LATIN1((U8) c) == 0xBF)))
#endif
#ifndef isSPACE
# define isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \
|| (c) == '\v' || (c) == '\f')
#endif
#ifndef isSPACE_L1
# define isSPACE_L1(c) ( isSPACE(c) \
|| (FITS_IN_8_BITS(c) \
&& ( NATIVE_TO_LATIN1((U8) c) == 0x85 \
|| NATIVE_TO_LATIN1((U8) c) == 0xA0)))
#endif
#ifndef isUPPER_L1
# define isUPPER_L1(c) ( isUPPER(c) \
|| (FITS_IN_8_BITS(c) \
&& ( NATIVE_TO_LATIN1((U8) c) >= 0xC0 \
&& NATIVE_TO_LATIN1((U8) c) <= 0xDE \
&& NATIVE_TO_LATIN1((U8) c) != 0xD7)))
#endif
#ifndef isWORDCHAR
# define isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_')
#endif
#ifndef isWORDCHAR_L1
# define isWORDCHAR_L1(c) (isIDFIRST_L1(c) || isDIGIT(c))
#endif
#ifndef isWORDCHAR_LC
# define isWORDCHAR_LC(c) (isIDFIRST_LC(c) || isDIGIT_LC(c))
#endif
#ifndef isXDIGIT
# define isXDIGIT(c) ( isDIGIT(c) \
|| inRANGE((c), 'a', 'f') \
|| inRANGE((c), 'A', 'F'))
#endif
#ifndef isXDIGIT_L1
# define isXDIGIT_L1(c) isXDIGIT(c)
#endif
#ifndef isXDIGIT_LC
# define isXDIGIT_LC(c) isxdigit(c)
#endif
#ifndef isALNUM_A
# define isALNUM_A(c) isALNUM(c)
#endif
#ifndef isALNUMC_A
# define isALNUMC_A(c) isALNUMC(c)
#endif
#ifndef isALPHA_A
# define isALPHA_A(c) isALPHA(c)
#endif
#ifndef isALPHANUMERIC_A
# define isALPHANUMERIC_A(c) isALPHANUMERIC(c)
#endif
#ifndef isASCII_A
# define isASCII_A(c) isASCII(c)
#endif
#ifndef isBLANK_A
# define isBLANK_A(c) isBLANK(c)
#endif
#ifndef isCNTRL_A
# define isCNTRL_A(c) isCNTRL(c)
#endif
#ifndef isDIGIT_A
# define isDIGIT_A(c) isDIGIT(c)
#endif
#ifndef isGRAPH_A
# define isGRAPH_A(c) isGRAPH(c)
#endif
#ifndef isIDCONT_A
# define isIDCONT_A(c) isIDCONT(c)
#endif
#ifndef isIDFIRST_A
# define isIDFIRST_A(c) isIDFIRST(c)
#endif
#ifndef isLOWER_A
# define isLOWER_A(c) isLOWER(c)
#endif
#ifndef isOCTAL_A
# define isOCTAL_A(c) isOCTAL(c)
#endif
#ifndef isPRINT_A
# define isPRINT_A(c) isPRINT(c)
#endif
#ifndef isPSXSPC_A
# define isPSXSPC_A(c) isPSXSPC(c)
#endif
#ifndef isPUNCT_A
# define isPUNCT_A(c) isPUNCT(c)
#endif
#ifndef isSPACE_A
# define isSPACE_A(c) isSPACE(c)
#endif
#ifndef isUPPER_A
# define isUPPER_A(c) isUPPER(c)
#endif
#ifndef isWORDCHAR_A
# define isWORDCHAR_A(c) isWORDCHAR(c)
#endif
#ifndef isXDIGIT_A
# define isXDIGIT_A(c) isXDIGIT(c)
#endif
#ifndef isASCII_utf8_safe
# define isASCII_utf8_safe(s,e) (((e) - (s)) <= 0 ? 0 : isASCII(*(s)))
#endif
#ifndef isASCII_uvchr
# define isASCII_uvchr(c) (FITS_IN_8_BITS(c) ? isASCII_L1(c) : 0)
#endif
#if (PERL_BCDVERSION >= 0x5006000)
# ifdef isALPHA_uni /* If one defined, all are; this is just an exemplar */
# define D_PPP_is_ctype(upper, lower, c) \
(FITS_IN_8_BITS(c) \
? is ## upper ## _L1(c) \
: is ## upper ## _uni((UV) (c))) /* _uni is old synonym */
# else
# define D_PPP_is_ctype(upper, lower, c) \
(FITS_IN_8_BITS(c) \
? is ## upper ## _L1(c) \
: is_uni_ ## lower((UV) (c))) /* is_uni_ is even older */
# endif
#ifndef isALPHA_uvchr
# define isALPHA_uvchr(c) D_PPP_is_ctype(ALPHA, alpha, c)
#endif
#ifndef isALPHANUMERIC_uvchr
# define isALPHANUMERIC_uvchr(c) (isALPHA_uvchr(c) || isDIGIT_uvchr(c))
#endif
# ifdef is_uni_blank
#ifndef isBLANK_uvchr
# define isBLANK_uvchr(c) D_PPP_is_ctype(BLANK, blank, c)
#endif
# else
#ifndef isBLANK_uvchr
# define isBLANK_uvchr(c) (FITS_IN_8_BITS(c) \
? isBLANK_L1(c) \
: ( (UV) (c) == 0x1680 /* Unicode 3.0 */ \
|| inRANGE((UV) (c), 0x2000, 0x200A) \
|| (UV) (c) == 0x202F /* Unicode 3.0 */\
|| (UV) (c) == 0x205F /* Unicode 3.2 */\
|| (UV) (c) == 0x3000))
#endif
# endif
#ifndef isCNTRL_uvchr
# define isCNTRL_uvchr(c) D_PPP_is_ctype(CNTRL, cntrl, c)
#endif
#ifndef isDIGIT_uvchr
# define isDIGIT_uvchr(c) D_PPP_is_ctype(DIGIT, digit, c)
#endif
#ifndef isGRAPH_uvchr
# define isGRAPH_uvchr(c) D_PPP_is_ctype(GRAPH, graph, c)
#endif
#ifndef isIDCONT_uvchr
# define isIDCONT_uvchr(c) isWORDCHAR_uvchr(c)
#endif
#ifndef isIDFIRST_uvchr
# define isIDFIRST_uvchr(c) D_PPP_is_ctype(IDFIRST, idfirst, c)
#endif
#ifndef isLOWER_uvchr
# define isLOWER_uvchr(c) D_PPP_is_ctype(LOWER, lower, c)
#endif
#ifndef isPRINT_uvchr
# define isPRINT_uvchr(c) D_PPP_is_ctype(PRINT, print, c)
#endif
#ifndef isPSXSPC_uvchr
# define isPSXSPC_uvchr(c) isSPACE_uvchr(c)
#endif
#ifndef isPUNCT_uvchr
# define isPUNCT_uvchr(c) D_PPP_is_ctype(PUNCT, punct, c)
#endif
#ifndef isSPACE_uvchr
# define isSPACE_uvchr(c) D_PPP_is_ctype(SPACE, space, c)
#endif
#ifndef isUPPER_uvchr
# define isUPPER_uvchr(c) D_PPP_is_ctype(UPPER, upper, c)
#endif
#ifndef isXDIGIT_uvchr
# define isXDIGIT_uvchr(c) D_PPP_is_ctype(XDIGIT, xdigit, c)
#endif
#ifndef isWORDCHAR_uvchr
# define isWORDCHAR_uvchr(c) (FITS_IN_8_BITS(c) \
? isWORDCHAR_L1(c) : isALPHANUMERIC_uvchr(c))
#endif
#ifndef isALPHA_utf8_safe
# define isALPHA_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHA)
#endif
# ifdef isALPHANUMERIC_utf8
#ifndef isALPHANUMERIC_utf8_safe
# define isALPHANUMERIC_utf8_safe(s,e) \
D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHANUMERIC)
#endif
# else
#ifndef isALPHANUMERIC_utf8_safe
# define isALPHANUMERIC_utf8_safe(s,e) \
(isALPHA_utf8_safe(s,e) || isDIGIT_utf8_safe(s,e))
#endif
# endif
/* This was broken before 5.18, and just use this instead of worrying about
* which releases the official works on */
# if 'A' == 65
#ifndef isBLANK_utf8_safe
# define isBLANK_utf8_safe(s,e) \
( ( LIKELY((e) > (s)) ) ? /* Machine generated */ \
( ( 0x09 == ((const U8*)s)[0] || 0x20 == ((const U8*)s)[0] ) ? 1 \
: ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \
( ( 0xC2 == ((const U8*)s)[0] ) ? \
( ( 0xA0 == ((const U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE1 == ((const U8*)s)[0] ) ? \
( ( ( 0x9A == ((const U8*)s)[1] ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: ( 0xE2 == ((const U8*)s)[0] ) ? \
( ( 0x80 == ((const U8*)s)[1] ) ? \
( ( inRANGE(((const U8*)s)[2], 0x80, 0x8A ) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\
: ( ( 0x81 == ((const U8*)s)[1] ) && ( 0x9F == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: ( ( ( 0xE3 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: 0 ) \
: 0 )
#endif
# elif 'A' == 193 && '^' == 95 /* EBCDIC 1047 */
#ifndef isBLANK_utf8_safe
# define isBLANK_utf8_safe(s,e) \
( ( LIKELY((e) > (s)) ) ? \
( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1 \
: ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \
( ( 0x80 == ((const U8*)s)[0] ) ? \
( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xBC == ((const U8*)s)[0] ) ? \
( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: ( 0xCA == ((const U8*)s)[0] ) ? \
( ( 0x41 == ((const U8*)s)[1] ) ? \
( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
: ( 0x42 == ((const U8*)s)[1] ) ? \
( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \
: ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: 0 ) \
: 0 )
#endif
# elif 'A' == 193 && '^' == 176 /* EBCDIC 037 */
#ifndef isBLANK_utf8_safe
# define isBLANK_utf8_safe(s,e) \
( ( LIKELY((e) > (s)) ) ? \
( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1 \
: ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \
( ( 0x78 == ((const U8*)s)[0] ) ? \
( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xBD == ((const U8*)s)[0] ) ? \
( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: ( 0xCA == ((const U8*)s)[0] ) ? \
( ( 0x41 == ((const U8*)s)[1] ) ? \
( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
: ( 0x42 == ((const U8*)s)[1] ) ? \
( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \
: ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: 0 ) \
: 0 )
#endif
# else
# error Unknown character set
# endif
#ifndef isCNTRL_utf8_safe
# define isCNTRL_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, CNTRL)
#endif
#ifndef isDIGIT_utf8_safe
# define isDIGIT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, DIGIT)
#endif
#ifndef isGRAPH_utf8_safe
# define isGRAPH_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, GRAPH)
#endif
# ifdef isIDCONT_utf8
#ifndef isIDCONT_utf8_safe
# define isIDCONT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDCONT)
#endif
# else
#ifndef isIDCONT_utf8_safe
# define isIDCONT_utf8_safe(s,e) isWORDCHAR_utf8_safe(s,e)
#endif
# endif
#ifndef isIDFIRST_utf8_safe
# define isIDFIRST_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDFIRST)
#endif
#ifndef isLOWER_utf8_safe
# define isLOWER_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, LOWER)
#endif
#ifndef isPRINT_utf8_safe
# define isPRINT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PRINT)
#endif
/* Use the modern definition */
#undef isPSXSPC_utf8_safe
#ifndef isPSXSPC_utf8_safe
# define isPSXSPC_utf8_safe(s,e) isSPACE_utf8_safe(s,e)
#endif
#ifndef isPUNCT_utf8_safe
# define isPUNCT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PUNCT)
#endif
#ifndef isSPACE_utf8_safe
# define isSPACE_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, SPACE)
#endif
#ifndef isUPPER_utf8_safe
# define isUPPER_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, UPPER)
#endif
# ifdef isWORDCHAR_utf8
#ifndef isWORDCHAR_utf8_safe
# define isWORDCHAR_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, WORDCHAR)
#endif
# else
#ifndef isWORDCHAR_utf8_safe
# define isWORDCHAR_utf8_safe(s,e) \
(isALPHANUMERIC_utf8_safe(s,e) || (*(s)) == '_')
#endif
# endif
/* This was broken before 5.12, and just use this instead of worrying about
* which releases the official works on */
# if 'A' == 65
#ifndef isXDIGIT_utf8_safe
# define isXDIGIT_utf8_safe(s,e) \
( ( LIKELY((e) > (s)) ) ? \
( ( inRANGE(((const U8*)s)[0], 0x30, 0x39 ) || inRANGE(((const U8*)s)[0], 0x41, 0x46 ) || inRANGE(((const U8*)s)[0], 0x61, 0x66 ) ) ? 1\
: ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xEF == ((const U8*)s)[0] ) ) ? ( ( 0xBC == ((const U8*)s)[1] ) ?\
( ( inRANGE(((const U8*)s)[2], 0x90, 0x99 ) || inRANGE(((const U8*)s)[2], 0xA1, 0xA6 ) ) ? 3 : 0 )\
: ( ( 0xBD == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x81, 0x86 ) ) ) ? 3 : 0 ) : 0 )\
: 0 )
#endif
# elif 'A' == 193 && '^' == 95 /* EBCDIC 1047 */
#ifndef isXDIGIT_utf8_safe
# define isXDIGIT_utf8_safe(s,e) \
( ( LIKELY((e) > (s)) ) ? \
( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
: ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x73 == ((const U8*)s)[1] ) ) ? ( ( 0x67 == ((const U8*)s)[2] ) ?\
( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || inRANGE(((const U8*)s)[3], 0x62, 0x68 ) ) ? 4 : 0 )\
: ( ( inRANGE(((const U8*)s)[2], 0x68, 0x69 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
: 0 )
#endif
# elif 'A' == 193 && '^' == 176 /* EBCDIC 037 */
#ifndef isXDIGIT_utf8_safe
# define isXDIGIT_utf8_safe(s,e) \
( ( LIKELY((e) > (s)) ) ? \
( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
: ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x72 == ((const U8*)s)[1] ) ) ? ( ( 0x66 == ((const U8*)s)[2] ) ?\
( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x67 ) ) ? 4 : 0 )\
: ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
: 0 )
#endif
# else
# error Unknown character set
# endif
#ifndef isALPHA_LC_utf8_safe
# define isALPHA_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHA)
#endif
# ifdef isALPHANUMERIC_utf8
#ifndef isALPHANUMERIC_LC_utf8_safe
# define isALPHANUMERIC_LC_utf8_safe(s,e) \
D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHANUMERIC)
#endif
# else
#ifndef isALPHANUMERIC_LC_utf8_safe
# define isALPHANUMERIC_LC_utf8_safe(s,e) \
(isALPHA_LC_utf8_safe(s,e) || isDIGIT_LC_utf8_safe(s,e))
#endif
# endif
#ifndef isBLANK_LC_utf8_safe
# define isBLANK_LC_utf8_safe(s,e) \
D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, BLANK)
#endif
#ifndef isCNTRL_LC_utf8_safe
# define isCNTRL_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, CNTRL)
#endif
#ifndef isDIGIT_LC_utf8_safe
# define isDIGIT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, DIGIT)
#endif
#ifndef isGRAPH_LC_utf8_safe
# define isGRAPH_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, GRAPH)
#endif
# ifdef isIDCONT_utf8
#ifndef isIDCONT_LC_utf8_safe
# define isIDCONT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, IDCONT)
#endif
# else
#ifndef isIDCONT_LC_utf8_safe
# define isIDCONT_LC_utf8_safe(s,e) isWORDCHAR_LC_utf8_safe(s,e)
#endif
# endif
#ifndef isIDFIRST_LC_utf8_safe
# define isIDFIRST_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, IDFIRST)
#endif
#ifndef isLOWER_LC_utf8_safe
# define isLOWER_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, LOWER)
#endif
#ifndef isPRINT_LC_utf8_safe
# define isPRINT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PRINT)
#endif
/* Use the modern definition */
#undef isPSXSPC_LC_utf8_safe
#ifndef isPSXSPC_LC_utf8_safe
# define isPSXSPC_LC_utf8_safe(s,e) isSPACE_LC_utf8_safe(s,e)
#endif
#ifndef isPUNCT_LC_utf8_safe
# define isPUNCT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PUNCT)
#endif
#ifndef isSPACE_LC_utf8_safe
# define isSPACE_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, SPACE)
#endif
#ifndef isUPPER_LC_utf8_safe
# define isUPPER_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, UPPER)
#endif
# ifdef isWORDCHAR_utf8
#ifndef isWORDCHAR_LC_utf8_safe
# define isWORDCHAR_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, WORDCHAR)
#endif
# else
#ifndef isWORDCHAR_LC_utf8_safe
# define isWORDCHAR_LC_utf8_safe(s,e) \
(isALPHANUMERIC_LC_utf8_safe(s,e) || (*(s)) == '_')
#endif
# endif
#ifndef isXDIGIT_LC_utf8_safe
# define isXDIGIT_LC_utf8_safe(s,e) \
D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, XDIGIT)
#endif
/* Warning: isALPHANUMERIC_utf8_safe, isALPHA_utf8_safe, isASCII_utf8_safe,
* isBLANK_utf8_safe, isCNTRL_utf8_safe, isDIGIT_utf8_safe, isGRAPH_utf8_safe,
* isIDCONT_utf8_safe, isIDFIRST_utf8_safe, isLOWER_utf8_safe,
* isPRINT_utf8_safe, isPSXSPC_utf8_safe, isPUNCT_utf8_safe, isSPACE_utf8_safe,
* isUPPER_utf8_safe, isWORDCHAR_utf8_safe, isWORDCHAR_utf8_safe,
* isXDIGIT_utf8_safe,
* isALPHANUMERIC_LC_utf8_safe, isALPHA_LC_utf8_safe, isASCII_LC_utf8_safe,
* isBLANK_LC_utf8_safe, isCNTRL_LC_utf8_safe, isDIGIT_LC_utf8_safe,
* isGRAPH_LC_utf8_safe, isIDCONT_LC_utf8_safe, isIDFIRST_LC_utf8_safe,
* isLOWER_LC_utf8_safe, isPRINT_LC_utf8_safe, isPSXSPC_LC_utf8_safe,
* isPUNCT_LC_utf8_safe, isSPACE_LC_utf8_safe, isUPPER_LC_utf8_safe,
* isWORDCHAR_LC_utf8_safe, isWORDCHAR_LC_utf8_safe, isXDIGIT_LC_utf8_safe,
* isALPHANUMERIC_uvchr, isALPHA_uvchr, isASCII_uvchr, isBLANK_uvchr,
* isCNTRL_uvchr, isDIGIT_uvchr, isGRAPH_uvchr, isIDCONT_uvchr,
* isIDFIRST_uvchr, isLOWER_uvchr, isPRINT_uvchr, isPSXSPC_uvchr,
* isPUNCT_uvchr, isSPACE_uvchr, isUPPER_uvchr, isWORDCHAR_uvchr,
* isWORDCHAR_uvchr, isXDIGIT_uvchr
*
* The UTF-8 handling is buggy in early Perls, and this can give inaccurate
* results for code points above 0xFF, until the implementation started
* settling down in 5.12 and 5.14 */
#endif
#define D_PPP_TOO_SHORT_MSG "Malformed UTF-8 character starting with:" \
" \\x%02x (too short; %d bytes available, need" \
" %d)\n"
/* Perls starting here had a new API which handled multi-character results */
#if (PERL_BCDVERSION >= 0x5007003)
#ifndef toLOWER_uvchr
# define toLOWER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_lower(NATIVE_TO_UNI(c), s, l))
#endif
#ifndef toUPPER_uvchr
# define toUPPER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_upper(NATIVE_TO_UNI(c), s, l))
#endif
#ifndef toTITLE_uvchr
# define toTITLE_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_title(NATIVE_TO_UNI(c), s, l))
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_fold( NATIVE_TO_UNI(c), s, l))
#endif
# if (PERL_BCDVERSION != 0x5015006) /* Just this version is broken */
/* Prefer the macro to the function */
# if defined toLOWER_utf8
# define D_PPP_TO_LOWER_CALLEE(s,r,l) toLOWER_utf8(s,r,l)
# else
# define D_PPP_TO_LOWER_CALLEE(s,r,l) to_utf8_lower(s,r,l)
# endif
# if defined toTITLE_utf8
# define D_PPP_TO_TITLE_CALLEE(s,r,l) toTITLE_utf8(s,r,l)
# else
# define D_PPP_TO_TITLE_CALLEE(s,r,l) to_utf8_title(s,r,l)
# endif
# if defined toUPPER_utf8
# define D_PPP_TO_UPPER_CALLEE(s,r,l) toUPPER_utf8(s,r,l)
# else
# define D_PPP_TO_UPPER_CALLEE(s,r,l) to_utf8_upper(s,r,l)
# endif
# if defined toFOLD_utf8
# define D_PPP_TO_FOLD_CALLEE(s,r,l) toFOLD_utf8(s,r,l)
# else
# define D_PPP_TO_FOLD_CALLEE(s,r,l) to_utf8_fold(s,r,l)
# endif
# else /* Below is 5.15.6, which failed to make the macros available
# outside of core, so we have to use the 'Perl_' form. khw
# decided it was easier to just handle this case than have to
# document the exception, and make an exception in the tests below
# */
# define D_PPP_TO_LOWER_CALLEE(s,r,l) \
Perl__to_utf8_lower_flags(aTHX_ s, r, l, 0, NULL)
# define D_PPP_TO_TITLE_CALLEE(s,r,l) \
Perl__to_utf8_title_flags(aTHX_ s, r, l, 0, NULL)
# define D_PPP_TO_UPPER_CALLEE(s,r,l) \
Perl__to_utf8_upper_flags(aTHX_ s, r, l, 0, NULL)
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
#ifndef toLOWER_utf8_safe
# define toLOWER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(LOWER,s,e,r,l)
#endif
#ifndef toTITLE_utf8_safe
# define toTITLE_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(TITLE,s,e,r,l)
#endif
#ifndef toFOLD_utf8_safe
# define toFOLD_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(FOLD,s,e,r,l)
#endif
#elif (PERL_BCDVERSION >= 0x5006000)
/* Here we have UTF-8 support, but using the original API where the case
* changing functions merely returned the changed code point; hence they
* couldn't handle multi-character results. */
# ifdef uvchr_to_utf8
# define D_PPP_UV_TO_UTF8 uvchr_to_utf8
# else
# define D_PPP_UV_TO_UTF8 uv_to_utf8
# endif
/* Get the utf8 of the case changed value, and store its length; then have
* to re-calculate the changed case value in order to return it */
# define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l) \
(*(l) = (D_PPP_UV_TO_UTF8(s, \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) - (s)), \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c))))
#ifndef toLOWER_uvchr
# define toLOWER_uvchr(c, s, l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(lower, c, s, l)
#endif
#ifndef toUPPER_uvchr
# define toUPPER_uvchr(c, s, l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(upper, c, s, l)
#endif
#ifndef toTITLE_uvchr
# define toTITLE_uvchr(c, s, l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
* toUPPER_uvchr, toLOWER_uvchr, toTITLE_uvchr
The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
this backport does not correct them.
In perls before 7.3, multi-character case changing is not implemented; this
backport uses the simple case changes available in those perls. */
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(upper, s, e, r, l)
#endif
#ifndef toLOWER_utf8_safe
# define toLOWER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(lower, s, e, r, l)
#endif
#ifndef toTITLE_utf8_safe
# define toTITLE_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(title, s, e, r, l)
#endif
/* Warning: toFOLD_utf8_safe, toFOLD_uvchr
The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
this backport does not correct them.
In perls before 7.3, case folding is not implemented; instead, this
backport substitutes simple (not multi-character, which isn't available)
lowercasing. This gives the correct result in most, but not all, instances
*/
#ifndef toFOLD_utf8_safe
# define toFOLD_utf8_safe(s,e,r,l) toLOWER_utf8_safe(s,e,r,l)
#endif
#endif
/* Until we figure out how to support this in older perls... */
#if (PERL_BCDVERSION >= 0x5008000)
#ifndef HeUTF8
# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
SvUTF8(HeKEY_sv(he)) : \
(U32)HeKUTF8(he))
#endif
#endif
#ifndef C_ARRAY_LENGTH
# define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
#endif
#ifndef C_ARRAY_END
# define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
#endif
#ifndef LIKELY
# define LIKELY(x) (x)
#endif
#ifndef UNLIKELY
# define UNLIKELY(x) (x)
#endif
#ifndef MUTABLE_PTR
#if defined(PERL_USE_GCC_BRACE_GROUPS)
# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
#else
# define MUTABLE_PTR(p) ((void *) (p))
#endif
#endif
#ifndef MUTABLE_AV
# define MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p))
#endif
#ifndef MUTABLE_CV
# define MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p))
#endif
#ifndef MUTABLE_GV
# define MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p))
#endif
#ifndef MUTABLE_HV
# define MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p))
#endif
#ifndef MUTABLE_IO
# define MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p))
#endif
#ifndef MUTABLE_SV
# define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
#if defined(PERL_USE_GCC_BRACE_GROUPS)
# define vnewSVpvf(pat, args) ({ SV *_sv = newSV(0); sv_vsetpvfn(_sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)); _sv; })
#else
# define vnewSVpvf(pat, args) ((PL_Sv = newSV(0)), sv_vsetpvfn(PL_Sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)), PL_Sv)
#endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg)
static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * const sv, const char * const pat, ...);
static
#else
extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * const sv, const char * const pat, ...);
#endif
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV * const sv, const char * const pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
#if defined(NEED_sv_catpvf_mg_nocontext)
static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * const sv, const char * const pat, ...);
static
#else
extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * const sv, const char * const pat, ...);
#endif
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV * const sv, const char * const pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
#ifndef sv_catpvf_mg
# ifdef PERL_IMPLICIT_CONTEXT
# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
# else
# define sv_catpvf_mg Perl_sv_catpvf_mg
# endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
# define sv_vcatpvf_mg(sv, pat, args) \
STMT_START { \
sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
SvSETMAGIC(sv); \
} STMT_END
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg)
static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * const sv, const char * const pat, ...);
static
#else
extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * const sv, const char * const pat, ...);
#endif
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV * const sv, const char * const pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext)
static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * const sv, const char * const pat, ...);
static
#else
extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * const sv, const char * const pat, ...);
#endif
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV * const sv, const char * const pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
#ifndef sv_setpvf_mg
# ifdef PERL_IMPLICIT_CONTEXT
# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
# else
# define sv_setpvf_mg Perl_sv_setpvf_mg
# endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
# define sv_vsetpvf_mg(sv, pat, args) \
STMT_START { \
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
SvSETMAGIC(sv); \
} STMT_END
#endif
/* Hint: sv_2pv_nolen
* Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
*/
#ifndef sv_2pv_nolen
# define sv_2pv_nolen(sv) SvPV_nolen(sv)
#endif
#ifdef SvPVbyte
/* Hint: SvPVbyte
* Does not work in perl-5.6.1, include/ppport.h implements a version
* borrowed from perl-5.7.3.
*/
#if (PERL_BCDVERSION < 0x5007000)
#ifndef sv_2pvbyte
# define sv_2pvbyte(sv, lp) (sv_utf8_downgrade((sv), 0), SvPV((sv), *(lp)))
#endif
/* Hint: sv_2pvbyte
* Use the SvPVbyte() macro instead of sv_2pvbyte().
*/
/* Replace sv_2pvbyte with SvPVbyte */
#undef SvPVbyte
#define SvPVbyte(sv, lp) \
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
#endif
#else
# define SvPVbyte SvPV
# define sv_2pvbyte sv_2pv
#endif
#ifndef sv_2pvbyte_nolen
# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
#endif
/* Hint: sv_pvn
* Always use the SvPV() macro instead of sv_pvn().
*/
/* Replace sv_pvn with SvPV */
/* Hint: sv_pvn_force
* Always use the SvPV_force() macro instead of sv_pvn_force().
*/
/* Replace sv_pvn_force with SvPV_force */
/* If these are undefined, they're not handled by the core anyway */
#ifndef SV_IMMEDIATE_UNREF
# define SV_IMMEDIATE_UNREF 0
#endif
#ifndef SV_GMAGIC
# define SV_GMAGIC 0
#endif
#ifndef SV_COW_DROP_PV
# define SV_COW_DROP_PV 0
#endif
#ifndef SV_UTF8_NO_ENCODING
# define SV_UTF8_NO_ENCODING 0
#endif
#ifndef SV_CONST_RETURN
# define SV_CONST_RETURN 0
#endif
#ifndef SV_MUTABLE_RETURN
# define SV_MUTABLE_RETURN 0
#endif
#ifndef SV_SMAGIC
# define SV_SMAGIC 0
#endif
#ifndef SV_HAS_TRAILING_NUL
# define SV_HAS_TRAILING_NUL 0
#endif
#ifndef SV_COW_SHARED_HASH_KEYS
# define SV_COW_SHARED_HASH_KEYS 0
#endif
#if (PERL_BCDVERSION < 0x5007002)
#
/* Fix sv_2pv for Perl < 5.7.2 - view https://github.com/Dual-Life/Devel-PPPort/issues/231 */
# ifdef sv_2pv
# undef sv_2pv
# endif
# if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef sv_2pv
# define sv_2pv(sv, lp) ({ SV *_sv_2pv = (sv); STRLEN sv_2pv_dummy_; STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &sv_2pv_dummy_; SvPOKp(_sv_2pv) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv(aTHX_ _sv_2pv, (_lp_2pv)); })
#endif
# else
#ifndef sv_2pv
# define sv_2pv(sv, lp) (SvPOKp(sv) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv(aTHX_ (sv), (lp)))
#endif
# endif
#endif
#if (PERL_BCDVERSION < 0x5007002)
/* Define sv_2pv_flags for Perl < 5.7.2 which does not have it at all */
#if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef sv_2pv_flags
# define sv_2pv_flags(sv, lp, flags) ({ SV *_sv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &sv_2pv_dummy_; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_2pv(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_2pv(_sv, _lp); })
#endif
#ifndef sv_pvn_force_flags
# define sv_pvn_force_flags(sv, lp, flags) ({ SV *_sv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &sv_2pv_dummy_; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_pvn_force(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_pvn_force(_sv, _lp); })
#endif
#else
#ifndef sv_2pv_flags
# define sv_2pv_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na))
#endif
#ifndef sv_pvn_force_flags
# define sv_pvn_force_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na))
#endif
#endif
#elif (PERL_BCDVERSION < 0x5017002)
/* Fix sv_2pv_flags for Perl < 5.17.2 */
# ifdef sv_2pv_flags
# undef sv_2pv_flags
# endif
# if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef sv_2pv_flags
# define sv_2pv_flags(sv, lp, flags) ({ SV *_sv_2pv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags_2pv = (flags); STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &sv_2pv_dummy_; ((!(_flags_2pv & SV_GMAGIC) || !SvGMAGICAL(_sv_2pv)) && SvPOKp(_sv_2pv)) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv_flags(aTHX_ _sv_2pv, (_lp_2pv), (_flags_2pv)); })
#endif
# else
#ifndef sv_2pv_flags
# define sv_2pv_flags(sv, lp, flags) (((!((flags) & SV_GMAGIC) || !SvGMAGICAL(sv)) && SvPOKp(sv)) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv_flags(aTHX_ (sv), (lp), (flags)))
#endif
# endif
#endif
#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
# define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
#else
# define D_PPP_SVPV_NOLEN_LP_ARG 0
#endif
#ifndef SvPV_const
# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_mutable
# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_flags
# define SvPV_flags(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
#endif
#ifndef SvPV_flags_const
# define SvPV_flags_const(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
(const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
#endif
#ifndef SvPV_flags_const_nolen
# define SvPV_flags_const_nolen(sv, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX_const(sv) : \
(const char*) sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
#endif
#ifndef SvPV_flags_mutable
# define SvPV_flags_mutable(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#endif
#ifndef SvPV_force
# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_force_nolen
# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
#endif
#ifndef SvPV_force_mutable
# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_force_nomg
# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
#endif
#ifndef SvPV_force_nomg_nolen
# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
#endif
#ifndef SvPV_force_flags
# define SvPV_force_flags(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
#endif
#ifndef SvPV_force_flags_nolen
# define SvPV_force_flags_nolen(sv, flags) \
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
? SvPVX(sv) : sv_pvn_force_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags))
#endif
#ifndef SvPV_force_flags_mutable
# define SvPV_force_flags_mutable(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
: sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#endif
#ifndef SvPV_nolen
# define SvPV_nolen(sv) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
#endif
#ifndef SvPV_nolen_const
# define SvPV_nolen_const(sv) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX_const(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
#endif
# if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef SvPVx_nolen_const
# define SvPVx_nolen_const(sv) ({SV *sV_ = (sv); SvPV_nolen_const(sV_); })
#endif
# else
#ifndef SvPVx_nolen_const
# define SvPVx_nolen_const(sv) (PL_Sv = sv, SvPV_nolen_const(PL_Sv))
#endif
# endif
#ifndef SvPV_nomg
# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
#endif
#ifndef SvPV_nomg_const
# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
#endif
#ifndef SvPV_nomg_const_nolen
# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
#endif
#ifndef SvPV_nomg_nolen
# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, 0))
#endif
#ifndef SvPV_renew
# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
SvPV_set((sv), (char *) saferealloc( \
(Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
} STMT_END
#endif
#ifndef SvPVCLEAR
# define SvPVCLEAR(sv) sv_setpvs((sv), "")
#endif
#ifndef WARN_ALL
# define WARN_ALL 0
#endif
#ifndef WARN_CLOSURE
# define WARN_CLOSURE 1
#endif
#ifndef WARN_DEPRECATED
# define WARN_DEPRECATED 2
#endif
#ifndef WARN_EXITING
# define WARN_EXITING 3
#endif
#ifndef WARN_GLOB
# define WARN_GLOB 4
#endif
#ifndef WARN_IO
# define WARN_IO 5
#endif
#ifndef WARN_CLOSED
# define WARN_CLOSED 6
#endif
#ifndef WARN_EXEC
# define WARN_EXEC 7
#endif
#ifndef WARN_LAYER
# define WARN_LAYER 8
#endif
#ifndef WARN_NEWLINE
# define WARN_NEWLINE 9
#endif
#ifndef WARN_PIPE
# define WARN_PIPE 10
#endif
#ifndef WARN_UNOPENED
# define WARN_UNOPENED 11
#endif
#ifndef WARN_MISC
# define WARN_MISC 12
#endif
#ifndef WARN_NUMERIC
# define WARN_NUMERIC 13
#endif
#ifndef WARN_ONCE
# define WARN_ONCE 14
#endif
#ifndef WARN_OVERFLOW
# define WARN_OVERFLOW 15
#endif
#ifndef WARN_PACK
# define WARN_PACK 16
#endif
#ifndef WARN_PORTABLE
# define WARN_PORTABLE 17
#endif
#ifndef WARN_RECURSION
# define WARN_RECURSION 18
#endif
#ifndef WARN_REDEFINE
# define WARN_REDEFINE 19
#endif
#ifndef WARN_REGEXP
# define WARN_REGEXP 20
#endif
#ifndef WARN_SEVERE
# define WARN_SEVERE 21
#endif
#ifndef WARN_DEBUGGING
# define WARN_DEBUGGING 22
#endif
#ifndef WARN_INPLACE
# define WARN_INPLACE 23
#endif
#ifndef WARN_INTERNAL
# define WARN_INTERNAL 24
#endif
#ifndef WARN_MALLOC
# define WARN_MALLOC 25
#endif
#ifndef WARN_SIGNAL
# define WARN_SIGNAL 26
#endif
#ifndef WARN_SUBSTR
# define WARN_SUBSTR 27
#endif
#ifndef WARN_SYNTAX
# define WARN_SYNTAX 28
#endif
#ifndef WARN_AMBIGUOUS
# define WARN_AMBIGUOUS 29
#endif
#ifndef WARN_BAREWORD
# define WARN_BAREWORD 30
#endif
#ifndef WARN_DIGIT
# define WARN_DIGIT 31
#endif
#ifndef WARN_PARENTHESIS
# define WARN_PARENTHESIS 32
#endif
#ifndef WARN_PRECEDENCE
# define WARN_PRECEDENCE 33
#endif
#ifndef WARN_PRINTF
# define WARN_PRINTF 34
#endif
#ifndef WARN_PROTOTYPE
# define WARN_PROTOTYPE 35
#endif
#ifndef WARN_QW
# define WARN_QW 36
#endif
#ifndef WARN_RESERVED
# define WARN_RESERVED 37
#endif
#ifndef WARN_SEMICOLON
# define WARN_SEMICOLON 38
#endif
#ifndef WARN_TAINT
# define WARN_TAINT 39
#endif
#ifndef WARN_THREADS
# define WARN_THREADS 40
#endif
#ifndef WARN_UNINITIALIZED
# define WARN_UNINITIALIZED 41
#endif
#ifndef WARN_UNPACK
# define WARN_UNPACK 42
#endif
#ifndef WARN_UNTIE
# define WARN_UNTIE 43
#endif
#ifndef WARN_UTF8
# define WARN_UTF8 44
#endif
#ifndef WARN_VOID
# define WARN_VOID 45
#endif
#ifndef WARN_ASSERTIONS
# define WARN_ASSERTIONS 46
#endif
#ifndef packWARN
# define packWARN(a) (a)
#endif
#ifndef packWARN2
# define packWARN2(a,b) (packWARN(a) << 8 | (b))
#endif
#ifndef packWARN3
# define packWARN3(a,b,c) (packWARN2(a,b) << 8 | (c))
#endif
#ifndef packWARN4
# define packWARN4(a,b,c,d) (packWARN3(a,b,c) << 8 | (d))
#endif
#ifndef ckWARN
# ifdef G_WARN_ON
# define ckWARN(a) (PL_dowarn & G_WARN_ON)
# else
# define ckWARN(a) PL_dowarn
# endif
#endif
#ifndef ckWARN2
# define ckWARN2(a,b) (ckWARN(a) || ckWARN(b))
#endif
#ifndef ckWARN3
# define ckWARN3(a,b,c) (ckWARN(c) || ckWARN2(a,b))
#endif
#ifndef ckWARN4
# define ckWARN4(a,b,c,d) (ckWARN(d) || ckWARN3(a,b,c))
#endif
#ifndef ckWARN_d
# ifdef isLEXWARN_off
# define ckWARN_d(a) (isLEXWARN_off || ckWARN(a))
# else
# define ckWARN_d(a) 1
# endif
#endif
#ifndef ckWARN2_d
# define ckWARN2_d(a,b) (ckWARN_d(a) || ckWARN_d(b))
#endif
#ifndef ckWARN3_d
# define ckWARN3_d(a,b,c) (ckWARN_d(c) || ckWARN2_d(a,b))
#endif
#ifndef ckWARN4_d
# define ckWARN4_d(a,b,c,d) (ckWARN_d(d) || ckWARN3_d(a,b,c))
#endif
#ifndef vwarner
# define vwarner(err, pat, argsp) \
STMT_START { SV *sv; \
PERL_UNUSED_ARG(err); \
sv = vnewSVpvf(pat, argsp); \
sv_2mortal(sv); \
warn("%s", SvPV_nolen(sv)); \
} STMT_END
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
# if defined(NEED_warner)
static void DPPP_(my_warner)(U32 err, const char * pat, ...);
static
#else
extern void DPPP_(my_warner)(U32 err, const char * pat, ...);
#endif
#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
#define Perl_warner DPPP_(my_warner)
void
DPPP_(my_warner)(U32 err, const char *pat, ...)
{
va_list args;
va_start(args, pat);
vwarner(err, pat, &args);
va_end(args);
}
# define warner Perl_warner
# define Perl_warner_nocontext Perl_warner
# endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(ck_warner)
# if defined(NEED_ck_warner)
static void DPPP_(my_ck_warner)(pTHX_ U32 err, const char * pat, ...);
static
#else
extern void DPPP_(my_ck_warner)(pTHX_ U32 err, const char * pat, ...);
#endif
#if defined(NEED_ck_warner) || defined(NEED_ck_warner_GLOBAL)
#define Perl_ck_warner DPPP_(my_ck_warner)
void
DPPP_(my_ck_warner)(pTHX_ U32 err, const char *pat, ...)
{
va_list args;
if ( ! ckWARN((err ) & 0xFF)
&& ! ckWARN((err >> 8) & 0xFF)
&& ! ckWARN((err >> 16) & 0xFF)
&& ! ckWARN((err >> 24) & 0xFF))
{
return;
}
va_start(args, pat);
vwarner(err, pat, &args);
va_end(args);
}
# define ck_warner Perl_ck_warner
# endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(ck_warner_d)
# if defined(NEED_ck_warner_d)
static void DPPP_(my_ck_warner_d)(pTHX_ U32 err, const char * pat, ...);
static
#else
extern void DPPP_(my_ck_warner_d)(pTHX_ U32 err, const char * pat, ...);
#endif
#if defined(NEED_ck_warner_d) || defined(NEED_ck_warner_d_GLOBAL)
#define Perl_ck_warner_d DPPP_(my_ck_warner_d)
void
DPPP_(my_ck_warner_d)(pTHX_ U32 err, const char *pat, ...)
{
va_list args;
if ( ! ckWARN_d((err ) & 0xFF)
&& ! ckWARN_d((err >> 8) & 0xFF)
&& ! ckWARN_d((err >> 16) & 0xFF)
&& ! ckWARN_d((err >> 24) & 0xFF))
{
return;
}
va_start(args, pat);
vwarner(err, pat, &args);
va_end(args);
}
# define ck_warner_d Perl_ck_warner_d
# endif
#endif
#ifndef IVdf
# if IVSIZE == LONGSIZE
# define IVdf "ld"
# define UVuf "lu"
# define UVof "lo"
# define UVxf "lx"
# define UVXf "lX"
# elif IVSIZE == INTSIZE
# define IVdf "d"
# define UVuf "u"
# define UVof "o"
# define UVxf "x"
# define UVXf "X"
# else
# error "cannot define IV/UV formats"
# endif
#endif
#ifndef NVef
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
/* Not very likely, but let's try anyway. */
# define NVef PERL_PRIeldbl
# define NVff PERL_PRIfldbl
# define NVgf PERL_PRIgldbl
# else
# define NVef "e"
# define NVff "f"
# define NVgf "g"
# endif
#endif
#ifndef sv_setuv
# define sv_setuv(sv, uv) \
STMT_START { \
UV TeMpUv = uv; \
if (TeMpUv <= IV_MAX) \
sv_setiv(sv, TeMpUv); \
else \
sv_setnv(sv, (double)TeMpUv); \
} STMT_END
#endif
#ifndef newSVuv
# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
#endif
#if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef sv_2uv
# define sv_2uv(sv) ({ SV *_sv = (sv); (UV) (SvNOK(_sv) ? SvNV(_sv) : sv_2nv(_sv)); })
#endif
#else
#ifndef sv_2uv
# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
#endif
#endif
#ifndef SvUVX
# define SvUVX(sv) ((UV)SvIVX(sv))
#endif
#ifndef SvUVXx
# define SvUVXx(sv) SvUVX(sv)
#endif
#ifndef SvUV
# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
#endif
#if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef SvUVx
# define SvUVx(sv) ({ SV *_sv = (sv)); SvUV(_sv); })
#endif
#else
#ifndef SvUVx
# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
#endif
#endif
/* Hint: sv_uv
* Always use the SvUVx() macro instead of sv_uv().
*/
/* Replace sv_uv with SvUVx */
#ifndef sv_uv
# define sv_uv(sv) SvUVx(sv)
#endif
#if !defined(SvUOK) && defined(SvIOK_UV)
# define SvUOK(sv) SvIOK_UV(sv)
#endif
#ifndef XST_mUV
# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
#endif
#ifndef XSRETURN_UV
# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
#endif
#ifndef PUSHu
# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
#endif
#ifndef XPUSHu
# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
#endif
#if !defined(my_strnlen)
#if defined(NEED_my_strnlen)
static Size_t DPPP_(my_my_strnlen)(const char * str, Size_t maxlen);
static
#else
extern Size_t DPPP_(my_my_strnlen)(const char * str, Size_t maxlen);
#endif
#if defined(NEED_my_strnlen) || defined(NEED_my_strnlen_GLOBAL)
#define my_strnlen DPPP_(my_my_strnlen)
#define Perl_my_strnlen DPPP_(my_my_strnlen)
Size_t
DPPP_(my_my_strnlen)(const char *str, Size_t maxlen)
{
const char *p = str;
while(maxlen-- && *p)
p++;
return p - str;
}
#endif
#endif
#ifdef HAS_MEMCMP
#ifndef memNE
# define memNE(s1,s2,l) (memcmp(s1,s2,l))
#endif
#ifndef memEQ
# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
#endif
#else
#ifndef memNE
# define memNE(s1,s2,l) (bcmp(s1,s2,l))
#endif
#ifndef memEQ
# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
#endif
#endif
#ifndef memEQs
# define memEQs(s1, l, s2) \
(sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
#endif
#ifndef memNEs
# define memNEs(s1, l, s2) !memEQs(s1, l, s2)
#endif
#ifndef memCHRs
# define memCHRs(s, c) ((const char *) memchr("" s "" , c, sizeof(s)-1))
#endif
#ifndef MoveD
# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
#endif
#ifndef CopyD
# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
#endif
#ifdef HAS_MEMSET
#ifndef ZeroD
# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
#endif
#else
#ifndef ZeroD
# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
#endif
#endif
#ifndef PoisonWith
# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
#endif
#ifndef PoisonNew
# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
#endif
#ifndef PoisonFree
# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
#endif
#ifndef Poison
# define Poison(d,n,t) PoisonFree(d,n,t)
#endif
#ifndef Newx
# define Newx(v,n,t) New(0,v,n,t)
#endif
#ifndef Newxc
# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
#endif
#ifndef Newxz
# define Newxz(v,n,t) Newz(0,v,n,t)
#endif
#ifdef NEED_mess_sv
#define NEED_mess
#endif
#ifdef NEED_mess
#define NEED_mess_nocontext
#define NEED_vmess
#endif
#ifndef croak_sv
#if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
# if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
# define D_PPP_FIX_UTF8_ERRSV_FOR_SV(sv) \
STMT_START { \
SV *_errsv = ERRSV; \
SvFLAGS(_errsv) = (SvFLAGS(_errsv) & ~SVf_UTF8) | \
(SvFLAGS(sv) & SVf_UTF8); \
} STMT_END
# else
# define D_PPP_FIX_UTF8_ERRSV_FOR_SV(sv) STMT_START {} STMT_END
# endif
PERL_STATIC_INLINE void D_PPP_croak_sv(SV *sv) {
dTHX;
SV *_sv = (sv);
if (SvROK(_sv)) {
sv_setsv(ERRSV, _sv);
croak(NULL);
} else {
D_PPP_FIX_UTF8_ERRSV_FOR_SV(_sv);
croak("%" SVf, SVfARG(_sv));
}
}
# define croak_sv(sv) D_PPP_croak_sv(sv)
#elif (PERL_BCDVERSION >= 0x5004000)
# define croak_sv(sv) croak("%" SVf, SVfARG(sv))
#else
# define croak_sv(sv) croak("%s", SvPV_nolen(sv))
#endif
#endif
#ifndef die_sv
#if defined(NEED_die_sv)
static OP * DPPP_(my_die_sv)(pTHX_ SV * baseex);
static
#else
extern OP * DPPP_(my_die_sv)(pTHX_ SV * baseex);
#endif
#if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
#ifdef die_sv
# undef die_sv
#endif
#define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
#define Perl_die_sv DPPP_(my_die_sv)
OP *
DPPP_(my_die_sv)(pTHX_ SV *baseex)
{
croak_sv(baseex);
return (OP *)NULL;
}
#endif
#endif
#ifndef warn_sv
#if (PERL_BCDVERSION >= 0x5004000)
# define warn_sv(sv) warn("%" SVf, SVfARG(sv))
#else
# define warn_sv(sv) warn("%s", SvPV_nolen(sv))
#endif
#endif
#if ! defined vmess && (PERL_BCDVERSION >= 0x5004000)
# if defined(NEED_vmess)
static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
static
#else
extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
#endif
#if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
#ifdef vmess
# undef vmess
#endif
#define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
#define Perl_vmess DPPP_(my_vmess)
SV*
DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
{
mess(pat, args);
return PL_mess_sv;
}
# endif
#endif
#if (PERL_BCDVERSION < 0x5006000) && (PERL_BCDVERSION >= 0x5004000)
#undef mess
#endif
#if !defined(mess_nocontext) && !defined(Perl_mess_nocontext) && (PERL_BCDVERSION >= 0x5004000)
#if defined(NEED_mess_nocontext)
static SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
static
#else
extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
#endif
#if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
#define mess_nocontext DPPP_(my_mess_nocontext)
#define Perl_mess_nocontext DPPP_(my_mess_nocontext)
SV*
DPPP_(my_mess_nocontext)(const char* pat, ...)
{
dTHX;
SV *sv;
va_list args;
va_start(args, pat);
sv = vmess(pat, &args);
va_end(args);
return sv;
}
#endif
#endif
#ifndef mess
#if defined(NEED_mess)
static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
static
#else
extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
#endif
#if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
#define Perl_mess DPPP_(my_mess)
SV*
DPPP_(my_mess)(pTHX_ const char* pat, ...)
{
SV *sv;
va_list args;
va_start(args, pat);
sv = vmess(pat, &args);
va_end(args);
return sv;
}
#ifdef mess_nocontext
#define mess mess_nocontext
#else
#define mess Perl_mess_nocontext
#endif
#endif
#endif
#if ! defined mess_sv && (PERL_BCDVERSION >= 0x5004000)
#if defined(NEED_mess_sv)
static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
static
#else
extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
#endif
#if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
#ifdef mess_sv
# undef mess_sv
#endif
#define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
#define Perl_mess_sv DPPP_(my_mess_sv)
SV *
DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
{
SV *tmp;
SV *ret;
if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
if (consume)
return basemsg;
ret = mess("");
SvSetSV_nosteal(ret, basemsg);
return ret;
}
if (consume) {
sv_catsv(basemsg, mess(""));
return basemsg;
}
ret = mess("");
tmp = newSVsv(ret);
SvSetSV_nosteal(ret, basemsg);
sv_catsv(ret, tmp);
sv_dec(tmp);
return ret;
}
#endif
#endif
#ifndef warn_nocontext
#define warn_nocontext warn
#endif
#ifndef croak_nocontext
#define croak_nocontext croak
#endif
#ifndef croak_no_modify
#define croak_no_modify() croak_nocontext("%s", PL_no_modify)
#define Perl_croak_no_modify() croak_no_modify()
#endif
#ifndef croak_memory_wrap
#if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
# define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
#else
# define croak_memory_wrap() croak_nocontext("panic: memory wrap")
#endif
#endif
#ifndef croak_xs_usage
#if defined(NEED_croak_xs_usage)
static void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
static
#else
extern void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
#endif
#if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
#define croak_xs_usage DPPP_(my_croak_xs_usage)
#define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
void
DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
{
dTHX;
const GV *const gv = CvGV(cv);
PERL_ARGS_ASSERT_CROAK_XS_USAGE;
if (gv) {
const char *const gvname = GvNAME(gv);
const HV *const stash = GvSTASH(gv);
const char *const hvname = stash ? HvNAME(stash) : NULL;
if (hvname)
croak("Usage: %s::%s(%s)", hvname, gvname, params);
else
croak("Usage: %s(%s)", gvname, params);
} else {
/* Pants. I don't think that it should be possible to get here. */
croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
}
}
#endif
#endif
#endif
#ifndef mPUSHs
# define mPUSHs(s) PUSHs(sv_2mortal(s))
#endif
#ifndef PUSHmortal
# define PUSHmortal PUSHs(sv_newmortal())
#endif
#ifndef mPUSHp
# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
#endif
#ifndef mPUSHn
# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
#endif
#ifndef mPUSHi
# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
#endif
#ifndef mPUSHu
# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
#endif
#ifndef mXPUSHs
# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
#endif
#ifndef XPUSHmortal
# define XPUSHmortal XPUSHs(sv_newmortal())
#endif
#ifndef mXPUSHp
# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
#endif
#ifndef mXPUSHn
# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
#endif
#ifndef mXPUSHi
# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
#endif
#ifndef mXPUSHu
# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
#endif
/* Replace: 1 */
#ifndef call_sv
# define call_sv perl_call_sv
#endif
#ifndef call_pv
# define call_pv perl_call_pv
#endif
#ifndef call_argv
# define call_argv perl_call_argv
#endif
#ifndef call_method
# define call_method perl_call_method
#endif
#ifndef eval_sv
# define eval_sv perl_eval_sv
#endif
#if (PERL_BCDVERSION >= 0x5003098) && (PERL_BCDVERSION < 0x5006000)
#ifndef eval_pv
# define eval_pv perl_eval_pv
#endif
#endif
/* Replace: 0 */
#if (PERL_BCDVERSION < 0x5006000)
#ifndef Perl_eval_sv
# define Perl_eval_sv perl_eval_sv
#endif
#if (PERL_BCDVERSION >= 0x5003098)
#ifndef Perl_eval_pv
# define Perl_eval_pv perl_eval_pv
#endif
#endif
#endif
#ifndef G_LIST
# define G_LIST G_ARRAY /* Replace */
#endif
#ifndef PERL_LOADMOD_DENY
# define PERL_LOADMOD_DENY 0x1
#endif
#ifndef PERL_LOADMOD_NOIMPORT
# define PERL_LOADMOD_NOIMPORT 0x2
#endif
#ifndef PERL_LOADMOD_IMPORT_OPS
# define PERL_LOADMOD_IMPORT_OPS 0x4
#endif
#if defined(PERL_USE_GCC_BRACE_GROUPS)
# define D_PPP_CROAK_IF_ERROR(cond) ({ \
SV *_errsv; \
( (cond) \
&& (_errsv = ERRSV) \
&& (SvROK(_errsv) || SvTRUE(_errsv)) \
&& (croak_sv(_errsv), 1)); \
})
#else
PERL_STATIC_INLINE void D_PPP_CROAK_IF_ERROR(int cond) {
dTHX;
SV *errsv;
if (!cond) return;
errsv = ERRSV;
if (SvROK(errsv) || SvTRUE(errsv)) croak_sv(errsv);
}
# define D_PPP_CROAK_IF_ERROR(cond) D_PPP_CROAK_IF_ERROR(cond)
#endif
#ifndef G_METHOD
# define G_METHOD 64
# ifdef call_sv
# undef call_sv
# endif
# if (PERL_BCDVERSION < 0x5006000)
# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : perl_call_sv(sv, flags))
# else
# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
# endif
#endif
#ifndef G_RETHROW
# define G_RETHROW 8192
# ifdef eval_sv
# undef eval_sv
# endif
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define eval_sv(sv, flags) ({ I32 _flags = (flags); I32 _ret = Perl_eval_sv(aTHX_ sv, (_flags & ~G_RETHROW)); D_PPP_CROAK_IF_ERROR(_flags & G_RETHROW); _ret; })
# else
# define eval_sv(sv, flags) ((PL_na = Perl_eval_sv(aTHX_ sv, ((flags) & ~G_RETHROW))), D_PPP_CROAK_IF_ERROR((flags) & G_RETHROW), (I32)PL_na)
# endif
#endif
/* Older Perl versions have broken croak_on_error=1 */
#if (PERL_BCDVERSION < 0x5031002)
# ifdef eval_pv
# undef eval_pv
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define eval_pv(p, croak_on_error) ({ SV *_sv = Perl_eval_pv(aTHX_ p, 0); D_PPP_CROAK_IF_ERROR(croak_on_error); _sv; })
# else
# define eval_pv(p, croak_on_error) ((PL_Sv = Perl_eval_pv(aTHX_ p, 0)), D_PPP_CROAK_IF_ERROR(croak_on_error), PL_Sv)
# endif
# endif
#endif
/* This is backport for Perl 5.3.97d and older which do not provide perl_eval_pv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV * DPPP_(my_eval_pv)(const char * p, I32 croak_on_error);
static
#else
extern SV * DPPP_(my_eval_pv)(const char * p, I32 croak_on_error);
#endif
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
SV*
DPPP_(my_eval_pv)(const char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
SPAGAIN;
sv = POPs;
PUTBACK;
D_PPP_CROAK_IF_ERROR(croak_on_error);
return sv;
}
#endif
#endif
#if ! defined(vload_module) && defined(start_subparse)
#if defined(NEED_vload_module)
static void DPPP_(my_vload_module)(U32 flags, SV * name, SV * ver, va_list * args);
static
#else
extern void DPPP_(my_vload_module)(U32 flags, SV * name, SV * ver, va_list * args);
#endif
#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
#ifdef vload_module
# undef vload_module
#endif
#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
#define Perl_vload_module DPPP_(my_vload_module)
void
DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
{
dTHR;
dVAR;
OP *veop, *imop;
OP * const modname = newSVOP(OP_CONST, 0, name);
/* 5.005 has a somewhat hacky force_normal that doesn't croak on
SvREADONLY() if PL_compiling is true. Current perls take care in
ck_require() to correctly turn off SvREADONLY before calling
force_normal_flags(). This seems a better fix than fudging PL_compiling
*/
SvREADONLY_off(((SVOP*)modname)->op_sv);
modname->op_private |= OPpCONST_BARE;
if (ver) {
veop = newSVOP(OP_CONST, 0, ver);
}
else
veop = NULL;
if (flags & PERL_LOADMOD_NOIMPORT) {
imop = sawparens(newNULLLIST());
}
else if (flags & PERL_LOADMOD_IMPORT_OPS) {
imop = va_arg(*args, OP*);
}
else {
SV *sv;
imop = NULL;
sv = va_arg(*args, SV*);
while (sv) {
imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
sv = va_arg(*args, SV*);
}
}
{
const line_t ocopline = PL_copline;
COP * const ocurcop = PL_curcop;
const int oexpect = PL_expect;
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
#if (PERL_BCDVERSION > 0x5003000)
veop,
#endif
modname, imop);
PL_expect = oexpect;
PL_copline = ocopline;
PL_curcop = ocurcop;
}
}
#endif
#endif
#ifndef load_module
#if defined(NEED_load_module)
static void DPPP_(my_load_module)(U32 flags, SV * name, SV * ver, ...);
static
#else
extern void DPPP_(my_load_module)(U32 flags, SV * name, SV * ver, ...);
#endif
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
#ifdef load_module
# undef load_module
#endif
#define load_module DPPP_(my_load_module)
#define Perl_load_module DPPP_(my_load_module)
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
}
#endif
#endif
#ifndef newRV_inc
# define newRV_inc(sv) newRV(sv) /* Replace */
#endif
#ifndef newRV_noinc
#if defined(PERL_USE_GCC_BRACE_GROUPS)
# define newRV_noinc(sv) ({ SV *_sv = (SV *)newRV((sv)); SvREFCNT_dec((sv)); _sv; })
#else
# define newRV_noinc(sv) ((PL_Sv = (SV *)newRV((sv))), SvREFCNT_dec((sv)), PL_Sv)
#endif
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* MY_CXT.member.
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
#ifndef START_MY_CXT
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define START_MY_CXT
#if (PERL_BCDVERSION < 0x5004068)
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV \
SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
sizeof(MY_CXT_KEY)-1, TRUE)
#endif /* < perl5.004_68 */
/* This declaration should be used within all functions that use the
* interpreter-local data. */
#define dMY_CXT \
dMY_CXT_SV; \
my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
/* Creates and zeroes the per-interpreter data.
* (We allocate my_cxtp in a Perl SV so that it will be released when
* the interpreter goes away.) */
#define MY_CXT_INIT \
dMY_CXT_SV; \
/* newSV() allocates one more than needed */ \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Zero(my_cxtp, 1, my_cxt_t); \
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define MY_CXT (*my_cxtp)
/* Judicious use of these macros can reduce the number of times dMY_CXT
* is used. Use is similar to pTHX, aTHX etc. */
#define pMY_CXT my_cxt_t *my_cxtp
#define pMY_CXT_ pMY_CXT,
#define _pMY_CXT ,pMY_CXT
#define aMY_CXT my_cxtp
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT ,aMY_CXT
#endif /* START_MY_CXT */
#ifndef MY_CXT_CLONE
/* Clones the per-interpreter data. */
#define MY_CXT_CLONE \
dMY_CXT_SV; \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
#endif
#else /* single interpreter */
#ifndef START_MY_CXT
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
#define MY_CXT_INIT NOOP
#define MY_CXT my_cxt
#define pMY_CXT void
#define pMY_CXT_
#define _pMY_CXT
#define aMY_CXT
#define aMY_CXT_
#define _aMY_CXT
#endif /* START_MY_CXT */
#ifndef MY_CXT_CLONE
#define MY_CXT_CLONE NOOP
#endif
#endif
#ifndef SvREFCNT_inc
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define SvREFCNT_inc(sv) \
({ \
SV * const _sv = (SV*)(sv); \
if (_sv) \
(SvREFCNT(_sv))++; \
_sv; \
})
# else
# define SvREFCNT_inc(sv) \
((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
# endif
#endif
#ifndef SvREFCNT_inc_simple
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define SvREFCNT_inc_simple(sv) \
({ \
if (sv) \
(SvREFCNT(sv))++; \
(SV *)(sv); \
})
# else
# define SvREFCNT_inc_simple(sv) \
((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
# endif
#endif
#ifndef SvREFCNT_inc_NN
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define SvREFCNT_inc_NN(sv) \
({ \
SV * const _sv = (SV*)(sv); \
SvREFCNT(_sv)++; \
_sv; \
})
# else
# define SvREFCNT_inc_NN(sv) \
(PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
# endif
#endif
#ifndef SvREFCNT_inc_void
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define SvREFCNT_inc_void(sv) \
({ \
SV * const _sv = (SV*)(sv); \
if (_sv) \
(void)(SvREFCNT(_sv)++); \
})
# else
# define SvREFCNT_inc_void(sv) \
(void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
# endif
#endif
/* not as efficient as the real thing, but it works */
#ifndef SvREFCNT_dec_NN
# define SvREFCNT_dec_NN(sv) SvREFCNT_dec(sv)
#endif
#ifndef SvREFCNT_inc_simple_void
# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
#endif
#ifndef SvREFCNT_inc_simple_NN
# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
#endif
#ifndef SvREFCNT_inc_void_NN
# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
#ifndef SvREFCNT_inc_simple_void_NN
# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
#ifndef newSV_type
#if defined(PERL_USE_GCC_BRACE_GROUPS)
# define newSV_type(t) ({ SV *_sv = newSV(0); sv_upgrade(_sv, (t)); _sv; })
#else
# define newSV_type(t) ((PL_Sv = newSV(0)), sv_upgrade(PL_Sv, (t)), PL_Sv)
#endif
#endif
#if (PERL_BCDVERSION < 0x5006000)
# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
#else
# define D_PPP_CONSTPV_ARG(x) (x)
#endif
#ifndef newSVpvn
# define newSVpvn(data,len) ((data) \
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
: newSV(0))
#endif
#ifndef newSVpvn_utf8
# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
#endif
#ifndef SVf_UTF8
# define SVf_UTF8 0
#endif
#ifndef newSVpvn_flags
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define newSVpvn_flags(s, len, flags) \
({ \
SV * sv = newSVpvn(D_PPP_CONSTPV_ARG(s), (len)); \
SvFLAGS(sv) |= ((flags) & SVf_UTF8); \
if ((flags) & SVs_TEMP) sv = sv_2mortal(sv); \
sv; \
})
# else
PERL_STATIC_INLINE SV* D_PPP_newSVpvn_flags(const char *const s, const STRLEN len, const U32 flags)
{
dTHX;
SV * sv = newSVpvn(s, len);
SvFLAGS(sv) |= (flags & SVf_UTF8);
if (flags & SVs_TEMP) return sv_2mortal(sv);
return sv;
}
# define newSVpvn_flags(s, len, flags) D_PPP_newSVpvn_flags((s), (len), (flags))
# endif
#endif
#ifndef SV_NOSTEAL
# define SV_NOSTEAL 16
#endif
#if ( (PERL_BCDVERSION >= 0x5007003) && (PERL_BCDVERSION < 0x5008007) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009002) )
#undef sv_setsv_flags
#if defined(PERL_USE_GCC_BRACE_GROUPS)
#define sv_setsv_flags(dstr, sstr, flags) \
STMT_START { \
if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \
SvTEMP_off((SV *)(sstr)); \
Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL); \
SvTEMP_on((SV *)(sstr)); \
} else { \
Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL); \
} \
} STMT_END
#else
#define sv_setsv_flags(dstr, sstr, flags) \
( \
(((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? ( \
SvTEMP_off((SV *)(sstr)), \
Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL), \
SvTEMP_on((SV *)(sstr)), \
1 \
) : ( \
Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL), \
1 \
) \
)
#endif
#endif
#if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef sv_setsv_flags
# define sv_setsv_flags(dstr, sstr, flags) \
STMT_START { \
if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \
SvTEMP_off((SV *)(sstr)); \
if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) { \
SvGMAGICAL_off((SV *)(sstr)); \
sv_setsv((dstr), (sstr)); \
SvGMAGICAL_on((SV *)(sstr)); \
} else { \
sv_setsv((dstr), (sstr)); \
} \
SvTEMP_on((SV *)(sstr)); \
} else { \
if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) { \
SvGMAGICAL_off((SV *)(sstr)); \
sv_setsv((dstr), (sstr)); \
SvGMAGICAL_on((SV *)(sstr)); \
} else { \
sv_setsv((dstr), (sstr)); \
} \
} \
} STMT_END
#endif
#else
#ifndef sv_setsv_flags
# define sv_setsv_flags(dstr, sstr, flags) \
( \
(((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? ( \
SvTEMP_off((SV *)(sstr)), \
(!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? ( \
SvGMAGICAL_off((SV *)(sstr)), \
sv_setsv((dstr), (sstr)), \
SvGMAGICAL_on((SV *)(sstr)), \
1 \
) : ( \
sv_setsv((dstr), (sstr)), \
1 \
), \
SvTEMP_on((SV *)(sstr)), \
1 \
) : ( \
(!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? ( \
SvGMAGICAL_off((SV *)(sstr)), \
sv_setsv((dstr), (sstr)), \
SvGMAGICAL_on((SV *)(sstr)), \
1 \
) : ( \
sv_setsv((dstr), (sstr)), \
1 \
) \
) \
)
#endif
#endif
#ifndef newSVsv_flags
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define newSVsv_flags(sv, flags) \
({ \
SV *n= newSV(0); \
sv_setsv_flags(n, (sv), (flags)); \
n; \
})
# else
PERL_STATIC_INLINE SV* D_PPP_newSVsv_flags(SV *const old, I32 flags)
{
dTHX;
SV *n= newSV(0);
sv_setsv_flags(n, old, flags);
return n;
}
# define newSVsv_flags(sv, flags) D_PPP_newSVsv_flags(sv, flags)
# endif
#endif
#ifndef newSVsv_nomg
# define newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL)
#endif
#if (PERL_BCDVERSION >= 0x5017005)
#ifndef sv_mortalcopy_flags
# define sv_mortalcopy_flags(sv, flags) Perl_sv_mortalcopy_flags(aTHX_ (sv), (flags))
#endif
#else
#ifndef sv_mortalcopy_flags
# define sv_mortalcopy_flags(sv, flags) sv_2mortal(newSVsv_flags((sv), (flags)))
#endif
#endif
#ifndef SvMAGIC_set
# define SvMAGIC_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
(((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
#endif
#if (PERL_BCDVERSION < 0x5009003)
#ifndef SvPVX_const
# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
#endif
#ifndef SvPVX_mutable
# define SvPVX_mutable(sv) (0 + SvPVX(sv))
#endif
#ifndef SvRV_set
# define SvRV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
(((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
#endif
#else
#ifndef SvPVX_const
# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
#endif
#ifndef SvPVX_mutable
# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
#endif
#ifndef SvRV_set
# define SvRV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
((sv)->sv_u.svu_rv = (val)); } STMT_END
#endif
#endif
#ifndef SvSTASH_set
# define SvSTASH_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
(((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
#endif
#if (PERL_BCDVERSION < 0x5004000)
#ifndef SvUV_set
# define SvUV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
(((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
#endif
#else
#ifndef SvUV_set
# define SvUV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
(((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
#endif
#endif
/* Hint: newSVpvn_share
* The SVs created by this function only mimic the behaviour of
* shared PVs without really being shared. Only use if you know
* what you're doing.
*/
#ifndef newSVpvn_share
#if defined(NEED_newSVpvn_share)
static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char * s, I32 len, U32 hash);
static
#else
extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char * s, I32 len, U32 hash);
#endif
#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
#ifdef newSVpvn_share
# undef newSVpvn_share
#endif
#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
SV *
DPPP_(my_newSVpvn_share)(pTHX_ const char *s, I32 len, U32 hash)
{
SV *sv;
if (len < 0)
len = -len;
if (!hash)
PERL_HASH(hash, (char*) s, len);
sv = newSVpvn((char *) s, len);
sv_upgrade(sv, SVt_PVIV);
SvIVX(sv) = hash;
SvREADONLY_on(sv);
SvPOK_on(sv);
return sv;
}
#endif
#endif
#ifndef SvSHARED_HASH
# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
#endif
#ifndef HvNAME_get
# define HvNAME_get(hv) HvNAME(hv)
#endif
#ifndef HvNAMELEN_get
# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
#if (PERL_BCDVERSION >= 0x5009002) && (PERL_BCDVERSION <= 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */
#undef gv_fetchpvn_flags
#endif
#ifdef GV_NOADD_MASK
# define D_PPP_GV_NOADD_MASK GV_NOADD_MASK
#else
# define D_PPP_GV_NOADD_MASK 0xE0
#endif
#ifndef gv_fetchpvn_flags
# define gv_fetchpvn_flags(name, len, flags, sv_type) gv_fetchpv(SvPVX(sv_2mortal(newSVpvn((name), (len)))), ((flags) & D_PPP_GV_NOADD_MASK) ? FALSE : TRUE, (I32)(sv_type))
#endif
#ifndef GvSVn
# define GvSVn(gv) GvSV(gv)
#endif
#ifndef isGV_with_GP
# define isGV_with_GP(gv) isGV(gv)
#endif
#ifndef gv_fetchsv
# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
#endif
#ifndef get_cvn_flags
# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
#endif
#ifndef gv_init_pvn
# define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
#endif
/* concatenating with "" ensures that only literal strings are accepted as argument
* note that STR_WITH_LEN() can't be used as argument to macros or functions that
* under some configurations might be macros
*/
#ifndef STR_WITH_LEN
# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
#endif
#ifndef newSVpvs
# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
#endif
#ifndef newSVpvs_flags
# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
#endif
#ifndef newSVpvs_share
# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
#endif
#ifndef sv_catpvs
# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
#endif
#ifndef sv_setpvs
# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
#endif
#ifndef hv_fetchs
# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
#endif
#ifndef hv_stores
# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
#endif
#ifndef gv_fetchpvs
# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
#endif
#ifndef gv_stashpvs
# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
#endif
#ifndef get_cvs
# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
#endif
#undef SvGETMAGIC
#ifndef SvGETMAGIC
# define SvGETMAGIC(x) ((void)(UNLIKELY(SvGMAGICAL(x)) && mg_get(x)))
#endif
/* That's the best we can do... */
#ifndef sv_catpvn_nomg
# define sv_catpvn_nomg sv_catpvn
#endif
#ifndef sv_catsv_nomg
# define sv_catsv_nomg sv_catsv
#endif
#ifndef sv_setsv_nomg
# define sv_setsv_nomg sv_setsv
#endif
#ifndef sv_pvn_nomg
# define sv_pvn_nomg sv_pvn
#endif
#ifdef SVf_IVisUV
#if defined(PERL_USE_GCC_BRACE_GROUPS)
#ifndef SvIV_nomg
# define SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ({ SV *_sviv = sv_mortalcopy_flags((sv), SV_NOSTEAL); IV _iv = SvIV(_sviv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_sviv) & SVf_IVisUV); _iv; }))
#endif
#ifndef SvUV_nomg
# define SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvUV((sv)) : ({ SV *_svuv = sv_mortalcopy_flags((sv), SV_NOSTEAL); UV _uv = SvUV(_svuv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_svuv) & SVf_IVisUV); _uv; }))
#endif
#else
#ifndef SvIV_nomg
# define SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ((PL_Sv = sv_mortalcopy_flags((sv), SV_NOSTEAL)), sv_upgrade(PL_Sv, SVt_PVIV), (SvIVX(PL_Sv) = SvIV(PL_Sv)), (SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(PL_Sv) & SVf_IVisUV)), SvIVX(PL_Sv)))
#endif
#ifndef SvUV_nomg
# define SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ((PL_Sv = sv_mortalcopy_flags((sv), SV_NOSTEAL)), sv_upgrade(PL_Sv, SVt_PVIV), (SvUVX(PL_Sv) = SvUV(PL_Sv)), (SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(PL_Sv) & SVf_IVisUV)), SvUVX(PL_Sv)))
#endif
#endif
#else
#ifndef SvIV_nomg
# define SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : SvIVx(sv_mortalcopy_flags((sv), SV_NOSTEAL)))
#endif
#ifndef SvUV_nomg
# define SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvUV((sv)) : SvUVx(sv_mortalcopy_flags((sv), SV_NOSTEAL)))
#endif
#endif
#ifndef SvNV_nomg
# define SvNV_nomg(sv) (!SvGMAGICAL((sv)) ? SvNV((sv)) : SvNVx(sv_mortalcopy_flags((sv), SV_NOSTEAL)))
#endif
#ifndef SvTRUE_nomg
# define SvTRUE_nomg(sv) (!SvGMAGICAL((sv)) ? SvTRUE((sv)) : SvTRUEx(sv_mortalcopy_flags((sv), SV_NOSTEAL)))
#endif
#ifndef sv_catpv_mg
# define sv_catpv_mg(sv, ptr) \
STMT_START { \
SV *TeMpSv = sv; \
sv_catpv(TeMpSv,ptr); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_catpvn_mg
# define sv_catpvn_mg(sv, ptr, len) \
STMT_START { \
SV *TeMpSv = sv; \
sv_catpvn(TeMpSv,ptr,len); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_catsv_mg
# define sv_catsv_mg(dsv, ssv) \
STMT_START { \
SV *TeMpSv = dsv; \
sv_catsv(TeMpSv,ssv); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setiv_mg
# define sv_setiv_mg(sv, i) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setiv(TeMpSv,i); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setnv_mg
# define sv_setnv_mg(sv, num) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setnv(TeMpSv,num); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setpv_mg
# define sv_setpv_mg(sv, ptr) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setpv(TeMpSv,ptr); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setpvn_mg
# define sv_setpvn_mg(sv, ptr, len) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setpvn(TeMpSv,ptr,len); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setsv_mg
# define sv_setsv_mg(dsv, ssv) \
STMT_START { \
SV *TeMpSv = dsv; \
sv_setsv(TeMpSv,ssv); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setuv_mg
# define sv_setuv_mg(sv, i) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setuv(TeMpSv,i); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_usepvn_mg
# define sv_usepvn_mg(sv, ptr, len) \
STMT_START { \
SV *TeMpSv = sv; \
sv_usepvn(TeMpSv,ptr,len); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef SvVSTRING_mg
# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
#endif
/* Hint: sv_magic_portable
* This is a compatibility function that is only available with
* Devel::PPPort. It is NOT in the perl core.
* Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
* it is being passed a name pointer with namlen == 0. In that
* case, perl 5.8.0 and later store the pointer, not a copy of it.
* The compatibility can be provided back to perl 5.004. With
* earlier versions, the code will not compile.
*/
#if (PERL_BCDVERSION < 0x5004000)
/* code that uses sv_magic_portable will not compile */
#elif (PERL_BCDVERSION < 0x5008000)
# define sv_magic_portable(sv, obj, how, name, namlen) \
STMT_START { \
SV *SvMp_sv = (sv); \
char *SvMp_name = (char *) (name); \
I32 SvMp_namlen = (namlen); \
if (SvMp_name && SvMp_namlen == 0) \
{ \
MAGIC *mg; \
sv_magic(SvMp_sv, obj, how, 0, 0); \
mg = SvMAGIC(SvMp_sv); \
mg->mg_len = -42; /* XXX: this is the tricky part */ \
mg->mg_ptr = SvMp_name; \
} \
else \
{ \
sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
} \
} STMT_END
#else
# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
#endif
#if !defined(mg_findext)
#if defined(NEED_mg_findext)
static MAGIC * DPPP_(my_mg_findext)(const SV * sv, int type, const MGVTBL * vtbl);
static
#else
extern MAGIC * DPPP_(my_mg_findext)(const SV * sv, int type, const MGVTBL * vtbl);
#endif
#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
#define mg_findext DPPP_(my_mg_findext)
#define Perl_mg_findext DPPP_(my_mg_findext)
MAGIC *
DPPP_(my_mg_findext)(const SV * sv, int type, const MGVTBL *vtbl) {
if (sv) {
MAGIC *mg;
#ifdef AvPAD_NAMELIST
assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
#endif
for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
if (mg->mg_type == type && mg->mg_virtual == vtbl)
return mg;
}
}
return NULL;
}
#endif
#endif
#if !defined(sv_unmagicext)
#if defined(NEED_sv_unmagicext)
static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, const MGVTBL * vtbl);
static
#else
extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, const MGVTBL * vtbl);
#endif
#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
#ifdef sv_unmagicext
# undef sv_unmagicext
#endif
#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
int
DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, const MGVTBL *vtbl)
{
MAGIC* mg;
MAGIC** mgp;
if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
return 0;
mgp = &(SvMAGIC(sv));
for (mg = *mgp; mg; mg = *mgp) {
const MGVTBL* const virt = mg->mg_virtual;
if (mg->mg_type == type && virt == vtbl) {
*mgp = mg->mg_moremagic;
if (virt && virt->svt_free)
virt->svt_free(aTHX_ sv, mg);
if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
if (mg->mg_len > 0)
Safefree(mg->mg_ptr);
else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
else if (mg->mg_type == PERL_MAGIC_utf8)
Safefree(mg->mg_ptr);
}
if (mg->mg_flags & MGf_REFCOUNTED)
SvREFCNT_dec(mg->mg_obj);
Safefree(mg);
}
else
mgp = &mg->mg_moremagic;
}
if (SvMAGIC(sv)) {
if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
mg_magical(sv); /* else fix the flags now */
}
else {
SvMAGICAL_off(sv);
SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
}
return 0;
}
#endif
#endif
#ifndef SvVSTRING
# define SvVSTRING(sv, len) (sv_vstring_get(sv, &(len)))
#endif
#ifndef SvVOK
# define SvVOK(sv) (FALSE)
#endif
#if !defined(sv_vstring_get)
#if defined(NEED_sv_vstring_get)
static const char * DPPP_(my_sv_vstring_get)(pTHX_ SV * sv, STRLEN * lenp);
static
#else
extern const char * DPPP_(my_sv_vstring_get)(pTHX_ SV * sv, STRLEN * lenp);
#endif
#if defined(NEED_sv_vstring_get) || defined(NEED_sv_vstring_get_GLOBAL)
#ifdef sv_vstring_get
# undef sv_vstring_get
#endif
#define sv_vstring_get(a,b) DPPP_(my_sv_vstring_get)(aTHX_ a,b)
#define Perl_sv_vstring_get DPPP_(my_sv_vstring_get)
const char *
DPPP_(my_sv_vstring_get)(pTHX_ SV *sv, STRLEN *lenp)
{
#ifdef SvVSTRING_mg
MAGIC *mg = SvVSTRING_mg(sv);
if (!mg) return NULL;
if (lenp) *lenp = mg->mg_len;
return mg->mg_ptr;
#else
return NULL;
#endif
}
#endif
#endif
#ifdef USE_ITHREADS
#ifndef CopFILE
# define CopFILE(c) ((c)->cop_file)
#endif
#ifndef CopFILEGV
# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
#endif
#ifndef CopFILE_set
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
#endif
#ifndef CopFILESV
# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
#endif
#ifndef CopFILEAV
# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
#endif
#ifndef CopSTASHPV
# define CopSTASHPV(c) ((c)->cop_stashpv)
#endif
#ifndef CopSTASHPV_set
# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
#endif
#ifndef CopSTASH
# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
#endif
#ifndef CopSTASH_set
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
#endif
#ifndef CopSTASH_eq
# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
|| (CopSTASHPV(c) && HvNAME(hv) \
&& strEQ(CopSTASHPV(c), HvNAME(hv)))))
#endif
#else
#ifndef CopFILEGV
# define CopFILEGV(c) ((c)->cop_filegv)
#endif
#ifndef CopFILEGV_set
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
#endif
#ifndef CopFILE_set
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
#endif
#ifndef CopFILESV
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
#endif
#ifndef CopFILEAV
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
#endif
#ifndef CopFILE
# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
#endif
#ifndef CopSTASH
# define CopSTASH(c) ((c)->cop_stash)
#endif
#ifndef CopSTASH_set
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
#endif
#ifndef CopSTASHPV
# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
#endif
#ifndef CopSTASHPV_set
# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
#endif
#ifndef CopSTASH_eq
# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
#endif
#endif /* USE_ITHREADS */
#if (PERL_BCDVERSION >= 0x5006000)
#ifndef caller_cx
# if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
static I32
DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
{
I32 i;
for (i = startingblock; i >= 0; i--) {
const PERL_CONTEXT * const cx = &cxstk[i];
switch (CxTYPE(cx)) {
default:
continue;
case CXt_EVAL:
case CXt_SUB:
case CXt_FORMAT:
return i;
}
}
return i;
}
# endif
# if defined(NEED_caller_cx)
static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 level, const PERL_CONTEXT * * dbcxp);
static
#else
extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 level, const PERL_CONTEXT * * dbcxp);
#endif
#if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
#ifdef caller_cx
# undef caller_cx
#endif
#define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
#define Perl_caller_cx DPPP_(my_caller_cx)
const PERL_CONTEXT *
DPPP_(my_caller_cx)(pTHX_ I32 level, const PERL_CONTEXT **dbcxp)
{
I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
const PERL_CONTEXT *cx;
const PERL_CONTEXT *ccstack = cxstack;
const PERL_SI *top_si = PL_curstackinfo;
for (;;) {
/* we may be in a higher stacklevel, so dig down deeper */
while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
top_si = top_si->si_prev;
ccstack = top_si->si_cxstack;
cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
}
if (cxix < 0)
return NULL;
/* caller() should not report the automatic calls to &DB::sub */
if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
level++;
if (!level--)
break;
cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
}
cx = &ccstack[cxix];
if (dbcxp) *dbcxp = cx;
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
/* caller() should not report the automatic calls to &DB::sub */
if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
cx = &ccstack[dbcxix];
}
return cx;
}
# endif
#endif /* caller_cx */
#endif /* 5.6.0 */
#ifndef IN_PERL_COMPILETIME
# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
#endif
#ifndef IN_LOCALE_RUNTIME
# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
#endif
#ifndef IN_LOCALE_COMPILETIME
# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
#endif
#ifndef IN_LOCALE
# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
#endif
#ifndef IS_NUMBER_IN_UV
# define IS_NUMBER_IN_UV 0x01
#endif
#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
#endif
#ifndef IS_NUMBER_NOT_INT
# define IS_NUMBER_NOT_INT 0x04
#endif
#ifndef IS_NUMBER_NEG
# define IS_NUMBER_NEG 0x08
#endif
#ifndef IS_NUMBER_INFINITY
# define IS_NUMBER_INFINITY 0x10
#endif
#ifndef IS_NUMBER_NAN
# define IS_NUMBER_NAN 0x20
#endif
#ifndef GROK_NUMERIC_RADIX
# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
#endif
#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
#endif
#ifndef PERL_SCAN_SILENT_ILLDIGIT
# define PERL_SCAN_SILENT_ILLDIGIT 0x04
#endif
#ifndef PERL_SCAN_ALLOW_UNDERSCORES
# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
#endif
#ifndef PERL_SCAN_DISALLOW_PREFIX
# define PERL_SCAN_DISALLOW_PREFIX 0x02
#endif
#ifndef grok_numeric_radix
#if defined(NEED_grok_numeric_radix)
static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char * * sp, const char * send);
static
#else
extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char * * sp, const char * send);
#endif
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
#ifdef grok_numeric_radix
# undef grok_numeric_radix
#endif
#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
bool
DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#ifdef PL_numeric_radix_sv
if (PL_numeric_radix_sv && IN_LOCALE) {
STRLEN len;
char* radix = SvPV(PL_numeric_radix_sv, len);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#else
/* older perls don't have PL_numeric_radix_sv so the radix
* must manually be requested from locale.h
*/
#include <locale.h>
dTHR; /* needed for older threaded perls */
struct lconv *lc = localeconv();
char *radix = lc->decimal_point;
if (radix && IN_LOCALE) {
STRLEN len = strlen(radix);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#endif
#endif /* USE_LOCALE_NUMERIC */
/* always try "." if numeric radix didn't match because
* we may have data from different locales mixed */
if (*sp < send && **sp == '.') {
++*sp;
return TRUE;
}
return FALSE;
}
#endif
#endif
#ifndef grok_number
#if defined(NEED_grok_number)
static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
static
#else
extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
#endif
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
#ifdef grok_number
# undef grok_number
#endif
#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
#define Perl_grok_number DPPP_(my_grok_number)
int
DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
const UV max_div_10 = UV_MAX / 10;
const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
int sawinf = 0;
int sawnan = 0;
while (s < send && isSPACE(*s))
s++;
if (s == send) {
return 0;
} else if (*s == '-') {
s++;
numtype = IS_NUMBER_NEG;
}
else if (*s == '+')
s++;
if (s == send)
return 0;
/* next must be digit or the radix separator or beginning of infinity */
if (isDIGIT(*s)) {
/* UVs are at least 32 bits, so the first 9 decimal digits cannot
overflow. */
UV value = *s - '0';
/* This construction seems to be more optimiser friendly.
(without it gcc does the isDIGIT test and the *s - '0' separately)
With it gcc on arm is managing 6 instructions (6 cycles) per digit.
In theory the optimiser could deduce how far to unroll the loop
before checking for overflow. */
if (++s < send) {
int digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
/* Now got 9 digits, so need to check
each time for overflow. */
digit = *s - '0';
while (digit >= 0 && digit <= 9
&& (value < max_div_10
|| (value == max_div_10
&& digit <= max_mod_10))) {
value = value * 10 + digit;
if (++s < send)
digit = *s - '0';
else
break;
}
if (digit >= 0 && digit <= 9
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
worry about setting *valuep. */
do {
s++;
} while (s < send && isDIGIT(*s));
numtype |=
IS_NUMBER_GREATER_THAN_UV_MAX;
goto skip_value;
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
numtype |= IS_NUMBER_IN_UV;
if (valuep)
*valuep = value;
skip_value:
if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT;
while (s < send && isDIGIT(*s)) /* optional digits after the radix */
s++;
}
}
else if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
/* no digits before the radix means we need digits after it */
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
if (valuep) {
/* integer approximation is valid - it's 0. */
*valuep = 0;
}
}
else
return 0;
} else if (*s == 'I' || *s == 'i') {
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
s++; if (s < send && (*s == 'I' || *s == 'i')) {
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
return 0;
if (sawinf) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
} else if (sawnan) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
} else if (s < send) {
/* we can have an optional exponent part */
if (*s == 'e' || *s == 'E') {
/* The only flag we keep is sign. Blow away any "it's UV" */
numtype &= IS_NUMBER_NEG;
numtype |= IS_NUMBER_NOT_INT;
s++;
if (s < send && (*s == '-' || *s == '+'))
s++;
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
}
else
return 0;
}
}
while (s < send && isSPACE(*s))
s++;
if (s >= send)
return numtype;
if (len == 10 && memEQ(pv, "0 but true", 10)) {
if (valuep)
*valuep = 0;
return IS_NUMBER_IN_UV;
}
return 0;
}
#endif
#endif
/*
* The grok_* routines have been modified to use warn() instead of
* Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading b or 0b.
for compatibility silently suffer "b" and "0b" as valid binary
numbers. */
if (len >= 1) {
if (s[0] == 'b') {
s++;
len--;
}
else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
s+=2;
len-=2;
}
}
}
for (; len-- && *s; s++) {
char bit = *s;
if (bit == '0' || bit == '1') {
/* Write it in this wonky order with a goto to attempt to get the
compiler to make the common case integer-only loop pretty tight.
With gcc seems to be much straighter code than old scan_bin. */
redo:
if (!overflowed) {
if (value <= max_div_2) {
value = (value << 1) | (bit - '0');
continue;
}
/* Bah. We're just overflowed. */
warn("Integer overflow in binary number");
overflowed = TRUE;
value_nv = (NV) value;
}
value_nv *= 2.0;
/* If an NV has not enough bits in its mantissa to
* represent a UV this summing of small low-order numbers
* is a waste of time (because the NV cannot preserve
* the low-order bits anyway): we could just remember when
* did we overflow and in the end just multiply value_nv by the
* right amount. */
value_nv += (NV)(bit - '0');
continue;
}
if (bit == '_' && len && allow_underscores && (bit = s[1])
&& (bit == '0' || bit == '1'))
{
--len;
++s;
goto redo;
}
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
warn("Illegal binary digit '%c' ignored", *s);
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
const char *xdigit;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading x or 0x.
for compatibility silently suffer "x" and "0x" as valid hex numbers.
*/
if (len >= 1) {
if (s[0] == 'x') {
s++;
len--;
}
else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
s+=2;
len-=2;
}
}
}
for (; len-- && *s; s++) {
xdigit = strchr((char *) PL_hexdigit, *s);
if (xdigit) {
/* Write it in this wonky order with a goto to attempt to get the
compiler to make the common case integer-only loop pretty tight.
With gcc seems to be much straighter code than old scan_hex. */
redo:
if (!overflowed) {
if (value <= max_div_16) {
value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
continue;
}
warn("Integer overflow in hexadecimal number");
overflowed = TRUE;
value_nv = (NV) value;
}
value_nv *= 16.0;
/* If an NV has not enough bits in its mantissa to
* represent a UV this summing of small low-order numbers
* is a waste of time (because the NV cannot preserve
* the low-order bits anyway): we could just remember when
* did we overflow and in the end just multiply value_nv by the
* right amount of 16-tuples. */
value_nv += (NV)((xdigit - PL_hexdigit) & 15);
continue;
}
if (*s == '_' && len && allow_underscores && s[1]
&& (xdigit = strchr((char *) PL_hexdigit, s[1])))
{
--len;
++s;
goto redo;
}
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
warn("Illegal hexadecimal digit '%c' ignored", *s);
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
for (; len-- && *s; s++) {
/* gcc 2.95 optimiser not smart enough to figure that this subtraction
out front allows slicker code. */
int digit = *s - '0';
if (digit >= 0 && digit <= 7) {
/* Write it in this wonky order with a goto to attempt to get the
compiler to make the common case integer-only loop pretty tight.
*/
redo:
if (!overflowed) {
if (value <= max_div_8) {
value = (value << 3) | digit;
continue;
}
/* Bah. We're just overflowed. */
warn("Integer overflow in octal number");
overflowed = TRUE;
value_nv = (NV) value;
}
value_nv *= 8.0;
/* If an NV has not enough bits in its mantissa to
* represent a UV this summing of small low-order numbers
* is a waste of time (because the NV cannot preserve
* the low-order bits anyway): we could just remember when
* did we overflow and in the end just multiply value_nv by the
* right amount of 8-tuples. */
value_nv += (NV)digit;
continue;
}
if (digit == ('_' - '0') && len && allow_underscores
&& (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
{
--len;
++s;
goto redo;
}
/* Allow \octal to work the DWIM way (that is, stop scanning
* as soon as non-octal characters are seen, complain only iff
* someone seems to want to use the digits eight and nine). */
if (digit == 8 || digit == 9) {
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
warn("Illegal octal digit '%c' ignored", *s);
}
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#if !defined(my_snprintf)
#if defined(NEED_my_snprintf)
static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
static
#else
extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
#endif
#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
#define my_snprintf DPPP_(my_my_snprintf)
#define Perl_my_snprintf DPPP_(my_my_snprintf)
int
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
{
dTHX;
int retval;
va_list ap;
va_start(ap, format);
#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
#else
retval = vsprintf(buffer, format, ap);
#endif
va_end(ap);
if (retval < 0 || (len > 0 && (Size_t)retval >= len))
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
return retval;
}
#endif
#endif
#if !defined(my_sprintf)
#if defined(NEED_my_sprintf)
static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
static
#else
extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
#endif
#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
#define my_sprintf DPPP_(my_my_sprintf)
/* Warning: my_sprintf
It's safer to use my_snprintf instead
*/
/* Replace my_sprintf with my_snprintf */
int
DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
{
va_list args;
va_start(args, pat);
vsprintf(buffer, pat, args);
va_end(args);
return strlen(buffer);
}
#endif
#endif
#ifdef NO_XSLOCKS
# ifdef dJMPENV
# define dXCPT dJMPENV; int rEtV = 0
# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
# define XCPT_TRY_END JMPENV_POP;
# define XCPT_CATCH if (rEtV != 0)
# define XCPT_RETHROW JMPENV_JUMP(rEtV)
# else
# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
# define XCPT_CATCH if (rEtV != 0)
# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
# endif
#endif
#if !defined(my_strlcat)
#if defined(NEED_my_strlcat)
static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
static
#else
extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
#endif
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
#define my_strlcat DPPP_(my_my_strlcat)
#define Perl_my_strlcat DPPP_(my_my_strlcat)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy)
static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
static
#else
extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
#endif
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
#define my_strlcpy DPPP_(my_my_strlcpy)
#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
#ifdef SVf_UTF8
#ifndef SvUTF8
# define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8)
#endif
#endif
#if (PERL_BCDVERSION == 0x5019001) /* 5.19.1 does not have UTF8fARG, only broken UTF8f */
#undef UTF8f
#endif
#ifdef SVf_UTF8
#ifndef UTF8f
# define UTF8f SVf
#endif
#ifndef UTF8fARG
# define UTF8fARG(u,l,p) newSVpvn_flags((p), (l), ((u) ? SVf_UTF8 : 0) | SVs_TEMP)
#endif
#endif
#define D_PPP_MIN(a,b) (((a) <= (b)) ? (a) : (b))
#ifndef UNICODE_REPLACEMENT
# define UNICODE_REPLACEMENT 0xFFFD
#endif
#ifdef UTF8_MAXLEN
#ifndef UTF8_MAXBYTES
# define UTF8_MAXBYTES UTF8_MAXLEN
#endif
#endif
#ifndef UTF_START_MARK
# define UTF_START_MARK(len) \
(((len) > 7) ? 0xFF : (0xFF & (0xFE << (7-(len)))))
#endif
/* On non-EBCDIC was valid for some releases earlier than this, but easier to
* just do one check */
#if (PERL_BCDVERSION < 0x5018000)
# undef UTF8_MAXBYTES_CASE
#endif
#if 'A' == 65
# define D_PPP_BYTE_INFO_BITS 6 /* 6 bits meaningful in continuation bytes */
#ifndef UTF8_MAXBYTES_CASE
# define UTF8_MAXBYTES_CASE 13
#endif
#else
# define D_PPP_BYTE_INFO_BITS 5 /* 5 bits meaningful in continuation bytes */
#ifndef UTF8_MAXBYTES_CASE
# define UTF8_MAXBYTES_CASE 15
#endif
#endif
#ifndef UTF_ACCUMULATION_SHIFT
# define UTF_ACCUMULATION_SHIFT D_PPP_BYTE_INFO_BITS
#endif
#ifdef NATIVE_TO_UTF
#ifndef NATIVE_UTF8_TO_I8
# define NATIVE_UTF8_TO_I8(c) NATIVE_TO_UTF(c)
#endif
#else /* System doesn't support EBCDIC */
#ifndef NATIVE_UTF8_TO_I8
# define NATIVE_UTF8_TO_I8(c) (c)
#endif
#endif
#ifdef UTF_TO_NATIVE
#ifndef I8_TO_NATIVE_UTF8
# define I8_TO_NATIVE_UTF8(c) UTF_TO_NATIVE(c)
#endif
#else /* System doesn't support EBCDIC */
#ifndef I8_TO_NATIVE_UTF8
# define I8_TO_NATIVE_UTF8(c) (c)
#endif
#endif
#ifndef UTF_START_MASK
# define UTF_START_MASK(len) \
(((len) >= 7) ? 0x00 : (0x1F >> ((len)-2)))
#endif
#ifndef UTF_IS_CONTINUATION_MASK
# define UTF_IS_CONTINUATION_MASK \
((U8) (0xFF << UTF_ACCUMULATION_SHIFT))
#endif
#ifndef UTF_CONTINUATION_MARK
# define UTF_CONTINUATION_MARK \
(UTF_IS_CONTINUATION_MASK & 0xB0)
#endif
#ifndef UTF_MIN_START_BYTE
# define UTF_MIN_START_BYTE \
((UTF_CONTINUATION_MARK >> UTF_ACCUMULATION_SHIFT) | UTF_START_MARK(2))
#endif
#ifndef UTF_MIN_ABOVE_LATIN1_BYTE
# define UTF_MIN_ABOVE_LATIN1_BYTE \
((0x100 >> UTF_ACCUMULATION_SHIFT) | UTF_START_MARK(2))
#endif
#if (PERL_BCDVERSION < 0x5007000) /* Was the complement of what should have been */
# undef UTF8_IS_DOWNGRADEABLE_START
#endif
#ifndef UTF8_IS_DOWNGRADEABLE_START
# define UTF8_IS_DOWNGRADEABLE_START(c) \
inRANGE(NATIVE_UTF8_TO_I8(c), \
UTF_MIN_START_BYTE, UTF_MIN_ABOVE_LATIN1_BYTE - 1)
#endif
#ifndef UTF_CONTINUATION_MASK
# define UTF_CONTINUATION_MASK \
((U8) ((1U << UTF_ACCUMULATION_SHIFT) - 1))
#endif
#ifndef UTF8_ACCUMULATE
# define UTF8_ACCUMULATE(base, added) \
(((base) << UTF_ACCUMULATION_SHIFT) \
| ((NATIVE_UTF8_TO_I8(added)) \
& UTF_CONTINUATION_MASK))
#endif
#ifndef UTF8_ALLOW_ANYUV
# define UTF8_ALLOW_ANYUV 0
#endif
#ifndef UTF8_ALLOW_EMPTY
# define UTF8_ALLOW_EMPTY 0x0001
#endif
#ifndef UTF8_ALLOW_CONTINUATION
# define UTF8_ALLOW_CONTINUATION 0x0002
#endif
#ifndef UTF8_ALLOW_NON_CONTINUATION
# define UTF8_ALLOW_NON_CONTINUATION 0x0004
#endif
#ifndef UTF8_ALLOW_SHORT
# define UTF8_ALLOW_SHORT 0x0008
#endif
#ifndef UTF8_ALLOW_LONG
# define UTF8_ALLOW_LONG 0x0010
#endif
#ifndef UTF8_ALLOW_OVERFLOW
# define UTF8_ALLOW_OVERFLOW 0x0080
#endif
#ifndef UTF8_ALLOW_ANY
# define UTF8_ALLOW_ANY ( UTF8_ALLOW_CONTINUATION \
|UTF8_ALLOW_NON_CONTINUATION \
|UTF8_ALLOW_SHORT \
|UTF8_ALLOW_LONG \
|UTF8_ALLOW_OVERFLOW)
#endif
#if defined UTF8SKIP
/* Don't use official versions because they use MIN, which may not be available */
#undef UTF8_SAFE_SKIP
#undef UTF8_CHK_SKIP
#ifndef UTF8_SAFE_SKIP
# define UTF8_SAFE_SKIP(s, e) ( \
((((e) - (s)) <= 0) \
? 0 \
: D_PPP_MIN(((e) - (s)), UTF8SKIP(s))))
#endif
#ifndef UTF8_CHK_SKIP
# define UTF8_CHK_SKIP(s) \
(s[0] == '\0' ? 1 : ((U8) D_PPP_MIN(my_strnlen((char *) (s), UTF8SKIP(s)), \
UTF8SKIP(s))))
#endif
/* UTF8_CHK_SKIP depends on my_strnlen */
#ifndef UTF8_SKIP
# define UTF8_SKIP(s) UTF8SKIP(s)
#endif
#endif
#if 'A' == 65
#ifndef UTF8_IS_INVARIANT
# define UTF8_IS_INVARIANT(c) isASCII(c)
#endif
#else
#ifndef UTF8_IS_INVARIANT
# define UTF8_IS_INVARIANT(c) (isASCII(c) || isCNTRL_L1(c))
#endif
#endif
#ifndef UVCHR_IS_INVARIANT
# define UVCHR_IS_INVARIANT(c) UTF8_IS_INVARIANT(c)
#endif
#ifdef UVCHR_IS_INVARIANT
# if 'A' != 65 || UVSIZE < 8
/* 32 bit platform, which includes UTF-EBCDIC on the releases this is
* backported to */
# define D_PPP_UVCHR_SKIP_UPPER(c) 7
# else
# define D_PPP_UVCHR_SKIP_UPPER(c) \
(((WIDEST_UTYPE) (c)) < \
(((WIDEST_UTYPE) 1) << (6 * D_PPP_BYTE_INFO_BITS)) ? 7 : 13)
# endif
#ifndef UVCHR_SKIP
# define UVCHR_SKIP(c) \
UVCHR_IS_INVARIANT(c) ? 1 : \
(WIDEST_UTYPE) (c) < (32 * (1U << ( D_PPP_BYTE_INFO_BITS))) ? 2 : \
(WIDEST_UTYPE) (c) < (16 * (1U << (2 * D_PPP_BYTE_INFO_BITS))) ? 3 : \
(WIDEST_UTYPE) (c) < ( 8 * (1U << (3 * D_PPP_BYTE_INFO_BITS))) ? 4 : \
(WIDEST_UTYPE) (c) < ( 4 * (1U << (4 * D_PPP_BYTE_INFO_BITS))) ? 5 : \
(WIDEST_UTYPE) (c) < ( 2 * (1U << (5 * D_PPP_BYTE_INFO_BITS))) ? 6 : \
D_PPP_UVCHR_SKIP_UPPER(c)
#endif
#endif
#ifdef is_ascii_string
#ifndef is_invariant_string
# define is_invariant_string(s,l) is_ascii_string(s,l)
#endif
#ifndef is_utf8_invariant_string
# define is_utf8_invariant_string(s,l) is_ascii_string(s,l)
#endif
/* Hint: is_ascii_string, is_invariant_string
is_utf8_invariant_string() does the same thing and is preferred because its
name is more accurate as to what it does */
#endif
#ifdef ibcmp_utf8
#ifndef foldEQ_utf8
# define foldEQ_utf8(s1,pe1,l1,u1,s2,pe2,l2,u2) \
cBOOL(! ibcmp_utf8(s1,pe1,l1,u1,s2,pe2,l2,u2))
#endif
#endif
#if defined(is_utf8_string) && defined(UTF8SKIP)
#ifndef isUTF8_CHAR
# define isUTF8_CHAR(s, e) ( \
(e) <= (s) || ! is_utf8_string(s, UTF8_SAFE_SKIP(s, e)) \
? 0 \
: UTF8SKIP(s))
#endif
#endif
#if 'A' == 65
#ifndef BOM_UTF8
# define BOM_UTF8 "\xEF\xBB\xBF"
#endif
#ifndef REPLACEMENT_CHARACTER_UTF8
# define REPLACEMENT_CHARACTER_UTF8 "\xEF\xBF\xBD"
#endif
#elif '^' == 95
#ifndef BOM_UTF8
# define BOM_UTF8 "\xDD\x73\x66\x73"
#endif
#ifndef REPLACEMENT_CHARACTER_UTF8
# define REPLACEMENT_CHARACTER_UTF8 "\xDD\x73\x73\x71"
#endif
#elif '^' == 176
#ifndef BOM_UTF8
# define BOM_UTF8 "\xDD\x72\x65\x72"
#endif
#ifndef REPLACEMENT_CHARACTER_UTF8
# define REPLACEMENT_CHARACTER_UTF8 "\xDD\x72\x72\x70"
#endif
#else
# error Unknown character set
#endif
#if (PERL_BCDVERSION < 0x5035010)
/* Versions prior to 5.31.4 accepted things that are now considered
* malformations, and didn't return -1 on error with warnings enabled.
* Versions before 5.35.10 dereferenced empty input without checking */
# undef utf8_to_uvchr_buf
#endif
/* This implementation brings modern, generally more restricted standards to
* utf8_to_uvchr_buf. Some of these are security related, and clearly must
* be done. But its arguable that the others need not, and hence should not.
* The reason they're here is that a module that intends to play with the
* latest perls should be able to work the same in all releases. An example is
* that perl no longer accepts any UV for a code point, but limits them to
* IV_MAX or below. This is for future internal use of the larger code points.
* If it turns out that some of these changes are breaking code that isn't
* intended to work with modern perls, the tighter restrictions could be
* relaxed. khw thinks this is unlikely, but has been wrong in the past. */
/* 5.6.0 is the first release with UTF-8, and we don't implement this function
* there due to its likely lack of still being in use, and the underlying
* implementation is very different from later ones, without the later
* safeguards, so would require extra work to deal with */
#if (PERL_BCDVERSION >= 0x5006001) && ! defined(utf8_to_uvchr_buf)
/* Choose which underlying implementation to use. At least one must be
* present or the perl is too early to handle this function */
# if defined(utf8n_to_uvchr) || defined(utf8_to_uvchr) || defined(utf8_to_uv)
# if defined(utf8n_to_uvchr) /* This is the preferred implementation */
# define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr
# elif /* Must be at least 5.6.1 from #if above; \
If have both regular and _simple, regular has all args */ \
defined(utf8_to_uv) && defined(utf8_to_uv_simple)
# define D_PPP_utf8_to_uvchr_buf_callee utf8_to_uv
# elif defined(utf8_to_uvchr) /* The below won't work well on error input */
# define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \
utf8_to_uvchr((U8 *)(s), (retlen))
# else
# define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \
utf8_to_uv((U8 *)(s), (retlen))
# endif
# endif
# if defined(NEED_utf8_to_uvchr_buf)
static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
static
#else
extern UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
#endif
#if defined(NEED_utf8_to_uvchr_buf) || defined(NEED_utf8_to_uvchr_buf_GLOBAL)
#ifdef utf8_to_uvchr_buf
# undef utf8_to_uvchr_buf
#endif
#define utf8_to_uvchr_buf(a,b,c) DPPP_(my_utf8_to_uvchr_buf)(aTHX_ a,b,c)
#define Perl_utf8_to_uvchr_buf DPPP_(my_utf8_to_uvchr_buf)
UV
DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
{
# if (PERL_BCDVERSION >= 0x5031004) /* But from above, must be < 5.35.10 */
# if (PERL_BCDVERSION != 0x5035009)
/* Versions less than 5.35.9 could dereference s on zero length, so
* pass it something where no harm comes from that. */
if (send <= s) s = send = (U8 *) "?";
return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen);
# else /* Below is 5.35.9, which also works on non-empty input, but
for empty input, can wrongly dereference, and additionally is
also just plain broken */
if (send > s) return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen);
if (! ckWARN_d(WARN_UTF8)) {
if (retlen) *retlen = 0;
return UNICODE_REPLACEMENT;
}
else {
s = send = (U8 *) "?";
/* Call just for its warning */
(void) Perl__utf8n_to_uvchr_msgs_helper(s, 0, NULL, 0, NULL, NULL);
if (retlen) *retlen = (STRLEN) -1;
return 0;
}
# endif
# else
UV ret;
STRLEN curlen;
bool overflows = 0;
const U8 *cur_s = s;
const bool do_warnings = ckWARN_d(WARN_UTF8);
# if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
STRLEN overflow_length = 0;
# endif
if (send > s) {
curlen = send - s;
}
else {
assert(0); /* Modern perls die under this circumstance */
curlen = 0;
if (! do_warnings) { /* Handle empty here if no warnings needed */
if (retlen) *retlen = 0;
return UNICODE_REPLACEMENT;
}
}
# if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
/* Perl did not properly detect overflow for much of its history on
* non-EBCDIC platforms, often returning an overlong value which may or may
* not have been tolerated in the call. Also, earlier versions, when they
* did detect overflow, may have disallowed it completely. Modern ones can
* replace it with the REPLACEMENT CHARACTER, depending on calling
* parameters. Therefore detect it ourselves in releases it was
* problematic in. */
if (curlen > 0 && UNLIKELY(*s >= 0xFE)) {
/* First, on a 32-bit machine the first byte being at least \xFE
* automatically is overflow, as it indicates something requiring more
* than 31 bits */
if (sizeof(ret) < 8) {
overflows = 1;
overflow_length = (*s == 0xFE) ? 7 : 13;
}
else {
const U8 highest[] = /* 2*63-1 */
"\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
const U8 *cur_h = highest;
for (cur_s = s; cur_s < send; cur_s++, cur_h++) {
if (UNLIKELY(*cur_s == *cur_h)) {
continue;
}
/* If this byte is larger than the corresponding highest UTF-8
* byte, the sequence overflows; otherwise the byte is less
* than (as we handled the equality case above), and so the
* sequence doesn't overflow */
overflows = *cur_s > *cur_h;
break;
}
/* Here, either we set the bool and broke out of the loop, or got
* to the end and all bytes are the same which indicates it doesn't
* overflow. If it did overflow, it would be this number of bytes
* */
overflow_length = 13;
}
}
if (UNLIKELY(overflows)) {
ret = 0;
if (! do_warnings && retlen) {
*retlen = overflow_length;
}
}
else
# endif /* < 5.26 */
/* Here, we are either in a release that properly detects overflow, or
* we have checked for overflow and the next statement is executing as
* part of the above conditional where we know we don't have overflow.
*
* The modern versions allow anything that evaluates to a legal UV, but
* not overlongs nor an empty input */
ret = D_PPP_utf8_to_uvchr_buf_callee(
(U8 *) /* Early perls: no const */
s, curlen, retlen, (UTF8_ALLOW_ANYUV
& ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY)));
# if (PERL_BCDVERSION >= 0x5026000) && (PERL_BCDVERSION < 0x5028000)
/* But actually, more modern versions restrict the UV to being no more than
* what an IV can hold, so it could still have gotten it wrong about
* overflowing. */
if (UNLIKELY(ret > IV_MAX)) {
overflows = 1;
}
# endif
if (UNLIKELY(overflows)) {
if (! do_warnings) {
if (retlen) {
*retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
*retlen = D_PPP_MIN(*retlen, curlen);
}
return UNICODE_REPLACEMENT;
}
else {
/* We use the error message in use from 5.8-5.26 */
Perl_warner(aTHX_ packWARN(WARN_UTF8),
"Malformed UTF-8 character (overflow at 0x%" UVxf
", byte 0x%02x, after start byte 0x%02x)",
ret, *cur_s, *s);
if (retlen) {
*retlen = (STRLEN) -1;
}
return 0;
}
}
/* Here, did not overflow, but if it failed for some other reason, and
* warnings are off, to emulate the behavior of the real utf8_to_uvchr(),
* try again, allowing anything. (Note a return of 0 is ok if the input
* was '\0') */
if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) {
/* If curlen is 0, we already handled the case where warnings are
* disabled, so this 'if' will be true, and so later on, we know that
* 's' is dereferencible */
if (do_warnings) {
if (retlen) {
*retlen = (STRLEN) -1;
}
}
else {
ret = D_PPP_utf8_to_uvchr_buf_callee(
(U8 *) /* Early perls: no const */
s, curlen, retlen, UTF8_ALLOW_ANY);
/* Override with the REPLACEMENT character, as that is what the
* modern version of this function returns */
ret = UNICODE_REPLACEMENT;
# if (PERL_BCDVERSION < 0x5016000)
/* Versions earlier than this don't necessarily return the proper
* length. It should not extend past the end of string, nor past
* what the first byte indicates the length is, nor past the
* continuation characters */
if (retlen && (IV) *retlen >= 0) {
unsigned int i = 1;
*retlen = D_PPP_MIN(*retlen, curlen);
*retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
do {
# ifdef UTF8_IS_CONTINUATION
if (! UTF8_IS_CONTINUATION(s[i]))
# else /* Versions without the above don't support EBCDIC anyway */
if (s[i] < 0x80 || s[i] > 0xBF)
# endif
{
*retlen = i;
break;
}
} while (++i < *retlen);
}
# endif /* end of < 5.16.0 */
}
}
return ret;
# endif /* end of < 5.31.4 */
}
# endif
#endif
#if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf)
#undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses
to read past a NUL, making it much less likely to read
off the end of the buffer. A NUL indicates the start
of the next character anyway. If the input isn't
NUL-terminated, the function remains unsafe, as it
always has been. */
#ifndef utf8_to_uvchr
# define utf8_to_uvchr(s, lp) \
((*(s) == '\0') \
? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */ \
: utf8_to_uvchr_buf(s, (s) + UTF8_CHK_SKIP(s), (lp)))
#endif
#endif
/* Hint: utf8_to_uvchr
Use utf8_to_uvchr_buf() instead. But ONLY if you KNOW the upper bound
of the input string (not resorting to using UTF8SKIP, etc., to infer it).
The backported utf8_to_uvchr() will do a better job to prevent most cases
of trying to read beyond the end of the buffer */
/* Replace utf8_to_uvchr with utf8_to_uvchr_buf */
#ifdef sv_len_utf8
# if (PERL_BCDVERSION >= 0x5017005)
# ifndef sv_len_utf8_nomg
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define sv_len_utf8_nomg(sv) \
({ \
SV *sv_ = (sv); \
sv_len_utf8(!SvGMAGICAL(sv_) \
? sv_ \
: sv_mortalcopy_flags(sv_, SV_NOSTEAL)); \
})
# else
PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8_nomg(SV * sv)
{
dTHX;
if (SvGMAGICAL(sv))
return sv_len_utf8(sv_mortalcopy_flags(sv,
SV_NOSTEAL));
else return sv_len_utf8(sv);
}
# define sv_len_utf8_nomg(sv) D_PPP_sv_len_utf8_nomg(sv)
# endif
# endif
# else /* < 5.17.5 */
/* Older Perl versions have broken sv_len_utf8() when passed sv does not
* have SVf_UTF8 flag set */
/* Also note that SvGETMAGIC() may change presence of SVf_UTF8 flag */
# undef sv_len_utf8
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define sv_len_utf8_nomg(sv) \
({ \
SV *sv2 = (sv); \
STRLEN len; \
if (SvUTF8(sv2)) { \
if (SvGMAGICAL(sv2)) \
len = Perl_sv_len_utf8(aTHX_ \
sv_mortalcopy_flags(sv2, \
SV_NOSTEAL));\
else \
len = Perl_sv_len_utf8(aTHX_ sv2); \
} \
else SvPV_nomg(sv2, len); \
len; \
})
# define sv_len_utf8(sv) ({ SV *_sv1 = (sv); \
SvGETMAGIC(_sv1); \
sv_len_utf8_nomg(_sv1); \
})
# else /* Below is no brace groups */
PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8_nomg(SV * sv)
{
dTHX;
STRLEN len;
if (SvUTF8(sv)) {
if (SvGMAGICAL(sv))
len = Perl_sv_len_utf8(aTHX_
sv_mortalcopy_flags(sv,
SV_NOSTEAL));
else
len = Perl_sv_len_utf8(aTHX_ sv);
}
else SvPV_nomg(sv, len);
return len;
}
# define sv_len_utf8_nomg(sv) D_PPP_sv_len_utf8_nomg(sv)
PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8(SV * sv)
{
dTHX;
SvGETMAGIC(sv);
return sv_len_utf8_nomg(sv);
}
# define sv_len_utf8(sv) D_PPP_sv_len_utf8(sv)
# endif
# endif /* End of < 5.17.5 */
#endif
#ifndef PERL_PV_ESCAPE_QUOTE
# define PERL_PV_ESCAPE_QUOTE 0x0001
#endif
#ifndef PERL_PV_PRETTY_QUOTE
# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
#endif
#ifndef PERL_PV_PRETTY_ELLIPSES
# define PERL_PV_PRETTY_ELLIPSES 0x0002
#endif
#ifndef PERL_PV_PRETTY_LTGT
# define PERL_PV_PRETTY_LTGT 0x0004
#endif
#ifndef PERL_PV_ESCAPE_FIRSTCHAR
# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
#endif
#ifndef PERL_PV_ESCAPE_UNI
# define PERL_PV_ESCAPE_UNI 0x0100
#endif
#ifndef PERL_PV_ESCAPE_UNI_DETECT
# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
#endif
#ifndef PERL_PV_ESCAPE_ALL
# define PERL_PV_ESCAPE_ALL 0x1000
#endif
#ifndef PERL_PV_ESCAPE_NOBACKSLASH
# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
#endif
#ifndef PERL_PV_ESCAPE_NOCLEAR
# define PERL_PV_ESCAPE_NOCLEAR 0x4000
#endif
#ifndef PERL_PV_ESCAPE_RE
# define PERL_PV_ESCAPE_RE 0x8000
#endif
#ifndef PERL_PV_PRETTY_NOCLEAR
# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
#endif
#ifndef PERL_PV_PRETTY_DUMP
# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
#endif
#ifndef PERL_PV_PRETTY_REGPROP
# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
#endif
/* Hint: pv_escape
* Note that unicode functionality is only backported to
* those perl versions that support it. For older perl
* versions, the implementation will fall back to bytes.
*/
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
#endif
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
#ifdef pv_escape
# undef pv_escape
#endif
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
#define Perl_pv_escape DPPP_(my_pv_escape)
char *
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags)
{
const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
char octbuf[32] = "%123456789ABCDF";
STRLEN wrote = 0;
STRLEN chsize = 0;
STRLEN readsize = 1;
#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
#endif
const char *pv = str;
const char * const end = pv + count;
octbuf[0] = esc;
if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
sv_setpvs(dsv, "");
#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
isuni = 1;
#endif
for (; pv < end && (!max || wrote < max) ; pv += readsize) {
const UV u =
#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
isuni ? utf8_to_uvchr_buf((U8*)pv, end, &readsize) :
#endif
(U8)*pv;
const U8 c = (U8)u & 0xFF;
if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
chsize = my_snprintf(octbuf, sizeof octbuf,
"%" UVxf, u);
else
chsize = my_snprintf(octbuf, sizeof octbuf,
"%cx{%" UVxf "}", esc, u);
} else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
chsize = 1;
} else {
if (c == dq || c == esc || !isPRINT(c)) {
chsize = 2;
switch (c) {
case '\\' : /* fallthrough */
case '%' : if (c == esc)
octbuf[1] = esc;
else
chsize = 1;
break;
case '\v' : octbuf[1] = 'v'; break;
case '\t' : octbuf[1] = 't'; break;
case '\r' : octbuf[1] = 'r'; break;
case '\n' : octbuf[1] = 'n'; break;
case '\f' : octbuf[1] = 'f'; break;
case '"' : if (dq == '"')
octbuf[1] = '"';
else
chsize = 1;
break;
default: chsize = my_snprintf(octbuf, sizeof octbuf,
pv < end && isDIGIT((U8)*(pv+readsize))
? "%c%03o" : "%c%o", esc, c);
}
} else {
chsize = 1;
}
}
if (max && wrote + chsize > max) {
break;
} else if (chsize > 1) {
sv_catpvn(dsv, octbuf, chsize);
wrote += chsize;
} else {
char tmp[2];
my_snprintf(tmp, sizeof tmp, "%c", c);
sv_catpvn(dsv, tmp, 1);
wrote++;
}
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
break;
}
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
#ifdef pv_pretty
# undef pv_pretty
#endif
#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
#define Perl_pv_pretty DPPP_(my_pv_pretty)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
sv_catpvs(dsv, "...");
return SvPVX(dsv);
}
#endif
#endif
#ifndef pv_display
#if defined(NEED_pv_display)
static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
static
#else
extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
#endif
#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
#ifdef pv_display
# undef pv_display
#endif
#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
#define Perl_pv_display DPPP_(my_pv_display)
char *
DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
{
pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
if (len > cur && pv[cur] == '\0')
sv_catpvs(dsv, "\\0");
return SvPVX(dsv);
}
#endif
#endif
#if PERL_VERSION_LT(5,27,9)
#ifndef LC_NUMERIC_LOCK
# define LC_NUMERIC_LOCK
#endif
#ifndef LC_NUMERIC_UNLOCK
# define LC_NUMERIC_UNLOCK
#endif
# if PERL_VERSION_LT(5,19,0)
# undef STORE_LC_NUMERIC_SET_STANDARD
# undef RESTORE_LC_NUMERIC
# undef DECLARATION_FOR_LC_NUMERIC_MANIPULATION
# ifdef USE_LOCALE
#ifndef DECLARATION_FOR_LC_NUMERIC_MANIPULATION
# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION char *LoC_
#endif
#ifndef STORE_NUMERIC_SET_STANDARD
# define STORE_NUMERIC_SET_STANDARD() \
LoC_ = savepv(setlocale(LC_NUMERIC, NULL)); \
SAVEFREEPV(LoC_); \
setlocale(LC_NUMERIC, "C");
#endif
#ifndef RESTORE_LC_NUMERIC
# define RESTORE_LC_NUMERIC() \
setlocale(LC_NUMERIC, LoC_);
#endif
# else
#ifndef DECLARATION_FOR_LC_NUMERIC_MANIPULATION
# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
#endif
#ifndef STORE_LC_NUMERIC_SET_STANDARD
# define STORE_LC_NUMERIC_SET_STANDARD()
#endif
#ifndef RESTORE_LC_NUMERIC
# define RESTORE_LC_NUMERIC()
#endif
# endif
# endif
#endif
#ifndef LOCK_NUMERIC_STANDARD
# define LOCK_NUMERIC_STANDARD()
#endif
#ifndef UNLOCK_NUMERIC_STANDARD
# define UNLOCK_NUMERIC_STANDARD()
#endif
/* The names of these changed in 5.28 */
#ifndef LOCK_LC_NUMERIC_STANDARD
# define LOCK_LC_NUMERIC_STANDARD LOCK_NUMERIC_STANDARD
#endif
#ifndef UNLOCK_LC_NUMERIC_STANDARD
# define UNLOCK_LC_NUMERIC_STANDARD UNLOCK_NUMERIC_STANDARD
#endif
/* If this doesn't exist, it's not needed, so is void noop */
#ifndef switch_to_global_locale
# define switch_to_global_locale()
#endif
/* Originally, this didn't return a value, but in perls like that, the value
* should always be TRUE. Add a return to Perl_sync_locale() when it's
* available. And actually do a sync when its not, if locales are available on
* this system. */
#ifdef sync_locale
# if (PERL_BCDVERSION < 0x5027009)
# if (PERL_BCDVERSION >= 0x5021003)
# undef sync_locale
# define sync_locale() (Perl_sync_locale(aTHX), 1)
# elif defined(sync_locale) /* These should only be the 5.20 maints*/
# undef sync_locale /* Just copy their defn and return 1 */
# define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), \
new_collate(setlocale(LC_COLLATE, NULL)), \
set_numeric_local(), \
new_numeric(setlocale(LC_NUMERIC, NULL)), \
1)
# elif defined(new_ctype) && defined(LC_CTYPE)
# define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), 1)
# endif
# endif
#endif
#ifndef sync_locale
# define sync_locale() 1
#endif
#endif /* _P_P_PORTABILITY_H_ */
/* End of File include/ppport.h */
FFI-Platypus-2.12/lib/ 000755 000000 000000 00000000000 15251066120 014403 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/ 000755 000000 000000 00000000000 15251066120 015007 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Build.pm 000644 000000 000000 00000035605 15251066120 016415 0 ustar 00root root 000000 000000 package FFI::Build;
use strict;
use warnings;
use 5.008004;
use FFI::Build::Plugin;
use FFI::Build::PluginData qw( plugin_data );
use FFI::Build::File::Library;
use Carp ();
use File::Glob ();
use File::Basename ();
use List::Util 1.45 ();
use Capture::Tiny ();
use File::Path ();
# ABSTRACT: Build shared libraries for use with FFI
our $VERSION = '2.12'; # VERSION
# Platypus-Man,
# Platypus-Man,
# Friendly Neighborhood Platypus-Man
# Is He Strong?
# Listen Bud
# He's got Proportional Strength of a Platypus
# Hey Man!
# There Goes The Platypus-Man
{
my $plugins = FFI::Build::Plugin->new;
# PLUGIN: require
# ARGS: NONE
$plugins->call('build-require');
sub _plugins { $plugins ||= FFI::Build::Plugin->new };
}
sub import
{
my @caller = caller;
# PLUGIN: import
# ARGS: @caller, \@args
_plugins->call('build-import', \@caller, \@_);
}
sub _native_name
{
my($self, $name) = @_;
join '', $self->platform->library_prefix, $name, scalar $self->platform->library_suffix;
}
sub new
{
my($class, $name, %args) = @_;
Carp::croak "name is required" unless defined $name;
# PLUGIN: new-pre
# ARGS: $name, \%args
_plugins->call('build-new-pre', $name, \%args);
my $self = bless {
source => [],
cflags_I => [],
cflags => [],
libs_L => [],
libs => [],
alien => [],
}, $class;
my $platform = $self->{platform} = $args{platform} || FFI::Build::Platform->default;
my $file = $self->{file} = $args{file} || FFI::Build::File::Library->new([$args{dir} || '.', $self->_native_name($name)], platform => $self->platform);
my $buildname = $self->{buildname} = $args{buildname} || '_build';
my $verbose = $self->{verbose} = $args{verbose} || 0;
my $export = $self->{export} = $args{export} || [];
$self->{verbose} = $verbose = 2 if $ENV{V};
if(defined $args{cflags})
{
my @flags = ref $args{cflags} ? @{ $args{cflags} } : $self->platform->shellwords($args{cflags});
push @{ $self->{cflags} }, grep !/^-I/, @flags;
push @{ $self->{cflags_I} }, grep /^-I/, @flags;
}
if(defined $args{libs})
{
my @flags = ref $args{libs} ? @{ $args{libs} } : $self->platform->shellwords($args{libs});
push @{ $self->{libs} }, grep !/^-L/, @flags;
push @{ $self->{libs_L} }, grep /^-L/, @flags;
}
if(defined $args{alien})
{
my @aliens = ref $args{alien} ? @{ $args{alien} } : ($args{alien});
foreach my $alien (@aliens)
{
unless(eval { $alien->can('cflags') && $alien->can('libs') })
{
my $pm = "$alien.pm";
$pm =~ s/::/\//g;
require $pm;
}
push @{ $self->{alien} }, $alien;
push @{ $self->{cflags} }, grep !/^-I/, $self->platform->shellwords($alien->cflags);
push @{ $self->{cflags_I} }, grep /^-I/, $self->platform->shellwords($alien->cflags);
push @{ $self->{libs} }, grep !/^-L/, $self->platform->shellwords($alien->libs);
push @{ $self->{libs_L} }, grep /^-L/, $self->platform->shellwords($alien->libs);
}
}
$self->source(ref $args{source} ? @{ $args{source} } : ($args{source})) if $args{source};
# PLUGIN: new-post
# ARGS: $self
_plugins->call('build-new-post', $self);
$self;
}
sub buildname { shift->{buildname} }
sub export { shift->{export} }
sub file { shift->{file} }
sub platform { shift->{platform} }
sub verbose { shift->{verbose} }
sub cflags { shift->{cflags} }
sub cflags_I { shift->{cflags_I} }
sub libs { shift->{libs} }
sub libs_L { shift->{libs_L} }
sub alien { shift->{alien} }
my @file_classes;
sub _file_classes
{
unless(@file_classes)
{
if(defined $FFI::Build::VERSION)
{
foreach my $inc (@INC)
{
push @file_classes,
map { my $f = $_; $f =~ s/\.pm$//; "FFI::Build::File::$f" }
grep !/^Base\.pm$/,
map { File::Basename::basename($_) }
File::Glob::bsd_glob(
File::Spec->catfile($inc, 'FFI', 'Build', 'File', '*.pm')
);
}
}
else
{
# When building out of git without dzil, $VERSION will not
# usually be defined and any file plugins that require a
# specific version will break, so we only use core file
# classes for that.
push @file_classes, map { "FFI::Build::File::$_" } qw( C CXX Library Object );
}
# also anything already loaded, that might not be in the
# @INC path (for testing ususally)
push @file_classes,
map { my $f = $_; $f =~ s/::$//; "FFI::Build::File::$f" }
grep !/Base::/,
grep /::$/,
keys %{FFI::Build::File::};
@file_classes = List::Util::uniq(@file_classes);
foreach my $class (@file_classes)
{
next if(eval { $class->can('new') });
my $pm = $class . ".pm";
$pm =~ s/::/\//g;
require $pm;
}
}
@file_classes;
}
sub source
{
my($self, @file_spec) = @_;
foreach my $file_spec (@file_spec)
{
if(eval { $file_spec->isa('FFI::Build::File::Base') })
{
push @{ $self->{source} }, $file_spec;
next;
}
if(ref $file_spec eq 'ARRAY')
{
my($type, $content, @args) = @$file_spec;
my $class = "FFI::Build::File::$type";
unless($class->can('new'))
{
my $pm = "FFI/Build/File/$type.pm";
require $pm;
}
push @{ $self->{source} }, $class->new(
$content,
build => $self,
platform => $self->platform,
@args
);
next;
}
my @paths = File::Glob::bsd_glob($file_spec);
path:
foreach my $path (@paths)
{
foreach my $class (_file_classes)
{
foreach my $regex ($class->accept_suffix)
{
if($path =~ $regex)
{
push @{ $self->{source} }, $class->new($path, platform => $self->platform, build => $self);
next path;
}
}
}
Carp::croak("Unknown file type: $path");
}
}
@{ $self->{source} };
}
sub build
{
my($self) = @_;
# PLUGIN: build
# ARGS: $self
_plugins->call('build-build', $self);
my @objects;
my $ld = $self->platform->ld;
foreach my $source ($self->source)
{
# PLUGIN: build-item
# ARGS: $self, $source
_plugins->call('build-build-item', $self, $source);
if($source->can('build_all'))
{
my $count = scalar $self->source;
if($count == 1)
{
return $source->build_all($self->file);
}
else
{
die "@{[ ref $source ]} has build_all method, but there is not exactly one source";
}
}
$ld = $source->ld if $source->ld;
my $output;
while(my $next = $source->build_item)
{
$ld = $next->ld if $next->ld;
$output = $source = $next;
}
push @objects, $output;
}
my $needs_rebuild = sub {
my(@objects) = @_;
return 1 unless -f $self->file->path;
my $target_time = [stat $self->file->path]->[9];
foreach my $object (@objects)
{
my $object_time = [stat "$object"]->[9];
return 1 if $object_time > $target_time;
}
return 0;
};
return $self->file unless $needs_rebuild->(@objects);
File::Path::mkpath($self->file->dirname, 0, oct(755));
my @cmd = (
$ld,
$self->libs_L,
$self->platform->ldflags,
(map { "$_" } @objects),
$self->libs,
$self->platform->flag_export(@{ $self->export }),
$self->platform->flag_library_output($self->file->path),
);
# PLUGIN: build-link
# ARGS: $self, \@cmd
_plugins->call('build-build-link', $self, \@cmd);
my($out, $exit) = Capture::Tiny::capture_merged(sub {
$self->platform->run(@cmd);
});
if($exit || !-f $self->file->path)
{
print $out;
die "error building @{[ $self->file->path ]} from @objects";
}
elsif($self->verbose >= 2)
{
print $out;
}
elsif($self->verbose >= 1)
{
print "LD @{[ $self->file->path ]}\n";
}
# PLUGIN: link-postlink
# ARGS: $self, \@cmd
_plugins->call('build-build-postlink', $self);
$self->file;
}
sub clean
{
my($self) = @_;
my $dll = $self->file->path;
if(-f $dll)
{
# PLUGIN: clean
# ARGS: $self, $path
_plugins->call('build-clean', $self, $dll);
unlink $dll;
}
foreach my $source ($self->source)
{
my $dir = File::Spec->catdir($source->dirname, $self->buildname);
if(-d $dir)
{
foreach my $path (File::Glob::bsd_glob("$dir/*"))
{
_plugins->call('build-clean', $self, $path);
unlink $path;
}
_plugins->call('build-clean', $self, $dir);
rmdir $dir;
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build - Build shared libraries for use with FFI
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
use FFI::Build;
my $build = FFI::Build->new(
'frooble',
source => 'ffi/*.c',
);
# $lib is an instance of FFI::Build::File::Library
my $lib = $build->build;
my $ffi = FFI::Platypus->new( api => 2 );
# The filename will be platform dependant, but something like libfrooble.so or frooble.dll
$ffi->lib($lib->path);
... # use $ffi to attach functions in ffi/*.c
=head1 DESCRIPTION
Using libffi based L<FFI::Platypus> is a great alternative to XS for writing library bindings for Perl.
Sometimes, however, you need to bundle a little C code with your FFI module, but this has never been
that easy to use. L<Module::Build::FFI> was an early attempt to address this use case, but it uses
the now out of fashion L<Module::Build>.
This module itself doesn't directly integrate with CPAN installers like L<ExtUtils::MakeMaker> or
L<Module::Build>, but there is a light weight layer L<FFI::Build::MM> that will allow you to easily
use this module with L<ExtUtils::MakeMaker>. If you are using L<Dist::Zilla> as your dist builder,
then there is also L<Dist::Zilla::Plugin::FFI::Build>, which will help with the connections.
There is some functional overlap with L<ExtUtils::CBuilder>, which was in fact used by L<Module::Build::FFI>.
For this iteration I have decided not to use that module because although it will generate dynamic libraries
that can sometimes be used by L<FFI::Platypus>, it is really designed for building XS modules, and trying
to coerce it into a more general solution has proved difficult in the past.
Supported languages out of the box are C, C++ and Fortran. Rust is supported via a language plugin,
see L<FFI::Platypus::Lang::Rust>.
=head1 CONSTRUCTOR
=head2 new
my $build = FFI::Build->new($name, %options);
Create an instance of this class. The C<$name> argument is used when computing the file name for
the library. The actual name will be something like C<lib$name.so> or C<$name.dll>. The following
options are supported:
=over 4
=item alien
List of Aliens to compile/link against. L<FFI::Build> will work with any L<Alien::Base> based
alien, or modules that provide a compatible API.
=item buildname
Directory name that will be used for building intermediate files, such as object files. This is
C<_build> by default.
=item cflags
Extra compiler flags to use. Things like C<-I/foo/include> or C<-DFOO=1>.
=item dir
The directory where the library will be written. This is C<.> by default.
=item export
Functions that should be exported (Windows + Visual C++ only)
=item file
An instance of L<FFI::Build::File::Library> to which the library will be written. Normally not needed.
=item libs
Extra library flags to use. Things like C<-L/foo/lib -lfoo>.
=item platform
An instance of L<FFI::Build::Platform>. Usually you want to omit this and use the default instance.
=item source
List of source files. You can use wildcards supported by C<bsd_glob> from L<File::Glob>.
=item verbose
By default this class does not print out the actual compiler and linker commands used in building
the library unless there is a failure. You can alter this behavior with this option. Set to
one of these values:
=over 4
=item zero (0)
Default, quiet unless there is a failure.
=item one (1)
Output the operation (compile, link, etc) and the file, but nothing else
=item two (2)
Output the complete commands run verbatim.
=back
If the environment variable C<V> is set to a true value then the verbosity will be set to C<2> regardless
of what is passed in.
=back
=head1 METHODS
=head2 dir
my $dir = $build->dir;
Returns the directory where the library will be written.
=head2 buildname
my $builddir = $build->builddir;
Returns the build name. This is used in computing a directory to save intermediate files like objects. For example,
if you specify a file like C<ffi/foo.c>, then the object file will be stored in C<ffi/_build/foo.o> by default.
C<_build> in this example (the default) is the build name.
=head2 export
my $exports = $build->export;
Returns a array reference of the exported functions (Windows + Visual C++ only)
=head2 file
my $file = $build->file;
Returns an instance of L<FFI::Build::File::Library> corresponding to the library being built. This is
also returned by the C<build> method below.
=head2 platform
my $platform = $build->platform;
An instance of L<FFI::Build::Platform>, which contains information about the platform on which you are building.
The default is usually reasonable.
=head2 verbose
my $verbose = $build->verbose;
Returns the verbose flag.
=head2 cflags
my @cflags = @{ $build->cflags };
Returns the compiler flags.
=head2 cflags_I
my @cflags_I = @{ $build->cflags_I };
Returns the C<-I> cflags.
=head2 libs
my @libs = @{ $build->libs };
Returns the library flags.
=head2 libs_L
my @libs = @{ $build->libs };
Returns the C<-L> library flags.
=head2 alien
my @aliens = @{ $build->alien };
Returns a the list of aliens being used.
=head2 source
$build->source(@files);
Add the C<@files> to the list of source files that will be used in building the library.
The format is the same as with the C<source> attribute above.
=head2 build
my $lib = $build->build;
This compiles the source files and links the library. Files that have already been compiled or linked
may be reused without recompiling/linking if the timestamps are newer than the source files. An instance
of L<FFI::Build::File::Library> is returned which can be used to get the path to the library, which can
be feed into L<FFI::Platypus> or similar.
=head2 clean
$build->clean;
Removes the library and intermediate files.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/ 000755 000000 000000 00000000000 15251066120 016046 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Build/File/ 000755 000000 000000 00000000000 15251066120 016725 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Build/File/Base.pm 000644 000000 000000 00000015753 15251066120 020150 0 ustar 00root root 000000 000000 package FFI::Build::File::Base;
use strict;
use warnings;
use 5.008004;
use Carp ();
use FFI::Temp;
use File::Basename ();
use FFI::Build::Platform;
use FFI::Build::PluginData;
use overload '""' => sub { $_[0]->path }, bool => sub { 1 }, fallback => 1;
# ABSTRACT: Base class for File::Build files
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, $content, %config) = @_;
my $base = $config{base} || 'ffi_build_';
my $dir = $config{dir};
my $build = $config{build};
my $platform = $config{platform} || FFI::Build::Platform->new;
my $self = bless {
platform => $platform,
build => $build,
}, $class;
if(!defined $content)
{
Carp::croak("content is required");
}
elsif(ref($content) eq 'ARRAY')
{
$self->{path} = File::Spec->catfile(@$content);
}
elsif(ref($content) eq 'SCALAR')
{
my %args;
$args{TEMPLATE} = "${base}XXXXXX";
$args{DIR} = $dir if $dir;
$args{SUFFIX} = $self->default_suffix;
$args{UNLINK} = 0;
my $fh = $self->{fh} = FFI::Temp->new(%args);
binmode( $fh, $self->default_encoding );
print $fh $$content;
close $fh;
$self->{path} = $fh->filename;
$self->{temp} = 1;
}
elsif(ref($content) eq '')
{
$self->{path} = $content;
}
if($self->platform->osname eq 'MSWin32')
{
$self->{native} = File::Spec->catfile($self->{path});
$self->{path} =~ s{\\}{/}g;
}
$self;
}
sub default_suffix { die "must define a default extension in subclass" }
sub default_encoding { die "must define an encoding" }
sub accept_suffix { () }
sub path { shift->{path} }
sub basename { File::Basename::basename shift->{path} }
sub dirname { File::Basename::dirname shift->{path} }
sub is_temp { shift->{temp} }
sub platform { shift->{platform} }
sub build { shift->{build} }
sub native {
my($self) = @_;
$self->platform->osname eq 'MSWin32'
? $self->{native}
: $self->{path};
}
sub slurp
{
my($self) = @_;
my $fh;
open($fh, '<', $self->path) || Carp::croak "Error opening @{[ $self->path ]} for read $!";
binmode($fh, $self->default_encoding);
my $content = do { local $/; <$fh> };
close $fh;
$content;
}
sub keep
{
delete shift->{temp};
}
sub build_item
{
Carp::croak("Not implemented!");
}
sub needs_rebuild
{
my($self, @source) = @_;
# if the target doesn't exist, then we definitely
# need a rebuild.
return 1 unless -f $self->path;
my $target_time = [stat $self->path]->[9];
foreach my $source (@source)
{
my $source_time = [stat "$source"]->[9];
return 1 if ! defined $source_time;
return 1 if $source_time > $target_time;
}
return 0;
}
sub ld
{
return undef;
}
sub DESTROY
{
my($self) = @_;
if($self->{temp})
{
unlink($self->path);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::Base - Base class for File::Build files
=head1 VERSION
version 2.12
=head1 SYNOPSIS
Create your own file class
package FFI::Build::File::Foo;
use parent qw( FFI::Build::File::Base );
use constant default_suffix => '.foo';
use constant default_encoding => ':utf8';
Use it:
# use an existing file in the filesystem
my $file = FFI::Build::File::Foo->new('src/myfile.foo');
# generate a temp file with provided content
# file will be deletd when $file falls out of scope.
my $file = FFI::Build::File::Foo->new(\'content for a temp foo');
=head1 DESCRIPTION
This class is the base class for other C<FFI::Build::File::*> classes.
=head1 CONSTRUCTOR
=head2 new
my $file = FFI::Build::File::Base->new(\$content, %options);
my $file = FFI::Build::File::Base->new($filename, %options);
Create a new instance of the file class. You may provide either the
content of the file as a scalar reference, or the path to an existing
filename. Options:
=over 4
=item base
The base name for any temporary file C<ffi_build_> by default.
=item build
The L<FFI::Build> instance to use.
=item dir
The directory to store any temporary file.
=item platform
The L<FFI::Build::Platform> instance to use.
=back
=head1 METHODS
=head2 default_suffix
my $suffix = $file->default_suffix;
B<MUST> be overridden in the subclass. This is the standard extension for the file type. C<.c> for a C file, C<.o> or C<.obj> for an object file depending on platform. etc.
=head2 default_encoding
my $encoding = $file->default_encoding;
B<MUST> be overridden in the subclass. This is the passed to C<binmode> when the file is opened for reading or writing.
=head2 accept_suffix
my @suffix_list = $file->accept_suffix;
Returns a list of regexes that recognize the file type.
=head2 path
my $path = $file->path;
The full or relative path to the file.
=head2 basename
my $basename = $file->basename;
The base filename part of the path.
=head2 dirname
my $dir = $file->dirname;
The directory part of the path.
=head2 is_temp
my $bool = $file->is_temp;
Returns true if the file is temporary, that is, it will be deleted when the file object falls out of scope.
You can call C<keep>, to keep the file.
=head2 platform
my $platform = $file->platform;
The L<FFI::Build::Platform> instance used for this file object.
=head2 build
my $build = $file->build;
The L<FFI::Build> instance used for this file object, if any.
=head2 native
my $path = $file->native;
Returns the operating system native version of the filename path. On Windows, this means that forward slash C<\> is
used instead of backslash C</>.
=head2 slurp
my $content = $file->slurp;
Returns the content of the file.
=head2 keep
$file->keep;
Turns off the temporary flag on the file object, meaning it will not automatically be deleted when the
file object is deallocated or falls out of scope.
=head2 build_item
$file->build_item;
Builds the file into its natural output type, usually an object file. It returns a new file instance,
or if the file is an object file then it returns empty list.
=head2 build_all
$file->build_all;
If implemented the file in question can directly create a shared or dynamic library
without needing a link step. This is useful for languages that have their own build
systems.
=head2 needs_rebuild
my $bool = $file->needs_rebuild
=head2 ld
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/File/C.pm 000644 000000 000000 00000011000 15251066120 017435 0 ustar 00root root 000000 000000 package FFI::Build::File::C;
use strict;
use warnings;
use 5.008004;
use parent qw( FFI::Build::File::Base );
use constant default_suffix => '.c';
use constant default_encoding => ':utf8';
use Capture::Tiny ();
use File::Path ();
use FFI::Build::File::Object;
# ABSTRACT: Class to track C source file in FFI::Build
our $VERSION = '2.12'; # VERSION
sub accept_suffix
{
(qr/\.(c|i)$/)
}
sub build_item
{
my($self) = @_;
my $oname = $self->basename;
$oname =~ s/\.(c(xx|pp)|i)?$//;
$oname .= $self->platform->object_suffix;
my $buildname = '_build';
$buildname = $self->build->buildname if $self->build;
my $object = FFI::Build::File::Object->new(
[ $self->dirname, $buildname, $oname ],
platform => $self->platform,
build => $self->build,
);
return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
File::Path::mkpath($object->dirname, { verbose => 0, mode => oct(700) });
my @cmd = (
$self->_base_args,
-c => $self->path,
$self->platform->flag_object_output($object->path),
);
my($out, $exit) = Capture::Tiny::capture_merged(sub {
$self->platform->run(@cmd);
});
if($exit || !-f $object->path)
{
print $out;
die "error building $object from $self";
}
elsif($self->build && $self->build->verbose >= 2)
{
print $out;
}
elsif($self->build && $self->build->verbose >= 1)
{
print "CC @{[ $self->path ]}\n";
}
$object;
}
sub cc
{
my($self) = @_;
$self->platform->cc;
}
sub _base_args
{
my($self) = @_;
my @cmd = ($self->cc);
push @cmd, $self->build->cflags_I if $self->build;
push @cmd, $self->platform->ccflags;
push @cmd, @{ $self->build->cflags } if $self->build;
@cmd;
}
sub _base_args_cpp
{
my($self) = @_;
my @cmd = ($self->platform->cpp);
push @cmd, $self->build->cflags_I if $self->build;
push @cmd, grep /^-[DI]/, $self->platform->ccflags;
push @cmd, grep /^-D/, @{ $self->build->cflags } if $self->build;
@cmd;
}
sub build_item_cpp
{
my($self) = @_;
my $oname = $self->basename;
$oname =~ s/\.(c(xx|pp)|i)$?$//;
$oname .= '.i';
my $buildname = '_build';
$buildname = $self->build->buildname if $self->build;
my $ifile = FFI::Build::File::C->new(
[ $self->dirname, $buildname, $oname ],
platform => $self->platform,
build => $self->build,
);
File::Path::mkpath($ifile->dirname, { verbose => 0, mode => oct(700) });
my @cmd = (
$self->_base_args_cpp,
$self->path,
);
my($out, $err, $exit) = Capture::Tiny::capture(sub {
$self->platform->run(@cmd);
});
if($exit)
{
print "[out]\n$out\n" if defined $out && $out ne '';
print "[err]\n$err\n" if defined $err && $err ne '';
die "error building $ifile from $self";
}
else
{
my $fh;
open($fh, '>', $ifile->path);
print $fh $out;
close $fh;
}
$ifile;
}
sub _deps
{
my($self) = @_;
return $self->path unless $self->platform->cc_mm_works;
my @cmd = (
$self->_base_args,
'-MM',
$self->path,
);
my($out,$err,$exit) = Capture::Tiny::capture(sub {
$self->platform->run(@cmd);
});
if($exit)
{
print $out;
print $err;
warn "error computing dependencies for $self";
return ($self->path);
}
else
{
$out =~ s/^\+.*\n//; # remove the command line
# which on windows could have an confusing :
my(undef, $deps) = split /:/, $out, 2;
$deps =~ s/^\s+//;
$deps =~ s/\s+$//;
return grep !/^\\$/, split /\s+/, $deps;
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::C - Class to track C source file in FFI::Build
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Build::File::C;
my $c = FFI::Build::File::C->new('src/foo.c');
=head1 DESCRIPTION
File class for C source files.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/File/CXX.pm 000644 000000 000000 00000002776 15251066120 017741 0 ustar 00root root 000000 000000 package FFI::Build::File::CXX;
use strict;
use warnings;
use 5.008004;
use parent qw( FFI::Build::File::C );
use constant default_suffix => '.cxx';
use constant default_encoding => ':utf8';
# ABSTRACT: Class to track C source file in FFI::Build
our $VERSION = '2.12'; # VERSION
sub accept_suffix
{
(qr/\.c(xx|pp)$/)
}
sub cc
{
my($self) = @_;
$self->platform->cxx;
}
sub ld
{
my($self) = @_;
$self->platform->cxxld;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::CXX - Class to track C source file in FFI::Build
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Build::File::CXX;
my $c = FFI::Build::File::CXX->new('src/foo.cxx');
=head1 DESCRIPTION
File class for C++ source files.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/File/Library.pm 000644 000000 000000 00000003464 15251066120 020676 0 ustar 00root root 000000 000000 package FFI::Build::File::Library;
use strict;
use warnings;
use 5.008004;
use parent qw( FFI::Build::File::Base );
use constant default_encoding => ':raw';
# ABSTRACT: Class to track object file in FFI::Build
our $VERSION = '2.12'; # VERSION
sub default_suffix
{
shift->platform->library_suffix;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::Library - Class to track object file in FFI::Build
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Build;
my $build = FFI::Build->new(source => 'src/*.c');
# $lib is an instance of FFI::Build::File::Library
my $lib = $build->build;
=head1 DESCRIPTION
This is a class to track a library generated by L<FFI::Build>.
This is returned by L<FFI::Build>'s build method. This class
is a subclass of L<FFI::Build::File::Base>. The most important
method is probably C<path>, which returns the path to the library
which can be passed into L<FFI::Platypus> for immediate use.
=head1 METHODS
=head2 path
my $path = $lib->path;
Returns the path of the library.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/File/Object.pm 000644 000000 000000 00000003067 15251066120 020477 0 ustar 00root root 000000 000000 package FFI::Build::File::Object;
use strict;
use warnings;
use 5.008004;
use parent qw( FFI::Build::File::Base );
use constant default_encoding => ':raw';
use Carp ();
# ABSTRACT: Class to track object file in FFI::Build
our $VERSION = '2.12'; # VERSION
sub default_suffix
{
shift->platform->object_suffix;
}
sub build_item
{
my($self) = @_;
unless(-f $self->path)
{
Carp::croak "File not built"
}
return;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::Object - Class to track object file in FFI::Build
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Build::File::Object;
my $o = FFI::Build::File::Object->new('src/_build/foo.o');
=head1 DESCRIPTION
This class represents an object file. You normally do not need
to use it directly.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/MM.pm 000644 000000 000000 00000021223 15251066120 016715 0 ustar 00root root 000000 000000 package FFI::Build::MM;
use strict;
use warnings;
use 5.008004;
use Carp ();
use FFI::Build;
use JSON::PP ();
use File::Glob ();
use File::Basename ();
use File::Path ();
use File::Copy ();
use ExtUtils::MakeMaker 7.12;
# ABSTRACT: FFI::Build installer code for ExtUtils::MakeMaker
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, %opt) = @_;
my $save = defined $opt{save} ? $opt{save} : 1;
my $self = bless { save => $save }, $class;
$self->load_prop;
$self;
}
sub mm_args
{
my($self, %args) = @_;
if($args{DISTNAME})
{
$self->{prop}->{distname} ||= $args{DISTNAME};
$self->{prop}->{share} ||= "blib/lib/auto/share/dist/@{[ $self->distname ]}";
$self->{prop}->{arch} ||= "blib/arch/auto/@{[ join '/', split /-/, $self->distname ]}";
$self->save_prop;
}
else
{
Carp::croak "DISTNAME is required";
}
if(my $build = $self->build)
{
foreach my $alien (@{ $build->alien })
{
next if ref $alien;
$args{BUILD_REQUIRES}->{$alien} ||= 0;
}
}
if(my $test = $self->test)
{
foreach my $alien (@{ $test->alien })
{
next if ref $alien;
$args{TEST_REQUIRES}->{$alien} ||= 0;
}
}
%args;
}
sub distname { shift->{prop}->{distname} }
sub sharedir
{
my($self, $new) = @_;
if(defined $new)
{
$self->{prop}->{share} = $new;
$self->save_prop;
}
$self->{prop}->{share};
}
sub archdir
{
my($self, $new) = @_;
if(defined $new)
{
$self->{prop}->{arch} = $new;
$self->save_prop;
}
$self->{prop}->{arch};
}
sub load_build
{
my($self, $dir, $name, $install) = @_;
return unless -d $dir;
my($fbx) = File::Glob::bsd_glob("./$dir/*.fbx");
my $options;
my $platform = FFI::Build::Platform->default;
if($fbx)
{
$name = File::Basename::basename($fbx);
$name =~ s/\.fbx$//;
$options = do {
package FFI::Build::MM::FBX;
our $DIR = $dir;
our $PLATFORM = $platform;
# make sure we catch all of the errors
# code copied from `perldoc -f do`
my $return = do $fbx;
unless ( $return ) {
Carp::croak( "couldn't parse $fbx: $@" ) if $@;
Carp::croak( "couldn't do $fbx: $!" ) unless defined $return;
Carp::croak( "couldn't run $fbx" ) unless $return;
}
$return;
};
}
else
{
$name ||= $self->distname;
$options = {
source => ["$dir/*.c", "$dir/*.cxx", "$dir/*.cpp"],
};
# if we see a Go, V, Rust or Zig control file then we assume the
# ffi mod is written in that language.
foreach my $control_file ("$dir/Cargo.toml", "$dir/go.mod", "$dir/v.mod", "$dir/build.zig")
{
if(-f $control_file)
{
$options->{source} = [$control_file];
last;
}
}
}
$options->{platform} ||= $platform;
$options->{dir} ||= ref $install ? $install->($options) : $install;
$options->{verbose} = 1 unless defined $options->{verbose};
FFI::Build->new($name, %$options);
}
sub build
{
my($self) = @_;
$self->{build} ||= $self->load_build('ffi', undef, $self->sharedir . "/lib");
}
sub test
{
my($self) = @_;
$self->{test} ||= $self->load_build('t/ffi', 'test', sub {
my($opt) = @_;
my $buildname = $opt->{buildname} || '_build';
"t/ffi/$buildname";
});
}
sub save_prop
{
my($self) = @_;
return unless $self->{save};
open my $fh, '>', 'fbx.json';
print $fh JSON::PP::encode_json($self->{prop});
close $fh;
}
sub load_prop
{
my($self) = @_;
return unless $self->{save};
unless(-f 'fbx.json')
{
$self->{prop} = {};
return;
}
open my $fh, '<', 'fbx.json';
$self->{prop} = JSON::PP::decode_json(do { local $/; <$fh> });
close $fh;
}
sub clean
{
my($self) = @_;
foreach my $stage (qw( build test ))
{
my $build = $self->$stage;
$build->clean if $build;
}
unlink 'fbx.json' if -f 'fbx.json';
}
sub mm_postamble
{
my($self) = @_;
my $postamble = ".PHONY: fbx_build ffi fbx_test ffi-test fbx_clean ffi-clean\n\n";
# make fbx_realclean ; make clean
$postamble .= "realclean :: fbx_clean\n" .
"\n" .
"fbx_clean ffi-clean:\n" .
"\t\$(FULLPERL) -MFFI::Build::MM=cmd -e fbx_clean\n\n";
# make fbx_build; make
$postamble .= "pure_all :: fbx_build\n" .
"\n" .
"fbx_build ffi:\n" .
"\t\$(FULLPERL) -MFFI::Build::MM=cmd -e fbx_build\n\n";
# make fbx_test; make test
$postamble .= "subdirs-test_dynamic subdirs-test_static subdirs-test :: fbx_test\n" .
"\n" .
"fbx_test ffi-test:\n" .
"\t\$(FULLPERL) -MFFI::Build::MM=cmd -e fbx_test\n\n";
$postamble;
}
sub action_build
{
my($self) = @_;
my $build = $self->build;
if($build)
{
my $lib = $build->build;
if($self->archdir)
{
File::Path::mkpath($self->archdir, 0, oct(755));
my $archfile = File::Spec->catfile($self->archdir, File::Basename::basename($self->archdir) . ".txt");
open my $fh, '>', $archfile;
my $lib_path = $lib->path;
$lib_path =~ s/^blib\/lib\///;
print $fh "FFI::Build\@$lib_path\n";
close $fh;
}
}
return;
}
sub action_test
{
my($self) = @_;
my $build = $self->test;
$build->build if $build;
}
sub action_clean
{
my($self) = @_;
my $build = $self->clean;
();
}
sub import
{
my(undef, @args) = @_;
foreach my $arg (@args)
{
if($arg eq 'cmd')
{
package main;
my $mm = sub {
my($action) = @_;
my $build = FFI::Build::MM->new;
$build->$action;
};
no warnings 'once';
*fbx_build = sub {
$mm->('action_build');
};
*fbx_test = sub {
$mm->('action_test');
};
*fbx_clean = sub {
$mm->('action_clean');
};
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::MM - FFI::Build installer code for ExtUtils::MakeMaker
=head1 VERSION
version 2.12
=head1 SYNOPSIS
In your Makefile.PL:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile($fbmm->mm_args(
ABSTRACT => 'My FFI extension',
DISTNAME => 'Foo-Bar-Baz-FFI',
NAME => 'Foo::Bar::Baz::FFI',
VERSION_FROM => 'lib/Foo/Bar/Baz/FFI.pm',
...
));
sub MY::postamble {
$fbmm->mm_postamble;
}
Then put the C, C++ or Fortran files in C<./ffi> for your runtime library
and C<./t/ffi> for your test time library.
=head1 DESCRIPTION
This module provides a thin layer between L<FFI::Build> and L<ExtUtils::MakeMaker>.
Its interface is influenced by the design of L<Alien::Build::MM>. The idea is that
for your distribution you throw some C, C++ or Fortran source files into a directory
called C<ffi> and these files will be compiled and linked into a library that can
be used by your module. There is a control file C<ffi/*.fbx> which can be used to
control the compiler and linker options. (options passed directly into L<FFI::Build>).
The interface for this file is still under development.
=head1 CONSTRUCTOR
=head2 new
my $fbmm = FFI::Build::MM->new;
Create a new instance of L<FFI::Build::MM>.
=head1 METHODS
=head2 mm_args
my %new_args = $fbmm->mm_args(%old_args);
This method does two things:
=over 4
=item reads the arguments to determine sensible defaults (library name, install location, etc).
=item adjusts the arguments as necessary and returns an updated set of arguments.
=back
=head2 mm_postamble
my $postamble = $fbmm->mm_postamble;
This returns the Makefile postamble used by L<ExtUtils::MakeMaker>. The synopsis above for
how to invoke it properly. It adds the following Make targets:
=over 4
=item fbx_build / ffi
build the main runtime library in C<./ffi>.
=item fbx_test / ffi-test
Build the test library in C<./t/ffi>.
=item fbx_clean / ffi-clean
Clean any runtime or test libraries already built.
=back
Normally you do not need to build these targets manually, they will be built automatically
at the appropriate stage.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/Platform.pm 000644 000000 000000 00000031317 15251066120 020175 0 ustar 00root root 000000 000000 package FFI::Build::Platform;
use strict;
use warnings;
use 5.008004;
use Carp ();
use Text::ParseWords ();
use FFI::Temp;
use Capture::Tiny ();
use File::Spec;
use FFI::Platypus::ShareConfig;
# ABSTRACT: Platform specific configuration.
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, $config) = @_;
$config ||= do {
require Config;
\%Config::Config;
};
my $self = bless {
config => $config,
}, $class;
$self;
}
my $default;
sub default
{
$default ||= FFI::Build::Platform->new;
}
sub _self
{
my($self) = @_;
ref $self ? $self : $self->default;
}
sub osname
{
_self(shift)->{config}->{osname};
}
sub object_suffix
{
_self(shift)->{config}->{obj_ext};
}
sub library_suffix
{
my $self = _self(shift);
my $osname = $self->osname;
my @suffix;
if($osname eq 'darwin')
{
push @suffix, '.dylib', '.bundle';
}
elsif($osname =~ /^(MSWin32|msys|cygwin)$/)
{
push @suffix, '.dll';
}
else
{
push @suffix, '.' . $self->{config}->{dlext};
}
wantarray ? @suffix : $suffix[0]; ## no critic (Community::Wantarray)
}
sub library_prefix
{
my $self = _self(shift);
# this almost certainly requires refinement.
if($self->osname eq 'cygwin')
{
return 'cyg';
}
elsif($self->osname eq 'msys')
{
return 'msys-';
}
elsif($self->osname eq 'MSWin32')
{
return '';
}
else
{
return 'lib';
}
}
sub cc
{
my $self = _self(shift);
my $cc = $self->{config}->{cc};
[$self->shellwords($cc)];
}
sub cpp
{
my $self = _self(shift);
my $cpp = $self->{config}->{cpprun};
[$self->shellwords($cpp)];
}
sub cxx
{
my $self = _self(shift);
my @cc = @{ $self->cc };
if($self->{config}->{ccname} eq 'gcc')
{
if($cc[0] =~ /gcc$/)
{
my @maybe = @cc;
$maybe[0] =~ s/gcc$/g++/;
return \@maybe if $self->which($maybe[0]);
}
if($cc[0] =~ /clang/)
{
my @maybe = @cc;
$maybe[0] =~ s/clang/clang++/;
return \@maybe if $self->which($maybe[0]);
}
# TODO: there are probably situations, eg solaris
# where we don't want to try c++ in the case of
# a ccname = gcc ?
my @maybe = qw( c++ g++ clang++ );
foreach my $maybe (@maybe)
{
return [$maybe] if $self->which($maybe);
}
}
elsif($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
# TODO: see https://github.com/PerlFFI/FFI-Platypus/issues/203
#return \@cc;
}
Carp::croak("unable to detect corresponding C++ compiler");
}
sub cxxld
{
my $self = _self(shift);
$DB::single = 1;
# This is definitely not exhaustive or complete or even
# particularlly good. Patches welcome.
if($self->osname eq 'darwin')
{
my @cxx = @{ $self->cxx };
return [map { /^(cc|clang|gcc)$/ ? @cxx : $_ } @{ $self->ld }];
}
else
{
return $self->cxx;
}
}
sub for
{
my $self = _self(shift);
my @cc = @{ $self->cc };
if($self->{config}->{ccname} eq 'gcc')
{
if($cc[0] =~ /gcc$/)
{
my @maybe = @cc;
$maybe[0] =~ s/gcc$/gfortran/;
return \@maybe if $self->which($maybe[0]);
}
foreach my $maybe (qw( gfortran ))
{
return [$maybe] if $self->which($maybe);
}
}
else
{
Carp::croak("unable to detect correspnding Fortran Compiler");
}
}
sub ld
{
my($self) = @_;
my $ld = $self->{config}->{ld};
[$self->shellwords($ld)];
}
sub shellwords
{
my $self = _self(shift);
my $win = !!($self->osname eq 'MSWin32');
grep { defined $_ } map {
ref $_
# if we have an array ref then it has already been shellworded
? @$_
: do {
# remove leading whitespace, confuses some older versions of shellwords
my $str = /^\s*(.*)$/ && $1;
# escape things on windows
$str =~ s,\\,\\\\,g if $win;
Text::ParseWords::shellwords($str);
}
} @_;
}
sub ccflags
{
my $self = _self(shift);
my @ccflags;
push @ccflags, $self->shellwords($self->{config}->{cccdlflags});
push @ccflags, $self->shellwords($self->{config}->{ccflags});
push @ccflags, $self->shellwords($self->{config}->{optimize});
my $dist_include = eval { File::Spec->catdir(FFI::Platypus::ShareConfig::dist_dir('FFI-Platypus'), 'include') };
push @ccflags, "-I$dist_include" unless $@;
\@ccflags;
}
sub ldflags
{
my $self = _self(shift);
my @ldflags = $self->shellwords($self->{config}->{lddlflags});
if($self->osname eq 'cygwin')
{
no warnings 'qw';
# doesn't appear to be necessary, Perl has this in lddlflags already on cygwin
#push @ldflags, qw( -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base );
}
elsif($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
push @ldflags, qw( -dll );
@ldflags = grep !/^-nodefaultlib$/, @ldflags;
}
elsif($self->osname eq 'MSWin32')
{
no warnings 'qw';
push @ldflags, qw( -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base );
}
elsif($self->osname eq 'darwin')
{
# we want to build a .dylib instead of a .bundle
@ldflags = map { $_ eq '-bundle' ? '-dynamiclib' : $_ } @ldflags;
}
\@ldflags;
}
sub cc_mm_works
{
my $self = _self(shift);
my $verbose = shift;
$verbose ||= 0;
unless(defined $self->{cc_mm_works})
{
require FFI::Build::File::C;
my $c = FFI::Build::File::C->new(\"#include \"foo.h\"\n");
my $dir = FFI::Temp->newdir;
{
open my $fh, '>', "$dir/foo.h";
print $fh "\n";
close $fh;
}
my @cmd = (
$self->cc,
$self->ccflags,
"-I$dir",
'-MM',
$c->path,
);
my($out, $exit) = Capture::Tiny::capture_merged(sub {
$self->run(@cmd);
});
if($verbose >= 2)
{
print $out;
}
elsif($verbose >= 1)
{
print "CC (checkfor -MM)\n";
}
if(!$exit && $out =~ /foo\.h/)
{
$self->{cc_mm_works} = '-MM';
}
else
{
$self->{cc_mm_works} = 0;
}
}
$self->{cc_mm_works};
}
sub flag_object_output
{
my $self = _self(shift);
my $file = shift;
if($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
return ("-Fo$file");
}
else
{
return ('-o' => $file);
}
}
sub flag_library_output
{
my $self = _self(shift);
my $file = shift;
if($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
return ("-OUT:$file");
}
elsif($self->osname eq 'darwin')
{
return ('-install_name' => "\@rpath/$file", -o => $file);
}
else
{
return ('-o' => $file);
}
}
sub flag_exe_output
{
my $self = _self(shift);
my $file = shift;
if($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
my $file = File::Spec->rel2abs($file);
return ("/Fe:$file");
}
else
{
return ('-o' => $file);
}
}
sub flag_export
{
my $self = _self(shift);
return () unless $self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl';
return map { "/EXPORT:$_" } @_;
}
sub which
{
my(undef, $command) = @_;
require IPC::Cmd;
my @command = ref $command ? @$command : ($command);
IPC::Cmd::can_run($command[0]);
}
sub run
{
my $self = shift;
my @command = map { ref $_ ? @$_ : $_ } grep { defined $_ } @_;
print "+@command\n";
system @command;
$?;
}
sub _c { join ',', @_ }
sub _l { join ' ', map { ref $_ ? @$_ : $_ } @_ }
sub diag
{
my $self = _self(shift);
my @diag;
push @diag, "osname : ". _c($self->osname);
push @diag, "cc : ". _l($self->cc);
push @diag, "cxx : ". (eval { _l($self->cxx) } || '---' );
push @diag, "cxxld : ". (eval { _l($self->cxxld) } || '---' );
push @diag, "for : ". (eval { _l($self->for) } || '---' );
push @diag, "ld : ". _l($self->ld);
push @diag, "ccflags : ". _l($self->ccflags);
push @diag, "ldflags : ". _l($self->ldflags);
push @diag, "object suffix : ". _c($self->object_suffix);
push @diag, "library prefix : ". _c($self->library_prefix);
push @diag, "library suffix : ". _c($self->library_suffix);
push @diag, "cc mm works : ". $self->cc_mm_works;
join "\n", @diag;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::Platform - Platform specific configuration.
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Build::Platform;
=head1 DESCRIPTION
This class is used to abstract out the platform specific parts of the L<FFI::Build> system.
You shouldn't need to use it directly in most cases, unless you are working on L<FFI::Build>
itself.
=head1 CONSTRUCTOR
=head2 new
my $platform = FFI::Build::Platform->new;
Create a new instance of L<FFI::Build::Platform>.
=head2 default
my $platform = FFI::Build::Platform->default;
Returns the default instance of L<FFI::Build::Platform>.
=head1 METHODS
All of these methods may be called either as instance or classes
methods. If called as a class method, the default instance will
be used.
=head2 osname
my $osname = $platform->osname;
The "os name" as understood by Perl. This is the same as C<$^O>.
=head2 object_suffix
my $suffix = $platform->object_suffix;
The object suffix for the platform. On UNIX this is usually C<.o>. On Windows this
is usually C<.obj>.
=head2 library_suffix
my(@suffix) = $platform->library_suffix;
my $suffix = $platform->library_suffix;
The library suffix for the platform. On Linux and some other UNIX this is often C<.so>.
On OS X, this is C<.dylib> and C<.bundle>. On Windows this is C<.dll>.
=head2 library_prefix
my $prefix = $platform->library_prefix;
The library prefix for the platform. On Unix this is usually C<lib>, as in C<libfoo>.
=head2 cc
my @cc = @{ $platform->cc };
The C compiler
=head2 cpp
my @cpp = @{ $platform->cpp };
The C pre-processor
=head2 cxx
my @cxx = @{ $platform->cxx };
The C++ compiler that naturally goes with the C compiler.
=head2 cxxld
my @cxxld = @{ $platform->cxxld };
The C++ linker that naturally goes with the C compiler.
=head2 for
my @for = @{ $platform->for };
The Fortran compiler that naturally goes with the C compiler.
=head2 ld
my $ld = $platform->ld;
The C linker
=head2 shellwords
my @words = $platform->shellwords(@strings);
This is a wrapper around L<Text::ParseWords>'s C<shellwords> with some platform workarounds
applied.
=head2 ccflags
my @ccflags = @{ $platform->cflags};
The compiler flags, including those needed to compile object files that can be linked into a dynamic library.
On Linux, for example, this is usually includes C<-fPIC>.
=head2 ldflags
my @ldflags = @{ $platform->ldflags };
The linker flags needed to link object files into a dynamic library. This is NOT the C<libs> style library
flags that specify the location and name of a library to link against, this is instead the flags that tell
the linker to generate a dynamic library. On Linux, for example, this is usually C<-shared>.
=head2 cc_mm_works
my $bool = $platform->cc_mm_works;
Returns the flags that can be passed into the C compiler to compute dependencies.
=head2 flag_object_output
my @flags = $platform->flag_object_output($object_filename);
Returns the flags that the compiler recognizes as being used to write out to a specific object filename.
=head2 flag_library_output
my @flags = $platform->flag_library_output($library_filename);
Returns the flags that the compiler recognizes as being used to write out to a specific library filename.
=head2 flag_exe_output
my @flags = $platform->flag_exe_output($library_filename);
Returns the flags that the compiler recognizes as being used to write out to a specific exe filename.
=head2 flag_export
my @flags = $platform->flag_export(@symbols);
Returns the flags that the linker recognizes for exporting functions.
=head2 which
my $path = $platform->which($command);
Returns the full path of the given command, if it is available, otherwise C<undef> is returned.
=head2 run
$platform->run(@command);
=head2 diag
Diagnostic for the platform as a string. This is for human consumption only, and the format
may and will change over time so do not attempt to use is programmatically.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/Plugin.pm 000644 000000 000000 00000004617 15251066120 017652 0 ustar 00root root 000000 000000 package FFI::Build::Plugin;
use strict;
use warnings;
use autodie;
use File::Spec::Functions qw( catdir catfile );
# ABSTRACT: Platform and local customizations of FFI::Build
our $VERSION = '2.12'; # VERSION
sub new
{
my($class) = @_;
my %plugins;
foreach my $inc (@INC)
{
# CAVEAT: won't work with an @INC hook. Plugins must be in a "real" directory.
my $path = catdir($inc, 'FFI', 'Build', 'Plugin');
next unless -d $path;
my $dh;
opendir $dh, $path;
my @list = readdir $dh;
closedir $dh;
foreach my $name (map { my $x = $_; $x =~ s/\.pm$//; $x } grep /\.pm$/, @list)
{
next if defined $plugins{$name};
my $pm = catfile('FFI', 'Build', 'Plugin', "$name.pm");
require $pm;
my $class = "FFI::Build::Plugin::$name";
if($class->can("api_version") && $class->api_version == 0)
{
$plugins{$name} = $class->new;
}
else
{
warn "$class is not the correct api version. You may need to upgrade the plugin, platypus or uninstall the plugin";
}
}
}
bless \%plugins, $class;
}
sub call
{
my($self, $method, @args) = @_;
foreach my $name (sort keys %$self)
{
my $plugin = $self->{$name};
$plugin->$method(@args) if $plugin->can($method);
}
1;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::Plugin - Platform and local customizations of FFI::Build
=head1 VERSION
version 2.12
=head1 SYNOPSIS
perldoc FFI::Build
=head1 DESCRIPTION
This class is experimental, but may do something useful in the future.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=item L<FFI::Build>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Build/PluginData.pm 000644 000000 000000 00000003140 15251066120 020432 0 ustar 00root root 000000 000000 package FFI::Build::PluginData;
use strict;
use warnings;
use parent qw( Exporter );
our @EXPORT_OK = qw( plugin_data );
# ABSTRACT: Platform and local customizations of FFI::Build
our $VERSION = '2.12'; # VERSION
sub plugin_data
{
my($self) = @_;
my $caller = caller;
if($caller =~ /^FFI::Build::Plugin::(.*)$/)
{
return $self->{plugin_data}->{$1} ||= {};
}
else
{
require Carp;
Carp::croak("plugin_data must be called by a plugin");
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::PluginData - Platform and local customizations of FFI::Build
=head1 VERSION
version 2.12
=head1 SYNOPSIS
perldoc FFI::Build
=head1 DESCRIPTION
This class is experimental, but may do something useful in the future.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=item L<FFI::Build>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus.pm 000644 000000 000000 00000271452 15251066120 017201 0 ustar 00root root 000000 000000 package FFI::Platypus;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use FFI::Platypus::Function;
use FFI::Platypus::Type;
# ABSTRACT: Write Perl bindings to non-Perl libraries with FFI. No XS required.
our $VERSION = '2.12'; # VERSION
# Platypus-Man,
# Platypus-Man,
# Does Whatever A Platypus Can
# Is Mildly Venomous
# Hangs Out In Rivers By Caves
# Look Out!
# Here Comes The Platypus-Man
# From the original FFI::Platypus prototype:
# Kinda like gluing a duckbill to an adorable mammal
our @CARP_NOT = qw( FFI::Platypus::Declare FFI::Platypus::Record );
require XSLoader;
XSLoader::load(
'FFI::Platypus', $FFI::Platypus::VERSION || 0
);
sub new
{
my($class, %args) = @_;
my @lib;
if(exists $args{lib})
{
if(!ref($args{lib}))
{
push @lib, $args{lib};
}
elsif(ref($args{lib}) eq 'ARRAY')
{
push @lib, @{$args{lib}};
}
else
{
croak "lib argument must be a scalar or array reference";
}
}
my $api = $args{api} || 0;
my $experimental = $args{experimental} || 0;
if($experimental == 1)
{
Carp::croak("Please do not use the experimental version of api = 1, instead require FFI::Platypus 1.00 or better");
}
elsif($experimental == 2)
{
Carp::croak("Please do not use the experimental version of api = 2, instead require FFI::Platypus 2.00 or better");
}
if(defined $api && $api > 2 && $experimental != $api)
{
Carp::cluck("Enabling development API version $api prior to FFI::Platypus $api.00");
}
my $tp;
if($api == 0)
{
$tp = 'Version0';
}
elsif($api == 1)
{
$tp = 'Version1';
}
elsif($api == 2)
{
$tp = 'Version2';
}
else
{
Carp::croak("API version $api not (yet) implemented");
}
require "FFI/Platypus/TypeParser/$tp.pm";
$tp = "FFI::Platypus::TypeParser::$tp";
my $self = bless {
lib => \@lib,
lang => '',
handles => {},
abi => -1,
api => $api,
tp => $tp->new,
fini => [],
ignore_not_found => defined $args{ignore_not_found} ? $args{ignore_not_found} : 0,
}, $class;
$self->lang($args{lang} || 'C');
$self;
}
sub _lang_class ($)
{
my($lang) = @_;
my $class = $lang =~ m/^=(.*)$/ ? $1 : "FFI::Platypus::Lang::$lang";
unless($class->can('native_type_map'))
{
my $pm = "$class.pm";
$pm =~ s/::/\//g;
require $pm;
}
croak "$class does not provide native_type_map method"
unless $class->can("native_type_map");
$class;
}
sub lib
{
my($self, @new) = @_;
if(@new)
{
push @{ $self->{lib} }, map { ref $_ eq 'CODE' ? $_->() : $_ } @new;
delete $self->{mangler};
}
@{ $self->{lib} };
}
sub ignore_not_found
{
my($self, $value) = @_;
if(defined $value)
{
$self->{ignore_not_found} = $value;
}
$self->{ignore_not_found};
}
sub lang
{
my($self, $value) = @_;
if(defined $value && $value ne $self->{lang})
{
$self->{lang} = $value;
my $class = _lang_class($self->{lang});
$self->abi($class->abi) if $class->can('abi');
{
my %type_map;
my $map = $class->native_type_map(
$self->{api} > 0
? (api => $self->{api})
: ()
);
foreach my $key (keys %$map)
{
my $value = $map->{$key};
next unless $self->{tp}->have_type($value);
$type_map{$key} = $value;
}
$type_map{$_} = $_ for grep { $self->{tp}->have_type($_) }
qw( void sint8 uint8 sint16 uint16 sint32 uint32 sint64 uint64 float double string opaque
longdouble complex_float complex_double );
$type_map{pointer} = 'opaque' if $self->{tp}->isa('FFI::Platypus::TypeParser::Version0');
$self->{tp}->type_map(\%type_map);
}
$class->load_custom_types($self) if $class->can('load_custom_types');
}
$self->{lang};
}
sub api { shift->{api} }
sub type
{
my($self, $name, $alias) = @_;
croak "usage: \$ffi->type(name => alias) (alias is optional)" unless defined $self && defined $name;
$self->{tp}->check_alias($alias) if defined $alias;
my $type = $self->{tp}->parse($name);
$self->{tp}->set_alias($alias, $type) if defined $alias;
$self;
}
sub custom_type
{
my($self, $alias, $cb) = @_;
my $argument_count = $cb->{argument_count} || 1;
croak "argument_count must be >= 1"
unless $argument_count >= 1;
croak "Usage: \$ffi->custom_type(\$alias, { ... })"
unless defined $alias && ref($cb) eq 'HASH';
croak "must define at least one of native_to_perl, perl_to_native, or perl_to_native_post"
unless defined $cb->{native_to_perl} || defined $cb->{perl_to_native} || defined $cb->{perl_to_native_post};
$self->{tp}->check_alias($alias);
my $type = $self->{tp}->create_type_custom(
$cb->{native_type},
$cb->{perl_to_native},
$cb->{native_to_perl},
$cb->{perl_to_native_post},
$argument_count,
);
$self->{tp}->set_alias($alias, $type);
$self;
}
sub load_custom_type
{
my($self, $name, $alias, @type_args) = @_;
croak "usage: \$ffi->load_custom_type(\$name, \$alias, ...)"
unless defined $name && defined $alias;
$name = "FFI::Platypus::Type$name" if $name =~ /^::/;
$name = "FFI::Platypus::Type::$name" unless $name =~ /::/;
unless($name->can("ffi_custom_type_api_1"))
{
my $pm = "$name.pm";
$pm =~ s/::/\//g;
eval { require $pm };
warn $@ if $@;
}
unless($name->can("ffi_custom_type_api_1"))
{
croak "$name does not appear to conform to the custom type API";
}
my $cb = $name->ffi_custom_type_api_1($self, @type_args);
$self->custom_type($alias => $cb);
$self;
}
sub types
{
my($self) = @_;
$self = $self->new unless ref $self && eval { $self->isa('FFI::Platypus') };
sort $self->{tp}->list_types;
}
sub type_meta
{
my($self, $name) = @_;
$self = $self->new unless ref $self && eval { $self->isa('FFI::Platypus') };
$self->{tp}->parse($name)->meta;
}
sub mangler
{
my($self, $sub) = @_;
$self->{mangler} = $self->{mymangler} = $sub;
}
sub function
{
my $wrapper;
$wrapper = pop if ref $_[-1] eq 'CODE';
croak "usage \$ffi->function( \$name, \\\@arguments, [\\\@var_args], [\$return_type])" unless @_ >= 3 && @_ <= 6;
my $self = shift;
my $name = shift;
my $fixed_args = shift;
my $var_args;
$var_args = shift if defined $_[0] && ref($_[0]) eq 'ARRAY';
my $ret = shift;
$ret = 'void' unless defined $ret;
# special case: treat a single void argument type as an empty list of
# arguments, a la olde timey C compilers.
if( (!defined $var_args) && @$fixed_args == 1 && $fixed_args->[0] eq 'void' )
{
$fixed_args = [];
}
my $fixed_arg_count = defined $var_args ? scalar(@$fixed_args) : -1;
my @args = map { $self->{tp}->parse($_) || croak "unknown type: $_" } @$fixed_args;
if($var_args)
{
push @args, map {
my $type = $self->{tp}->parse($_);
# https://github.com/PerlFFI/FFI-Platypus/issues/323
$type->type_code == 67 ? $self->{tp}->parse('double') : $type
} @$var_args;
}
$ret = $self->{tp}->parse($ret) || croak "unknown type: $ret";
my $address = $name =~ /^-?[0-9]+$/ ? $name : $self->find_symbol($name);
croak "unable to find $name" unless defined $address || $self->ignore_not_found;
return unless defined $address;
$address = @args > 0 ? _cast1() : _cast0() if $address == 0;
my $function = FFI::Platypus::Function::Function->new($self, $address, $self->{abi}, $fixed_arg_count, $ret, @args);
$wrapper
? FFI::Platypus::Function::Wrapper->new($function, $wrapper)
: $function;
}
sub _function_meta
{
# NOTE: may be upgraded to a documented function one day,
# but shouldn't be used externally as we will rename it
# if that happens.
my($self, $name, $meta, $args, $ret) = @_;
$args = ['opaque','int',@$args];
$self->function(
$name, $args, $ret, sub {
my $xsub = shift;
$xsub->($meta, scalar(@_), @_);
},
);
}
sub attach
{
my $wrapper;
$wrapper = pop if ref $_[-1] eq 'CODE';
my $self = shift;
my $name = shift;
my $args = shift;
my $varargs;
$varargs = shift if defined $_[0] && ref($_[0]) eq 'ARRAY';
my $ret = shift;
my $proto = shift;
$ret = 'void' unless defined $ret;
my($c_name, $perl_name) = ref($name) ? @$name : ($name, $name);
croak "you tried to provide a perl name that looks like an address"
if $perl_name =~ /^-?[0-9]+$/;
my $function = $varargs
? $self->function($c_name, $args, $varargs, $ret, $wrapper)
: $self->function($c_name, $args, $ret, $wrapper);
if(defined $function)
{
$function->attach($perl_name, $proto);
}
$self;
}
sub closure
{
my($self, $coderef) = @_;
return undef unless defined $coderef;
croak "not a coderef" unless ref $coderef eq 'CODE';
require FFI::Platypus::Closure;
FFI::Platypus::Closure->new($coderef);
}
sub cast
{
$_[0]->function(0 => [$_[1]] => $_[2])->call($_[3]);
}
sub attach_cast
{
my($self, $name, $type1, $type2, $wrapper) = @_;
my $caller = caller;
$name = join '::', $caller, $name unless $name =~ /::/;
if(defined $wrapper && ref($wrapper) eq 'CODE')
{
$self->attach([0 => $name] => [$type1] => $type2 => '$', $wrapper);
}
else
{
$self->attach([0 => $name] => [$type1] => $type2 => '$');
}
$self;
}
sub sizeof
{
my($self,$name) = @_;
ref $self
? $self->{tp}->parse($name)->sizeof
: $self->new->sizeof($name);
}
sub alignof
{
my($self, $name) = @_;
ref $self
? $self->{tp}->parse($name)->alignof
: $self->new->alignof($name);
}
sub kindof
{
my($self, $name) = @_;
ref $self
? $self->{tp}->parse($name)->kindof
: $self->new->kindof($name);
}
sub countof
{
my($self, $name) = @_;
ref $self
? $self->{tp}->parse($name)->countof
: $self->new->countof($name);
}
sub def
{
my $self = shift;
my $package = shift || caller;
my $type = shift;
if(@_)
{
$self->type($type);
$self->{def}->{$package}->{$type} = shift;
}
$self->{def}->{$package}->{$type};
}
sub unitof
{
my($self, $name) = @_;
ref $self
? $self->{tp}->parse($name)->unitof
: $self->new->unitof($name);
}
sub find_lib
{
my $self = shift;
require FFI::CheckLib;
$self->lib(FFI::CheckLib::find_lib(@_));
$self;
}
sub find_symbol
{
my($self, $name) = @_;
$self->{mangler} ||= $self->{mymangler};
unless(defined $self->{mangler})
{
my $class = _lang_class($self->{lang});
if($class->can('mangler'))
{
$self->{mangler} = $class->mangler($self->lib);
}
else
{
$self->{mangler} = sub { $_[0] };
}
}
foreach my $path (@{ $self->{lib} })
{
my $handle = do { no warnings; $self->{handles}->{$path||0} } || FFI::Platypus::DL::dlopen($path, FFI::Platypus::DL::RTLD_PLATYPUS_DEFAULT());
unless($handle)
{
warn "warning: error loading $path: ", FFI::Platypus::DL::dlerror()
if $self->{api} > 0 || $ENV{FFI_PLATYPUS_DLERROR};
next;
}
my $address = FFI::Platypus::DL::dlsym($handle, $self->{mangler}->($name));
if($address)
{
$self->{handles}->{$path||0} = $handle;
return $address;
}
else
{
FFI::Platypus::DL::dlclose($handle) unless $self->{handles}->{$path||0};
}
}
return;
}
sub bundle
{
croak "bundle method only available with api => 1 or better" if $_[0]->{api} < 1;
require FFI::Platypus::Bundle;
goto &_bundle;
}
sub package
{
croak "package method only available with api => 0" if $_[0]->{api} > 0;
require FFI::Platypus::Legacy;
goto &_package;
}
sub abis
{
require FFI::Platypus::ShareConfig;
FFI::Platypus::ShareConfig->get("abi");
}
sub abi
{
my($self, $newabi) = @_;
unless($newabi =~ /^[0-9]+$/)
{
unless(defined $self->abis->{$newabi})
{
croak "no such ABI: $newabi";
}
$newabi = $self->abis->{$newabi};
}
unless(FFI::Platypus::ABI::verify($newabi))
{
croak "no such ABI: $newabi";
}
$self->{abi} = $newabi;
$self->{tp}->abi($newabi);
$self;
}
sub DESTROY
{
my($self) = @_;
foreach my $fini (@{ $self->{fini} })
{
$fini->($self);
}
foreach my $handle (values %{ $self->{handles} })
{
next unless $handle;
FFI::Platypus::DL::dlclose($handle);
}
delete $self->{handles};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus - Write Perl bindings to non-Perl libraries with FFI. No XS required.
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
# for all new code you should use api => 2
my $ffi = FFI::Platypus->new(
api => 2,
lib => undef, # search libc
);
# call dynamically
$ffi->function( puts => ['string'] => 'int' )->call("hello world");
# attach as a xsub and call (much faster)
$ffi->attach( puts => ['string'] => 'int' );
puts("hello world");
=head1 DESCRIPTION
Platypus is a library for creating interfaces to machine code libraries
written in languages like C, L<C++|FFI::Platypus::Lang::CPP>,
L<Go|FFI::Platypus::Lang::Go>,
L<Fortran|FFI::Platypus::Lang::Fortran>,
L<Rust|FFI::Platypus::Lang::Rust>,
L<Pascal|FFI::Platypus::Lang::Pascal>. Essentially anything that gets
compiled into machine code. This implementation uses L<libffi|https://sourceware.org/libffi/> to
accomplish this task. L<libffi|https://sourceware.org/libffi/> is battle tested by a number of other
scripting and virtual machine languages, such as Python and Ruby to
serve a similar role. There are a number of reasons why you might want
to write an extension with Platypus instead of XS:
=over 4
=item FFI / Platypus does not require messing with the guts of Perl
XS is less of an API and more of the guts of perl splayed out to do
whatever you want. That may at times be very powerful, but it can also
be a frustrating exercise in hair pulling.
=item FFI / Platypus is portable
Lots of languages have FFI interfaces, and it is subjectively easier to
port an extension written in FFI in Perl or another language to FFI in
another language or Perl. One goal of the Platypus Project is to reduce
common interface specifications to a common format like JSON that could
be shared between different languages.
=item FFI / Platypus could be a bridge to Raku
One of those "other" languages could be Raku and Raku already has an
FFI interface I am told.
=item FFI / Platypus can be reimplemented
In a bright future with multiple implementations of Perl 5, each
interpreter will have its own implementation of Platypus, allowing
extensions to be written once and used on multiple platforms, in much
the same way that Ruby-FFI extensions can be use in Ruby, JRuby and
Rubinius.
=item FFI / Platypus is pure perl (sorta)
One Platypus script or module works on any platform where the libraries
it uses are available. That means you can deploy your Platypus script
in a shared filesystem where they may be run on different platforms. It
also means that Platypus modules do not need to be installed in the
platform specific Perl library path.
=item FFI / Platypus is not C or C++ centric
XS is implemented primarily as a bunch of C macros, which requires at
least some understanding of C, the C pre-processor, and some C++ caveats
(since on some platforms Perl is compiled and linked with a C++
compiler). Platypus on the other hand could be used to call other
compiled languages, like L<Fortran|FFI::Platypus::Lang::Fortran>,
L<Go|FFI::Platypus::Lang::Go>,
L<Rust|FFI::Platypus::Lang::Rust>,
L<Pascal|FFI::Platypus::Lang::Pascal>, L<C++|FFI::Platypus::Lang::CPP>,
or even L<assembly|FFI::Platypus::Lang::ASM>, allowing you to focus
on your strengths.
=item FFI / Platypus does not require a parser
L<Inline> isolates the extension developer from XS to some extent, but
it also requires a parser. The various L<Inline> language bindings are
a great technical achievement, but I think writing a parser for every
language that you want to interface with is a bit of an anti-pattern.
=back
This document consists of an API reference, a set of examples, some
support and development (for contributors) information. If you are new
to Platypus or FFI, you may want to skip down to the
L<EXAMPLES|/EXAMPLES> to get a taste of what you can do with Platypus.
Platypus has extensive documentation of types at L<FFI::Platypus::Type>
and its custom types API at L<FFI::Platypus::API>.
You are B<strongly> encouraged to use API level 2 for all new code.
There are a number of improvements and design fixes that you get
for free. You should even consider updating existing modules to
use API level 2 where feasible. How do I do that you might ask?
Simply pass in the API level to the platypus constructor.
my $ffi = FFI::Platypus->new( api => 2 );
The Platypus documentation has already been updated to assume API
level 1.
=for stopwords ØMQ
=head1 CONSTRUCTORS
=head2 new
my $ffi = FFI::Platypus->new( api => 2, %options);
Create a new instance of L<FFI::Platypus>.
Any types defined with this instance will be valid for this instance
only, so you do not need to worry about stepping on the toes of other
CPAN FFI / Platypus Authors.
Any functions found will be out of the list of libraries specified with
the L<lib|/lib> attribute.
=head3 options
=over 4
=item api
[version 0.91]
Sets the API level. The recommended value for all new code is C<2>.
The Platypus documentation assumes API level C<2> except for a few
places that specifically document older versions. You should
only use a lower value for a legacy code base that cannot be migrated to
a newer API level. Legal values are:
=over
=item C<0>
Original API level. See L<FFI::Platypus::TypeParser::Version0> for details
on the differences.
=item C<1>
Enable version 1 API type parser which allows pass-by-value records
and type decoration on basic types.
=item C<2>
Enable version 2 API.
The Platypus documentation assumes this api level is set.
API version 2 is identical to version 1, except:
=over 4
=item Pointer functions that return C<NULL> will return C<undef> instead of empty list
This fixes a long standing design bug in Platypus.
=item Array references may be passed to pointer argument types
This replicates the behavior of array argument types with no size. So the types C<sint8*> and C<sint8[]>
behave identically when an array reference is passed in. They differ in that, as before, you can
pass a scalar reference into type C<sint8*>.
=item The fixed string type can be specified without pointer modifier
That is you can use C<string(10)> instead of C<string(10)*> as you were previously able to
in API 0.
=back
=back
=item lib
Either a pathname (string) or a list of pathnames (array ref of strings)
to pre-populate the L<lib|/lib> attribute. Use C<[undef]> to search the
current process for symbols.
0.48
C<undef> (without the array reference) can be used to search the current
process for symbols.
=item ignore_not_found
[version 0.15]
Set the L<ignore_not_found|/ignore_not_found> attribute.
=item lang
[version 0.18]
Set the L<lang|/lang> attribute.
=back
=head1 ATTRIBUTES
=head2 lib
$ffi->lib($path1, $path2, ...);
my @paths = $ffi->lib;
The list of libraries to search for symbols in.
The most portable and reliable way to find dynamic libraries is by using
L<FFI::CheckLib>, like this:
use FFI::CheckLib 0.06;
$ffi->lib(find_lib_or_die lib => 'archive');
# finds libarchive.so on Linux
# libarchive.bundle on OS X
# libarchive.dll (or archive.dll) on Windows
# cygarchive-13.dll on Cygwin
# ...
# and will die if it isn't found
L<FFI::CheckLib> has a number of options, such as checking for specific
symbols, etc. You should consult the documentation for that module.
As a special case, if you add C<undef> as a "library" to be searched,
Platypus will also search the current process for symbols. This is
mostly useful for finding functions in the standard C library, without
having to know the name of the standard c library for your platform (as
it turns out it is different just about everywhere!).
You may also use the L</find_lib> method as a shortcut:
$ffi->find_lib( lib => 'archive' );
=head2 ignore_not_found
[version 0.15]
$ffi->ignore_not_found(1);
my $ignore_not_found = $ffi->ignore_not_found;
Normally the L<attach|/attach> and L<function|/function> methods will
throw an exception if it cannot find the name of the function you
provide it. This will change the behavior such that
L<function|/function> will return C<undef> when the function is not
found and L<attach|/attach> will ignore functions that are not found.
This is useful when you are writing bindings to a library and have many
optional functions and you do not wish to wrap every call to
L<function|/function> or L<attach|/attach> in an C<eval>.
=head2 lang
[version 0.18]
$ffi->lang($language);
Specifies the foreign language that you will be interfacing with. The
default is C. The foreign language specified with this attribute
changes the default native types (for example, if you specify
L<Rust|FFI::Platypus::Lang::Rust>, you will get C<i32> as an alias for
C<sint32> instead of C<int> as you do with L<C|FFI::Platypus::Lang::C>).
If the foreign language plugin supports it, this will also enable
Platypus to find symbols using the demangled names (for example, if you
specify L<CPP|FFI::Platypus::Lang::CPP> for C++ you can use method names
like C<Foo::get_bar()> with L</attach> or L</function>.
=head2 api
[version 1.11]
my $level = $ffi->api;
Returns the API level of the Platypus instance.
=head1 METHODS
=head2 type
$ffi->type($typename);
$ffi->type($typename => $alias);
Define a type. The first argument is the native or C name of the type.
The second argument (optional) is an alias name that you can use to
refer to this new type. See L<FFI::Platypus::Type> for legal type
definitions.
Examples:
$ffi->type('sint32'); # only checks to see that sint32 is a valid type
$ffi->type('sint32' => 'myint'); # creates an alias myint for sint32
$ffi->type('bogus'); # dies with appropriate diagnostic
=head2 custom_type
$ffi->custom_type($alias => {
native_type => $native_type,
native_to_perl => $coderef,
perl_to_native => $coderef,
perl_to_native_post => $coderef,
});
Define a custom type. See L<FFI::Platypus::Type#Custom-Types> for details.
=head2 load_custom_type
$ffi->load_custom_type($name => $alias, @type_args);
Load the custom type defined in the module I<$name>, and make an alias
I<$alias>. If the custom type requires any arguments, they may be passed
in as I<@type_args>. See L<FFI::Platypus::Type#Custom-Types> for
details.
If I<$name> contains C<::> then it will be assumed to be a fully
qualified package name. If not, then C<FFI::Platypus::Type::> will be
prepended to it.
=head2 types
my @types = $ffi->types;
my @types = FFI::Platypus->types;
Returns the list of types that FFI knows about. This will include the
native C<libffi> types (example: C<sint32>, C<opaque> and C<double>) and
the normal C types (example: C<unsigned int>, C<uint32_t>), any types
that you have defined using the L<type|/type> method, and custom types.
The list of types that Platypus knows about varies somewhat from
platform to platform, L<FFI::Platypus::Type> includes a list of the core
types that you can always count on having access to.
It can also be called as a class method, in which case, no user defined
or custom types will be included in the list.
=head2 type_meta
my $meta = $ffi->type_meta($type_name);
my $meta = FFI::Platypus->type_meta($type_name);
Returns a hash reference with the meta information for the given type.
It can also be called as a class method, in which case, you won't be
able to get meta data on user defined types.
The format of the meta data is implementation dependent and subject to
change. It may be useful for display or debugging.
Examples:
my $meta = $ffi->type_meta('int'); # standard int type
my $meta = $ffi->type_meta('int[64]'); # array of 64 ints
$ffi->type('int[128]' => 'myintarray');
my $meta = $ffi->type_meta('myintarray'); # array of 128 ints
=head2 mangler
$ffi->mangler(\&mangler);
Specify a customer mangler to be used for symbol lookup. This is usually useful
when you are writing bindings for a library where all of the functions have the
same prefix. Example:
$ffi->mangler(sub {
my($symbol) = @_;
return "foo_$symbol";
});
$ffi->function( get_bar => [] => 'int' ); # attaches foo_get_bar
my $f = $ffi->function( set_baz => ['int'] => 'void' );
$f->call(22); # calls foo_set_baz
=head2 function
my $function = $ffi->function($name => \@argument_types => $return_type);
my $function = $ffi->function($address => \@argument_types => $return_type);
my $function = $ffi->function($name => \@argument_types => $return_type, \&wrapper);
my $function = $ffi->function($address => \@argument_types => $return_type, \&wrapper);
Returns an object that is similar to a code reference in that it can be
called like one.
Caveat: many situations require a real code reference, so at the price
of a performance penalty you can get one like this:
my $function = $ffi->function(...);
my $coderef = sub { $function->(@_) };
It may be better, and faster to create a real Perl function using the
L<attach|/attach> method.
In addition to looking up a function by name you can provide the address
of the symbol yourself:
my $address = $ffi->find_symbol('my_function');
my $function = $ffi->function($address => ...);
Under the covers, L<function|/function> uses L<find_symbol|/find_symbol>
when you provide it with a name, but it is useful to keep this in mind
as there are alternative ways of obtaining a functions address.
Example: a C function could return the address of another C function
that you might want to call.
[version 0.76]
If the last argument is a code reference, then it will be used as a
wrapper around the function when called. The first argument to the wrapper
will be the inner function, or if it is later attached an xsub. This can be
used if you need to verify/modify input/output data.
Examples:
my $function = $ffi->function('my_function_name', ['int', 'string'] => 'string');
my $return_string = $function->(1, "hi there");
[version 0.91]
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types => $return_type);
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types => $return_type, \&wrapper);
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types);
my $function = $ffi->function( $name => \@fixed_argument_types => \@var_argument_types => \&wrapper);
Version 0.91 and later allows you to creat functions for c variadic functions
(such as printf, scanf, etc) which can take a variable number of arguments.
The first set of arguments are the fixed set, the second set are the variable
arguments to bind with. The variable argument types must be specified in order
to create a function object, so if you need to call variadic function with
different set of arguments then you will need to create a new function object
each time:
# int printf(const char *fmt, ...);
$ffi->function( printf => ['string'] => ['int'] => 'int' )
->call("print integer %d\n", 42);
$ffi->function( printf => ['string'] => ['string'] => 'int' )
->call("print string %s\n", 'platypus');
Some older versions of libffi and possibly some platforms may not support
variadic functions. If you try to create a one, then an exception will be
thrown.
[version 1.26]
If the return type is omitted then C<void> will be the assumed return type.
=head2 attach
$ffi->attach($name => \@argument_types => $return_type);
$ffi->attach([$c_name => $perl_name] => \@argument_types => $return_type);
$ffi->attach([$address => $perl_name] => \@argument_types => $return_type);
$ffi->attach($name => \@argument_types => $return_type, \&wrapper);
$ffi->attach([$c_name => $perl_name] => \@argument_types => $return_type, \&wrapper);
$ffi->attach([$address => $perl_name] => \@argument_types => $return_type, \&wrapper);
Find and attach a C function as a real live Perl xsub. The advantage of
attaching a function over using the L<function|/function> method is that
it is much much much faster since no object resolution needs to be done.
The disadvantage is that it locks the function and the L<FFI::Platypus>
instance into memory permanently, since there is no way to deallocate an
xsub.
If just one I<$name> is given, then the function will be attached in
Perl with the same name as it has in C. The second form allows you to
give the Perl function a different name. You can also provide an
address (the third form), just like with the L<function|/function>
method.
Examples:
$ffi->attach('my_function_name', ['int', 'string'] => 'string');
$ffi->attach(['my_c_function_name' => 'my_perl_function_name'], ['int', 'string'] => 'string');
my $string1 = my_function_name($int);
my $string2 = my_perl_function_name($int);
[version 0.20]
If the last argument is a code reference, then it will be used as a
wrapper around the attached xsub. The first argument to the wrapper
will be the inner xsub. This can be used if you need to verify/modify
input/output data.
Examples:
$ffi->attach('my_function', ['int', 'string'] => 'string', sub {
my($my_function_xsub, $integer, $string) = @_;
$integer++;
$string .= " and another thing";
my $return_string = $my_function_xsub->($integer, $string);
$return_string =~ s/Belgium//; # HHGG remove profanity
$return_string;
});
[version 0.91]
$ffi->attach($name => \@fixed_argument_types => \@var_argument_types, $return_type);
$ffi->attach($name => \@fixed_argument_types => \@var_argument_types, $return_type, \&wrapper);
As of version 0.91 you can attach a variadic functions, if it is supported
by the platform / libffi that you are using. For details see the C<function>
documentation. If not supported by the implementation then an exception
will be thrown.
=head2 closure
my $closure = $ffi->closure($coderef);
my $closure = FFI::Platypus->closure($coderef);
Prepares a code reference so that it can be used as a FFI closure (a
Perl subroutine that can be called from C code). For details on
closures, see L<FFI::Platypus::Type#Closures> and L<FFI::Platypus::Closure>.
=head2 cast
my $converted_value = $ffi->cast($original_type, $converted_type, $original_value);
The C<cast> function converts an existing I<$original_value> of type
I<$original_type> into one of type I<$converted_type>. Not all types
are supported, so care must be taken. For example, to get the address
of a string, you can do this:
my $address = $ffi->cast('string' => 'opaque', $string_value);
Something that won't work is trying to cast an array to anything:
my $address = $ffi->cast('int[10]' => 'opaque', \@list); # WRONG
=head2 attach_cast
$ffi->attach_cast("cast_name", $original_type, $converted_type);
$ffi->attach_cast("cast_name", $original_type, $converted_type, \&wrapper);
my $converted_value = cast_name($original_value);
This function attaches a cast as a permanent xsub. This will make it
faster and may be useful if you are calling a particular cast a lot.
[version 1.26]
A wrapper may be added as the last argument to C<attach_cast> and works
just like the wrapper for C<attach> and C<function> methods.
=head2 sizeof
my $size = $ffi->sizeof($type);
my $size = FFI::Platypus->sizeof($type);
Returns the total size of the given type in bytes. For example to get
the size of an integer:
my $intsize = $ffi->sizeof('int'); # usually 4
my $longsize = $ffi->sizeof('long'); # usually 4 or 8 depending on platform
You can also get the size of arrays
my $intarraysize = $ffi->sizeof('int[64]'); # usually 4*64
my $intarraysize = $ffi->sizeof('long[64]'); # usually 4*64 or 8*64
# depending on platform
Keep in mind that "pointer" types will always be the pointer / word size
for the platform that you are using. This includes strings, opaque and
pointers to other types.
This function is not very fast, so you might want to save this value as
a constant, particularly if you need the size in a loop with many
iterations.
=head2 alignof
[version 0.21]
my $align = $ffi->alignof($type);
Returns the alignment of the given type in bytes.
=head2 kindof
[version 1.24]
my $kind = $ffi->kindof($type);
Returns the kind of a type. This is a string with a value of one of
=over 4
=item C<void>
=item C<scalar>
=item C<string>
=item C<closure>
=item C<record>
=item C<record-value>
=item C<pointer>
=item C<array>
=item C<object>
=back
=head2 countof
[version 1.24]
my $count = $ffi->countof($type);
For array types returns the number of elements in the array (returns 0 for variable length array).
For the C<void> type returns 0. Returns 1 for all other types.
=head2 def
[version 1.24]
$ffi->def($package, $type, $value);
my $value = $ff->def($package, $type);
This method allows you to store data for types. If the C<$package> is not provided, then the
caller's package will be used. C<$type> must be a legal Platypus type for the L<FFI::Platypus>
instance.
=head2 unitof
[version 1.24]
my $unittype = $ffi->unitof($type);
For array and pointer types, returns the basic type without the array or pointer part.
In other words, for C<sin16[]> or C<sint16*> it will return C<sint16>.
=head2 find_lib
[version 0.20]
$ffi->find_lib( lib => $libname );
This is just a shortcut for calling L<FFI::CheckLib#find_lib> and
updating the L</lib> attribute appropriately. Care should be taken
though, as this method simply passes its arguments to
L<FFI::CheckLib#find_lib>, so if your module or script is depending on a
specific feature in L<FFI::CheckLib> then make sure that you update your
prerequisites appropriately.
=head2 find_symbol
my $address = $ffi->find_symbol($name);
Return the address of the given symbol (usually function).
=head2 bundle
[version 0.96 api = 1+]
$ffi->bundle($package, \@args);
$ffi->bundle(\@args);
$ffi->bundle($package);
$ffi->bundle;
This is an interface for bundling compiled code with your
distribution intended to eventually replace the C<package> method documented
above. See L<FFI::Platypus::Bundle> for details on how this works.
=head2 package
[version 0.15 api = 0]
$ffi->package($package, $file); # usually __PACKAGE__ and __FILE__ can be used
$ffi->package; # autodetect
B<Note>: This method is officially discouraged in favor of C<bundle>
described above.
If you use L<FFI::Build> (or the older deprecated L<Module::Build::FFI>
to bundle C code with your distribution, you can use this method to tell
the L<FFI::Platypus> instance to look for symbols that came with the
dynamic library that was built when your distribution was installed.
=head2 abis
my $href = $ffi->abis;
my $href = FFI::Platypus->abis;
Get the legal ABIs supported by your platform and underlying
implementation. What is supported can vary a lot by CPU and by
platform, or even between 32 and 64 bit on the same CPU and platform.
They keys are the "ABI" names, also known as "calling conventions". The
values are integers used internally by the implementation to represent
those ABIs.
=head2 abi
$ffi->abi($name);
Set the ABI or calling convention for use in subsequent calls to
L</function> or L</attach>. May be either a string name or integer
value from the L</abis> method above.
=head1 EXAMPLES
Here are some examples. These examples are provided in full with the
Platypus distribution in the "examples" directory. There are also some
more examples in L<FFI::Platypus::Type> that are related to types.
=head2 Passing and Returning Integers
=head3 C Source
int add(int a, int b) {
return a+b;
}
=head3 Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use File::Basename qw( dirname );
my $ffi = FFI::Platypus->new( api => 2, lib => './add.so' );
$ffi->attach( add => ['int', 'int'] => 'int' );
print add(1,2), "\n"; # prints 3
=head3 Execute
$ cc -shared -o add.so add.c
$ perl add.pl
3
=head3 Discussion
Basic types like integers and floating points are the easiest to pass
across the FFI boundary. Because they are values that are passed on
the stack (or through registers) you don't need to worry about memory
allocations or ownership.
Here we are building our own C dynamic library using the native C
compiler on a Unix like platform. The exact incantation that you
will use to do this would unfortunately depend on your platform and
C compiler.
By default, Platypus uses the
L<Platypus C language plugin|FFI::Platypus::Lang::C>, which gives you
easy access to many of the basic types used by C APIs. (for example
C<int>, C<unsigned long>, C<double>, C<size_t> and others).
If you are working with another language like
L<Fortran|FFI::Platypus::Lang::Fortran/"Passing and Returning Integers">,
L<Go|FFI::Platypus::Lang::Go/"Passing and Returning Integers">,
L<Rust|FFI::Platypus::Lang::Rust/"Passing and Returning Integers"> or
L<Zig|FFI::Platypus::Lang::Zig/"Passing and Returning Integers">,
you will find similar examples where you can use the Platypus language
plugin for that language and use the native types.
=head2 String Arguments (with puts)
=head3 C API
L<cppreference - puts|https://en.cppreference.com/w/c/io/puts>
=head3 Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2, lib => undef );
$ffi->attach( puts => ['string'] => 'int' );
puts("hello world");
=head3 Execute
$ perl puts.pl
hello world
=head3 Discussion
Passing strings into a C function as an argument is also pretty easy
using Platypus. Just use the C<string> type, which is equivalent to
the C <char *> or C<const char *> types.
In this example we are using the C Standard Library's C<puts> function,
so we don't need to build our own C code. We do still need to tell
Platypus where to look for the C<puts> symbol though, which is why
we set C<lib> to C<undef>. This is a special value which tells
Platypus to search the Perl runtime executable itself (including any
dynamic libraries) for symbols. That helpfully includes the C Standard
Library.
=head2 Returning Strings
=head3 C Source
#include <string.h>
#include <stdlib.h>
const char *
string_reverse(const char *input)
{
static char *output = NULL;
int i, len;
if(output != NULL)
free(output);
if(input == NULL)
return NULL;
len = strlen(input);
output = malloc(len+1);
for(i=0; input[i]; i++)
output[len-i-1] = input[i];
output[len] = '\0';
return output;
}
=head3 Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './string_reverse.so',
);
$ffi->attach( string_reverse => ['string'] => 'string' );
print string_reverse("\nHello world");
string_reverse(undef);
=head3 Execute
$ cc -shared -o string_reverse.so string_reverse.c
$ perl string_reverse.pl
dlrow olleH
=head3 Discussion
The C code here takes an input ASCII string and reverses it, returning
the result. Note that it retains ownership of the string, the caller
is expected to use it before the next call to C<reverse_string>, or
copy it.
The Perl code simply declares the return value as C<string> and is very
simple. This does bring up an inconsistency though, strings passed in
to a function as arguments are passed by reference, whereas the return
value is copied! This is usually what you want because C APIs usually
follow this pattern where you are expected to make your own copy of
the string.
At the end of the program we call C<reverse_string> with C<undef>, which
gets translated to C as C<NULL>. This allows it to free the output buffer
so that the memory will not leak.
=head2 Returning and Freeing Strings with Embedded NULLs
=head3 C Source
#include <string.h>
#include <stdlib.h>
char *
string_crypt(const char *input, int len, const char *key)
{
char *output;
int i, n;
if(input == NULL)
return NULL;
output = malloc(len+1);
output[len] = '\0';
for(i=0, n=0; i<len; i++, n++) {
if(key[n] == '\0')
n = 0;
output[i] = input[i] ^ key[n];
}
return output;
}
void
string_crypt_free(char *output)
{
if(output != NULL)
free(output);
}
=head3 Perl Source
use FFI::Platypus 2.00;
use FFI::Platypus::Buffer qw( buffer_to_scalar );
use YAML ();
my $ffi = FFI::Platypus->new(
api => 2,
lib => './xor_cipher.so',
);
$ffi->attach( string_crypt_free => ['opaque'] );
$ffi->attach( string_crypt => ['string','int','string'] => 'opaque' => sub{
my($xsub, $input, $key) = @_;
my $ptr = $xsub->($input, length($input), $key);
my $output = buffer_to_scalar $ptr, length($input);
string_crypt_free($ptr);
return $output;
});
my $orig = "hello world";
my $key = "foobar";
print YAML::Dump($orig);
my $encrypted = string_crypt($orig, $key);
print YAML::Dump($encrypted);
my $decrypted = string_crypt($encrypted, $key);
print YAML::Dump($decrypted);
=head3 Execute
$ cc -shared -o xor_cipher.so xor_cipher.c
$ perl xor_cipher.pl
--- hello world
--- "\x0e\n\x03\x0e\x0eR\x11\0\x1d\x0e\x05"
--- hello world
=head3 Discussion
The C code here also returns a string, but it has some different expectations,
so we can't just use the C<string> type like we did in the previous example
and copy the string.
This C code implements a simple XOR cipher. Given an input string and a key
it returns an encrypted or decrypted output string where the characters are
XORd with the key. There are some challenges here though. First the input
and output strings can have embedded C<NULL>s in them. For the string passed
in, we can provide the length of the input string. For the output, the
C<string> type expects a C<NULL> terminated string, so we can't use that. So
instead we get a pointer to the output using the C<opaque> type. Because we
know that the output string is the same length as the input string we can
convert the pointer to a regular Perl string using the C<buffer_to_scalar>
function. (For more details about working with buffers and strings see
L<FFI::Platypus::Buffer>).
Next, the C code here does not keep the pointer to the output string, as in
the previous example. We are expected to call C<string_encrypt_free> when
we are done. Since we are getting the pointer back from the C code instead
of copying the string that is easy to do.
Finally, we are using a wrapper to hide a lot of this complexity from our
caller. The last argument to the C<attach> call is a code reference which will
wrap around the C function, which is passed in as the first argument of
the wrapper. This is a good practice when writing modules, to hide the
complexity of C.
=head2 Pointers
=head3 C Source
void
swap(int *a, int *b)
{
int tmp = *b;
*b = *a;
*a = tmp;
}
=head3 Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './swap.so',
);
$ffi->attach( swap => ['int*','int*'] );
my $a = 1;
my $b = 2;
print "[a,b] = [$a,$b]\n";
swap( \$a, \$b );
print "[a,b] = [$a,$b]\n";
=head3 Execute
$ cc -shared -o swap.so swap.c
$ perl swap.pl
[a,b] = [1,2]
[a,b] = [2,1]
=head3 Discussion
Pointers are often use in C APIs to return simple values like this. Platypus
provides access to pointers to primitive types by appending C<*> to the
primitive type. Here for example we are using C<int*> to create a function
that takes two pointers to integers and swaps their values.
When calling the function from Perl we pass in a reference to a scalar.
Strictly speaking Perl allows modifying the argument values to subroutines, so
we could have allowed just passing in a scalar, but in the design of Platypus
we decided that forcing the use of a reference here emphasizes that you are
passing a reference to the variable, not just the value.
Not pictured in this example, but you can also pass in C<undef> for a pointer
value and that will be translated into C<NULL> on the C side. You can also
return a pointer to a primitive type from a function, again this will be
returned to Perl as a reference to a scalar. Platypus also supports string
pointers (C<string*>). (Though the C equivalent to a C<string*> is a double
pointer to char C<char**>).
=head2 Opaque Pointers (objects)
=head3 C Source
#include <string.h>
#include <stdlib.h>
typedef struct person_t {
char *name;
unsigned int age;
} person_t;
person_t *
person_new(const char *name, unsigned int age) {
person_t *self = malloc(sizeof(person_t));
self->name = strdup(name);
self->age = age;
}
const char *
person_name(person_t *self) {
return self->name;
}
unsigned int
person_age(person_t *self) {
return self->age;
}
void
person_free(person_t *self) {
free(self->name);
free(self);
}
=head3 Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './person.so',
);
$ffi->type( 'opaque' => 'person_t' );
$ffi->attach( person_new => ['string','unsigned int'] => 'person_t' );
$ffi->attach( person_name => ['person_t'] => 'string' );
$ffi->attach( person_age => ['person_t'] => 'unsigned int' );
$ffi->attach( person_free => ['person_t'] );
my $person = person_new( 'Roger Frooble Bits', 35 );
print "name = ", person_name($person), "\n";
print "age = ", person_age($person), "\n";
person_free($person);
=head3 Execute
$ cc -shared -o person.so person.c
$ perl person.pl
name = Roger Frooble Bits
age = 35
=head3 Discussion
An opaque pointer is a pointer (memory address) that is pointing to I<something>
but you do not know the structure of that something. In C this is usually a
C<void*>, but it could also be a pointer to a C<struct> without a defined body.
This is often used to as an abstraction around objects in C. Here in the C
code we have a C<person_t> struct with functions to create (a constructor), free
(a destructor) and query it (methods).
The Perl code can then use the constructor, methods and destructors without having
to understand the internals. The C<person_t> internals can also be changed
without having to modify the calling code.
We use the Platypus L<type method|/type> to create an alias of C<opaque> called
C<person_t>. While this is not necessary, it does make the Perl code easier
to understand.
In later examples we will see how to hide the use of C<opaque> types further
using the C<object> type, but for some code direct use of C<opaque> is
appropriate.
=head2 Opaque Pointers (buffers and strings)
=head3 C API
=over 4
=item L<cppreference - free|https://en.cppreference.com/w/c/memory/free>
=item L<cppreference - malloc|https://en.cppreference.com/w/c/memory/malloc>
=item L<cppreference - memcpy|https://en.cppreference.com/w/c/string/byte/memcpy>
=item L<cppreference - strdup|https://en.cppreference.com/w/c/string/byte/strdup>
=back
=head3 Perl Source
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( malloc free memcpy strdup );
my $ffi = FFI::Platypus->new( api => 2 );
my $buffer = malloc 14;
my $ptr_string = strdup("hello there!!\n");
memcpy $buffer, $ptr_string, 15;
print $ffi->cast('opaque' => 'string', $buffer);
free $ptr_string;
free $buffer;
=head3 Execute
$ perl malloc.pl
hello there!!
=head3 Discussion
Another useful application of the C<opaque> type is for dealing with buffers,
and C strings that you do not immediately need to convert into Perl strings.
This example is completely contrived, but we are using C<malloc> to create a
buffer of 14 bytes. We create a C string using C<strdup>, and then copy it
into the buffer using C<memcpy>. When we are done with the C<opaque> pointers
we can free them using C<free> since they. (This is generally only okay when
freeing memory that was allocated by C<malloc>, which is the case for C<strdup>).
These memory tools, along with others are provided by the L<FFI::Platypus::Memory>
module, which is worth reviewing when you need to manipulate memory from
Perl when writing your FFI code.
Just to verify that the C<memcpy> did the right thing we convert the
buffer into a Perl string and print it out using the Platypus L<cast method|/cast>.
=head2 Arrays
=head3 C Source
void
array_reverse(int a[], int len) {
int tmp, i;
for(i=0; i < len/2; i++) {
tmp = a[i];
a[i] = a[len-i-1];
a[len-i-1] = tmp;
}
}
void
array_reverse10(int a[10]) {
array_reverse(a, 10);
}
=head3 Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './array_reverse.so',
);
$ffi->attach( array_reverse => ['int[]','int'] );
$ffi->attach( array_reverse10 => ['int[10]'] );
my @a = (1..10);
array_reverse10( \@a );
print "$_ " for @a;
print "\n";
@a = (1..20);
array_reverse( \@a, 20 );
print "$_ " for @a;
print "\n";
=head3 Execute
$ cc -shared -o array_reverse.so array_reverse.c
$ perl array_reverse.pl
10 9 8 7 6 5 4 3 2 1
20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
=head3 Discussion
Arrays in C are passed as pointers, so the C code here reverses the array
in place, rather than returning it. Arrays can also be fixed or variable
length. If the array is variable length the length of the array must be
provided in some way. In this case we explicitly pass in a length. Another
way might be to end the array with C<0>, if you don't otherwise expect any
C<0> to appear in your data. For this reason, Platypus adds a zero (or
C<NULL> in the case of pointers) element at the end of the array when passing
it into a variable length array type, although we do not use it here.
With Platypus you can declare an array type as being either fixed or variable
length. Because Perl stores arrays in completely differently than C, a
temporary array is created by Platypus, passed into the C function as a pointer.
When the function returns the array is re-read by Platypus and the Perl array
is updated with the new values. The temporary array is then freed.
You can use any primitive type for arrays, even C<string>. You can also
return an array from a function. As in our discussion about strings, when
you return an array the value is copied, which is usually what you want.
=head2 Pointers as Arrays
=head3 C Source
#include <stdlib.h>
int
array_sum(const int *a) {
int i, sum;
if(a == NULL)
return -1;
for(i=0, sum=0; a[i] != 0; i++)
sum += a[i];
return sum;
}
=head3 Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './array_sum.so',
);
$ffi->attach( array_sum => ['int*'] => 'int' );
print array_sum(undef), "\n"; # -1
print array_sum([0]), "\n"; # 0
print array_sum([1,2,3,0]), "\n"; # 6
=head3 Execute
$ cc -shared -o array_sum.so array_sum.c
$ perl array_sum.pl
-1
0
6
=head3 Discussion
Starting with the Platypus version 2 API, you can also pass an array reference
in to a pointer argument.
In C pointer and array arguments are often used somewhat interchangeably. In
this example we have an C<array_sum> function that takes a zero terminated
array of integers and computes the sum. If the pointer to the array is zero
(C<0>) then we return C<-1> to indicate an error.
This is the main advantage from Perl for using pointer argument rather than
an array one: the array argument will not let you pass in C<undef> / C<NULL>.
=head2 Sending Strings to GUI on Unix with libnotify
=head3 C API
L<Libnotify Reference Manual|https://developer-old.gnome.org/libnotify/unstable>
=head3 Perl Source
use FFI::CheckLib;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'notify'),
);
$ffi->attach( notify_init => ['string'] );
$ffi->attach( notify_uninit => [] );
$ffi->attach( notify_notification_new => ['string', 'string', 'string'] => 'opaque' );
$ffi->attach( notify_notification_show => ['opaque', 'opaque'] );
my $message = join "\n",
"Hello from Platypus!",
"Welcome to the fun",
"world of FFI";
notify_init('Platypus Hello');
my $n = notify_notification_new('Platypus Hello World', $message, 'dialog-information');
notify_notification_show($n, undef);
notify_uninit();
=head3 Execute
$ perl notify.pl
=for html <p>And this is what it will look like:</p>
<div style="display: flex">
<div style="margin: 3px; flex: 1 1 50%">
<img alt="Test" src="/examples//notify.png">
</div>
</div>
=head3 Discussion
The GNOME project provides an API to send notifications to its desktop environment.
Nothing here is particularly new: all of the types and techniques are ones that we
have seen before, except we are using a third party library, instead of using our
own C code or the standard C library functions.
When using a third party library you have to know the name or location of it, which
is not typically portable, so here we use L<FFI::CheckLib>'s
L<find_lib_or_die function|FFI::CheckLib/find_lib_or_die>. If the library is not
found the script will die with a useful diagnostic. L<FFI::CheckLib> has a number
of useful features and will integrate nicely with L<Alien::Build> based L<Alien>s.
=head2 The Win32 API with MessageBoxW
=head3 Win32 API
L<MessageBoxW function (winuser.h)|https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-messageboxw>
=head3 Perl Source
use utf8;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => [undef],
);
# see FFI::Platypus::Lang::Win32
$ffi->lang('Win32');
# Send a Unicode string to the Windows API MessageBoxW function.
use constant MB_OK => 0x00000000;
use constant MB_DEFAULT_DESKTOP_ONLY => 0x00020000;
$ffi->attach( [MessageBoxW => 'MessageBox'] => [ 'HWND', 'LPCWSTR', 'LPCWSTR', 'UINT'] => 'int' );
MessageBox(undef, "I â¤ï¸ Platypus", "Confession", MB_OK|MB_DEFAULT_DESKTOP_ONLY);
=head3 Execute
$ perl win32_messagebox.pl
=for html <p>And this is what it will look like:</p>
<div style="display: flex">
<div style="margin: 3px; flex: 1 1 50%">
<img alt="Test" src="/examples/win32_messagebox.png">
</div>
</div>
=head3 Discussion
The API used by Microsoft Windows presents some unique
challenges. On 32 bit systems a different ABI is used than what
is used by the standard C library. It also provides a rats nest of
type aliases. Finally if you want to talk Unicode to any of the
Windows API you will need to use C<UTF-16LE> instead of C<UTF-8>
which is native to Perl. (The Win32 API refers to these as
C<LPWSTR> and C<LPCWSTR> types). As much as possible the Win32
"language" plugin attempts to handle these challenges transparently.
For more details see L<FFI::Platypus::Lang::Win32>.
=head3 Discussion
The libnotify library is a desktop GUI notification system for the
GNOME Desktop environment. This script sends a notification event that
should show up as a balloon, for me it did so in the upper right hand
corner of my screen.
=head2 Structured Data Records (by pointer or by reference)
=head3 C API
L<cppreference - localtime|https://en.cppreference.com/w/c/chrono/localtime>
=head3 Perl Source
use FFI::Platypus 2.00;
use FFI::C;
my $ffi = FFI::Platypus->new(
api => 2,
lib => [undef],
);
FFI::C->ffi($ffi);
package Unix::TimeStruct {
FFI::C->struct(tm => [
tm_sec => 'int',
tm_min => 'int',
tm_hour => 'int',
tm_mday => 'int',
tm_mon => 'int',
tm_year => 'int',
tm_wday => 'int',
tm_yday => 'int',
tm_isdst => 'int',
tm_gmtoff => 'long',
_tm_zone => 'opaque',
]);
# For now 'string' is unsupported by FFI::C, but we
# can cast the time zone from an opaque pointer to
# string.
sub tm_zone {
my $self = shift;
$ffi->cast('opaque', 'string', $self->_tm_zone);
}
# attach the C localtime function
$ffi->attach( localtime => ['time_t*'] => 'tm', sub {
my($inner, $class, $time) = @_;
$time = time unless defined $time;
$inner->(\$time);
});
}
# now we can actually use our Unix::TimeStruct class
my $time = Unix::TimeStruct->localtime;
printf "time is %d:%d:%d %s\n",
$time->tm_hour,
$time->tm_min,
$time->tm_sec,
$time->tm_zone;
=head3 Execute
$ perl time_struct.pl
time is 3:48:19 MDT
=head3 Discussion
C and other machine code languages frequently provide interfaces that
include structured data records (defined using the C<struct> keyword
in C). Some libraries will provide an API which you are expected to read
or write before and/or after passing them along to the library.
For C pointers to C<strict>, C<union>, nested C<struct> and nested
C<union> structures, the easiest interface to use is via L<FFI::C>.
If you are working with a C<struct> that must be passed by value
(not pointers), then you will want to use L<FFI::Platypus::Record>
class instead. We will discuss an example of that next.
The C C<localtime> function takes a pointer to a C struct. We simply define
the members of the struct using the L<FFI::C> C<struct> method. Because
we used the C<ffi> method to tell L<FFI::C> to use our local instance of
L<FFI::Platypus> it registers the C<tm> type for us, and we can just start
using it as a return type!
=head2 Structured Data Records (on stack or by value)
=head3 C Source
#include <stdint.h>
#include <string.h>
typedef struct color_t {
char name[8];
uint8_t red;
uint8_t green;
uint8_t blue;
} color_t;
color_t
color_increase_red(color_t color, uint8_t amount)
{
strcpy(color.name, "reddish");
color.red += amount;
return color;
}
=head3 Perl Source
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => './color.so'
);
package Color {
use FFI::Platypus::Record;
use overload
'""' => sub { shift->as_string },
bool => sub { 1 }, fallback => 1;
record_layout_1($ffi,
'string(8)' => 'name', qw(
uint8 red
uint8 green
uint8 blue
));
sub as_string {
my($self) = @_;
sprintf "%s: [red:%02x green:%02x blue:%02x]",
$self->name, $self->red, $self->green, $self->blue;
}
}
$ffi->type('record(Color)' => 'color_t');
$ffi->attach( color_increase_red => ['color_t','uint8'] => 'color_t' );
my $gray = Color->new(
name => 'gray',
red => 0xDC,
green => 0xDC,
blue => 0xDC,
);
my $slightly_red = color_increase_red($gray, 20);
print "$gray\n";
print "$slightly_red\n";
=head3 Execute
$ cc -shared -o color.so color.c
$ perl color.pl
gray: [red:dc green:dc blue:dc]
reddish: [red:f0 green:dc blue:dc]
=head3 Discussion
In the C source of this example, we pass a C C<struct> by value by
copying it onto the stack. On the Perl side we create a C<Color> class
using L<FFI::Platypus::Record>, which allows us to pass the structure
the way the C source wants us to.
Generally you should only reach for L<FFI::Platypus::Record> if you
need to pass small records on the stack like this. For more complicated
(including nested) data you want to use L<FFI::C> using pointers.
=head2 Avoiding Copy Using Memory Windows (with libzmq3)
=head3 C API
L<ØMQ/3.2.6 API Reference|http://api.zeromq.org/3-2:_start>
=head3 Perl Source
use constant ZMQ_IO_THREADS => 1;
use constant ZMQ_MAX_SOCKETS => 2;
use constant ZMQ_REQ => 3;
use constant ZMQ_REP => 4;
use FFI::CheckLib qw( find_lib_or_die );
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( malloc );
use FFI::Platypus::Buffer qw( scalar_to_buffer window );
my $endpoint = "ipc://zmq-ffi-$$";
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die lib => 'zmq',
);
$ffi->attach(zmq_version => ['int*', 'int*', 'int*'] => 'void');
my($major,$minor,$patch);
zmq_version(\$major, \$minor, \$patch);
print "libzmq version $major.$minor.$patch\n";
die "this script only works with libzmq 3 or better" unless $major >= 3;
$ffi->type('opaque' => 'zmq_context');
$ffi->type('opaque' => 'zmq_socket');
$ffi->type('opaque' => 'zmq_msg_t');
$ffi->attach(zmq_ctx_new => [] => 'zmq_context');
$ffi->attach(zmq_ctx_set => ['zmq_context', 'int', 'int'] => 'int');
$ffi->attach(zmq_socket => ['zmq_context', 'int'] => 'zmq_socket');
$ffi->attach(zmq_connect => ['opaque', 'string'] => 'int');
$ffi->attach(zmq_bind => ['zmq_socket', 'string'] => 'int');
$ffi->attach(zmq_send => ['zmq_socket', 'opaque', 'size_t', 'int'] => 'int');
$ffi->attach(zmq_msg_init => ['zmq_msg_t'] => 'int');
$ffi->attach(zmq_msg_recv => ['zmq_msg_t', 'zmq_socket', 'int'] => 'int');
$ffi->attach(zmq_msg_data => ['zmq_msg_t'] => 'opaque');
$ffi->attach(zmq_errno => [] => 'int');
$ffi->attach(zmq_strerror => ['int'] => 'string');
my $context = zmq_ctx_new();
zmq_ctx_set($context, ZMQ_IO_THREADS, 1);
my $socket1 = zmq_socket($context, ZMQ_REQ);
zmq_connect($socket1, $endpoint);
my $socket2 = zmq_socket($context, ZMQ_REP);
zmq_bind($socket2, $endpoint);
{ # send
our $sent_message = "hello there";
my($pointer, $size) = scalar_to_buffer $sent_message;
my $r = zmq_send($socket1, $pointer, $size, 0);
die zmq_strerror(zmq_errno()) if $r == -1;
}
{ # recv
my $msg_ptr = malloc 100;
zmq_msg_init($msg_ptr);
my $size = zmq_msg_recv($msg_ptr, $socket2, 0);
die zmq_strerror(zmq_errno()) if $size == -1;
my $data_ptr = zmq_msg_data($msg_ptr);
window(my $recv_message, $data_ptr, $size);
print "recv_message = $recv_message\n";
}
=head3 Execute
$ perl zmq3.pl
libzmq version 4.3.4
recv_message = hello there
=head3 Discussion
ØMQ is a high-performance asynchronous messaging library. There are a
few things to note here.
Firstly, sometimes there may be multiple versions of a library in the
wild and you may need to verify that the library on a system meets your
needs (alternatively you could support multiple versions and configure
your bindings dynamically). Here we use C<zmq_version> to ask libzmq
which version it is.
C<zmq_version> returns the version number via three integer pointer
arguments, so we use the pointer to integer type: C<int *>. In order to
pass pointer types, we pass a reference. In this case it is a reference
to an undefined value, because zmq_version will write into the pointers
the output values, but you can also pass in references to integers,
floating point values and opaque pointer types. When the function
returns the C<$major> variable (and the others) has been updated and we
can use it to verify that it supports the API that we require.
Finally we attach the necessary functions, send and receive a message.
When we receive we use the L<FFI::Platypus::Buffer> function C<window>
instead of C<buffer_to_scalar>. They have a similar effect in that
the provide a scalar from a region of memory, but C<window> doesn't
have to copy any data, so it is cheaper to call. The only downside
is that a windowed scalar like this is read-only.
=head2 libarchive
=head3 C Documentation
L<https://www.libarchive.org/>
=head3 Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
# This example uses FreeBSD's libarchive to list the contents of any
# archive format that it suppors. We've also filled out a part of
# the ArchiveWrite class that could be used for writing archive formats
# supported by libarchive
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'archive'),
);
$ffi->type('object(Archive)' => 'archive_t');
$ffi->type('object(ArchiveRead)' => 'archive_read_t');
$ffi->type('object(ArchiveWrite)' => 'archive_write_t');
$ffi->type('object(ArchiveEntry)' => 'archive_entry_t');
package Archive {
# base class is "abstract" having no constructor or destructor
$ffi->mangler(sub {
my($name) = @_;
"archive_$name";
});
$ffi->attach( error_string => ['archive_t'] => 'string' );
}
package ArchiveRead {
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_read_$name";
});
$ffi->attach( new => ['string'] => 'archive_read_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_t'] );
$ffi->attach( support_filter_all => ['archive_t'] => 'int' );
$ffi->attach( support_format_all => ['archive_t'] => 'int' );
$ffi->attach( open_filename => ['archive_t','string','size_t'] => 'int' );
$ffi->attach( next_header2 => ['archive_t', 'archive_entry_t' ] => 'int' );
$ffi->attach( data_skip => ['archive_t'] => 'int' );
# ... define additional read methods
}
package ArchiveWrite {
our @ISA = qw( Archive );
$ffi->mangler(sub {
my($name) = @_;
"archive_write_$name";
});
$ffi->attach( new => ['string'] => 'archive_write_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_write_t'] );
# ... define additional write methods
}
package ArchiveEntry {
$ffi->mangler(sub {
my($name) = @_;
"archive_entry_$name";
});
$ffi->attach( new => ['string'] => 'archive_entry_t' );
$ffi->attach( [ free => 'DESTROY' ] => ['archive_entry_t'] );
$ffi->attach( pathname => ['archive_entry_t'] => 'string' );
# ... define additional entry methods
}
use constant ARCHIVE_OK => 0;
# this is a Perl version of the C code here:
# https://github.com/libarchive/libarchive/wiki/Examples#List_contents_of_Archive_stored_in_File
my $archive_filename = shift @ARGV;
unless(defined $archive_filename)
{
print "usage: $0 archive.tar\n";
exit;
}
my $archive = ArchiveRead->new;
$archive->support_filter_all;
$archive->support_format_all;
my $r = $archive->open_filename($archive_filename, 1024);
die "error opening $archive_filename: ", $archive->error_string
unless $r == ARCHIVE_OK;
my $entry = ArchiveEntry->new;
while($archive->next_header2($entry) == ARCHIVE_OK)
{
print $entry->pathname, "\n";
$archive->data_skip;
}
=head3 Execute
$ perl archive_object.pl archive.tar
archive.pl
archive_object.pl
=head3 Discussion
libarchive is the implementation of C<tar> for FreeBSD provided as a
library and available on a number of platforms.
One interesting thing about libarchive is that it provides a kind of
object oriented interface via opaque pointers. This example creates an
abstract class C<Archive>, and concrete classes C<ArchiveWrite>,
C<ArchiveRead> and C<ArchiveEntry>. The concrete classes can even be
inherited from and extended just like any Perl classes because of the
way the custom types are implemented. We use Platypus's C<object>
type for this implementation, which is a wrapper around an C<opaque>
(can also be an integer) type that is blessed into a particular class.
Another advanced feature of this example is that we define a mangler
to modify the symbol resolution for each class. This means we can do
this when we define a method for Archive:
$ffi->attach( support_filter_all => ['archive_t'] => 'int' );
Rather than this:
$ffi->attach(
[ archive_read_support_filter_all => 'support_read_filter_all' ] =>
['archive_t'] => 'int' );
);
As nice as C<libarchive> is, note that we have to shoehorn then
C<archive_free> function name into the Perl convention of using
C<DESTROY> as the destructor. We can easily do that for just this
one function with:
$ffi->attach( [ free => 'DESTROY' ] => ['archive_t'] );
The C<libarchive> is a large library with hundreds of methods.
For comprehensive FFI bindings for C<libarchive> see L<Archive::Libarchive>.
=head2 unix open
=head3 C API
L<Input-output system calls in C|https://www.geeksforgeeks.org/input-output-system-calls-c-create-open-close-read-write/>
=head3 Perl Source
use FFI::Platypus 2.00;
{
package FD;
use constant O_RDONLY => 0;
use constant O_WRONLY => 1;
use constant O_RDWR => 2;
use constant IN => bless \do { my $in=0 }, __PACKAGE__;
use constant OUT => bless \do { my $out=1 }, __PACKAGE__;
use constant ERR => bless \do { my $err=2 }, __PACKAGE__;
my $ffi = FFI::Platypus->new( api => 2, lib => [undef]);
$ffi->type('object(FD,int)' => 'fd');
$ffi->attach( [ 'open' => 'new' ] => [ 'string', 'int', 'mode_t' ] => 'fd' => sub {
my($xsub, $class, $fn, @rest) = @_;
my $fd = $xsub->($fn, @rest);
die "error opening $fn $!" if $$fd == -1;
$fd;
});
$ffi->attach( write => ['fd', 'string', 'size_t' ] => 'ssize_t' );
$ffi->attach( read => ['fd', 'string', 'size_t' ] => 'ssize_t' );
$ffi->attach( close => ['fd'] => 'int' );
}
my $fd = FD->new("file_handle.txt", FD::O_RDONLY);
my $buffer = "\0" x 10;
while(my $br = $fd->read($buffer, 10))
{
FD::OUT->write($buffer, $br);
}
$fd->close;
=head3 Execute
$ perl file_handle.pl
Hello World
=head3 Discussion
The Unix file system calls use an integer handle for each open file.
We can use the same C<object> type that we used for libarchive above,
except we let platypus know that the underlying type is C<int> instead
of C<opaque> (the latter being the default for the C<object> type).
Mainly just for demonstration since Perl has much better IO libraries,
but now we have an OO interface to the Unix IO functions.
=head2 Varadic Functions (with libcurl)
=head3 C API
=over 4
=item L<curl_easy_init|https://curl.se/libcurl/c/curl_easy_init.html>
=item L<curl_easy_setopt|https://curl.se/libcurl/c/curl_easy_setopt.html>
=item L<curl_easy_perform|https://curl.se/libcurl/c/curl_easy_perform.html>
=item L<curl_easy_cleanup|https://curl.se/libcurl/c/curl_easy_cleanup.html>
=item L<CURLOPT_URL|https://curl.se/libcurl/c/CURLOPT_URL.html>
=back
=head3 Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use constant CURLOPT_URL => 10002;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'curl'),
);
my $curl_handle = $ffi->function( 'curl_easy_init' => [] => 'opaque' )
->call;
$ffi->function( 'curl_easy_setopt' => ['opaque', 'enum' ] => ['string'] )
->call($curl_handle, CURLOPT_URL, "https://pl.atypus.org" );
$ffi->function( 'curl_easy_perform' => ['opaque' ] => 'enum' )
->call($curl_handle);
$ffi->function( 'curl_easy_cleanup' => ['opaque' ] )
->call($curl_handle);
=head3 Execute
$ perl curl.pl
<!doctype html>
<html lang="en">
<head>
<meta charset="utf-8" />
<title>pl.atypus.org - Home for the Perl Platypus Project
...
=head3 Discussion
The L library makes extensive use of "varadic" functions.
The C programming language and ABI have the concept of "varadic" functions
that can take a variable number and variable type of arguments. Assuming
you have a C that supports it (and most modern systems should),
then you can create bindings to a varadic function by providing two sets
of array references, one for the fixed arguments (for reasons, C varadic
functions must have at least one) and one for variable arguments. In
this example we call C as a varadic function.
For functions that have a large or infinite number of possible signatures
it may be impracticable or impossible to attach them all. You can instead
do as we did in this example, create a function object using the
L and call it immediately. This is not as
performant either when you create or call as using the L,
but in some cases the performance penalty may be worth it or unavoidable.
=head2 Callbacks (with libcurl)
=head3 C API
=over 4
=item L
=item L
=item L
=item L
=item L
=item L
=back
=head3 Perl Source
use FFI::Platypus 2.00;
use FFI::CheckLib qw( find_lib_or_die );
use FFI::Platypus::Buffer qw( window );
use constant CURLOPT_URL => 10002;
use constant CURLOPT_WRITEFUNCTION => 20011;
my $ffi = FFI::Platypus->new(
api => 2,
lib => find_lib_or_die(lib => 'curl'),
);
my $curl_handle = $ffi->function( 'curl_easy_init' => [] => 'opaque' )
->call;
$ffi->function( 'curl_easy_setopt' => [ 'opaque', 'enum' ] => ['string'] )
->call($curl_handle, CURLOPT_URL, "https://pl.atypus.org" );
my $html;
my $closure = $ffi->closure(sub {
my($ptr, $len, $num, $user) = @_;
window(my $buf, $ptr, $len*$num);
$html .= $buf;
return $len*$num;
});
$ffi->function( 'curl_easy_setopt' => [ 'opaque', 'enum' ] => ['(opaque,size_t,size_t,opaque)->size_t'] => 'enum' )
->call($curl_handle, CURLOPT_WRITEFUNCTION, $closure);
$ffi->function( 'curl_easy_perform' => [ 'opaque' ] => 'enum' )
->call($curl_handle);
$ffi->function( 'curl_easy_cleanup' => [ 'opaque' ] )
->call($curl_handle);
if($html =~ /(.*?)<\/title>/) {
print "$1\n";
}
=head3 Execute
$ perl curl_callback.pl
pl.atypus.org - Home for the Perl Platypus Project
=head3 Discussion
This example is similar to the previous one, except instead of letting
L<libcurl|https://curl.se> write the content body to C<STDOUT>, we give
it a callback to send the data to instead. The L<closure method|/closure>
can be used to create a callback function pointer that can be called from
C. The type for the callback is in the form C<< (arg_type,arg_type,etc)->return_type >>
where the argument types are in parentheticals with an arrow between the
argument types and the return type.
Inside the closure or callback we use the L<window function|FFI::Platypus::Buffer/window>
from L<FFI::Platypus::Buffer> again to avoid an I<extra> copy. We still
have to copy the buffer to append it to C<$hmtl> but it is at least one
less copy.
=head2 bundle your own code
=head3 C Source
C<ffi/foo.c>:
#include <ffi_platypus_bundle.h>
#include <string.h>
typedef struct {
char *name;
int value;
} foo_t;
foo_t*
foo__new(const char *class_name, const char *name, int value) {
(void)class_name;
foo_t *self = malloc( sizeof( foo_t ) );
self->name = strdup(name);
self->value = value;
return self;
}
const char *
foo__name(foo_t *self) {
return self->name;
}
int
foo__value(foo_t *self) {
return self->value;
}
void
foo__DESTROY(foo_t *self) {
free(self->name);
free(self);
}
=head3 Perl Source
C<lib/Foo.pm>:
package Foo;
use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('object(Foo)' => 'foo_t');
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/foo__/;
$name;
});
$ffi->bundle;
$ffi->attach( new => [ 'string', 'string', 'int' ] => 'foo_t' );
$ffi->attach( name => [ 'foo_t' ] => 'string' );
$ffi->attach( value => [ 'foo_t' ] => 'int' );
$ffi->attach( DESTROY => [ 'foo_t' ] => 'void' );
1;
C<t/foo.t>:
use Test2::V0;
use Foo;
my $foo = Foo->new("platypus", 10);
isa_ok $foo, 'Foo';
is $foo->name, "platypus";
is $foo->value, 10;
done_testing;
C<Makefile.PL>:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile(
$fbmm->mm_args(
NAME => 'Foo',
DISTNAME => 'Foo',
VERSION => '1.00',
# ...
)
);
sub MY::postamble
{
$fbmm->mm_postamble;
}
=head3 Execute
With prove:
$ prove -lvm
t/foo.t ..
# Seeded srand with seed '20221105' from local date.
ok 1 - Foo=SCALAR->isa('Foo')
ok 2
ok 3
1..3
ok
All tests successful.
Files=1, Tests=3, 0 wallclock secs ( 0.00 usr 0.00 sys + 0.10 cusr 0.00 csys = 0.10 CPU)
Result: PASS
With L<ExtUtils::MakeMaker>:
$ perl Makefile.PL
Generating a Unix-style Makefile
Writing Makefile for Foo
Writing MYMETA.yml and MYMETA.json
$ make
cp lib/Foo.pm blib/lib/Foo.pm
"/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" -MFFI::Build::MM=cmd -e fbx_build
CC ffi/foo.c
LD blib/lib/auto/share/dist/Foo/lib/libFoo.so
$ make test
"/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" -MFFI::Build::MM=cmd -e fbx_build
"/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" -MFFI::Build::MM=cmd -e fbx_test
PERL_DL_NONLAZY=1 "/home/ollisg/opt/perl/5.37.5/bin/perl5.37.5" "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/foo.t .. ok
All tests successful.
Files=1, Tests=3, 1 wallclock secs ( 0.00 usr 0.00 sys + 0.03 cusr 0.00 csys = 0.03 CPU)
Result: PASS
=head3 Discussion
You can bundle your own C code with your Perl extension. There are a number
of reasons you might want to do this Sometimes you need to optimize a
tight loop for speed. Or you might need a little bit of glue code for your
bindings to a library that isn't inherently FFI friendly. Either way
what you want is the L<FFI::Build> system on the install step and the
L<FFI::Platypus::Bundle> interface on the runtime step. If you are using
L<Dist::Zilla> for your distribution, you will also want to check out the
L<Dist::Zilla::Plugin::FFI::Build> plugin to make this as painless as possible.
One of the nice things about the bundle interface is that it is smart enough to
work with either L<App::Prove> or L<ExtUtils::MakeMaker>. This means, unlike
XS, you do not need to explicitly compile your C code in development mode, that
will be done for you when you call C<< $ffi->bundle >>
=head1 FAQ
=head2 How do I get constants defined as macros in C header files
This turns out to be a challenge for any language calling into C, which
frequently uses C<#define> macros to define constants like so:
#define FOO_STATIC 1
#define FOO_DYNAMIC 2
#define FOO_OTHER 3
As macros are expanded and their definitions are thrown away by the C pre-processor
there isn't any way to get the name/value mappings from the compiled dynamic
library.
You can manually create equivalent constants in your Perl source:
use constant FOO_STATIC => 1;
use constant FOO_DYNAMIC => 2;
use constant FOO_OTHER => 3;
If there are a lot of these types of constants you might want to consider using
a tool (L<Convert::Binary::C> can do this) that can extract the constants for you.
See also the "Integer constants" example in L<FFI::Platypus::Type>.
You can also use the new Platypus bundle interface to define Perl constants
from C space. This is more reliable, but does require a compiler at install
time. It is recommended mainly for writing bindings against libraries that
have constants that can vary widely from platform to platform. See
L<FFI::Platypus::Constant> for details.
=head2 What about enums?
The C enum types are integers. The underlying type is up to the platform, so
Platypus provides C<enum> and C<senum> types for unsigned and singed enums
respectively. At least some compilers treat signed and unsigned enums as
different types. The enum I<values> are essentially the same as macro constants
described above from an FFI perspective. Thus the process of defining enum values
is identical to the process of defining macro constants in Perl.
For more details on enumerated types see L<FFI::Platypus::Type/"Enum types">.
There is also a type plugin (L<FFI::Platypus::Type::Enum>) that can be helpful
in writing interfaces that use enums.
=head2 Memory leaks
There are a couple places where memory is allocated, but never deallocated that may
look like memory leaks by tools designed to find memory leaks like valgrind. This
memory is intended to be used for the lifetime of the perl process so there normally
this isn't a problem unless you are embedding a Perl interpreter which doesn't closely
match the lifetime of your overall application.
Specifically:
=over 4
=item type cache
some types are cached and not freed. These are needed as long as there are FFI
functions that could be called.
=item attached functions
Attaching a function as an xsub will definitely allocate memory that won't be freed
because the xsub could be called at any time, including in C<END> blocks.
=back
The Platypus team plans on adding a hook to free some of this "leaked" memory
for use cases where Perl and Platypus are embedded in a larger application
where the lifetime of the Perl process is significantly smaller than the
overall lifetime of the whole process.
=head2 I get seg faults on some platforms but not others with a library using pthreads.
On some platforms, Perl isn't linked with C<libpthreads> if Perl threads are not
enabled. On some platforms this doesn't seem to matter, C<libpthreads> can be
loaded at runtime without much ill-effect. (Linux from my experience doesn't seem
to mind one way or the other). Some platforms are not happy about this, and about
the only thing that you can do about it is to build Perl such that it links with
C<libpthreads> even if it isn't a threaded Perl.
This is not really an FFI issue, but a Perl issue, as you will have the same
problem writing XS code for the such libraries.
=head2 Doesn't work on Perl 5.10.0.
The first point release of Perl 5.10 was buggy, and is not supported by Platypus.
Please upgrade to a newer Perl.
=head1 CAVEATS
Platypus and Native Interfaces like libffi rely on the availability of
dynamic libraries. Things not supported include:
=over 4
=item Systems that lack dynamic library support
Like MS-DOS
=item Systems that are not supported by libffi
Like OpenVMS
=item Languages that do not support using dynamic libraries from other languages
This used to be the case with Google's Go, but is no longer the case. This is
a problem for C / XS code as well.
=item Languages that do not compile to machine code
Like .NET based languages and Java.
=back
The documentation has a bias toward using FFI / Platypus with C. This
is my fault, as my background mainly in C/C++ programmer (when I am
not writing Perl). In many places I use "C" as a short form for "any
language that can generate machine code and is callable from C". I
welcome pull requests to the Platypus core to address this issue. In an
attempt to ease usage of Platypus by non C programmers, I have written a
number of foreign language plugins for various popular languages (see
the SEE ALSO below). These plugins come with examples specific to those
languages, and documentation on common issues related to using those
languages with FFI. In most cases these are available for easy adoption
for those with the know-how or the willingness to learn. If your
language doesn't have a plugin YET, that is just because you haven't
written it yet.
=head1 SUPPORT
The intent of the C<FFI-Platypus> team is to support the same versions of
Perl that are supported by the Perl toolchain. As of this writing that
means 5.16 and better.
IRC: #native on irc.perl.org
L<(click for instant chat room login)|http://chat.mibbit.com/#native@irc.perl.org>
If something does not work the way you think it should, or if you have a
feature request, please open an issue on this project's GitHub Issue
tracker:
L<https://github.com/perlFFI/FFI-Platypus/issues>
=head1 SECURITY
If you have identified a security vulnerability in the code, or the
possibility of one, please report it right away using GitHub's private
vulnerability reporting feature at
L<https://github.com/PerlFFI/FFI-Platypus/security/advisories/new>,
rather than this project's public GitHub issue tracker, so that a fix
can be prepared before any public disclosure.
The maintainer will try to respond promptly, and will release a fix
as soon as reasonably possible. Please keep in mind, though, that
C<FFI-Platypus> is maintained by volunteers in their spare time, and a
rapid response cannot be guaranteed.
Security fixes will normally only be made for the most recent
production release.
You may also report the issue to L<CPANSec|https://security.metacpan.org/>,
particularly if the issue is urgent or you do not get a response from
the maintainer in a reasonable amount of time.
=head1 CONTRIBUTING
If you have implemented a new feature or fixed a bug then you may make a
pull request on this project's GitHub repository:
L<https://github.com/PerlFFI/FFI-Platypus/pulls>
This project is developed using L<Dist::Zilla>. The project's git
repository also comes with the C<Makefile.PL> file necessary
for building, testing (and even installing if necessary) without
L<Dist::Zilla>. Please keep in mind though that these files are
generated so if changes need to be made to those files they should be
done through the project's C<dist.ini> file. If you do use
L<Dist::Zilla> and already have the necessary plugins installed, then I
encourage you to run C<dzil test> before making any pull requests. This
is not a requirement, however, I am happy to integrate especially
smaller patches that need tweaking to fit the project standards. I may
push back and ask you to write a test case or alter the formatting of a
patch depending on the amount of time I have and the amount of code that
your patch touches.
This project's GitHub issue tracker listed above is not Write-Only. If
you want to contribute then feel free to browse through the existing
issues and see if there is something you feel you might be good at and
take a whack at the problem. I frequently open issues myself that I
hope will be accomplished by someone in the future but do not have time
to immediately implement myself.
Another good area to help out in is documentation. I try to make sure
that there is good document coverage, that is there should be
documentation describing all the public features and warnings about
common pitfalls, but an outsider's or alternate view point on such
things would be welcome; if you see something confusing or lacks
sufficient detail I encourage documentation only pull requests to
improve things.
The Platypus distribution comes with a test library named C<libtest>
that is normally automatically built by C<./Build test>. If you prefer
to use C<prove> or run tests directly, you can use the C<./Build
libtest> command to build it. Example:
% perl Makefile.PL
% make
% make ffi-test
% prove -bv t
# or an individual test
% perl -Mblib t/ffi_platypus_memory.t
The build process also respects these environment variables:
=over 4
=item FFI_PLATYPUS_DEBUG_FAKE32
When building Platypus on 32 bit Perls, it will use the L<Math::Int64> C
API and make L<Math::Int64> a prerequisite. Setting this environment
variable will force Platypus to build with both of those options on a 64
bit Perl as well.
% env FFI_PLATYPUS_DEBUG_FAKE32=1 perl Makefile.PL
DEBUG_FAKE32:
+ making Math::Int64 a prereq
+ Using Math::Int64's C API to manipulate 64 bit values
Generating a Unix-style Makefile
Writing Makefile for FFI::Platypus
Writing MYMETA.yml and MYMETA.json
%
=item FFI_PLATYPUS_NO_ALLOCA
Platypus uses the non-standard and somewhat controversial C function
C<alloca> by default on platforms that support it. I believe that
Platypus uses it responsibly to allocate small amounts of memory for
argument type parameters, and does not use it to allocate large
structures like arrays or buffers. If you prefer not to use C<alloca>
despite these precautions, then you can turn its use off by setting this
environment variable when you run C<Makefile.PL>:
helix% env FFI_PLATYPUS_NO_ALLOCA=1 perl Makefile.PL
NO_ALLOCA:
+ alloca() will not be used, even if your platform supports it.
Generating a Unix-style Makefile
Writing Makefile for FFI::Platypus
Writing MYMETA.yml and MYMETA.json
=item V
When building platypus may hide some of the excessive output when
probing and building, unless you set C<V> to a true value.
% env V=1 perl Makefile.PL
% make V=1
...
=back
=head2 Coding Guidelines
=over 4
=item
Do not hesitate to make code contribution. Making useful contributions
is more important than following byzantine bureaucratic coding
regulations. We can always tweak things later.
=item
Please make an effort to follow existing coding style when making pull
requests.
=item
The intent of the C<FFI-Platypus> team is to support the same versions of
Perl that are supported by the Perl toolchain. As of this writing that
means 5.16 and better. As such, please do not include any code that
requires a newer version of Perl.
=back
=head2 Performance Testing
As Mark Twain was fond of saying there are four types of lies: lies,
damn lies, statistics and benchmarks. That being said, it can sometimes
be helpful to compare the runtime performance of Platypus if you are
making significant changes to the Platypus Core. For that I use
`FFI-Performance`, which can be found in my GitHub repository here:
=over 4
=item L<https://github.com/Perl5-FFI/FFI-Performance>
=back
=head2 System integrators
This distribution uses L<Alien::FFI> in fallback mode, meaning if
the system doesn't provide C<pkg-config> and C<libffi> it will attempt
to download C<libffi> and build it from source. If you are including
Platypus in a larger system (for example a Linux distribution) you
only need to make sure to declare C<pkg-config> or C<pkgconf> and
the development package for C<libffi> as prereqs for this module.
=head1 SEE ALSO
=head2 Extending Platypus
=over 4
=item L<FFI::Platypus::Type>
Type definitions for Platypus.
=item L<FFI::C>
Interface for defining structured data records for use with
Platypus. It supports C C<struct>, C<union>, nested structures
and arrays of all of those. It only supports passing these
types by reference or pointer, so if you need to pass structured
data by value see L<FFI::Platypus::Record> below.
=item L<FFI::Platypus::Record>
Interface for defining structured data records for use with
Platypus. Included in the Platypus core. Supports pass by
value which is uncommon in C, but frequently used in languages
like Rust and Go. Consider using L<FFI::C> instead if you
don't need to pass by value.
=item L<FFI::Platypus::API>
The custom types API for Platypus.
=item L<FFI::Platypus::Memory>
Memory functions for FFI.
=back
=head2 Languages
=over 4
=item L<FFI::Platypus::Lang::C>
Documentation and tools for using Platypus with the C programming
language
=item L<FFI::Platypus::Lang::CPP>
Documentation and tools for using Platypus with the C++ programming
language
=item L<FFI::Platypus::Lang::Fortran>
Documentation and tools for using Platypus with Fortran
=item L<FFI::Platypus::Lang::Go>
Documentation and tools for using Platypus with Go
=item L<FFI::Platypus::Lang::Pascal>
Documentation and tools for using Platypus with Free Pascal
=item L<FFI::Platypus::Lang::Rust>
Documentation and tools for using Platypus with the Rust programming
language
=item L<FFI::Platypus::Lang::ASM>
Documentation and tools for using Platypus with the Assembly
=item L<FFI::Platypus::Lang::Win32>
Documentation and tools for using Platypus with the Win32 API.
=item L<FFI::Platypus::Lang::Zig>
Documentation and tools for using Platypus with the Zig programming
language
=item L<Wasm> and L<Wasm::Wasmtime>
Modules for writing WebAssembly bindings in Perl. This allows you to call
functions written in any language supported by WebAssembly. These modules
are also implemented using Platypus.
=back
=head2 Other Tools Related Tools Useful for FFI
=over 4
=item L<FFI::CheckLib>
Find dynamic libraries in a portable way.
=item L<Convert::Binary::C>
A great interface for decoding C data structures, including C<struct>s,
C<enum>s, C<#define>s and more.
=item L<pack and unpack|perlpacktut>
Native to Perl functions that can be used to decode C C<struct> types.
=item L<C::Scan>
This module can extract constants and other useful objects from C header
files that may be relevant to an FFI application. One downside is that
its use may require development packages to be installed.
=back
=head2 Other Foreign Function Interfaces
=over 4
=item L<Affix>
A wrapper around L<infix|https://github.com/sanko/infix>, an FFI-focused
just-in-time (JIT) compiler.
=item L<NativeCall>
Promising interface to Platypus inspired by Raku.
=item L<Win32::API>
Microsoft Windows specific FFI style interface.
=item L<FFI>
Older, simpler, less featureful FFI. It used to be implemented
using FSF's C<ffcall>. Because C<ffcall> has been unsupported for
some time, I reimplemented this module using L<FFI::Platypus>.
=item L<C::DynaLib>
Another FFI for Perl that doesn't appear to have worked for a long time.
=item L<C::Blocks>
Embed a tiny C compiler into your Perl scripts.
=item L<P5NCI>
Yet another FFI like interface that does not appear to be supported or
under development anymore.
=back
=head2 Other
=over 4
=item L<Alien::FFI>
Provides libffi for Platypus during its configuration and build stages.
=back
=head1 ACKNOWLEDGMENTS
In addition to the contributors mentioned below, I would like to
acknowledge Brock Wilcox (AWWAIID) and Meredith Howard (MHOWARD) whose
work on C<FFI::Sweet> not only helped me get started with FFI but
significantly influenced the design of Platypus.
Dan Book, who goes by Grinnz on IRC for answering user questions about
FFI and Platypus.
In addition I'd like to thank Alessandro Ghedini (ALEXBIO) whose work
on another Perl FFI library helped drive some of the development ideas
for L<FFI::Platypus>.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus.xs 000644 000000 000000 00000003627 15251066120 017214 0 ustar 00root root 000000 000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
#include "perl_math_int64.h"
#define MY_CXT_KEY "FFI::Platypus::_guts" XS_VERSION
typedef struct {
ffi_pl_arguments *current_argv;
/*
* 0 not loaded
* 1 loaded ok
* 2 attempted load, but errored
*/
int loaded_math_longdouble;
AV* custom_keepers;
} my_cxt_t;
START_MY_CXT
XS(ffi_pl_sub_call)
{
ffi_pl_function *self;
int i,n, perl_arg_index;
SV *arg;
ffi_pl_arguments *arguments;
void **argument_pointers;
dMY_CXT;
dVAR; dXSARGS;
self = (ffi_pl_function*) CvXSUBANY(cv).any_ptr;
{
#define EXTRA_ARGS 0
#define FFI_PL_CALL_NO_RECORD_VALUE 1
#include "ffi_platypus_call.h"
}
}
XS(ffi_pl_sub_call_rv)
{
ffi_pl_function *self;
int i,n, perl_arg_index;
SV *arg;
ffi_pl_arguments *arguments;
void **argument_pointers;
dMY_CXT;
dVAR; dXSARGS;
self = (ffi_pl_function*) CvXSUBANY(cv).any_ptr;
{
#define EXTRA_ARGS 0
#define FFI_PL_CALL_RET_NO_NORMAL 1
#include "ffi_platypus_call.h"
}
}
MODULE = FFI::Platypus PACKAGE = FFI::Platypus
BOOT:
{
HV *stash;
MY_CXT_INIT;
MY_CXT.current_argv = NULL;
MY_CXT.loaded_math_longdouble = 0;
MY_CXT.custom_keepers = get_av("FFI::Platypus::keep", GV_ADD);
PERL_MATH_INT64_LOAD_OR_CROAK;
stash = gv_stashpv("FFI::Platypus", TRUE);
newCONSTSUB(stash, "_cast0", newSVuv(PTR2UV(cast0)));
newCONSTSUB(stash, "_cast1", newSVuv(PTR2UV(cast1)));
}
void
CLONE(...)
CODE:
MY_CXT_CLONE;
MY_CXT.custom_keepers = get_av("FFI::Platypus::keep", GV_ADD);
INCLUDE: ../../xs/DL.xs
INCLUDE: ../../xs/Internal.xs
INCLUDE: ../../xs/Type.xs
INCLUDE: ../../xs/TypeParser.xs
INCLUDE: ../../xs/Function.xs
INCLUDE: ../../xs/ClosureData.xs
INCLUDE: ../../xs/API.xs
INCLUDE: ../../xs/ABI.xs
INCLUDE: ../../xs/Record.xs
INCLUDE: ../../xs/Closure.xs
INCLUDE: ../../xs/Buffer.xs
FFI-Platypus-2.12/lib/FFI/Platypus/ 000755 000000 000000 00000000000 15251066120 016630 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Platypus/API.pm 000644 000000 000000 00000013466 15251066120 017611 0 ustar 00root root 000000 000000 package FFI::Platypus::API;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Exporter qw( import );
our @EXPORT = grep /^arguments_/, keys %FFI::Platypus::API::;
# ABSTRACT: Platypus arguments and return value API for custom types
our $VERSION = '2.12'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::API - Platypus arguments and return value API for custom types
=head1 VERSION
version 2.12
=head1 SYNOPSIS
package FFI::Platypus::Type::MyCustomType;
use FFI::Platypus::API;
sub ffi_custom_type_api_1
{
{
native_type => 'uint32',
perl_to_native => sub {
my($value, $i) = @_;
# Translates ($value) passed in from Perl
# into ($value+1, $value+2)
arguments_set_uint32($i, $value+1);
arguments_set_uint32($i+1, $value+2);
},
argument_count => 2,
}
}
=head1 DESCRIPTION
B<NOTE>: I added this interface early on to L<FFI::Platypus>, but haven't
used it much, generally finding function wrappers to be a more powerful
(although possibly not as fast) interface. It has thus not been
tested as much as the rest of Platypus. If you feel the need to use
this interface please coordinate with the Platypus developers.
The custom types API for L<FFI::Platypus> allows you to set multiple C
arguments from a single Perl argument as a common type. This is
sometimes useful for pointer / size pairs which are a common pattern in
C, but are usually represented by a single value (a string scalar) in
Perl.
The custom type API is somewhat experimental, and you should expect some
changes as needs arise (I won't break compatibility lightly, however).
=head1 FUNCTIONS
These functions are only valid within a custom type callback.
=head2 arguments_count
my $count = argument_count;
Returns the total number of native arguments.
=head2 arguments_get_sint8
my $sint8 = arguments_get_sint8 $i;
Get the 8 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint8
arguments_set_sint8 $i, $sint8;
Set the 8 bit signed integer argument at position I<$i> to I<$sint8>.
=head2 arguments_get_uint8
my $uint8 = arguments_get_uint8 $i;
Get the 8 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint8
arguments_set_uint8 $i, $uint8;
Set the 8 bit unsigned integer argument at position I<$i> to I<$uint8>.
=head2 arguments_get_sint16
my $sint16 = arguments_get_sint16 $i;
Get the 16 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint16
arguments_set_sint16 $i, $sint16;
Set the 16 bit signed integer argument at position I<$i> to I<$sint16>.
=head2 arguments_get_uint16
my $uint16 = arguments_get_uint16 $i;
Get the 16 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint16
arguments_set_uint16 $i, $uint16;
Set the 16 bit unsigned integer argument at position I<$i> to I<$uint16>.
=head2 arguments_get_sint32
my $sint32 = arguments_get_sint32 $i;
Get the 32 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint32
arguments_set_sint32 $i, $sint32;
Set the 32 bit signed integer argument at position I<$i> to I<$sint32>.
=head2 arguments_get_uint32
my $uint32 = arguments_get_uint32 $i;
Get the 32 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint32
arguments_set_uint32 $i, $uint32;
Set the 32 bit unsigned integer argument at position I<$i> to I<$uint32>.
=head2 arguments_get_sint64
my $sint64 = arguments_get_sint64 $i;
Get the 64 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint64
arguments_set_sint64 $i, $sint64;
Set the 64 bit signed integer argument at position I<$i> to I<$sint64>.
=head2 arguments_get_uint64
my $uint64 = arguments_get_uint64 $i;
Get the 64 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint64
arguments_set_uint64 $i, $uint64;
Set the 64 bit unsigned integer argument at position I<$i> to I<$uint64>.
=head2 arguments_get_float
my $float = arguments_get_float $i;
Get the floating point argument from position I<$i>.
=head2 arguments_set_float
arguments_set_float $i, $float;
Set the floating point argument at position I<$i> to I<$float>
=head2 arguments_get_double
my $double = arguments_get_double $i;
Get the double precision floating point argument from position I<$i>.
=head2 arguments_set_double
arguments_set_double $i, $double;
Set the double precision floating point argument at position I<$i> to
I<$double>
=head2 arguments_get_pointer
my $pointer = arguments_get_pointer $i;
Get the pointer argument from position I<$i>.
=head2 arguments_set_pointer
arguments_set_pointer $i, $pointer;
Set the pointer argument at position I<$i> to I<$pointer>.
=head2 arguments_get_string
my $string = arguments_get_string $i;
Get the string argument from position I<$i>.
=head2 arguments_set_string
arguments_set_string $i, $string;
Set the string argument at position I<$i> to I<$string>.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=back
Examples of use:
=over 4
=item L<FFI::Platypus::Type::PointerSizeBuffer>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Buffer.pm 000644 000000 000000 00000024450 15251066120 020404 0 ustar 00root root 000000 000000 package FFI::Platypus::Buffer;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Exporter qw( import );
our @EXPORT = qw( scalar_to_buffer buffer_to_scalar );
our @EXPORT_OK = qw ( scalar_to_pointer grow set_used_length window raw_scalar );
# ABSTRACT: Convert scalars to C buffers
our $VERSION = '2.12'; # VERSION
use constant _incantation =>
$^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
? 'Q'
: 'L!';
sub scalar_to_buffer ($)
{
(unpack(_incantation, pack 'P', $_[0]), do { use bytes; length $_[0] });
}
sub scalar_to_pointer ($)
{
unpack(_incantation, pack 'P', $_[0]);
}
sub buffer_to_scalar ($$)
{
unpack 'P'.$_[1], pack _incantation, defined $_[0] ? $_[0] : 0;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Buffer - Convert scalars to C buffers
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus::Buffer;
my($pointer, $size) = scalar_to_buffer $scalar;
my $scalar2 = buffer_to_scalar $pointer, $size;
=head1 DESCRIPTION
A common pattern in C is to pass a "buffer" or region of memory into a
function with a pair of arguments, an opaque pointer and the size of the
memory region. In Perl the equivalent structure is a scalar containing
a string of bytes. This module provides portable functions for
converting a Perl string or scalar into a buffer and back.
These functions are implemented using L<pack and unpack|perlpacktut> and
so they should be relatively fast.
Both functions are exported by default, but you can explicitly export
one or neither if you so choose.
A better way to do this might be with custom types see
L<FFI::Platypus::API> and L<FFI::Platypus::Type>. These functions were
taken from the now obsolete L<FFI::Util> module, as they may be useful
in some cases.
B<Caution>: This module provides great power in the way that you
interact with C code, but with that power comes great responsibility.
Since you are dealing with blocks of memory you need to take care to
understand the underlying ownership model of these pointers.
=head1 FUNCTIONS
=head2 scalar_to_buffer
my($pointer, $size) = scalar_to_buffer $scalar;
Convert a string scalar into a buffer. Returned in order are a pointer
to the start of the string scalar's memory region and the size of the
region.
You should NEVER try to free C<$pointer>.
When you pass this pointer and size into a C function, it has direct
access to the data stored in your scalar, so it is important that you
not resize or free the scalar while it is in use by the C code. Typically
if you are passing a buffer into a C function which reads or writes to
the buffer, but does not keep the pointer for later use you are okay.
If the buffer is in use long term by the C code, then you should consider
copying the buffer instead. For example:
use FFI::Platypus::Buffer qw( scalar_to_buffer );
use FFI::Platypus::Memory qw( malloc memcpy free )
my($ptr, $size) = scalar_to_buffer $string;
c_function_that_does_not_keep_ptr( $ptr, $size); # okay
my($ptr, $size) = scalar_to_buffer $string;
my $ptr_copy = malloc($size);
memcpy($ptr_copy, $ptr, $size);
c_function_that_DOES_keep_ptr( $ptr_copy, $size); # also okay
...
# later when you know that the c code is no longer using the pointer
# Since you allocated the copy, you are responsible for free'ing it.
free($ptr_copy);
=head2 scalar_to_pointer
my $pointer = scalar_to_pointer $scalar;
Get the pointer to the scalar. (Similar to C<scalar_to_buffer> above, but
the size of the scalar is not computed or returned).
Not exported by default, but may be exported on request.
=head2 buffer_to_scalar
my $scalar = buffer_to_scalar $pointer, $size;
Convert the buffer region defined by the pointer and size into a string
scalar.
Because of the way memory management works in Perl, the buffer is copied
from the buffer into the scalar. If this pointer was returned from C
land, then you should only free it if you allocated it.
=head2 grow
grow $scalar, $size, \%options;
Ensure that the scalar can contain at least C<$size> bytes. The
following are recognized:
=over
=item clear => I<boolean>
If true, C<$scalar> is cleared prior to being enlarged. This
avoids copying the existing contents to the reallocated memory
if they are not needed.
For example, after
$scalar = "my string";
grow $scalar, 100, { clear => 0 };
C<$scalar == "my string">, while after
$scalar = "my string";
grow $scalar, 100;
C<length($scalar) == 0>
It defaults to C<true>.
=item set_length => I<boolean>
If true, the length of the I<string> in the C<$scalar> is set to C<$size>.
(See the discussion in L</set_used_length>.) This is useful if a
foreign function writes exactly C<$size> bytes to C<$scalar>, as it avoids
a subsequent call to C<set_used_length>. Contrast this
grow my $scalar, 100;
read_exactly_100_bytes_into_scalar( scalar_to_pointer($scalar) );
@chars = unpack( 'c*', $scalar );
with this:
grow my $scalar, 100, { set_length => 0 };
read_exactly_100_bytes_into_scalar( scalar_to_pointer($scalar) );
set_used_length( $scalar, 100 );
@chars = unpack( 'c*', $scalar );
It defaults to C<true>.
=back
Any pointers obtained with C<scalar_to_pointer> or C<scalar_to_buffer>
are no longer valid after growing the scalar.
Not exported by default, but may be exported on request.
=head2 set_used_length
set_used_length $scalar, $length;
Update Perl's notion of the length of the string in the scalar. A
string scalar keeps track of two lengths: the number of available
bytes and the number of used bytes. When a string scalar is
used as a buffer by a foreign function, it is necessary to indicate
to Perl how many bytes were actually written to it so that Perl's
string functions (such as C<substr> or C<unpack>) will work correctly.
If C<$length> is larger than what the scalar can hold, it is set to the
maximum possible size.
In the following example, the foreign routine C<read_doubles>
may fill the buffer with up to a set number of doubles, returning the
number actually written.
my $sizeof_double = $ffi->sizeof( 'double' );
my $max_doubles = 100;
my $max_length = $max_doubles * $sizeof_double;
my $buffer; # length($buffer) == 0
grow $buffer, $max_length; # length($buffer) is still 0
my $pointer = scalar_to_pointer($buffer);
my $num_read = read_doubles( $pointer, $max_doubles );
# length($buffer) is still == 0
set_used_length $buffer, $num_read * $sizeof_double;
# length($buffer) is finally != 0
# unpack the native doubles into a Perl array
my @doubles = unpack( 'd*', $buffer ); # @doubles == $num_read
Not exported by default, but may be exported on request.
=head2 window
window $scalar, $pointer;
window $scalar, $pointer, $size;
window $scalar, $pointer, $size, $utf8;
This makes the scalar a read-only window into the arbitrary region of
memory defined by C<$pointer>, pointing to the start of the region
and C<$size>, the size of the region. If C<$size> is omitted then
it will assume a C style string and use the C C<strlen> function to
determine the size (the terminating C<'\0'> will not be included).
This can be useful if you have a C function that returns a buffer
pair (pointer, size), and want to access it from Perl without having
to copy the data. This can also be useful when interfacing with
programming languages that store strings as a address/length pair
instead of a pointer to null-terminated sequence of bytes.
You can specify C<$utf8> to set the UTF-8 flag on the scalar. Note
that the behavior of setting the UTF-8 flag on a buffer that does
not contain UTF-8 as understood by the version of Perl that you are
running is undefined.
I<Hint>: If you have a buffer that needs to be free'd by C once the
scalar falls out of scope you can use L<Variable::Magic> to apply
magic to the scalar and free the pointer once it falls out of scope.
use FFI::Platypus::Buffer qw( scalar_to_pointer );
use FFI::Platypus::Memory qw( strdup free );
use Variable::Magic qw( wizard cast );
my $free_when_out_of_scope = wizard(
free => sub {
my $ptr = scalar_to_pointer ${$_[0]};
free $ptr;
}
);
my $ptr = strdup "Hello Perl";
my $scalar;
window $scalar, $ptr, 10;
cast $scalar, $free_when_out_of_scope;
undef $ptr; # don't need to track the pointer anymore.
# we can now use scalar as a regular read-only Perl variable
print $scalar, "\n"; # prints "Hello Perl" without the \0
# this will free the C pointer
undef $scalar;
I<Hint>: Returning a scalar string from a Perl function actually
copies the value. If you want to return a string without copying
then you need to return a reference.
sub c_string
{
my $ptr = strdup "Hello Perl";
my $scalar;
window $scalar, $ptr, 10;
cast $scalar, $free_when_out_of_scope;
\$scalar;
}
my $ref = c_string();
print $$ref, "\n"; # prints "Hello Perl" without the \0
Not exported by default, but may be exported on request.
=head2 raw_scalar
my $buffer = raw_scalar $size;
Returns a new scalar of exactly C<$size> bytes, suitable for use as a
buffer. The contents of the returned scalar are B<not> initialized, so
it will contain whatever happened to be in the memory that was allocated
for it. This makes it cheaper than the equivalent
my $buffer = "\0" x $size;
when you are about to have a foreign function overwrite the whole thing
anyway. If you need the buffer zeroed out, use the C<"\0" x $size> form
instead.
Not exported by default, but may be exported on request.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Bundle.pm 000644 000000 000000 00000050355 15251066120 020407 0 ustar 00root root 000000 000000 package FFI::Platypus::Bundle;
use strict;
use warnings;
use 5.008004;
use Carp ();
# ABSTRACT: Bundle foreign code with your Perl module
our $VERSION = '2.12'; # VERSION
package FFI::Platypus;
sub _bundle
{
my @arg_ptrs;
if(defined $_[-1] && ref($_[-1]) eq 'ARRAY')
{
@arg_ptrs = @{ pop @_ };
}
push @arg_ptrs, undef;
my($self, $package) = @_;
$package = caller unless defined $package;
require List::Util;
my($pm) = do {
my $pm = "$package.pm";
$pm =~ s{::}{/}g;
# if the module is already loaded, we can use %INC
# otherwise we can go through @INC and find the first .pm
# this doesn't handle all edge cases, but probably enough
List::Util::first(sub { (defined $_) && (-f $_) }, ($INC{$pm}, map { "$_/$pm" } @INC));
};
Carp::croak "unable to find module $package" unless $pm;
my @parts = split /::/, $package;
my $incroot = $pm;
{
my $c = @parts;
$incroot =~ s![\\/][^\\/]+$!! while $c--;
}
my $txtfn = List::Util::first(sub { -f $_ }, do {
my $dir = join '/', @parts;
my $file = $parts[-1] . ".txt";
(
"$incroot/auto/$dir/$file",
"$incroot/../arch/auto/$dir/$file",
);
});
my $lib;
if($txtfn)
{
$lib = do {
my $fh;
open($fh, '<', $txtfn) or die "unable to read $txtfn $!";
my $line = <$fh>;
close $fh;
$line =~ /^FFI::Build\@(.*)$/
? "$incroot/$1"
: Carp::croak "bad format $txtfn";
};
Carp::croak "bundle code is missing: $lib" unless -f $lib;
}
elsif(-d "$incroot/../ffi")
{
require FFI::Build::MM;
require Capture::Tiny;
require Cwd;
require File::Spec;
my $save = Cwd::getcwd();
chdir "$incroot/..";
my($output, $error) = Capture::Tiny::capture_merged(sub {
$lib = eval {
my $dist_name = $package;
$dist_name =~ s/::/-/g;
my $fbmm = FFI::Build::MM->new( save => 0 );
$fbmm->mm_args( DISTNAME => $dist_name );
my $build = $fbmm->load_build('ffi', undef, 'ffi/_build');
$build->build;
};
$@;
});
if($error)
{
chdir $save;
print STDERR $output;
die $error;
}
else
{
$lib = File::Spec->rel2abs($lib);
chdir $save;
}
}
else
{
Carp::croak "unable to find bundle code for $package";
}
my $handle = FFI::Platypus::DL::dlopen($lib, FFI::Platypus::DL::RTLD_PLATYPUS_DEFAULT())
or Carp::croak "error loading bundle code: $lib @{[ FFI::Platypus::DL::dlerror() ]}";
$self->{handles}->{$lib} = $handle;
$self->lib($lib);
if(my $init = eval { $self->function( 'ffi_pl_bundle_init' => [ 'string', 'sint32', 'opaque[]' ] => 'void' ) })
{
$init->call($package, scalar(@arg_ptrs)-1, \@arg_ptrs);
}
if(my $init = eval { $self->function( 'ffi_pl_bundle_constant' => [ 'string', 'opaque' ] => 'void' ) })
{
require FFI::Platypus::Constant;
my $api = FFI::Platypus::Constant->new($package);
$init->call($package, $api->ptr);
}
if(my $address = $self->find_symbol( 'ffi_pl_bundle_fini' ))
{
push @{ $self->{fini} }, sub {
my $self = shift;
$self->function( $address => [ 'string' ] => 'void' )
->call( $package );
};
}
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Bundle - Bundle foreign code with your Perl module
=head1 VERSION
version 2.12
=head1 SYNOPSIS
C<ffi/foo.c>:
#include <ffi_platypus_bundle.h>
#include <string.h>
typedef struct {
char *name;
int value;
} foo_t;
foo_t*
foo__new(const char *class_name, const char *name, int value) {
(void)class_name;
foo_t *self = malloc( sizeof( foo_t ) );
self->name = strdup(name);
self->value = value;
return self;
}
const char *
foo__name(foo_t *self) {
return self->name;
}
int
foo__value(foo_t *self) {
return self->value;
}
void
foo__DESTROY(foo_t *self) {
free(self->name);
free(self);
}
C<lib/Foo.pm>:
package Foo;
use strict;
use warnings;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('object(Foo)' => 'foo_t');
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/foo__/;
$name;
});
$ffi->bundle;
$ffi->attach( new => [ 'string', 'string', 'int' ] => 'foo_t' );
$ffi->attach( name => [ 'foo_t' ] => 'string' );
$ffi->attach( value => [ 'foo_t' ] => 'int' );
$ffi->attach( DESTROY => [ 'foo_t' ] => 'void' );
1;
C<t/foo.t>
use Test2::V0;
use Foo;
my $foo = Foo->new("platypus", 10);
isa_ok $foo, 'Foo';
is $foo->name, "platypus";
is $foo->value, 10;
done_testing;
C<Makefile.PL>:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile(
$fbmm->mm_args(
NAME => 'Foo',
DISTNAME => 'Foo',
VERSION => '1.00',
# ...
)
);
sub MY::postamble
{
$fbmm->mm_postamble;
}
or C<dist.ini>:
name = Foo
version = 0.01
...
[FFI::Build]
version = 1.04
=head1 DESCRIPTION
This document serves as a tutorial for using the new bundling interface provided
by L<FFI::Platypus> as of api version 1. It requires L<FFI::Platypus> of at least
1.00.
Sometimes when writing FFI bindings you need to include a little C code (or your
favorite compiled language) to finish things off. Alternatively, you might just
want to write some C code (or your favorite compiled language) to include with your
Perl module to make a tight loop faster. The bundling interface has you covered.
=head2 Basic example
To illustrate we will go through the files in the synopsis and explain
how and why they work. To start with we have some C code which emulates object
oriented code using C<foo__> as a prefix. We use a C struct that we call
C<foo_t> to store our object data. On the C level the struct acts as a class,
when combined with its functions that act as methods. The constructor just
allocates the memory it needs for the C<foo_t> instance, fills in the
appropriate fields and returns the pointer:
foo_t*
foo__new(const char *class_name, const char *name, int value)
{
(void) class_name;
foo_t *self = malloc( sizeof( foo_t ) );
self->name = strdup(name);
self->value = value;
return self;
}
We include a class name as the first argument, because Perl will include that
when calling the constructor, but we do not use it here. An exercise for the
reader would be to add hierarchical inheritance.
There are also some methods which return member values. This class has only
read only members, but you could have read/write or other methods depending
on your needs.
const char *
foo__name(foo_t *self)
{
return self->name;
}
We also include a destructor so that the memory owned by the object can be
freed when it is no longer needed.
void
foo__DESTROY(foo_t *self)
{
free(self->name);
free(self);
}
This might start to look a little like a Perl module, and when we look at the Perl
code that binds to this code, you will see why. First lets prepare the
L<FFI::Platypus> instance and specify the correct api version:
my $ffi = FFI::Platypus->new( api => 2 );
The bundle interface is only supported with api version 1, so if you try to use
version 0 it will not work. Next we define an object type for C<foo_t> which will
associate it with the Perl class C<Foo>.
$ffi->type('object(Foo)' => 'foo_t');
As object type is a blessed reference to an opaque (default) or integer type which
can be used as a Perl object. Platypus does the translating of Perl object to and
from the foo_t pointers that the C code understands. For more details on Platypus
types see L<FFI::Platypus::Type>.
Next we set the mangler on the Platypus instance so that we can refer to function
names without the C<foo__> prefix. You could just not use the prefix in your C
code and skip this step, or you could refer to the function names in their full
in your Perl code, however, this saves extra typing and allows you to bundle more
than one class with your Perl code without having to worry about name conflicts.
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/foo__/;
$name;
});
Finally we let Platypus know that we will be bundling code.
$ffi->bundle;
By default, this searches for the appropriate place for your dynamic libraries using
the current package. In some cases you may need to override this, for example if your
dist is named C<Foo-Bar> but your specific class is named C<Foo::Bar::Baz>, you'd
want something like this:
package Foo::Bar::Baz;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle('Foo::Bar');
...
Now, finally we can attach the methods for our class:
$ffi->attach( new => [ 'string', 'int' ] => 'foo_t' );
$ffi->attach( name => [ 'foo_t' ] => 'string' );
$ffi->attach( value => [ 'foo_t' ] => 'int' );
$ffi->attach( DESTROY => [ 'foo_t' ] => 'void' );
Note that we do not have to include the C<foo__> prefix because of the way we set up
the mangler. If we hadn't done that then we could instead attach with the full names:
$ffi->attach( [ 'foo__new' => 'new' ] => [ 'string', 'int' ] => 'foo_t' );
$ffi->attach( [ 'foo__name' => 'name' ] => [ 'foo_t' ] => 'string' );
...
You're done! You can now use this class. Lets write a test to make sure it works,
use Test2::V0;
use Foo;
my $foo = Foo->new("platypus", 10);
isa_ok $foo, 'Foo';
is $foo->name, "platypus";
is $foo->value, 10;
done_testing;
and use C<prove> to check that it works:
% prove -lvm
t/foo.t ..
ok 1 - An object of class 'Foo' isa 'Foo'
ok 2
ok 3
1..3
ok
All tests successful.
Files=1, Tests=3, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.14 cusr 0.03 csys = 0.19 CPU)
Result: PASS
Platypus automatically compiles and links the dynamic library for you:
% ls ffi/_build
foo.c.o libFoo.so
The C code will be rebuilt next time if the source code is newer than the object or dynamic libraries
files. If the source files are not changed, then it won't be rebuilt to save time. If you are using
the code without MakeMaker, or another build system you are responsible for cleaning up these files.
This is intended as a convenience to allow you to test your code without having to invoke MakeMaker,
or C<dzil> or whatever build system you are using.
When you distribute your module though, you will want the dynamic library built just once
at build-time and installed correctly so that it can be found at run-time. You don't need
to make any changes to your C or Perl code, but you do need to tell MakeMaker to build and
install the appropriate files using L<FFI::Build::MM>:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile(
$fbmm->mm_args(
NAME => 'Foo',
DISTNAME => 'Foo',
VERSION => '1.00',
# ...
)
);
sub MY::postamble
{
$fbmm->mm_postamble;
}
And we can invoke all the normal MakeMaker style stuff and our C code will be compiled, linked
and installed at the appropriate steps.
% perl Makefile.PL
Generating a Unix-style Makefile
Writing Makefile for Foo
Writing MYMETA.yml and MYMETA.json
% make
cp lib/Foo.pm blib/lib/Foo.pm
"/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" -MFFI::Build::MM=cmd -e fbx_build
CC ffi/foo.c
LD blib/lib/auto/share/dist/Foo/lib/libFoo.dylib
% make test
"/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" -MFFI::Build::MM=cmd -e fbx_build
"/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" -MFFI::Build::MM=cmd -e fbx_test
PERL_DL_NONLAZY=1 "/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/foo.t .. ok
All tests successful.
Files=1, Tests=3, 0 wallclock secs ( 0.01 usr 0.00 sys + 0.06 cusr 0.01 csys = 0.08 CPU)
Result: PASS
If the C<Makefile.PL> file above looks overly complicated, you can use the
L<Dist::Zilla::Plugin::FFI::Build> plugin to simplify your life if you are
using L<Dist::Zilla>:
[FFI::Build]
version = 1.04
Specifying version 1.04 will ensure that any C<.o> or C<.so> files are pruned
from your build tree and not distributed by mistake.
=head2 Initialization example
The bundle interface also gives you entry points which will be called automatically
when your code is loaded and unloaded if they are found.
=over 4
=item C<ffi_pl_bundle_init>
void ffi_pl_bundle_init(const char *package, int argc, void *argv[]);
Called when the dynamic library is loaded. C<package> is the Perl package
that called C<bundle> from Perl space. C<argc> and C<argv> represents an
array of opaque pointers that can be passed as an array to bundle as the
last argument. (the count C<argc> is a little redundant because C<argv>
is also NULL terminated).
=item C<ffi_pl_bundle_constant>
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c);
Called immediately after C<ffi_pl_bundle_init>, and is intended to allow
you to set Perl constants from C space. For details on how this works
and what methods you can call on the C<ffi_platypus_constant_t> instance,
see L<FFI::Platypus::Constant>.
=item C<ffi_pl_bundle_fini>
void ffi_pl_bundle_fini(const char *package);
Called when the dynamic library is unloaded. C<package> is the Perl
package that called C<bundle> from Perl space when the library was
loaded. B<CAVEAT>: if you attach any functions then this will
never be called, because attaching functions locks the Platypus
instance into memory along with the libraries which it is using.
=back
Here is an example that passes the version and a callback back into Perl
space that emulates the Perl 5.10 C<say> feature.
C<ffi/init.c>:
#include <ffi_platypus_bundle.h>
char buffer[512];
const char *version;
void (*say)(const char *);
void
ffi_pl_bundle_init(const char *package, int argc, void *argv[])
{
version = argv[0];
say = argv[1];
say("in init!");
snprintf(buffer, 512, "package = %s, version = %s", package, version);
say(buffer);
snprintf(buffer, 512, "args = %d", argc);
say(buffer);
}
void
ffi_pl_bundle_fini(const char *package)
{
say("in fini!");
}
C<lib/Init.pm>:
package Init;
use strict;
use warnings;
use FFI::Platypus 2.00;
our $VERSION = '1.00';
{
my $ffi = FFI::Platypus->new( api => 2 );
my $say = $ffi->closure(sub {
my $string = shift;
print "$string\n";
});
$ffi->bundle([
$ffi->cast( 'string' => 'opaque', $VERSION ),
$ffi->cast( '(string)->void' => 'opaque', $say ),
]);
undef $ffi;
undef $say;
}
1;
The deinitialization order for the C<$say> callback and the C<$ffi>
instance is essential here, so we do it manually with C<undef>:
undef $ffi;
undef $say;
First we deallocate C<$ffi> which calls C<ffi_pl_bundle_fini>,
which calls C<$say>, so we want to make sure the latter is still
allocated. Once C<ffi_pl_bundle_fini> is done, we can safely
deallocate C<$say>.
If C<ffi_pl_bundle_fini> didn't call back into Perl space like
this then we don't have to be as careful about deallocating
things in Perl space.
=head2 Compiler or linker flags example
There are times when you will want to specify your own compiler and
linker flags for the C code that you are bundling. The C<TL;DR> is that
you can put a C<.fbx> file in your C<ffi> directory. This is a Perl
script that returns a hash reference that is passed into the
L<FFI::Build> constructor. This allows you to set a number of options,
including compiler and linker flags. A more detailed example follows:
You may want or need to set compiler and linker flags for your bundled
C code. For example, say we have a header file, but instead of
putting it in the C<ffi> directory we want to put it in a separate
directory called C<include>.
C<include/answer.h>:
#ifndef ANSWER_H
#define ANSWER_H
int answer(void);
#endif
C<ffi/answer.c>:
int
answer(void)
{
/* the answer to life the universe and everything */
return 42;
}
C<lib/Answer.pm>:
package Answer;
use strict;
use warnings;
use FFI::Platypus 2.00;
use Exporter qw( import );
our @EXPORT = qw( answer );
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle;
$ffi->attach( answer => [] => 'int' );
1;
If you try to use this module just as-is you will get an error, about
not being able to find the header file. Probably something like this:
ffi/answer.c:1:10: fatal error: 'answer.h' file not found
So we put a C<answer.fbx> file in the C<ffi> directory. (In case you
are wondering FBX stands for "Ffi Build and file eXtensions should
whenever possible be three characters long"). The name of the file
can be anything so long as it ends in C<.fbx>, we just choose C<answer>
here because that is the name of the project.
C<ffi/answer.fbx>:
our $DIR;
return {
cflags => "-I/include",
source => "$DIR/*.c",
}
The C<$DIR> variable is provided by the builder code. It is the root
of the distribution, and is helpful if you need a fully qualified path.
In this case you could have also used C<ffi/*.c>.
The script returns a hash reference which is passed into the L<FFI::Build>
constructor, so you can use any of the options supported by that
class. Now we should be able to use our bundled module:
% perl -Ilib -MAnswer=answer -E 'say answer'
42
=head2 Using bundled code with Alien.
A useful technique is to use Platypus with L<Alien> technology. The
L<Alien> namespace is reserved for providing external non-Perl dependencies
for CPAN modules. The nominal L<Alien> module when installed looks
for the library locally, and if it can't be found it fetches it from
the internet, builds it, and installs it in a private directory so that
it can be used by other CPAN modules. For L<Alien>s that provide
shared libraries, and that have simple interfaces that do not require
additional C code you can easily just pass the shared libraries
to Platypus directly. For modules that require some bundled C code
and an L<Alien> you have to link the L<Alien> library with your bundled
code. If the L<Alien> uses the L<Alien::Base> interface then all you have
to do is give the name of the L<Alien> to L<FFI::Build>.
For example, the C<bzip2> library provides an interface that requires
the caller to allocate a C C<struct> and then pass it to its various
functions. The C<struct> is actually pretty simple and you could use
L<FFI::C> or L<FFI::Platypus::Record>, but here is an example of how you
would connect bundled C code with an L<Alien>.
C<ffi/compress.c>:
#include <bzlib.h>
#include <stdlib.h>
int
bzip2__new(bz_stream **stream, int blockSize100k, int verbosity, int workFactor )
{
*stream = calloc(1, sizeof(bz_stream));
return BZ2_bzCompressInit(*stream, blockSize100k, verbosity, workFactor );
}
C<lib/Bzip2.pm>:
package Bzip2;
use strict;
use warnings;
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( free );
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle;
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/bzip2__/ unless $name =~ /^BZ2_/;
$name;
});
=head2 new
my $bzip2 = Bzip2->new($block_size_100k, $verbosity, $work_flow);
=cut
$ffi->attach( new => ['opaque*', 'int', 'int', 'int'] => 'int' => sub {
my $xsub = shift;
my $class = shift;
my $ptr;
my $ret = $xsub->(\$ptr, @_);
return bless \$ptr, $class;
});
$ffi->attach( [ BZ2_bzCompressEnd => 'DESTROY' ] => ['opaque'] => 'int' => sub {
my $xsub = shift;
my $self = shift;
my $ret = $xsub->($$self);
free $$self;
});
1;
The C<.fbx> file that goes with this to make it work with L<Alien::Libbz2>
is now pretty trivial:
C<ffi/bz2.fbx>:
{
alien => ['Alien::Libbz2'],
source => ['ffi/*.c'],
};
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Closure.pm 000644 000000 000000 00000007270 15251066120 020610 0 ustar 00root root 000000 000000 package FFI::Platypus::Closure;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Scalar::Util qw( refaddr);
use Carp qw( croak );
use overload '&{}' => sub {
my $self = shift;
sub { $self->{code}->(@_) };
}, bool => sub { 1 }, fallback => 1;
# ABSTRACT: Platypus closure object
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, $coderef) = @_;
croak "not a coderef" unless ref($coderef) eq 'CODE';
my $self = bless { code => $coderef, cbdata => {}, sticky => 0 }, $class;
$self;
}
sub add_data
{
my($self, $payload, $type) = @_;
$self->{cbdata}{$type} = bless \$payload, 'FFI::Platypus::ClosureData';
}
sub get_data
{
my($self, $type) = @_;
if (exists $self->{cbdata}->{$type}) {
return ${$self->{cbdata}->{$type}};
}
return 0;
}
sub call
{
my $self = shift;
$self->{code}->(@_)
}
sub sticky
{
my($self) = @_;
unless( $self->{sticky}) {
$self->{sticky} = 1;
$self->_sticky;
}
return $self;
}
sub unstick
{
my($self) = @_;
if( $self->{sticky} ) {
$self->{sticky} = 0;
$self->_unstick;
}
return $self;
}
package FFI::Platypus::ClosureData;
our $VERSION = '2.12'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Closure - Platypus closure object
=head1 VERSION
version 2.12
=head1 SYNOPSIS
create closure with OO interface
use FFI::Platypus::Closure;
my $closure = FFI::Platypus::Closure->new(sub { print "hello world\n" });
create closure from Platypus object
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
my $closure = $ffi->closure(sub { print "hello world\n" });
use closure
$ffi->function(foo => ['()->void'] => 'void')->call($closure);
=head1 DESCRIPTION
This class represents a Perl code reference that can be called from compiled code.
When you create a closure object, you can pass it into any function that expects
a function pointer. Care needs to be taken with closures because compiled languages
typically have a different way of handling lifetimes of objects. You have to make
sure that if the compiled code is going to call a closure that the closure object
is still in scope somewhere, or has been made sticky, otherwise you may get a
segment violation or other mysterious crash.
=head1 CONSTRUCTOR
=head2 new
my $closure = FFI::Platypus::Closure->new($coderef);
Create a new closure object; C<$coderef> must be a subroutine code reference.
=head1 METHODS
=head2 call
$closure->call(@arguments);
$closure->(@arguments);
Call the closure from Perl space. May also be invoked by treating
the closure object as a code reference.
=head2 sticky
$closure->sticky;
Mark the closure sticky, meaning that it won't be free'd even if
all the reference of the object fall out of scope.
[version 2.12]
Returns C<$self>, so this method may be chained.
=head2 unstick
$closure->unstick;
Unmark the closure as sticky.
[version 2.12]
Returns C<$self>, so this method may be chained.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Constant.pm 000644 000000 000000 00000011324 15251066120 020760 0 ustar 00root root 000000 000000 package FFI::Platypus::Constant;
use strict;
use warnings;
use 5.008004;
use constant 1.32 ();
use FFI::Platypus;
# ABSTRACT: Define constants in C space for Perl
our $VERSION = '2.12'; # VERSION
{
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle;
$ffi->type( 'opaque' => 'ffi_platypus_constant_t' );
$ffi->type( '(string,string)->void' => 'set_str_t' );
$ffi->type( '(string,sint64)->void' => 'set_sint_t' );
$ffi->type( '(string,uint64)->void' => 'set_uint_t' );
$ffi->type( '(string,double)->void' => 'set_double_t' );
$ffi->mangler(sub {
my($name) = @_;
$name =~ s/^/ffi_platypus_constant__/;
$name;
});
$ffi->attach( new => [ 'set_str_t', 'set_sint_t', 'set_uint_t', 'set_double_t' ] => 'ffi_platypus_constant_t' => sub {
my($xsub, $class, $default_package) = @_;
my $f = $ffi->closure(sub {
my($name, $value) = @_;
if($name !~ /::/)
{
$name = join('::', $default_package, $name);
}
constant->import($name, $value);
});
bless {
ptr => $xsub->($f, $f, $f, $f),
f => $f,
}, $class;
});
$ffi->attach( DESTROY => ['ffi_platypus_constant_t'] => 'void' => sub {
my($xsub, $self) = @_;
$xsub->($self->ptr);
});
sub ptr { shift->{ptr} }
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Constant - Define constants in C space for Perl
=head1 VERSION
version 2.12
=head1 SYNOPSIS
C<ffi/foo.c>:
#include <ffi_platypus_bundle.h>
void
ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c)
{
c->set_str("FOO", "BAR"); /* sets $package::FOO to "BAR" */
c->set_str("ABC::DEF", "GHI"); /* sets ABC::DEF to GHI */
}
C<lib/Foo.pm>:
package Foo;
use strict;
use warnings;
use FFI::Platypus 2.00;
use Exporter qw( import );
my $ffi = FFI::Platypus->new( api => 2 );
# sets constants Foo::FOO and ABC::DEF from C
$ffi->bundle;
1;
=head1 DESCRIPTION
The Platypus bundle interface (see L<FFI::Platypus::Bundle>) has an entry point
C<ffi_pl_bundle_constant> that lets you define constants in Perl space from C.
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c);
The first argument C<package> is the name of the Perl package. The second argument
C<c> is a struct with function pointers that lets you define constants of different
types. The first argument for each function is the name of the constant and the
second is the value. If C<::> is included in the constant name then it will be
defined in that package space. If it isn't then the constant will be defined in
whichever package called C<bundle>.
=over 4
=item set_str
c->set_str(name, value);
Sets a string constant.
=item set_sint
c->set_sint(name, value);
Sets a 64-bit signed integer constant.
=item set_uint
c->set_uint(name, value);
Sets a 64-bit unsigned integer constant.
=item set_double
c->set_double(name, value);
Sets a double precision floating point constant.
=back
=head2 Example
Suppose you have a header file C<myheader.h>:
#ifndef MYHEADER_H
#define MYHEADER_H
#define MYVERSION_STRING "1.2.3"
#define MYVERSION_MAJOR 1
#define MYVERSION_MINOR 2
#define MYVERSION_PATCH 3
enum {
MYBAD = -1,
MYOK = 1
};
#define MYPI 3.14
#endif
You can define these constants from C:
#include <ffi_platypus_bundle.h>
#include "myheader.h"
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c)
{
c->set_str("MYVERSION_STRING", MYVERSION_STRING);
c->set_uint("MYVERSION_MAJOR", MYVERSION_MAJOR);
c->set_uint("MYVERSION_MINOR", MYVERSION_MINOR);
c->set_uint("MYVERSION_PATCH", MYVERSION_PATCH);
c->set_sint("MYBAD", MYBAD);
c->set_sint("MYOK", MYOK);
c->set_double("MYPI", MYPI);
}
Your Perl code doesn't have to do anything when calling bundle:
package Const;
use strict;
use warnings;
use FFI::Platypus 2.00;
{
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->bundle;
}
1;
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/DL.pm 000644 000000 000000 00000013113 15251066120 017464 0 ustar 00root root 000000 000000 package FFI::Platypus::DL;
use strict;
use warnings;
use 5.008004;
use Exporter qw( import );
require FFI::Platypus;
our @EXPORT = qw( dlopen dlerror dlsym dlclose );
push @EXPORT, grep /RTLD_/, keys %FFI::Platypus::DL::;
# ABSTRACT: Slightly non-portable interface to libdl
our $VERSION = '2.12'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::DL - Slightly non-portable interface to libdl
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
use FFI::Platypus::DL;
my $handle = dlopen("./libfoo.so", RTLD_PLATYPUS_DEFAULT);
my $address = dlsym($handle, "my_function_named_foo");
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->function($address => [] => 'void')->call;
dlclose($handle);
=head1 DESCRIPTION
This module provides an interface to libdl, the dynamic loader on UNIX. The underlying interface
has always been used by L<FFI::Platypus>, but it wasn't a public interface until version 0.52. The
name was changed with that version when it became a public interface, so be sure to specify that
version if you are going to use it.
It is somewhat non-portable for these reasons:
=over 4
=item GNU extensions
It provides some GNU extensions to platforms such as Linux that support them.
=item Windows
It provides an emulation layer on Windows. The emulation layer only supports C<RTLD_PLATYPUS_DEFAULT>
as a flag. The emulation layer emulates the convention described below of passing C<undef> as
the dynamic library name to mean, use the currently running executable. I've used it without
any problems for years, but Windows is not my main development platform.
=back
=head1 FUNCTIONS
=head2 dlopen
my $handle = dlopen($filename, $flags);
This opens a dynamic library in the context of the dynamic loader. C<$filename> is the full or
relative path to a dynamic library (usually a C<.so> on Linux and some other UNIXen, a C<.dll> on
Windows and a C<.dylib> on OS X). C<$flags> are flags that can be used to alter the behavior
of the library and the symbols it contains. The return value is an opaque pointer or C<$handle>
which can be used to look up symbols with C<dlsym>. The handle should be closed with C<dlclose>
when you are done with it.
By convention if you pass in C<undef> for the filename, the currently loaded executable will be
used instead of a separate dynamic library. This is the easiest and most portable way to find
the address of symbols in the standard C library. This convention is baked into most UNIXen,
but this capability is emulated in Windows which doesn't come with the capability out of the box.
If there is an error in opening the library then C<undef> will be returned and the diagnostic
for the failure can be retrieved with C<dlerror> as described below.
Not all flags are supported on all platforms. You can test if a flag is available using can:
if(FFI::Platypus::DL->can('RTLD_LAZY'))
{
...
}
Typically where flags are not mutually exclusive, they can be or'd together:
my $handle = dlopen("libfoo.so", RTLD_LAZY | RTLD_GLOBAL);
Check your operating system documentation for detailed descriptions of these flags.
=over 4
=item RTLD_PLATYPUS_DEFAULT
This is the L<FFI::Platypus> default for C<dlopen> (NOTE: NOT the libdl default). This is the only
flag supported on Windows. For historical reasons, this is usually C<RTLD_LAZY> on Unix and C<0> on
Windows.
=item RTLD_LAZY
Perform lazy binding.
=item RTLD_NOW
Resolve all symbols before returning from C<dlopen>. Error if all symbols cannot resolve.
=item RTLD_GLOBAL
Symbols are shared.
=item RTLD_LOCAL
Symbols are NOT shared.
=item RTLD_NODELETE
glibc 2.2 extension.
=item RTLD_NOLOAD
glibc 2.2 extension.
=item RTLD_DEEPBIND
glibc 2.3.4 extension.
=back
=head2 dlsym
my $opaque = dlsym($handle, $symbol);
This looks up the given C<$symbol> in the library pointed to by C<$handle>. If the symbol is found,
the address for that symbol is returned as an opaque pointer. This pointer can be passed into
the L<FFI::Platypus> C<function> and C<attach> methods instead of a function name.
If the symbol cannot be found then C<undef> will be returned and the diagnostic for the failure can
be retrieved with C<dlerror> as described below.
=head2 dlclose
my $status = dlclose($handle);
On success, C<dlclose> returns 0; on error, it returns a nonzero value, and the diagnostic for the
failure can be retrieved with C<dlerror> as described below.
=head2 dlerror
my $error_string = dlerror;
Returns the human readable diagnostic for the reason for the failure for the most recent C<dl>
prefixed function call.
=head1 CAVEATS
Some flags for C<dlopen> are not portable. This module may not be supported platforms added to
L<FFI::Platypus> in the future. It does work as far as I know on all of the currently supported
platforms.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Function.pm 000644 000000 000000 00000007611 15251066120 020760 0 ustar 00root root 000000 000000 package FFI::Platypus::Function;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
# ABSTRACT: An FFI function object
our $VERSION = '2.12'; # VERSION
use overload '&{}' => sub {
my $ffi = shift;
sub { $ffi->call(@_) };
}, 'bool' => sub {
my $ffi = shift;
return $ffi;
}, fallback => 1;
package FFI::Platypus::Function::Function;
use parent qw( FFI::Platypus::Function );
sub attach
{
my($self, $perl_name, $proto) = @_;
my $frame = -1;
my($caller, $filename, $line);
do {
($caller, $filename, $line) = caller(++$frame);
} while( $caller =~ /^FFI::Platypus(|::Function|::Function::Wrapper|::Declare)$/ );
$perl_name = join '::', $caller, $perl_name
unless $perl_name =~ /::/;
$self->_attach($perl_name, "$filename:$line", $proto);
$self;
}
sub sub_ref
{
my($self) = @_;
my $frame = -1;
my($caller, $filename, $line);
do {
($caller, $filename, $line) = caller(++$frame);
} while( $caller =~ /^FFI::Platypus(|::Function|::Function::Wrapper|::Declare)$/ );
$self->_sub_ref("$filename:$line");
}
package FFI::Platypus::Function::Wrapper;
use parent qw( FFI::Platypus::Function );
sub new
{
my($class, $function, $wrapper) = @_;
bless [ $function, $wrapper ], $class;
}
sub call
{
my($function, $wrapper) = @{ shift() };
@_ = ($function, @_);
goto &$wrapper;
}
sub attach
{
my($self, $perl_name, $proto) = @_;
my($function, $wrapper) = @{ $self };
unless($perl_name =~ /::/)
{
my $caller;
my $frame = -1;
do { $caller = caller(++$frame) } while( $caller =~ /^FFI::Platypus(|::Declare)$/ );
$perl_name = join '::', $caller, $perl_name
}
my $xsub = $function->sub_ref;
{
my $code = sub {
unshift @_, $xsub;
goto &$wrapper;
};
if(defined $proto)
{
_set_prototype($proto, $code);
}
no strict 'refs';
*{$perl_name} = $code;
}
$self;
}
sub sub_ref
{
my($self) = @_;
my($function, $wrapper) = @{ $self };
my $xsub = $function->sub_ref;
return sub {
unshift @_, $xsub;
goto &$wrapper;
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Function - An FFI function object
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
# call directly
my $ffi = FFI::Platypus->new( api => 2 );
my $f = $ffi->function(puts => ['string'] => 'int');
$f->call("hello there");
# attach as xsub and call (faster for repeated calls)
$f->attach('puts');
puts('hello there');
=head1 DESCRIPTION
This class represents an unattached platypus function. For more
context and better examples see L<FFI::Platypus>.
=head1 METHODS
=head2 attach
$f->attach($name);
$f->attach($name, $prototype);
Attaches the function as an xsub (similar to calling attach directly
from an L<FFI::Platypus> instance). You may optionally include a
prototype.
=head2 call
my $ret = $f->call(@arguments);
my $ret = $f->(@arguments);
Calls the function and returns the result. You can also use the
function object B<like> a code reference.
=head2 sub_ref
my $code = $f->sub_ref;
Returns an anonymous code reference. This will usually be faster
than using the C<call> method above.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Internal.pm 000644 000000 000000 00000002617 15251066120 020750 0 ustar 00root root 000000 000000 package FFI::Platypus::Internal;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Exporter qw( import );
require FFI::Platypus;
_init();
our @EXPORT = grep /^FFI_PL/, keys %FFI::Platypus::Internal::;
# ABSTRACT: For internal use only
our $VERSION = '2.12'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Internal - For internal use only
=head1 VERSION
version 2.12
=head1 SYNOPSIS
perldoc FFI::Platypus
=head1 DESCRIPTION
This module is for internal use only. Do not rely on it having any particular behavior, or even existing in future versions.
You have been warned.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Lang.pm 000644 000000 000000 00000004671 15251066120 020057 0 ustar 00root root 000000 000000 package FFI::Platypus::Lang;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Language specific customizations
our $VERSION = '2.12'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang - Language specific customizations
=head1 VERSION
version 2.12
=head1 SYNOPSIS
perldoc FFI::Platypus::Lang;
=head1 DESCRIPTION
This namespace is reserved for language specific customizations of L<FFI::Platypus>.
This usually involves providing native type maps. It can also involve computing
mangled names. The default language is C, and is defined in L<FFI::Platypus::Lang::C>.
This package itself doesn't do anything, it serves only as documentation.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Platypus itself.
=item L<FFI::Platypus::Lang::ASM>
This language plugin provides no type aliases, and is intended
for use with assembly language or for when no other language
plugin is appropriate.
=item L<FFI::Platypus::Lang::C>
Language plugin for the C programming language.
=item L<FFI::Platypus::Lang::Fortran>
Non-core language plugin for the Fortran programming language.
=item L<FFI::Platypus::Lang::CPP>
Non-core language plugin for the C++ programming language.
=item L<FFI::Platypus::Lang::Go>
Non-core language plugin for the Go programming language.
=item L<FFI::Platypus::Lang::Pascal>
Non-core language plugin for the Pascal programming language.
=item L<FFI::Platypus::Lang::Rust>
Non-core language plugin for the Rust programming language.
=item L<FFI::Platypus::Lang::Win32>
Language plugin for use with the Win32 API.
=item L<FFI::Platypus::Lang::Zig>
Non-core language plugin for the Zig programming language.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Lang/ 000755 000000 000000 00000000000 15251066120 017511 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Platypus/Lang/ASM.pm 000644 000000 000000 00000004232 15251066120 020470 0 ustar 00root root 000000 000000 package FFI::Platypus::Lang::ASM;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Documentation and tools for using Platypus with the Assembly
our $VERSION = '2.12'; # VERSION
sub native_type_map
{
{}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang::ASM - Documentation and tools for using Platypus with the Assembly
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lang('ASM');
=head1 DESCRIPTION
Setting your lang to C<ASM> includes no native type aliases, so types
like C<int> or C<unsigned long> will not work. You need to specify
instead C<sint32> or C<sint64>. Although intended for use with Assembly
it could also be used for other languages if you did not want to use
the normal C aliases for native types.
This document will one day include information on bundling Assembly
with your Perl / FFI / Platypus distribution. Pull requests welcome!
=head1 METHODS
=head2 native_type_map
my $hashref = FFI::Platypus::Lang::ASM->native_type_map;
This returns an empty hash reference. For other languages it returns
a hash reference that defines the aliases for the types normally used
for that language.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The Core Platypus documentation.
=item L<FFI::Platypus::Lang>
Includes a list of other language plugins for Platypus.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Lang/C.pm 000644 000000 000000 00000004055 15251066120 020235 0 ustar 00root root 000000 000000 package FFI::Platypus::Lang::C;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Documentation and tools for using Platypus with the C programming language
our $VERSION = '2.12'; # VERSION
sub native_type_map
{
require FFI::Platypus::ShareConfig;
FFI::Platypus::ShareConfig->get('type_map');
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang::C - Documentation and tools for using Platypus with the C programming language
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lang('C'); # the default
=head1 DESCRIPTION
This module provides some hooks for Platypus to interact with the C
programming language. It is generally used by default if you do not
specify another foreign programming language with the
L<FFI::Platypus#lang> attribute.
=head1 METHODS
=head2 native_type_map
my $hashref = FFI::Platypus::Lang::C->native_type_map;
This returns a hash reference containing the native aliases for the
C programming languages. That is the keys are native C types and the
values are libffi native types.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The Core Platypus documentation.
=item L<FFI::Platypus::Lang>
Includes a list of other language plugins for Platypus.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Lang/Win32.pm 000644 000000 000000 00000034167 15251066120 020764 0 ustar 00root root 000000 000000 package FFI::Platypus::Lang::Win32;
use strict;
use warnings;
use 5.008004;
use Config;
# ABSTRACT: Documentation and tools for using Platypus with the Windows API
our $VERSION = '2.12'; # VERSION
sub abi
{
$^O =~ /^(cygwin|MSWin32|msys)$/ && $Config{ptrsize} == 4
? 'stdcall'
: 'default_abi';
}
my %map;
sub native_type_map
{
unless(%map)
{
require FFI::Platypus::ShareConfig;
%map = %{ FFI::Platypus::ShareConfig->get('type_map') };
my %win32_map = qw(
BOOL int
BOOLEAN BYTE
BYTE uchar
CCHAR char
CHAR char
COLORREF DWORD
DWORD uint
DWORDLONG uint64
DWORD_PTR ULONG_PTR
DWORD32 uint32
DWORD64 uint64
FLOAT float
HACCEL HANDLE
HANDLE PVOID
HBITMAP HANDLE
HBRUSH HANDLE
HCOLORSPACE HANDLE
HCONV HANDLE
HCONVLIST HANDLE
HCURSOR HICON
HDC HANDLE
HDDEDATA HANDLE
HDESK HANDLE
HDROP HANDLE
HDWP HANDLE
HENHMETAFILE HANDLE
HFILE int
HFONT HANDLE
HGDIOBJ HANDLE
HGLOBAL HANDLE
HHOOK HANDLE
HICON HANDLE
HINSTANCE HANDLE
HKEY HANDLE
HKL HANDLE
HLOCAL HANDLE
HMENU HANDLE
HMETAFILE HANDLE
HMODULE HINSTANCE
HMONITOR HANDLE
HPALETTE HANDLE
HPEN HANDLE
HRESULT LONG
HRGN HANDLE
HRSRC HANDLE
HSZ HANDLE
HWINSTA HANDLE
HWND HANDLE
INT int
INT8 sint8
INT16 sint16
INT32 sint32
INT64 sint64
LANGID WORD
LCID DWORD
LCTYPE DWORD
LGRPID DWORD
LONG sint32
LONGLONG sint64
LONG32 sint32
LONG64 sint64
LPCSTR string
LPCVOID opaque
LPVOID opaque
LRESULT LONG_PTR
PSTR string
PVOID opaque
QWORD uint64
SC_HANDLE HANDLE
SC_LOCK LPVOID
SERVICE_STATUS_HANDLE HANDLE
SHORT sint16
SIZE_T ULONG_PTR
SSIZE_T LONG_PTR
UCHAR uint8
UINT uint
UINT8 uint8
UINT16 uint16
UINT32 uint32
UINT64 uint64
ULONG uint32
ULONGLONG uint64
ULONG32 uint32
ULONG64 uint64
USHORT uint16
USN LONGLONG
VOID void
WORD uint16
WPARAM UINT_PTR
);
if($Config{ptrsize} == 4)
{
$win32_map{HALF_PTR} = 'sint16';
$win32_map{INT_PTR} = 'sint32';
$win32_map{LONG_PTR} = 'sint16';
$win32_map{UHALF_PTR} = 'uint16';
$win32_map{UINT_PTR} = 'uint32';
$win32_map{ULONG_PTR} = 'uint16';
}
elsif($Config{ptrsize} == 8)
{
$win32_map{HALF_PTR} = 'sint16';
$win32_map{INT_PTR} = 'sint32';
$win32_map{LONG_PTR} = 'sint16';
$win32_map{UHALF_PTR} = 'uint16';
$win32_map{UINT_PTR} = 'uint32';
$win32_map{ULONG_PTR} = 'uint16';
}
else
{
die "interesting word size you have";
}
foreach my $alias (keys %win32_map)
{
my $type = $alias;
while(1)
{
if($type =~ /^(opaque|[us]int(8|16|32|64)|float|double|string|void)$/)
{
$map{$alias} = $type;
last;
}
if(defined $map{$type})
{
$map{$alias} = $map{$type};
last;
}
if(defined $win32_map{$type})
{
$type = $win32_map{$type};
next;
}
die "unable to resolve $alias => ... => $type";
}
}
# stuff we are not yet dealing with
# LPCTSTR is unicode string, not currently supported
# LPWSTR 16 bit unicode string
# TBYTE TCHAR UNICODE_STRING WCHAR
# Not supported: POINTER_32 POINTER_64 POINTER_SIGNED POINTER_UNSIGNED
}
\%map;
}
sub load_custom_types
{
my(undef, $ffi) = @_;
$ffi->load_custom_type('::WideString' => 'LPCWSTR', access => 'read' );
$ffi->load_custom_type('::WideString' => 'LPWSTR', access => 'write' );
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang::Win32 - Documentation and tools for using Platypus with the Windows API
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use utf8;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new(
api => 2,
lib => [undef],
);
# load this plugin
$ffi->lang('Win32');
# Pass two double word integer values to the Windows API Beep function.
$ffi->attach( Beep => ['DWORD','DWORD'] => 'BOOL');
Beep(262, 300);
# Send a Unicode string to the Windows API MessageBoxW function.
use constant MB_OK => 0x00000000;
use constant MB_DEFAULT_DESKTOP_ONLY => 0x00020000;
$ffi->attach( [MessageBoxW => 'MessageBox'] => [ 'HWND', 'LPCWSTR', 'LPCWSTR', 'UINT'] => 'int' );
MessageBox(undef, "I â¤ï¸ Platypus", "Confession", MB_OK|MB_DEFAULT_DESKTOP_ONLY);
# Get a Unicode string from the Windows API GetCurrentDirectoryW function.
$ffi->attach( [GetCurrentDirectoryW => 'GetCurrentDirectory'] => ['DWORD', 'LPWSTR'] => 'DWORD');
my $buf_size = GetCurrentDirectory(0,undef);
my $dir = "\0\0" x $buf_size;
GetCurrentDirectory($buf_size, \$dir) or die $^E;
print "$dir\n";
=head1 DESCRIPTION
This module provides the Windows datatypes used by the Windows API.
This means that you can use things like C<DWORD> as an alias for
C<uint32>. The full list of type aliases is not documented here as
it may change over time or be dynamic. You can get the list for your
current environment with this one-liner:
perl -MFFI::Platypus::Lang::Win32 -E "say for sort keys %{ FFI::Platypus::Lang::Win32->native_type_map }"
This plugin will also set the correct ABI for use with Win32 API
functions. (On 32 bit systems a different ABI is used for Win32 API
than what is used by the C library, on 32 bit systems the same ABI
is used). Most of the time this exactly what you want, but if you
need to use functions that are using the standard C calling convention,
but need the Win32 types, you can do that by setting the ABI back
immediately after loading the language plugin:
$ffi->lang('Win32');
$ffi->abi('default_abi');
Most of the types should be pretty self-explanatory or at least provided
in the Microsoft documentation on the internet, but the use of Unicode
strings probably requires some more detail:
[version 1.35]
This plugin also provides C<LPCWSTR> and C<LPWSTR> "wide" string types
which are implemented using L<FFI::Platypus::Type::WideString>. For
full details, please see the documentation for that module, and note
that C<LPCWSTR> is a wide string in the read-only string mode and
C<LPWSTR> is a wide string in the read-write buffer mode.
The C<LPCWSTR> is handled fairly transparently by the plugin, but for
when using read-write buffers (C<LPWSTR>) with the Win32 API you typically
need to allocate a buffer string of the right size. These examples will
use C<GetCurrentDirectoryW> attached as C<GetCurrentDirectory>
as in the synopsis above. These are illustrative only, you would normally
want to use the L<Cwd> module to get the current working directory.
=over 4
=item default buffer size 2048
The simplest way is to fallback on the rather arbitrary default buffer size of 2048.
my $dir;
GetCurrentDirectory(1024, \$dir);
print "I am in the directory: $dir\n";
B<Discussion>: This only works if you know the API that you are using will not ever use
more than 2048 bytes. The author believes this to be the case for C<GetCurrentDirectoryW>
since directory paths in windows have a maximum of 260 characters. If every character was
outside the Basic Multilingual Plane (BMP) they would take up exactly 4 characters each.
(This is probably not ever the case since the disk volume at least will be a Latin letter).
Taking account of the C<NULL> termination you would need 260 * 4 + 2 bytes or 1048 bytes.
We pass in a reference to our scalar so that the Win32 API can write into it.
We are passing in half the number of bytes as the first argument because the API expects
the number of C<WCHAR> (or C<wchar_t>), not the number of bytes or the technically the
number of characters since characters can take up either 2 or 4 bytes in UTF-16.
=item allocate your buffer to your own size.
If possible it is of course always best to allocate exactly the size of buffer that
you need.
my $size = GetCurrentDirectory(0, undef);
my $dir = "\0\0" x $size;
GetCurrentDirectory($size, \$dir);
print "I am in the directory: $dir\n";
B<Discussion>: In this case the API provides a way of getting the exact size of buffer
that you need. We allocate this in Perl by creating a string of C<NULLs> of the right
length. The Perl string C<"\0"> is exactly on byte, so we double that before using the
C<x> operator to multiple that by the size returned by the API.
Now, somewhat unexpectedly what is returned is not the same buffer, but a new string
in new UTF-8 encoded Perl string. This is what you want most of the time.
=item initialize your read-write buffer
Some APIs might be modifying an existing string rather than just writing an entirely
new one. In that case you still want to allocate a buffer, but you want to initialize
it with a value. You can do this by passing an array reference instead of a scalar
reference. The firs element of the array is the buffer, and the second is the initialization.
my $dir;
GetCurrentDirectory($size, [ \$dir, "I ⤠Perl + Platypus" ]);
B<Discussion>: Note that this particular API ignores the string passed in and writes
over it, but this demonstrates how you would initialize a buffer string. Once again,
if C<$dir> is not initialized (is C<undef>), then a buffer of the default size of 2048
bytes will be created internally. You can also allocate a specific number of bytes
as in the previous example.
=item allocate memory using C<malloc> etc.
You can also allocate memory using C<malloc> (see L<FFI::Platypus::Memory>) and encode
your string using L<Encode> and copy it using C<wcscpy>. This may be appropriate in
some cases, but it is beyond the scope of this document.
=back
=head1 METHODS
=head2 abi
my $abi = FFI::Platypus::Lang::Win32->abi;
This is called internally when the type plugin is loaded by Platypus.
It selects the appropriate ABI to make Win32 API function calls.
=head2 native_type_map
my $hashref = FFI::Platypus::Lang::Win32->native_type_map;
This is called internally when the type plugin is loaded by Platypus.
It provides types aliases useful on the Windows platform, so it may
also be useful for introspection.
This returns a hash reference containing the native aliases for the
Windows API. That is the keys are native Windows API C types and the
values are libffi native types.
This will includes types like C<DWORD> and C<HWND>, and others. The
full list may be adjusted over time and may be computed dynamically.
To get the full list for your install you can use this one-liner:
perl -MFFI::Platypus::Lang::Win32 -E "say for sort keys %{ FFI::Platypus::Lang::Win32->native_type_map }"
=head2 load_custom_types
FFI::Platypus::Lang::Win32->load_custom_types($ffi);
This is called internally when the type plugin is loaded by Platypus.
It provides custom types useful on the Windows platform. For now
that means the C<LPWSTR> and C<LPCWSTR> types.
=head1 CAVEATS
The Win32 API isn't a different computer language in the same sense that the
other language plugins (those for Fortran or Rust for example). But implementing
these types as a language plugin is the most convenient way to do it.
Prior to version 1.35, this plugin didn't provide an implementation for
C<LPWSTR> or C<LPCWSTR>, so in the likely event that you need those types make
sure you also require at least that version of Platypus.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The Core Platypus documentation.
=item L<FFI::Platypus::Lang>
Includes a list of other language plugins for Platypus.
=item L<FFI::Platypus::Type::WideString>
The wide string type plugin use for C<LPWSTR> and C<LPCWSTR> types.
=item L<Win32::API>
Another FFI, but for Windows only.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Legacy.pm 000644 000000 000000 00000004435 15251066120 020400 0 ustar 00root root 000000 000000 package FFI::Platypus::Legacy;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Legacy Platypus interfaces
our $VERSION = '2.12'; # VERSION
package FFI::Platypus;
sub _package
{
my($self, $module, $modlibname) = @_;
($module, $modlibname) = caller unless defined $modlibname;
my @modparts = split /::/, $module;
my $modfname = $modparts[-1];
my $modpname = join('/',@modparts);
my $c = @modparts;
$modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
{
my @maybe = (
"$modlibname/auto/$modpname/$modfname.txt",
"$modlibname/../arch/auto/$modpname/$modfname.txt",
);
foreach my $file (@maybe)
{
if(-f $file)
{
open my $fh, '<', $file;
my $line = <$fh>;
close $fh;
if($line =~ /^FFI::Build\@(.*)$/)
{
$self->lib("$modlibname/$1");
return $self;
}
}
}
}
require FFI::Platypus::ShareConfig;
my @dlext = @{ FFI::Platypus::ShareConfig->get("config_dlext") };
foreach my $dlext (@dlext)
{
my $file = "$modlibname/auto/$modpname/$modfname.$dlext";
unless(-e $file)
{
$modlibname =~ s,[\\/][^\\/]+$,,;
$file = "$modlibname/arch/auto/$modpname/$modfname.$dlext";
}
if(-e $file)
{
$self->lib($file);
return $self;
}
}
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Legacy - Legacy Platypus interfaces
=head1 VERSION
version 2.12
=head1 DESCRIPTION
This class is private to L<FFI::Platypus>.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Memory.pm 000644 000000 000000 00000014545 15251066120 020447 0 ustar 00root root 000000 000000 package FFI::Platypus::Memory;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Exporter qw( import );
# ABSTRACT: Memory functions for FFI
our $VERSION = '2.12'; # VERSION
our @EXPORT = qw( malloc free calloc realloc memcpy memset strdup strndup strcpy );
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->bundle;
sub _ffi { $ffi }
$ffi->attach(malloc => ['size_t'] => 'opaque' => '$');
$ffi->attach(free => ['opaque'] => 'void' => '$');
$ffi->attach(calloc => ['size_t', 'size_t'] => 'opaque' => '$$');
$ffi->attach(realloc => ['opaque', 'size_t'] => 'opaque' => '$$');
$ffi->attach(memcpy => ['opaque', 'opaque', 'size_t'] => 'opaque' => '$$$');
$ffi->attach(memset => ['opaque', 'int', 'size_t'] => 'opaque' => '$$$');
$ffi->attach(strcpy => ['opaque', 'string'] => 'opaque' => '$$');
my $_strdup_impl = 'not-loaded';
sub _strdup_impl { $_strdup_impl }
eval {
die "do not use c impl" if ($ENV{FFI_PLATYPUS_MEMORY_STRDUP_IMPL}||'libc') eq 'ffi';
$ffi->attach(strdup => ['string'] => 'opaque' => '$');
$_strdup_impl = 'libc';
};
if($@ && $^O eq 'MSWin32')
{
eval {
die "do not use c impl" if ($ENV{FFI_PLATYPUS_MEMORY_STRDUP_IMPL}||'libc') eq 'ffi';
$ffi->attach([ _strdup => 'strdup' ] => ['string'] => 'opaque' => '$');
$_strdup_impl = 'libc';
};
}
if($@)
{
warn "using bundled strdup";
$_strdup_impl = 'ffi';
$ffi->attach([ ffi_platypus_memory__strdup => 'strdup' ] => ['string'] => 'opaque' => '$');
}
my $_strndup_impl = 'not-loaded';
sub _strndup_impl { $_strndup_impl }
eval {
die "do not use c impl" if ($ENV{FFI_PLATYPUS_MEMORY_STRDUP_IMPL}||'libc') eq 'ffi';
$ffi->attach(strndup => ['string','size_t'] => 'opaque' => '$$');
$_strndup_impl = 'libc';
};
if($@)
{
$_strndup_impl = 'ffi';
$ffi->attach([ ffi_platypus_memory__strndup => 'strndup' ] => ['string','size_t'] => 'opaque' => '$$');
}
# used internally by FFI::Platypus::Type::WideString, may go away.
eval { $ffi->attach( [ wcslen => '_wcslen' ] => [ 'opaque' ] => 'size_t' => '$' ) };
eval { $ffi->attach( [ wcsnlen => '_wcsnlen' ] => [ 'string', 'size_t' ] => 'size_t' => '$$' ) };
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Memory - Memory functions for FFI
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus::Memory;
# allocate 64 bytes of memory using the
# libc malloc function.
my $pointer = malloc 64;
# use that memory wisely
...
# free the memory when you are done.
free $pointer;
=head1 DESCRIPTION
This module provides an interface to common memory functions provided by
the standard C library. They may be useful when constructing interfaces
to C libraries with FFI. It works mostly with the C<opaque> type and it
is worth reviewing the section on opaque pointers in L<FFI::Platypus::Type>.
Allocating memory and forgetting to free it is a common source of memory
leaks in C and when using this module. Very recent Perls have a C<defer>
keyword that lets you automatically call functions like C<free> when a
block ends. This can be especially handy when you have multiple code
paths or possible exceptions to keep track of.
use feature 'defer';
use FFI::Platypus::Memory qw( malloc free );
sub run {
my $ptr = malloc 66;
defer { free $ptr };
my $data = do_something($ptr);
# do not need to remember to place free $ptr here, as it will
# run through defer.
return $data;
}
If you are not lucky enough to have the C<defer> feature in your version
of Perl you may be able to use L<Feature::Compat::Defer>, which will use
the feature if available, and provides its own mostly compatible version
if not.
=head1 FUNCTIONS
=head2 calloc
my $pointer = calloc $count, $size;
The C<calloc> function contiguously allocates enough space for I<$count>
objects that are I<$size> bytes of memory each.
=head2 free
free $pointer;
The C<free> function frees the memory allocated by C<malloc>, C<calloc>,
C<realloc> or C<strdup>. It is important to only free memory that you
yourself have allocated. A good way to crash your program is to try and
free a pointer that some C library has returned to you.
=head2 malloc
my $pointer = malloc $size;
The C<malloc> function allocates I<$size> bytes of memory.
=head2 memcpy
memcpy $dst_pointer, $src_pointer, $size;
The C<memcpy> function copies I<$size> bytes from I<$src_pointer> to
I<$dst_pointer>. It also returns I<$dst_pointer>.
=head2 memset
memset $buffer, $value, $length;
The C<memset> function writes I<$length> bytes of I<$value> to the address
specified by I<$buffer>.
=head2 realloc
my $new_pointer = realloc $old_pointer, $size;
The C<realloc> function reallocates enough memory to fit I<$size> bytes.
It copies the existing data and frees I<$old_pointer>.
If you pass C<undef> in as I<$old_pointer>, then it behaves exactly like
C<malloc>:
my $pointer = realloc undef, 64; # same as malloc 64
=head2 strcpy
strcpy $opaque, $string;
Copies the string to the memory location pointed to by C<$opaque>.
=head2 strdup
my $pointer = strdup $string;
The C<strdup> function allocates enough memory to contain I<$string> and
then copies it to that newly allocated memory. This version of
C<strdup> returns an opaque pointer type, not a string type. This may
seem a little strange, but returning a string type would not be very
useful in Perl.
=head2 strndup
my $pointer = strndup $string, $max;
The same as C<strdup> above, except at most C<$max> characters will be
copied in the new string.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Record.pm 000644 000000 000000 00000027350 15251066120 020413 0 ustar 00root root 000000 000000 package FFI::Platypus::Record;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use FFI::Platypus;
use Exporter qw( import );
use constant 1.32 ();
our @EXPORT = qw( record_layout record_layout_1 );
# ABSTRACT: FFI support for structured records data
our $VERSION = '2.12'; # VERSION
sub record_layout_1
{
if(@_ % 2 == 0)
{
my $ffi = FFI::Platypus->new( api => 2);
unshift @_, $ffi;
goto &record_layout;
}
elsif(defined $_[0] && ref($_[0]) eq 'ARRAY')
{
my @args = @{ shift @_ };
unshift @args, api => 2;
unshift @_, \@args;
goto &record_layout;
}
elsif(defined $_[0] && eval { $_[0]->isa('FFI::Platypus') })
{
goto &record_layout;
}
else
{
croak "odd number of arguments, but first argument is not either an array reference or Platypus instance";
}
}
sub record_layout
{
my $ffi;
if(defined $_[0])
{
if(ref($_[0]) eq 'ARRAY')
{
my @args = @{ shift() };
$ffi = FFI::Platypus->new(@args);
}
elsif(eval { $_[0]->isa('FFI::Platypus') })
{
$ffi = shift;
}
}
$ffi ||= FFI::Platypus->new;
my $offset = 0;
my $record_align = 0;
croak "uneven number of arguments!" if scalar(@_) % 2;
my($caller, $filename, $line) = caller;
if($caller->can("_ffi_record_size")
|| $caller->can("ffi_record_size"))
{
croak "record already defined for the class $caller";
}
my @destroy;
my @ffi_types;
my $has_string;
while(@_)
{
my $spec = shift;
my $name = shift;
my $type = $ffi->{tp}->parse( $spec, { member => 1 } );
croak "illegal name $name"
unless $name =~ /^[A-Za-z_][A-Za-z_0-9]*$/
|| $name eq ':';
croak "accessor/method $name already exists"
if $caller->can($name);
my $size = $type->sizeof;
my $align = $type->alignof;
$record_align = $align if $align > $record_align;
my $meta = $type->meta;
$offset++ while $offset % $align;
{
my $count;
my $ffi_type;
if($meta->{type} eq 'record') # this means fixed string atm
{
$ffi_type = 'sint8';
$count = $size;
}
else
{
$ffi_type = $meta->{ffi_type};
$count = $meta->{element_count};
$count = 1 unless defined $count;
$has_string = 1 if $meta->{type} eq 'string';
}
push @ffi_types, $ffi_type for 1..$count;
}
if($name ne ':')
{
if($meta->{type} eq 'string'
&& $meta->{access} eq 'rw')
{
push @destroy, eval '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) .qq{
sub {
shift->$name(undef);
};
};
die $@ if $@;
}
my $full_name = join '::', $caller, $name;
my $error_str = _accessor
$full_name,
"$filename:$line",
$type,
$offset;
croak("$error_str ($spec $name)") if $error_str;
};
$offset += $size;
}
my $size = $offset;
no strict 'refs';
constant->import("${caller}::_ffi_record_size", $size);
constant->import("${caller}::_ffi_record_align", $record_align);
*{join '::', $caller, '_ffi_record_ro'} = \&_ffi_record_ro;
*{join '::', $caller, 'new'} = sub {
my $class = shift;
my $args = ref($_[0]) ? [%{$_[0]}] : \@_;
croak "uneven number of arguments to record constructor"
if @$args % 2;
my $record = "\0" x $class->_ffi_record_size;
my $self = bless \$record, $class;
while(@$args)
{
my $key = shift @$args;
my $value = shift @$args;
$self->$key($value);
}
$self;
};
{
require FFI::Platypus::Record::Meta;
my $ffi_meta = FFI::Platypus::Record::Meta->new(
\@ffi_types,
!$has_string,
);
*{join '::', $caller, '_ffi_meta'} = sub { $ffi_meta };
}
my $destroy_sub = sub {};
if(@destroy)
{
$destroy_sub = sub {
return if _ffi_record_ro($_[0]);
$_->($_[0]) for @destroy;
};
}
do {
no strict 'refs';
*{"${caller}::DESTROY"} = $destroy_sub;
};
();
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Record - FFI support for structured records data
=head1 VERSION
version 2.12
=head1 SYNOPSIS
C:
struct my_person {
int age;
const char title[3];
const char *name
};
void process_person(struct my_person *person)
{
/* ... */
}
Perl:
package MyPerson;
use FFI::Platypus::Record;
record_layout_1(
'int' => 'age',
'string(3)' => 'title',
'string rw' => 'name',
);
package main;
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib("myperson.so");
$ffi->type("record(MyPerson)" => 'MyPerson');
my $person = MyPerson->new(
age => 40,
title => "Mr.",
name => "John Smith",
);
$ffi->attach( process_person => [ 'MyPerson*' ] => 'void' );
process_person($person);
$person->age($person->age + 1); # another year older
process_person($person);
=head1 DESCRIPTION
[version 0.21]
This module provides a mechanism for building classes that can be used
to mange structured data records (known as C as "structs" and in some
languages as "records"). A structured record is a series of bytes that
have structure understood by the C or other foreign language library
that you are interfacing with. It is designed for use with FFI and
L<FFI::Platypus>, though it may have other applications.
Before you get to deep into using this class you should also consider
the L<FFI::C>, which provides some overlapping functionality. Briefly,
it comes down to this:
(The tl;dr is: use this class when you need to pass by value (since
L<FFI::C> does not support pass by value) and use L<FFI::C> in all
other circumstances).
=over 4
=item L<FFI::Platypus::Record>
Supports:
=over 4
=item C pointers to C<struct> types
=item Passing C C<struct>s by-value.
=back
Does not support:
=over 4
=item C C<union> types.
=item C arrays of C<struct> and C<union> types.
=back
=item L<FFI::C>
Supports:
=over 4
=item C C<struct> andC<union> types
=item C arrays of C<struct> and C<union> types.
=back
Does not support:
=over 4
=item Passing C C<struct>s by-value.
=back
String members are as of this writing a TODO for L<FFI::C>, but
should be coming soon!
=back
=head1 FUNCTIONS
=head2 record_layout_1
record_layout_1($ffi, $type => $name, ... );
record_layout_1(\@ffi_args, $type => $name, ... );
record_layout_1($type => $name, ... );
Define the layout of the record. You may optionally provide an instance
of L<FFI::Platypus> as the first argument in order to use its type
aliases. Alternatively you may provide constructor arguments that will
be passed to the internal platypus instance. Thus this is the same:
my $ffi = FFI::Platypus->new( lang => 'Rust', api => 2 );
record_layout_1( $ffi, ... );
# same as:
record_layout_1( [ lang => 'Rust' ], ... );
and this is the same:
my $ffi = FFI::Platypus->new( api => 2 );
record_layout_1( $ffi, ... );
# same as:
record_layout_1( ... );
Then you provide members as type/name pairs.
For each member you declare, C<record_layout_1> will create an accessor
which can be used to read and write its value. For example imagine a
class C<Foo>:
package Foo;
use FFI::Platypus::Record;
record_layout_1(
int => 'bar', # int bar;
'string(10)' => 'baz', # char baz[10];
);
You can get and set its fields with like named C<bar> and C<baz>
accessors:
my $foo = Foo->new;
$foo->bar(22);
my $value = $foo->bar;
$foo->baz("grimlock\0\0"); # should be 10 characters long
my $string_value = $foo->baz; # includes the trailing \0\0
You can also pass initial values in to the constructor, either passing
as a list of key value pairs or by passing a hash reference:
$foo = Foo->new(
bar => 22,
baz => "grimlock\0\0",
);
# same as:
$foo = Foo->new( {
bar => 22,
baz => "grimlock\0\0",
} );
If there are members of a record that you need to account for in terms
of size and alignment, but do not want to have an accessor for, you can
use C<:> as a place holder for its name:
record_layout_1(
'int' => ':',
'string(10)' => 'baz',
);
=head3 strings
So far I've shown fixed length strings. These are declared with the
word C<string> followed by the length of the string in parentheticals.
Fixed length strings are included inside the record itself and do not
need to be allocated or deallocated separately from the record.
Variable length strings must be allocated on the heap, and thus require
a sense of "ownership", that is whomever allocates variable length
strings should be responsible for also free'ing them. To handle this,
you can add a C<ro> or C<rw> trait to a string field. The default is
C<ro>, means that you can get, but not set its value:
package Foo;
record_layout_1(
'string ro' => 'bar', # same type as 'string' and 'string_ro'
);
package main;
my $foo = Foo->new;
my $string = $foo->bar; # GOOD
$foo->bar("starscream"); # BAD
If you specify a field is C<rw>, then you can set its value:
package Foo;
record_layout_1(
'string rw' => 'bar', # same type as 'string_rw'
);
package main;
my $foo = Foo->new;
my $string = $foo->bar; # GOOD
$foo->bar("starscream"); # GOOD
Any string value that is pointed to by the record will be free'd when it
falls out of scope, so you must be very careful that any C<string rw>
fields are not set or modified by C code. You should also take care not
to copy any record that has a C<rw> string in it because its values will
be free'd twice!
use Clone qw( clone );
my $foo2 = clone $foo; # BAD bar will be free'd twice
=head3 arrays
Arrays of integer, floating points and opaque pointers are supported.
package Foo;
record_layout_1(
'int[10]' => 'bar',
);
my $foo = Foo->new;
$foo->bar([1,2,3,4,5,6,7,8,9,10]); # sets the values for the array
my $list = $foo->bar; # returns a list reference
$foo->bar(5, -6); # sets the 5th element in the array to -6
my $item = $foo->bar(5); gets the 5th element in the array
=head2 record_layout
record_layout($ffi, $type => $name, ... );
record_layout(\@ffi_args, $type => $name, ... );
record_layout($type => $name, ... );
This function works like C<record_layout> except that
C<api =E<gt> 0> is used instead of C<api =E<gt> 1>.
All new code should use C<record_layout_1> instead.
=head1 CAVEATS
These useful features (and probably more) are missing, and unlikely to be added.
=over 4
=item Unions
=item Nested records
=back
If you need these features, consider using L<FFI::C> instead.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The main platypus documentation.
=item L<FFI::C>
Another interface for constructing structured data. It includes support for
C<union> and array types (which this module does not), but lacks support for
passing records by-value.
=item L<FFI::Platypus::Record::TieArray>
Tied array interface for record array members.
=item L<Convert::Binary::C>
Another method for constructing and dissecting structured data records.
=item L<pack and unpack|perlpacktut>
Built-in Perl functions for constructing and dissecting structured data
records.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Record/ 000755 000000 000000 00000000000 15251066120 020046 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Platypus/Record/Meta.pm 000644 000000 000000 00000005304 15251066120 021274 0 ustar 00root root 000000 000000 package FFI::Platypus::Record::Meta;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: FFI support for structured records data
our $VERSION = '2.12'; # VERSION
{
require FFI::Platypus;
my $ffi = FFI::Platypus->new(
api => 2,
);
$ffi->bundle;
$ffi->mangler(sub {
my($name) = @_;
$name =~ s/^/ffi_platypus_record_meta__/;
$name;
});
$ffi->type('opaque' => 'ffi_type');
$ffi->custom_type('meta_t' => {
native_type => 'opaque',
perl_to_native => sub {
${ $_[0] };
},
});
$ffi->attach( _find_symbol => ['string'] => 'ffi_type');
$ffi->attach( new => ['ffi_type[]','int'] => 'meta_t', sub {
my($xsub, $class, $elements, $closure_safe) = @_;
if(ref($elements) ne 'ARRAY')
{
require Carp;
Carp::croak("passed something other than a array ref to @{[ __PACKAGE__ ]}");
}
my @element_type_pointers;
foreach my $element_type (@$elements)
{
my $ptr = _find_symbol($element_type);
if($ptr)
{
push @element_type_pointers, $ptr;
}
else
{
require Carp;
Carp::croak("unknown type: $element_type");
}
}
push @element_type_pointers, undef;
my $ptr = $xsub->(\@element_type_pointers, $closure_safe);
bless \$ptr, $class;
});
$ffi->attach( ffi_type => ['meta_t'] => 'ffi_type' );
$ffi->attach( size => ['meta_t'] => 'size_t' );
$ffi->attach( alignment => ['meta_t'] => 'ushort' );
$ffi->attach( element_pointers => ['meta_t'] => 'ffi_type[]' );
$ffi->attach( DESTROY => ['meta_t'] => 'void' );
}
sub ptr { ${ shift() } }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Record::Meta - FFI support for structured records data
=head1 VERSION
version 2.12
=head1 DESCRIPTION
This class is private to FFI::Platypus. See L<FFI::Platypus::Record> for
the public interface to Platypus records.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Record/TieArray.pm 000644 000000 000000 00000005347 15251066120 022135 0 ustar 00root root 000000 000000 package FFI::Platypus::Record::TieArray;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
# ABSTRACT: Tied array interface for record array members
our $VERSION = '2.12'; # VERSION
sub TIEARRAY
{
my $class = shift;
bless [ @_ ], $class;
}
sub FETCH
{
my($self, $key) = @_;
my($obj, $member) = @$self;
$obj->$member($key);
}
sub STORE
{
my($self, $key, $value) = @_;
my($obj, $member) = @$self;
$obj->$member($key, $value);
}
sub FETCHSIZE
{
my($self) = @_;
$self->[2];
}
sub CLEAR
{
my($self) = @_;
my($obj, $member) = @$self;
$obj->$member([]);
}
sub EXTEND
{
my($self, $count) = @_;
croak "tried to extend a fixed length array" if $count > $self->[2];
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Record::TieArray - Tied array interface for record array members
=head1 VERSION
version 2.12
=head1 SYNOPSIS
package Foo;
use FFI::Platypus::Record;
use FFI::Platypus::Record::TieArray;
record_layout(qw(
int[20] _bar
));
sub bar
{
my($self, $arg) = @_;
$self->_bar($arg) if ref($arg) eq ' ARRAY';
tie my @list, 'FFI::Platypus::Record::TieArray',
$self, '_bar', 20;
}
package main;
my $foo = Foo->new;
my $bar5 = $foo->bar->[5]; # get the 5th element of the bar array
$foo->bar->[5] = 10; # set the 5th element of the bar array
@{ $foo->bar } = (); # set all elements in bar to 0
@{ $foo->bar } = (1..5); # set the first five elements of the bar array
=head1 DESCRIPTION
B<WARNING>: This module is considered EXPERIMENTAL. It may go away or
be changed in incompatible ways, possibly without notice, but not
without a good reason.
This class provides a tie interface for record array members.
In the future a short cut for using this with L<FFI::Platypus::Record>
directly may be provided.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The main Platypus documentation.
=item L<FFI::Platypus::Record>
Documentation on Platypus records.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/ShareConfig.pm 000644 000000 000000 00000003641 15251066120 021362 0 ustar 00root root 000000 000000 package FFI::Platypus::ShareConfig;
use strict;
use warnings;
use 5.008004;
use File::Spec;
our $VERSION = '2.12'; # VERSION
sub dist_dir ($)
{
my($dist_name) = @_;
my @pm = split /-/, $dist_name;
$pm[-1] .= ".pm";
foreach my $inc (@INC)
{
if(-f File::Spec->catfile($inc, @pm))
{
my $share = File::Spec->catdir($inc, qw( auto share dist ), $dist_name );
if(-d $share)
{
return File::Spec->rel2abs($share);
}
last;
}
}
Carp::croak("unable to find dist share directory for $dist_name");
}
sub get
{
my(undef, $name) = @_;
my $config;
unless($config)
{
my $fn = File::Spec->catfile(dist_dir('FFI-Platypus'), 'config.pl');
$fn = File::Spec->rel2abs($fn) unless File::Spec->file_name_is_absolute($fn);
local $@;
unless($config = do $fn)
{
die "couldn't parse configuration $fn $@" if $@;
die "couldn't do $fn $!" if $!;
die "bad or missing config file $fn";
};
}
defined $name ? $config->{$name} : $config;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::ShareConfig
=head1 VERSION
version 2.12
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Type.pm 000644 000000 000000 00000125423 15251066120 020116 0 ustar 00root root 000000 000000 package FFI::Platypus::Type;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
require FFI::Platypus;
# ABSTRACT: Defining types for FFI::Platypus
our $VERSION = '2.12'; # VERSION
# The TypeParser and Type classes are used internally ONLY and
# are not to be exposed to the user. External users should
# not under any circumstances rely on the implementation of
# these classes.
sub alignof
{
my($self) = @_;
my $meta = $self->meta;
# TODO: it is possible, though complicated
# to compute the alignment of a struct
# type record.
croak "cannot determine alignment of record"
if $meta->{type} eq 'record'
&& $meta->{ref} == 1;
my $ffi_type;
if($meta->{type} eq 'pointer')
{
$ffi_type = 'pointer';
}
elsif($meta->{type} eq 'record')
{
$ffi_type = 'uint8';
}
else
{
$ffi_type = $meta->{ffi_type};
}
require FFI::Platypus::ShareConfig;
FFI::Platypus::ShareConfig->get('align')->{$ffi_type};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type - Defining types for FFI::Platypus
=head1 VERSION
version 2.12
=head1 SYNOPSIS
OO Interface:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('int' => 'my_int');
=head1 DESCRIPTION
B<Note>: This document assumes that you are using C<api =E<gt> 2>,
which you should be using for all new code.
This document describes how to define types using L<FFI::Platypus>.
Types may be "defined" ahead of time, or simply used when defining or
attaching functions.
# Example of defining types
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('int');
$ffi->type('string');
# Example of simply using types in function declaration or attachment
my $f = $ffi->function(puts => ['string'] => 'int');
$ffi->attach(puts => ['string'] => 'int');
Unless you are using aliases the L<FFI::Platypus#type> method is not
necessary, but they will throw an exception if the type is incorrectly
specified or not supported, which may be helpful for determining if
the types are available or not.
Note: This document sometimes uses the term "C Function" as short hand
for function implemented in a compiled language. Unless the term is
referring literally to a C function example code, you can assume that
it should also work with another compiled language.
=head2 meta information about types
You can get the size of a type using the L<FFI::Platypus#sizeof> method.
my $intsize = $ffi->sizeof('int'); # usually 4
my $intarraysize = $ffi->sizeof('int[64]'); # usually 256
=head2 converting types
Sometimes it is necessary to convert types. In particular various
pointer types often need to be converted for consumption in Perl. For
this purpose the L<FFI::Platypus#cast> method is provided. It needs to
be used with care though, because not all type combinations are
supported. Here are some useful ones:
my $address = $ffi->cast('string' => 'opaque', $string);
This converts a Perl string to a pointer address that can be used
by functions that take an C<opaque> type. Be carefully though that
the Perl string is not resized or free'd while in use from C code.
my $string = $ffi->cast('opaque' => 'string', $pointer);
This does the opposite, converting a null terminated string (the
type of strings used by C) into a Perl string. In this case the
string is copied, so the other language is free to deallocate or
otherwise manipulate the string after the conversion without adversely
affecting the Perl.
=head2 aliases
Some times using alternate names is useful for documenting the purpose
of an argument or return type. For this "aliases" can be helpful. The
second argument to the L<FFI::Platypus#type> method can be used to
define a type alias that can later be used by function declaration
and attachment.
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('int' => 'myint');
$ffi->type('string' => 'mystring');
my $f = $ffi->function( puts => ['mystring'] => 'myint' );
$ffi->attach( puts => ['mystring'] => 'myint' );
Aliases are contained without the L<FFI::Platypus> object, so feel free
to define your own crazy types without stepping on the toes of other
CPAN developers using Platypus.
One useful application of an alias is when you know types are different
on two different platforms:
if($^O eq 'MSWin32')
{
$type->type('sint16' => 'foo_t');
} elsif($^O eq 'linux')
{
$type->type('sint32' => 'foo_t');
}
# function foo takes 16 bit signed integer on Windows
# and a 32 bit signed integer on Linux.
$ffi->attach( foo => [ 'foo_t' ] => 'void' );
=for stopwords tm
=head1 TYPE CATEGORIES
=head2 Native types
So called native types are the types that the CPU understands that can
be passed on the argument stack or returned by a function. It does not
include more complicated types like arrays or structs, which can be
passed via pointers (see the opaque type below). Generally native types
include void, integers, floats and pointers.
=head3 the void type
This can be used as a return value to indicate a function does not
return a value (or if you want the return value to be ignored).
$ffi->type( foo => [] => 'void' );
Newer versions of Platypus also allow you to omit the return type and
C<void> is assumed.
$ffi->type( foo => [] );
It doesn't really make sense to use C<void> in any other context. However,
because of historical reasons involving older versions of Perl.
It doesn't really make sense for C<void> to be passed in as an argument.
However, because C functions that take no arguments frequently are specified
as taking C<void> as this was required by older C compilers, as a special
case you can specify a function's arguments as taking a single C<void> to
mean it takes no arguments.
# C: void foo(void);
$ffi->type( foo => ['void'] );
# same (but probably better)
$ffi->type( foo => [] );
=head3 integer types
The following native integer types are always available (parentheticals
indicates the usual corresponding C type):
=over 4
=item sint8
Signed 8 bit byte (C<signed char>, C<int8_t>).
=item uint8
Unsigned 8 bit byte (C<unsigned char>, C<uint8_t>).
=item sint16
Signed 16 bit integer (C<short>, C<int16_t>)
=item uint16
Unsigned 16 bit integer (C<unsigned short>, C<uint16_t>)
=item sint32
Signed 32 bit integer (C<int>, C<int32_t>)
=item uint32
Unsigned 32 bit integer (C<unsigned int>, C<uint32_t>)
=item sint64
Signed 64 bit integer (C<long long>, C<int64_t>)
=item uint64
Unsigned 64 bit integer (C<unsigned long long>,
C<uint64_t>)
=back
You may also use C<uchar>, C<ushort>, C<uint> and C<ulong> as short
names for C<unsigned char>, C<unsigned short>, C<unsigned int> and
C<unsigned long>.
These integer types are also available, but there actual size and sign
may depend on the platform.
=over 4
=item char
Somewhat confusingly, C<char> is an integer type! This is really an
alias for either C<sint8_t> or C<uint8_t> depending on your platform.
If you want to pass a character (not integer) in to a C function that
takes a character you want to use the perl L<ord|perlfunc/ord> function.
Here is an example that uses the standard libc C<isalpha>, C<isdigit>
type functions:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->type('int' => 'character');
my @list = qw(
alnum alpha ascii blank cntrl digit lower print punct
space upper xdigit
);
$ffi->attach("is$_" => ['character'] => 'int') for @list;
my $char = shift(@ARGV) || 'a';
no strict 'refs';
printf "'%s' is %s %s\n", $char, $_, &{'is'.$_}(ord $char) for @list;
=item size_t
This is usually an C<unsigned long>, but it is up to the compiler to
decide. The C<malloc> function is defined in terms of C<size_t>:
$ffi->attach( malloc => ['size_t'] => 'opaque';
(Note that you can get C<malloc> from L<FFI::Platypus::Memory>).
=item long, unsigned long
On 64 bit systems, this is usually a 64 bit integer. On 32 bit systems
this is frequently a 32 bit integer (and C<long long> or
C<unsigned long long> are for 64 bit).
=back
There are a number of other types that may or may not be available if
they are detected when L<FFI::Platypus> is installed. This includes
things like C<wchar_t>, C<off_t>, C<wint_t>. You can use this script to
list all the integer types that L<FFI::Platypus> knows about, plus how
they are implemented.
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
foreach my $type_name (sort $ffi->types)
{
my $meta = $ffi->type_meta($type_name);
next unless defined $meta->{element_type} && $meta->{element_type} eq 'int';
printf "%20s %s\n", $type_name, $meta->{ffi_type};
}
If you need a common system type that is not provided, please open a
ticket in the Platypus project's GitHub issue tracker. Be sure to
include the usual header file the type can be found in.
=head3 Enum types
C provides enumerated types, which are typically implemented as integer
types.
enum {
BAR = 1,
BAZ = 2
} foo_t;
void f(enum foo_t foo);
Platypus provides C<enum> and C<senum> types for the integer types used
to represent enum and signed enum types respectively.
use constant BAR => 1;
use constant BAZ => 2;
$ffi->attach( f => [ 'enum' ] => 'void' );
f(BAR);
f(BAZ);
When do you use C<senum>? Anytime the enum has negative values:
enum {
BAR = -1;
BAZ = 2;
} foo_t;
void f(enum foo_t foo);
Perl:
use constant BAR => -1;
use constant BAZ => 2;
$ffi->attach( f => [ 'senum' ] => 'void' );
f(BAR);
f(BAZ);
Dealing with enumerated values with FFI can be tricky because these are
usually defined in C header files and cannot be found in dynamic libraries.
For trivial usage you can do as illustrated above, simply define your own
Perl constants. For more complicated usage, or where the values might vary
from platform to platform you may want to consider the new Platypus bundle
interface to define Perl constants (essentially the same as an enumerated
value) from C space. This is more reliable, but does require a compiler
at install time. See L<FFI::Platypus::Constant> for details.
The main FAQ (L<FFI::Platypus/FAQ>) also has a discussion on dealing
with constants and enumerated types.
There is also a type plugin (L<FFI::Platypus::Type::Enum>) that can be helpful
in writing interfaces that use enums.
=head3 Boolean types
At install time Platypus attempts to detect the correct type for C<bool>
for your platform, and you can use that. C<bool> is really an integer
type, but the type used varies from platform to platform.
C header:
#include <stdbool.h>
bool foo();
Platypus
$ffi->attach( foo => [] => 'bool' );
If you get an exception when trying to use this type it means you either
have a very old version of Platypus, or for some reason it was unable to
detect the correct type at install time. Please open a ticket if that is
the case.
=head3 floating point types
The following native floating point types are always available
(parentheticals indicates the usual corresponding C type):
=over 4
=item float
Single precision floating point (I<float>)
=item double
Double precision floating point (I<double>)
=item longdouble
Floating point that may be larger than C<double> (I<longdouble>). This
type is only available if supported by the C compiler used to build
L<FFI::Platypus>. There may be a performance penalty for using this
type, even if your Perl uses long doubles internally for its number
value (NV) type, because of the way L<FFI::Platypus> interacts with
C<libffi>.
As an argument type either regular number values (NV) or instances of
L<Math::LongDouble> are accepted. When used as a return type,
L<Math::LongDouble> will be used, if you have that module installed.
Otherwise the return type will be downgraded to whatever your Perl's
number value (NV) is.
=item complex_float
Complex single precision floating point (I<float complex>)
=item complex_double
Complex double precision floating point (I<double complex>)
C<complex_float> and C<complex_double> are only available if supported
by your C compiler and by libffi. Complex numbers are only supported in
very recent versions of libffi, and as of this writing the latest
production version doesn't work on x86_64. It does seem to work with
the latest production version of libffi on 32 bit Intel (x86), and with
the latest libffi version in git on x86_64.
=back
=head3 opaque pointers
Opaque pointers are simply a pointer to a region of memory that you do
not manage, and do not know or care about its structure. It is like
a C<void *> in C. These types are represented in Perl space as integers
and get converted to and from pointers by L<FFI::Platypus>. You may use
C<pointer> as an alias for C<opaque>, although this is discouraged.
(The Platypus documentation uses the convention of using "pointer"
to refer to pointers to known types (see below) and "opaque" as short
hand for opaque pointer).
As an example, libarchive defines C<struct archive> type in its header
files, but does not define its content. Internally it is defined as a
C<struct> type, but the caller does not see this. It is therefore
opaque to its caller. There are C<archive_read_new> and
C<archive_write_new> functions to create a new instance of this opaque
object and C<archive_read_free> and C<archive_write_free> to destroy
this objects when you are done.
C header:
struct archive;
struct archive *archive_read_new(void);
struct archive *archive_write_new(void);
int archive_free(struct archive *);
int archive_write_free(struct archive *);
Perl code:
$lib->find_lib( lib => 'archive' );
$ffi->attach(archive_read_new => [] => 'opaque');
$ffi->attach(archive_write_new => [] => 'opaque');
$ffi->attach(archive_read_free => ['opaque'] => 'int');
$ffi->attach(archive_write_free => ['opaque'] => 'int');
It is often useful to alias an C<opaque> type like this so that you know
what the object represents:
$lib->find_lib( lib => 'archive' );
$ffi->type('opaque' => 'archive');
$ffi->attach(archive_read_new => [] => 'archive');
$ffi->attach(archive_read_free => ['archive'] => 'int');
...
As a special case, when you pass C<undef> into a function that takes an
opaque type it will be translated into C<NULL> for C. When a C function
returns a NULL pointer, it will be translated back to C<undef>.
For functions that take a pointer to a void pointer (that is a C<void **>),
you can use a pointer to an opaque type. Consider the C code:
struct archive_entry;
int archive_read_next_header(struct archive *, struvct archive_entry **);
Once again the internals of C<archive_entry> are not provided. Perl code:
$ffi->type('opaque' => 'archive_entry');
$ffi->attach(archive_read_next_header => [ 'archive', 'archive_entry*' ] => 'int');
Now we can call this function
my $archive = archive_read_new();
... # additional prep for $active is required
while(1) {
my $entry;
archive_read_next_header($archive, \$entry);
last unless defined $entry;
# can now use $entry for other archive_entry_ methods.
}
The way C<archive_read_next_header> works, it will return a pointer to the next
C<archive_entry> object until it gets to the end, when it will return a pointer
to C<NULL> which will be represented in Perl by a C<undef>.
There are a number of useful utility functions for dealing with opaque
types in the L<FFI::Platypus::Memory> module.
=head2 Objects
Object types are thin wrappers around two native types: integer and
C<opaque> types. They are just blessed references around either of
those two types so that methods can be defined on them, but when they
get passed to a Platypus xsub they are converted into the native
integer or C<opaque> types. This type is most useful when a API
provides an OO style interface with an integer or C<opaque> value
acting as an instance of a class. There are two detailed examples
in the main Platypus documentation using libarchive and unix open:
=over 4
=item L<FFI::Platypus/libarchive>
=item L<FFI::Platypus/"unix open">
=back
=head2 Strings
# used when you need a char * or const char *
$ffi->attach( puts => [ 'string' ] => 'int' );
The C<string> type is a series of bytes that usually represent a
series of characters. They will be NULL terminated for C and passed
in as a pointer. This will typically work for APIs that take ASCII
or UTF-8 strings which are common in Unix environments.
(Note if you need to handle the native "wide" string for example
if you need to talk UTF-16 on Windows see L<FFI::Platypus::Type::WideString>).
(Note if you need to pass in a fixed length string by value (not as
a pointer) then you can do so using L<FFI::Platypus::Record>).
(Note that languages like L<Go|FFI::Platypus::Lang::Go> and L<Rust|FFI::Platypus::Lang::Rust> do not use NULL terminated strings
and need their own string types; see the appropriate language plugins for details)
# can also be used when you need a void * or const void *
$ffi->attach( write => ['int', 'string', 'size_t' ] => 'ssizet' );
The C<string> type can also be used to pass in the start of a buffer
of arbitrary bytes stored in a Perl scalar. Because a C<string> is
passed just as a pointer you will typically need to also pass the
length of the buffer as a separate argument. This is necessary because
buffers could potentially have a NULL in them.
The pointer passed into C (or other language) is to the content of the
actual scalar, which means it can modify the content of a scalar.
B<NOTE>: When used as a return type, the string is I<copied> into a
new scalar rather than using the original address. This is due to
the ownership model of scalars in Perl, but it is also most of the
time what you want.
This can be problematic when a function returns a string that the callee
is expected to free. Consider the functions:
char *
get_string()
{
char *buffer;
buffer = malloc(20);
strcpy(buffer, "Perl");
}
void
free_string(char *buffer)
{
free(buffer);
}
This API returns a string that you are expected to free when you are
done with it. (At least they have provided an API for freeing the
string instead of expecting you to call libc free)! A simple binding
to get the string would be:
$ffi->attach( get_string => [] => 'string' ); # memory leak
my $str = get_string();
Which will work to a point, but the memory allocated by get_string
will leak. Instead you need to get the opaque pointer, cast it to
a string and then free it.
$ffi->attach( get_string => [] => 'opaque' );
$ffi->attach( free_string => ['opaque'] => 'void' );
my $ptr = get_string();
my $str = $ffi->cast( 'opaque' => 'string', $ptr ); # copies the string
free_string($ptr);
If you are doing this sort of thing a lot, it can be worth adding a
custom type:
$ffi->attach( free_string => ['opaque'] => 'void' );
$ffi->custom_type( 'my_string' => {
native_type => 'opaque',
native_to_perl => sub {
my($ptr) = @_;
my $str = $ffi->cast( 'opaque' => 'string', $ptr ); # copies the string
free_string($ptr);
$str;
}
});
$ffi->attach( get_string => [] => 'my_string' );
my $str = get_string();
Since version 0.62, pointers and arrays to strings are supported as a
first class type. Prior to that L<FFI::Platypus::Type::StringArray>
and L<FFI::Platypus::Type::StringPointer> could be used, though their
use in new code is discouraged.
$ffi->attach( foo => ['string[]'] => 'void' );
foo( [ 'array', 'of', 'strings' ] );
$ffi->attach( bar => ['string*'] => 'void' );
my $string = 'baz';
bar( \$string ); # $string may be modified.
Strings are not allowed as return types from closure. This, again
is due to the ownership model of scalars in Perl. (There is no way
for Perl to know when calling language is done with the memory allocated
to the string). Consider the API:
typedef const char *(*get_message_t)(void);
void
print_message(get_message_t get_message)
{
const char *str;
str = get_message();
printf("message = %s\n", str);
}
It feels like this should be able to work:
$ffi->type('()->string' => 'get_message_t'); # not ok
$ffi->attach( print_message => ['get_message_t'] => 'void' );
my $get_message = $ffi->closure(sub {
return "my message";
});
print_message($get_message);
If the type declaration for C<get_message_t> were legal, then this
script would likely segfault or in the very least corrupt memory.
The problem is that once C<"my message"> is returned from the closure
Perl doesn't have a reference to it anymore and will free it.
To do this safely, you have to keep a reference to the scalar around
and return an opaque pointer to the string using a cast.
$ffi->type('()->opaque' => 'get_message_t');
$ffi->attach( print_message => ['get_message_t'] => 'void' );
my $get_message => $ffi->closure(sub {
our $message = "my message"; # needs to be our so that it doesn't
# get free'd
my $ptr = $ffi->cast('string' => 'opaque', $message);
return $ptr;
});
print_message($get_message);
Another type of string that you may run into with some APIs is the
so called "wide" string. In your C code if you see C<wchar_t*>
or C<const wchar_t*> or if in Win32 API code you see C<LPWSTR>
or C<LPCWSTR>. Most commonly you will see these types when working
with the Win32 API, but you may see them in Unix as well. These
types are intended for dealing with Unicode, but they do not use
the same UTF-8 format used by Perl internally, so they need to be
converted. You can do this manually by allocating the memory
and using the L<Encode> module, but the easier way is to use
either L<FFI::Platypus::Type::WideString> or
L<FFI::Platypus::Lang::Win32>, which handle the memory allocation
and conversion for you.
String types can be defined to have a fixed length using a trailing
parenthetical like so C<string(10)>. For arguments this has little
practical effect since the strings are passed as pointers anyway,
but does impact return values. If a function that returns a C<string(10)>
type returns a string that is not NULL terminated, only the first ten bytes
will be returned in the result.
Internally fixed length strings are implemented the same as
classless record types (that is to say C<string(10)> is identically
internally to C<record(10)*>).
For the 1.00 Platypus API, the C<string(10)> type was specified as
a pointer (that is C<string(10)*>). This was a mistake, but you
can still use the latter as an alias for the correct form in the
2.00 API.
=head2 Pointers and Arrays of Strings
As of the 1.00 Platypus API, you can specify pointers to strings
(C<string*>) and arrays of strings (C<string[10]>). Since strings
themselves are passed as pointers, this means these types are
passed in as pointers to pointers. If the pointer to the string
is changed then when the function returns the scalar or array
will be updated as well.
=head2 Pointer / References
In C you can pass a pointer to a variable to a function in order
accomplish the task of pass by reference. In Perl the same task is
accomplished by passing a reference (although you can also modify the
argument stack thus Perl supports proper pass by reference as well).
With L<FFI::Platypus> you can define a pointer to any native, string
or record type. You cannot (at least not yet) define a pointer to
a pointer or a pointer to an array or any other type not otherwise
supported. When passing in a pointer to something you must make sure
to pass in a reference to a scalar, or C<undef> (C<undef> will be
translated int C<NULL>).
If the C code makes a change to the value pointed to by the pointer, the
scalar will be updated before returning to Perl space. Example, with C
code.
/* foo.c */
void increment_int(int *value)
{
if(value != NULL)
(*value)++;
else
fprintf(stderr, "NULL pointer!\n");
}
# foo.pl
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib('libfoo.so'); # change to reflect the dynamic lib
# that contains foo.c
$ffi->type('int*' => 'int_p');
$ffi->attach(increment_int => ['int_p'] => 'void');
my $i = 0;
increment_int(\$i); # $i == 1
increment_int(\$i); # $i == 2
increment_int(\$i); # $i == 3
increment_int(undef); # prints "NULL pointer!\n"
Older versions of Platypus did not support pointers to strings or records.
=head2 Records
Records are structured data of a fixed length. In C they are called
C<struct>s.
For most C structured data, as long as you do not need to a record
by value, L<FFI::C> is the better choice. Briefly, L<FFI::C> supports
C<struct>, C<union>, and arrays of C<struct> and C<unions>. L<FFI::C>
does not support passing by value. The reminder of this section will
discuss only the C<record> type.
To declare a record type, use C<record>:
$ffi->type( 'record (42)' => 'my_record_of_size_42_bytes' );
The easiest way to mange records with Platypus is by using
L<FFI::Platypus::Record> to define a record layout for a record class.
Here is a brief example:
package Unix::TimeStruct;
use FFI::Platypus 2.00;
use FFI::Platypus::Record;
record_layout_1(qw(
int tm_sec
int tm_min
int tm_hour
int tm_mday
int tm_mon
int tm_year
int tm_wday
int tm_yday
int tm_isdst
long tm_gmtoff
string tm_zone
));
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
# define a record class Unix::TimeStruct and alias it to "tm"
$ffi->type("record(Unix::TimeStruct)*" => 'tm');
# attach the C localtime function as a constructor
$ffi->attach( localtime => ['time_t*'] => 'tm', sub {
my($inner, $class, $time) = @_;
$time = time unless defined $time;
$inner->(\$time);
});
package main;
# now we can actually use our Unix::TimeStruct class
my $time = Unix::TimeStruct->localtime;
printf "time is %d:%d:%d %s\n",
$time->tm_hour,
$time->tm_min,
$time->tm_sec,
$time->tm_zone;
For more detailed usage, see L<FFI::Platypus::Record>.
Platypus does not manage the structure of a record (that is up to you),
it just keeps track of their size and makes sure that they are copied
correctly when used as a return type. A record in Perl is just a string
of bytes stored as a scalar. In addition to defining a record layout
for a record class, there are a number of tools you can use manipulate
records in Perl, two notable examples are L<pack and unpack|perlpacktut>
and L<Convert::Binary::C>.
Here is an example with commentary that uses L<Convert::Binary::C> to
extract the component time values from the C C<localtime> function, and
then smushes them back together to get the original C<time_t> (an
integer).
use Convert::Binary::C;
use FFI::Platypus 2.00;
use Data::Dumper qw( Dumper );
my $c = Convert::Binary::C->new;
# Alignment of zero (0) means use
# the alignment of your CPU
$c->configure( Alignment => 0 );
# parse the tm record structure so
# that Convert::Binary::C knows
# what to spit out and suck in
$c->parse(<<ENDC);
struct tm {
int tm_sec;
int tm_min;
int tm_hour;
int tm_mday;
int tm_mon;
int tm_year;
int tm_wday;
int tm_yday;
int tm_isdst;
long int tm_gmtoff;
const char *tm_zone;
};
ENDC
# get the size of tm so that we can give it
# to Platypus
my $tm_size = $c->sizeof("tm");
# create the Platypus instance and create the appropriate
# types and functions
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->type("record($tm_size)*" => 'tm');
$ffi->attach( [ localtime => 'my_localtime' ] => ['time_t*'] => 'tm' );
$ffi->attach( [ time => 'my_time' ] => ['tm'] => 'time_t' );
# ===============================================
# get the tm struct from the C localtime function
# note that we pass in a reference to the value that time
# returns because localtime takes a pointer to time_t
# for some reason.
my $time_hashref = $c->unpack( tm => my_localtime(\time) );
# tm_zone comes back from Convert::Binary::C as an opaque,
# cast it into a string. We localize it to just this do
# block so that it will be a pointer when we pass it back
# to C land below.
do {
local $time_hashref->{tm_zone} = $ffi->cast(opaque => string => $time_hashref->{tm_zone});
print Dumper($time_hashref);
};
# ===============================================
# convert the tm struct back into an epoch value
my $time = my_time( $c->pack( tm => $time_hashref ) );
print "time = $time\n";
print "perl time = ", time, "\n";
You can also link a record type to a class. It will then be accepted
when blessed into that class as an argument passed into a C function,
and when it is returned from a C function it will be blessed into that
class. Basically:
$ffi->type( 'record(My::Class)*' => 'my_class' );
$ffi->attach( my_function1 => [ 'my_class' ] => 'void' );
$ffi->attach( my_function2 => [ ] => 'my_class' );
The only thing that your class MUST provide is either a
C<ffi_record_size> or C<_ffi_record_size> class method that returns the
size of the record in bytes.
Contrast a record type which is stored as a scalar string of bytes in
Perl to an opaque pointer which is stored as an integer in Perl. Both
are treated as pointers in C functions. The situations when you usually
want to use a record are when you know ahead of time what the size of
the object that you are working with and probably something about its
structure. Because a function that returns a structure copies the
structure into a Perl data structure, you want to make sure that it is
okay to copy the record objects that you are dealing with if any of your
functions will be returning one of them.
Opaque pointers should be used when you do not know the size of the
object that you are using, or if the objects are created and free'd
through an API interface other than C<malloc> and C<free>.
The examples in this section actually use pointers to records (note
the trailing star C<*> in the declarations). Most programming languages
allow you to pass or return a record as either pass-by-value or as a
pointer (pass-by-reference).
C code:
struct { int a; } foo_t;
void pass_by_value_example( struct foo_t foo );
void pass_by_reference_example( struct foo_t *foo );
Perl code:
{
package Foo;
use FFI::Platypus::Record;
record_layout_1( int => 'a' );
}
$ffi->type( 'Record(Foo)' => 'foo_t' );
$ffi->attach( pass_by_value_example => [ 'foo_t' ] => 'void' );
$ffi->attach( pass_by_reference_example => [ 'foo_t*' ] => 'void' );
As with strings, functions that return a pointer to a record are actually
copied.
C code:
struct foo_t *return_struct_pointer_example();
Perl code:
$ffi->attach( return_struct_pointer_example => [] => 'foo_t*' );
my $foo = return_struct_pointer_example();
# $foo is a copy of the record returned by the function.
As with strings, if the API expects you to free the record it returns
(it is misbehaving a little, but lets set that aside), then you can
work around this by returning an C<opaque> type, casting to the
record, and finally freeing the original pointer.
use FFI::Platypus::Memory qw( free );
$ffi->attach( return_struct_pointer_example => [] => 'opaque' );
my $foo_ptr = return_struct_pointer_example();
my $foo = $ffi->cast( 'opaque' => 'foo_t*', $foo_ptr );
free $foo_ptr;
You can pass records into a closure, but care needs to be taken.
Records passed into a closure are read-only inside the closure,
including C<string rw> members. Although you can pass a "pointer"
to a record into a closure, because of limitations of the
implementation you actually have a copy, so all records passed
into closures are passed by-value.
Note that a record that does not have a class (classless) and is
defined instead using a length is internally identical to fixed
strings. That is to say C<string(10)> and C<record(10)*> are
identical.
=head2 Fixed length arrays
Fixed length arrays of native types and strings are supported by
L<FFI::Platypus>. Like pointers, if the values contained in the
array are updated by the C function these changes will be reflected
when it returns to Perl space. An example of using this is the
Unix C<pipe> command which returns a list of two file descriptors
as an array.
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib(undef);
$ffi->attach([pipe=>'mypipe'] => ['int[2]'] => 'int');
my @fd = (0,0);
mypipe(\@fd);
my($fd1,$fd2) = @fd;
print "$fd1 $fd2\n";
Because of the way records are implemented, an array of records
does not make sense and is not currently supported.
=head2 Variable length arrays
[version 0.22]
Variable length arrays are supported for argument types can also be
specified by using the C<[]> notation but by leaving the size empty:
$ffi->type('int[]' => 'var_int_array');
When used as an argument type it will probe the array reference that you
pass in to determine the correct size. Usually you will need to
communicate the size of the array to the C code. One way to do this is
to pass the length of the array in as an additional argument. For
example the C code:
int
sum(int *array, int size)
{
int total, i;
for (i = 0, total = 0; i < size; i++)
{
total += array[i];
}
return total;
}
Can be called from Perl like this:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib('./var_array.so');
$ffi->attach( sum => [ 'int[]', 'int' ] => 'int' );
my @list = (1..100);
print sum(\@list, scalar @list), "\n";
Another method might be to have a special value, such as 0 or NULL
indicate the termination of the array.
Because of the way records are implemented, an array of records
does not make sense and is not currently supported.
=head2 Closures
A closure (sometimes called a "callback", we use the C<libffi>
terminology) is a Perl subroutine that can be called from C. In order
to be called from C it needs to be passed to a C function. To define
the closure type you need to provide a list of argument types and a
return type. Currently only native types (integers, floating point
values, opaque), strings and records (by-value; you can pass a pointer
to a record, but due to limitations of the record implementation this
is actually a copy) are supported as closure argument types, and only
native types and records (by-value; pointer records and records with
string pointers cannot be returned from a closure) are supported as
closure return types. Inside the closure any records passed in are
read-only.
We plan to add other types, though they can be converted using the Platypus
C<cast> or C<attach_cast> methods.
Here is an example, with C code:
/*
* closure.c - on Linux compile with: gcc closure.c -shared -o closure.so -fPIC
*/
#include <stdio.h>
typedef int (*closure_t)(int);
closure_t my_closure = NULL;
void set_closure(closure_t value)
{
my_closure = value;
}
int call_closure(int value)
{
if(my_closure != NULL)
return my_closure(value);
else
fprintf(stderr, "closure is NULL\n");
}
And the Perl code:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib('./closure.so');
$ffi->type('(int)->int' => 'closure_t');
$ffi->attach(set_closure => ['closure_t'] => 'void');
$ffi->attach(call_closure => ['int'] => 'int');
my $closure1 = $ffi->closure(sub { $_[0] * 2 });
set_closure($closure1);
print call_closure(2), "\n"; # prints "4"
my $closure2 = $ffi->closure(sub { $_[0] * 4 });
set_closure($closure2);
print call_closure(2), "\n"; # prints "8"
If you have a pointer to a function in the form of an C<opaque> type,
you can pass this in place of a closure type:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->lib('./closure.so');
$ffi->type('(int)->int' => 'closure_t');
$ffi->attach(set_closure => ['closure_t'] => 'void');
$ffi->attach(call_closure => ['int'] => 'int');
my $closure = $ffi->closure(sub { $_[0] * 6 });
my $opaque = $ffi->cast(closure_t => 'opaque', $closure);
set_closure($opaque);
print call_closure(2), "\n"; # prints "12"
The syntax for specifying a closure type is a list of comma separated
types in parentheticals followed by a narrow arrow C<-E<gt>>, followed
by the return type for the closure. For example a closure that takes a
pointer, an integer and a string and returns an integer would look like
this:
$ffi->type('(opaque, int, string) -> int' => 'my_closure_type');
Care needs to be taken with scoping and closures, because of the way
Perl and C handle responsibility for allocating memory differently.
Perl keeps reference counts and frees objects when nothing is
referencing them. In C the code that allocates the memory is considered
responsible for explicitly free'ing the memory for objects it has
created when they are no longer needed. When you pass a closure into a
C function, the C code has a pointer or reference to that object, but it
has no way up letting Perl know when it is no longer using it. As a
result, if you do not keep a reference to your closure around it will be
free'd by Perl and if the C code ever tries to call the closure it will
probably SIGSEGV. Thus supposing you have a C function C<set_closure>
that takes a Perl closure, this is almost always wrong:
set_closure($ffi->closure({ $_[0] * 2 })); # BAD
In some cases, you may want to create a closure shouldn't ever be
free'd. For example you are passing a closure into a C function that
will retain it for the lifetime of your application. You can use the
sticky method to keep the closure, without the need to keep a reference
of the closure:
{
my $closure = $ffi->closure(sub { $_[0] * 2 });
$closure->sticky;
set_closure($closure); # OKAY
}
# closure still exists and is accesible from C, but
# not from Perl land.
=head2 Custom Types
=head3 Custom Types in Perl
Platypus custom types are the rough analogue to typemaps in the XS
world. They offer a method for converting Perl types into native types
that the C<libffi> can understand and pass on to the C code.
=head4 Example 1: Integer constants
Say you have a C header file like this:
/* possible foo types: */
#define FOO_STATIC 1
#define FOO_DYNAMIC 2
#define FOO_OTHER 3
typedef int foo_t;
void foo(foo_t foo);
foo_t get_foo();
The challenge is here that once the source is processed by the C
pre-processor the name/value mappings for these C<FOO_> constants
are lost. There is no way to fetch them from the library once it
is compiled and linked.
One common way of implementing this would be to create and export
constants in your Perl module, like this:
package Foo;
use FFI::Platypus 2.00;
use Exporter qw( import );
our @EXPORT_OK = qw( FOO_STATIC FOO_DYNAMIC FOO_OTHER foo get_foo );
use constant FOO_STATIC => 1;
use constant FOO_DYNAMIC => 2;
use constant FOO_OTHER => 3;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->attach(foo => ['int'] => 'void');
$ffi->attach(get_foo => [] => 'int');
Then you could use the module thus:
use Foo qw( foo FOO_STATIC );
foo(FOO_STATIC);
If you didn't want to rely on integer constants or exports, you could
also define a custom type, and allow strings to be passed into your
function, like this:
package Foo;
use FFI::Platypus 2.00;
our @EXPORT_OK = qw( foo get_foo );
my %foo_types = (
static => 1,
dynamic => 2,
other => 3,
);
my %foo_types_reverse = reverse %foo_types;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->custom_type(foo_t => {
native_type => 'int',
native_to_perl => sub {
$foo_types{$_[0]};
},
perl_to_native => sub {
$foo_types_reverse{$_[0]};
},
});
$ffi->attach(foo => ['foo_t'] => 'void');
$ffi->attach(get_foo => [] => 'foo_t');
Now when an argument of type C<foo_t> is called for it will be converted
from an appropriate string representation, and any function that returns
a C<foo_t> type will return a string instead of the integer
representation:
use Foo;
foo('static');
If the library that you are using has a lot of these constants you can
try using L<Convert::Binary::C> or another C header parser to obtain
the appropriate name/value pairings for the constants that you need.
=head4 Example 2: Blessed references
Supposing you have a C library that uses an opaque pointer with a pseudo
OO interface, like this:
typedef struct foo_t;
foo_t *foo_new();
void foo_method(foo_t *, int argument);
void foo_free(foo_t *);
One approach to adapting this to Perl would be to create a OO Perl
interface like this:
package Foo;
use FFI::Platypus 2.00;
use FFI::Platypus::API qw( arguments_get_string );
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->custom_type(foo_t => {
native_type => 'opaque',
native_to_perl => sub {
my $class = arguments_get_string(0);
bless \$_[0], $class;
}
perl_to_native => sub { ${$_[0]} },
});
$ffi->attach([ foo_new => 'new' ] => [ 'string' ] => 'foo_t' );
$ffi->attach([ foo_method => 'method' ] => [ 'foo_t', 'int' ] => 'void');
$ffi->attach([ foo_free => 'DESTROY' ] => [ 'foo_t' ] => 'void');
my $foo = Foo->new;
Here we are blessing a reference to the opaque pointer when we return
the custom type for C<foo_t>, and dereferencing that reference before we
pass it back in. The function C<arguments_get_string> queries the C
arguments to get the class name to make sure the object is blessed into
the correct class (for more details on the custom type API see
L<FFI::Platypus::API>), so you can inherit and extend this class like a
normal Perl class. This works because the C "constructor" ignores the
class name that we pass in as the first argument. If you have a C
"constructor" like this that takes arguments you'd have to write a
wrapper for new.
A good example of a C library that uses this pattern, including
inheritance is C<libarchive>. Platypus comes with a more extensive
example in C<examples/archive.pl> that demonstrates this.
=head4 Example 3: Pointers with pack / unpack
TODO
See example L<FFI::Platypus::Type::StringPointer>.
=head4 Example 4: Custom Type modules and the Custom Type API
TODO
See example L<FFI::Platypus::Type::PointerSizeBuffer>.
=head4 Example 5: Custom Type on CPAN
You can distribute your own Platypus custom types on CPAN, if you think
they may be applicable to others. The default namespace is prefix with
C<FFI::Platypus::Type::>, though you can stick it anywhere (under your
own namespace may make more sense if the custom type is specific to your
application).
A good example and pattern to follow is
L<FFI::Platypus::Type::StringArray>.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main platypus documentation.
=item L<FFI::Platypus::API>
Custom types API.
=item L<FFI::Platypus::Type::StringPointer>
String pointer type.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Type/ 000755 000000 000000 00000000000 15251066120 017551 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Platypus/Type/PointerSizeBuffer.pm 000644 000000 000000 00000005623 15251066120 023522 0 ustar 00root root 000000 000000 package FFI::Platypus::Type::PointerSizeBuffer;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use FFI::Platypus::API qw(
arguments_set_pointer
arguments_set_uint32
arguments_set_uint64
);
use FFI::Platypus::Buffer qw( scalar_to_buffer );
use FFI::Platypus::Buffer qw( buffer_to_scalar );
# ABSTRACT: Convert string scalar to a buffer as a pointer / size_t combination
our $VERSION = '2.12'; # VERSION
my @stack;
*arguments_set_size_t
= FFI::Platypus->new( api => 2 )->sizeof('size_t') == 4
? \&arguments_set_uint32
: \&arguments_set_uint64;
sub perl_to_native
{
my($pointer, $size) = scalar_to_buffer($_[0]);
push @stack, [ $pointer, $size ];
arguments_set_pointer $_[1], $pointer;
arguments_set_size_t($_[1]+1, $size);
}
sub perl_to_native_post
{
my($pointer, $size) = @{ pop @stack };
$_[0] = buffer_to_scalar($pointer, $size);
}
sub ffi_custom_type_api_1
{
{
native_type => 'opaque',
perl_to_native => \&perl_to_native,
perl_to_native_post => \&perl_to_native_post,
argument_count => 2,
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type::PointerSizeBuffer - Convert string scalar to a buffer as a pointer / size_t combination
=head1 VERSION
version 2.12
=head1 SYNOPSIS
In your C code:
void
function_with_buffer(void *pointer, size_t size)
{
...
}
In your Platypus::FFI code:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->load_custom_type('::PointerSizeBuffer' => 'buffer');
$ffi->attach(function_with_buffer => ['buffer'] => 'void');
my $string = "content of buffer";
function_with_buffer($string);
=head1 DESCRIPTION
A common pattern in C code is to pass in a region of memory as a buffer,
consisting of a pointer and a size of the memory region. In Perl,
string scalars also point to a contiguous series of bytes that has a
size, so when interfacing with C libraries it is handy to be able to
pass in a string scalar as a pointer / size buffer pair.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=item L<FFI::Platypus::Type>
Platypus types documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Type/StringArray.pm 000644 000000 000000 00000014415 15251066120 022361 0 ustar 00root root 000000 000000 package FFI::Platypus::Type::StringArray;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
# ABSTRACT: Platypus custom type for arrays of strings
our $VERSION = '2.12'; # VERSION
use constant _incantation =>
$^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
? 'Q'
: 'L!';
use constant _size_of_pointer => FFI::Platypus->new( api => 2 )->sizeof('opaque');
use constant _pointer_buffer => "P" . _size_of_pointer;
my @stack;
sub perl_to_native
{
# this is the variable length version
# and is actually simpler than the
# fixed length version
my $count = scalar @{ $_[0] };
my $pointers = pack(('P' x $count)._incantation, @{ $_[0] }, 0);
my $array_pointer = unpack _incantation, pack 'P', $pointers;
push @stack, [ \$_[0], \$pointers ];
$array_pointer;
}
sub perl_to_native_post
{
pop @stack;
();
}
sub native_to_perl
{
return unless defined $_[0];
my @list;
my $i=0;
while(1)
{
my $pointer_pointer = unpack(
_incantation,
unpack(
_pointer_buffer,
pack(
_incantation, $_[0]+_size_of_pointer*$i
)
)
);
last unless $pointer_pointer;
push @list, unpack('p', pack(_incantation, $pointer_pointer));
$i++;
}
\@list;
}
sub ffi_custom_type_api_1
{
# arg0 = class
# arg1 = FFI::Platypus instance
# arg2 = array size
# arg3 = default value
my(undef, undef, $count, $default) = @_;
my $config = {
native_type => 'opaque',
perl_to_native => \&perl_to_native,
perl_to_native_post => \&perl_to_native_post,
native_to_perl => \&native_to_perl,
};
if(defined $count)
{
my $end = $count-1;
$config->{perl_to_native} = sub {
my $incantation = '';
my @list = ((map {
defined $_
? do { $incantation .= 'P'; $_ }
: defined $default
? do { $incantation .= 'P'; $default }
: do { $incantation .= _incantation; 0 };
} @{ $_[0] }[0..$end]), 0);
$incantation .= _incantation;
my $pointers = pack $incantation, @list;
my $array_pointer = unpack _incantation, pack 'P', $pointers;
push @stack, [ \@list, $pointers ];
$array_pointer;
};
my $pointer_buffer = "P@{[ FFI::Platypus->new( api => 2 )->sizeof('opaque') * $count ]}";
my $incantation_count = _incantation.$count;
$config->{native_to_perl} = sub {
return unless defined $_[0];
my @pointer_pointer = unpack($incantation_count, unpack($pointer_buffer, pack(_incantation, $_[0])));
[map { $_ ? unpack('p', pack(_incantation, $_)) : $default } @pointer_pointer];
};
}
$config;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type::StringArray - Platypus custom type for arrays of strings
=head1 VERSION
version 2.12
=head1 SYNOPSIS
In your C code:
void
takes_string_array(const char **array)
{
...
}
void
takes_fixed_string_array(const char *array[5])
{
...
}
In your L<FFI::Platypus> code:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->load_custom_type('::StringArray' => 'string_array');
$ffi->load_custom_type('::StringArray' => 'string_5' => 5);
$ffi->attach(takes_string_array => ['string_array'] => 'void');
$ffi->attach(takes_fixed_string_array => ['string_5'] => 'void');
my @list = qw( foo bar baz );
takes_string_array(\@list);
takes_fixed_string_array([qw( s1 s2 s3 s4 s5 )]);
=head1 DESCRIPTION
B<NOTE>: The primary motivation for this custom type was originally to
fill the void left by the fact that L<FFI::Platypus> did not support arrays
of strings by itself. Since 0.62 this support has been added, and that is
probably what you want to use, but the semantics and feature set are
slightly different, so there are cases where you might want to use this
custom type.
This module provides a L<FFI::Platypus> custom type for arrays of
strings. The array is always NULL terminated. Return types are supported!
This custom type takes two optional arguments. The first is the size of
arrays and the second is a default value to fill in any values that
aren't provided when the function is called. If not default is provided
then C<NULL> will be passed in for those values.
=head1 SUPPORT
If something does not work the way you think it should, or if you have a
feature request, please open an issue on this project's GitHub Issue
tracker:
L<https://github.com/plicease/FFI-Platypus-Type-StringArray/issues>
=head1 CONTRIBUTING
If you have implemented a new feature or fixed a bug then you may make a
pull request on this project's GitHub repository:
L<https://github.com/plicease/FFI-Platypus-Type-StringArray/pulls>
This project's GitHub issue tracker listed above is not Write-Only. If
you want to contribute then feel free to browse through the existing
issues and see if there is something you feel you might be good at and
take a whack at the problem. I frequently open issues myself that I
hope will be accomplished by someone in the future but do not have time
to immediately implement myself.
Another good area to help out in is documentation. I try to make sure
that there is good document coverage, that is there should be
documentation describing all the public features and warnings about
common pitfalls, but an outsider's or alternate view point on such
things would be welcome; if you see something confusing or lacks
sufficient detail I encourage documentation only pull requests to
improve things.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=item L<FFI::Platypus::Type::StringPointer>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Type/StringPointer.pm 000644 000000 000000 00000006513 15251066120 022723 0 ustar 00root root 000000 000000 package FFI::Platypus::Type::StringPointer;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Scalar::Util qw( readonly );
# ABSTRACT: Convert a pointer to a string and back
our $VERSION = '2.12'; # VERSION
use constant _incantation =>
$^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
? 'Q'
: 'L!';
use constant _pointer_buffer => "P" . FFI::Platypus->new( api => 2 )->sizeof('opaque');
my @stack;
sub perl_to_native
{
if(defined $_[0])
{
my $packed = pack 'P', ${$_[0]};
my $pointer_pointer = pack 'P', $packed;
my $unpacked = unpack _incantation, $pointer_pointer;
push @stack, [ \$packed, \$pointer_pointer ];
return $unpacked;
}
else
{
push @stack, [];
return undef;
}
}
sub perl_to_native_post
{
my($packed) = @{ pop @stack };
return unless defined $packed;
unless(readonly(${$_[0]}))
{
${$_[0]} = unpack 'p', $$packed;
}
}
sub native_to_perl
{
return unless defined $_[0];
my $pointer_pointer = unpack(_incantation, unpack(_pointer_buffer, pack(_incantation, $_[0])));
$pointer_pointer ? \unpack('p', pack(_incantation, $pointer_pointer)) : \undef;
}
sub ffi_custom_type_api_1
{
return {
native_type => 'opaque',
perl_to_native => \&perl_to_native,
perl_to_native_post => \&perl_to_native_post,
native_to_perl => \&native_to_perl,
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type::StringPointer - Convert a pointer to a string and back
=head1 VERSION
version 2.12
=head1 SYNOPSIS
In your C code:
void
string_pointer_argument(const char **string)
{
...
}
const char **
string_pointer_return(void)
{
...
}
In your Platypus::FFI code:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->load_custom_type('::StringPointer' => 'string_pointer');
$ffi->attach(string_pointer_argument => ['string_pointer'] => 'void');
$ffi->attach(string_pointer_return => [] => 'string_pointer');
my $string = "foo";
string_pointer_argument(\$string); # $string may be modified
$ref = string_pointer_return();
print $$ref; # print the string pointed to by $ref
=head1 DESCRIPTION
B<NOTE>: As of version 0.61, this custom type is now deprecated since
pointers to strings are supported in the L<FFI::Platypus> directly
without custom types.
This module provides a L<FFI::Platypus> custom type for pointers to
strings.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=item L<FFI::Platypus::Type>
Platypus types documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/Type/WideString.pm 000644 000000 000000 00000037174 15251066120 022202 0 ustar 00root root 000000 000000 package FFI::Platypus::Type::WideString;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use FFI::Platypus::Memory qw( memcpy );
use FFI::Platypus::Buffer qw( buffer_to_scalar scalar_to_pointer scalar_to_buffer );
use Encode qw( decode encode find_encoding );
use Carp ();
# ABSTRACT: Platypus custom type for Unicode "wide" strings
our $VERSION = '2.12'; # VERSION
my @stack; # To keep buffer alive.
sub _compute_wide_string_encoding
{
foreach my $need (qw( wcslen wcsnlen ))
{
die "This type plugin needs $need from libc, and cannot find it"
unless FFI::Platypus::Memory->can("_$need");
}
my $ffi = FFI::Platypus->new( api => 2, lib => [undef] );
my $size = eval { $ffi->sizeof('wchar_t') };
die 'no wchar_t' if $@;
my %orders = (
join('', 1..$size) => 'BE',
join('', reverse 1..$size) => 'LE',
);
my $byteorder = join '', @{ $ffi->cast( "wchar_t*", "uint8[$size]", \hex(join '', map { "0$_" } 1..$size) ) };
my $encoding;
if($size == 2)
{
$encoding = 'UTF-16';
}
elsif($size == 4)
{
$encoding = 'UTF-32';
}
else
{
die "not sure what encoding to use for size $size";
}
if(defined $orders{$byteorder})
{
$encoding .= $orders{$byteorder};
}
else
{
die "odd byteorder $byteorder not (yet) supported";
}
die "Perl doesn't recognize $encoding as an encoding"
unless find_encoding($encoding);
return ($encoding, $size);
}
sub ffi_custom_type_api_1
{
my %args = @_;
# TODO: it wold be nice to allow arbitrary encodings, but we are
# relying on a couple of wcs* functions to compute the string, so
# we will leave that for future development.
my($encoding, $width) = __PACKAGE__->_compute_wide_string_encoding();
# it is hard to come up with a default size for write buffers
# but 2048 is a multiple of 1024 that is large enough to fit
# any Windows PATH (260*4)+2 = 1042
#
# (assuming all characters in the PATH are in the BMP, which is
# admitedly unlikely, possilby impossible (?) and and a null
# termination of two bytes).
#
# it is arbitrary and based on a platform specific windows
# thing, but windows is where wide strings are most likely
# to be found, so seems good as anything.
my $size = $args{size} || 2048;
my $access = $args{access} || 'read';
my %ct = (
native_type => 'opaque',
);
$ct{native_to_perl} = sub {
return undef unless defined $_[0];
return decode($encoding,
buffer_to_scalar(
$_[0],
FFI::Platypus::Memory::_wcslen($_[0])*$width,
)
);
};
if($access eq 'read')
{
$ct{perl_to_native} = sub {
if(defined $_[0])
{
my $buf = encode($encoding, $_[0]."\0");
push @stack, \$buf;
return scalar_to_pointer $buf;
}
else
{
push @stack, undef;
return undef;
}
};
$ct{perl_to_native_post} = sub {
pop @stack;
return;
};
}
elsif($access eq 'write')
{
my @stack;
$ct{perl_to_native} = sub {
my $ref = shift;
if(ref($ref) eq 'ARRAY')
{
${ $ref->[0] } = "\0" x $size unless defined ${ $ref->[0] };
my $ptr = scalar_to_pointer ${ $ref->[0] };
if(defined $ref->[0])
{
my $init = encode($encoding, $ref->[1]);
my($sptr, $ssize) = scalar_to_buffer($init);
memcpy($ptr, $sptr, $ssize);
}
push @stack, \${ $ref->[0] };
return $ptr;
}
elsif(ref($ref) eq 'SCALAR')
{
push @stack, $ref;
$$ref = "\0" x $size unless defined $$ref;
return scalar_to_pointer $$ref;
}
else
{
push @stack, $ref;
return undef;
}
};
$ct{perl_to_native_post} = sub {
my $ref = pop @stack;
return unless defined $ref;
my $len = length $$ref;
$len = FFI::Platypus::Memory::_wcsnlen($$ref, $len);
$$ref = decode($encoding, substr($$ref, 0, $len*$width));
};
}
else
{
Carp::croak("Unknown access type $access");
}
return \%ct;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type::WideString - Platypus custom type for Unicode "wide" strings
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2, lib => [undef] );
$ffi->load_custom_type('::WideString' => 'wstring', access => 'read' );
$ffi->load_custom_type('::WideString' => 'wstring_w', access => 'write' );
# call function that takes a constant wide string
$ffi->attach( wcscmp => ['wstring', 'wstring'] => 'int' );
my $diff = wcscmp("I ⤠perl + Platypus", "I ⤠perl + Platypus"); # returns 0
# call a function that takes a wide string for writing
$ffi->attach( wcscpy => ['wstring_w', 'wstring'] );
my $buf;
wcscpy(\$buf, "I ⤠perl + Platypus");
print $buf, "\n"; # prints "I ⤠perl + Platypus"
# call a function that takes a wide string for modification
$ffi->attach( wcscat => ['wstring_w', 'wstring'] );
my $buf;
wcscat( [ \$buf, "I ⤠perl" ], " + Platypus");
print $buf, "\n"; # prints "I ⤠perl + Platypus"
On Windows use with C<LPCWSTR>:
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2, lib => [undef] );
# define some custom Win32 Types
# to get these automatically see FFI::Platypus::Lang::Win32
$ffi->load_custom_type('::WideString' => 'LPCWSTR', access => 'read' );
$ffi->type('opaque' => 'HWND');
$ffi->type('uint' => 'UINT');
use constant MB_OK => 0x00000000;
use constant MB_DEFAULT_DESKTOP_ONLY => 0x00020000;
$ffi->attach( [MessageBoxW => 'MessageBox'] => [ 'HWND', 'LPCWSTR', 'LPCWSTR', 'UINT'] => 'int' );
MessageBox(undef, "I â¤ï¸ Platypus", "Confession", MB_OK|MB_DEFAULT_DESKTOP_ONLY);
=head1 DESCRIPTION
This custom type plugin for L<FFI::Platypus> provides support for the native
"wide" string type on your platform, if it is available.
Wide strings are made of up wide characters (C<wchar_t>, also known as C<WCHAR>
on Windows) and have enough bits to represent character sets that require
larger than the traditional one byte C<char>.
These strings are most commonly used on Windows where they are referred to as
C<LPWSTR> and C<LPCWSTR> (The former for read/write buffers and the latter for
const read-only strings), where they are encoded as C<UTF-16LE>.
They are also supported by libc on many modern Unix systems where they are usually
C<UTF-32> of the native byte-order of the system. APIs on Unix systems more
commonly use UTF-8 which provides some compatibility with ASCII, but you may
occasionally find APIs that talk in wide strings. (libarchive, for example,
can work in both).
This plugin will detect the native wide string format for you and transparently
convert Perl strings, which are typically encoded internally as UTF-8. If for
some reason it cannot detect the correct encoding, or if your platform is
currently supported, an exception will be thrown (please open a ticket if this
is the case). It can be used either for read/write buffers, for const read-only
strings, and for return values. It supports these options:
Options:
=over 4
=item access
Either C<read> or C<write> depending on if you are using a read/write buffer
or a const read-only string.
=item size
For read/write buffer, the size of the buffer to create, if not provided by
the caller.
=back
=head2 read-only
Read-only strings are the easiest of all, are converted to the native wide
string format in a buffer and are freed after that function call completes.
$ffi->load_custom_type('::WideString' => 'wstring' );
$ffi->function( wprintf => [ 'wstring' ] => [ 'wstring' ] => 'int' )
->call("I %s perl + Platypus", "â¤");
This is the mode that you want to use when you are calling a function that
takes a C<const wchar_t*> or a C<LPCWSTR>.
=head2 return value
For return values the C<access> and C<size> options are ignored. The string
is simply copied into a Perl native string.
$ffi->load_custom_type('::WideString' => 'wstring' );
# see note below in CAVEATS about wcsdup
my $str = $ffi->function( wcsdup => [ 'wstring' ] => 'wstring' )
->call("I ⤠perl + Platypus");
This is the mode that you want to use when you are calling a function that
returns a C<const wchar_t*>, C<wchar_t>, C<LPWSTR> or C<LPCWSTR>.
=head2 read/write
Read/write strings can be passed in one of two ways. Which you choose
depends on if you want to initialize the read/write buffer or not.
=over 4
=item default buffer size
The simplest way is to fallback on the default buffer size, which can
be specified using the C<size> option when creating the custom type.
my $ffi = FFI::Platypus->new( api => 2, lib => [undef] );
$ffi->load_custom_type('::WideString' => 'wstring', access => 'read' );
$ffi->load_custom_type('::WideString' => 'wstring_w', access => 'write', size => 512 );
$ffi->attach( wcscpy => ['wstring_w', 'wstring'] );
my $buf;
wcscpy(\$buf, "I ⤠perl + Platypus");
print $buf, "\n"; # prints "I ⤠perl + Platypus"
B<Discussion>: This is the most sensical approach when the exact size of the
buffer is known for all usages of the string type. It can also be sensical
if the buffer size is larger than any possible output, though care should
be taken since this may be hard to determine reliably.
The default size if none is specified when creating the custom type is 2048,
which is probably large enough for many uses, but also probably wastes
memory for many of them.
=item allocate your buffer of a specific size
The safest and most memory efficient method is of course to allocate exactly
the amount of memory that you need.
my $ffi = FFI::Platypus->new( api => 2, lib => [undef] );
$ffi->load_custom_type('::WideString' => 'wstring', access => 'read' );
$ffi->load_custom_type('::WideString' => 'wstring_w', access => 'write' );
$ffi->attach( wcscpy => ['wstring_w', 'wstring'] );
my $width = $ffi->sizeof('wchar_t');
my $buf = "\0" x ( (length ("I ⤠perl + Platypus") + 1)*$width);
wcscpy(\$buf, "I ⤠perl + Platypus");
print $buf, "\n"; # prints "I ⤠perl + Platypus"
B<Discussion>: By assigning C<$buf> to a string of null characters the
length of the source string, plus one (for the null at the end) and then
multiplying that by the size of C<wchar_t>, you get the exact number of
bytes needed for the destination buffer.
Note that although we pass in a reference to a buffer, what comes back
is converted to a Perl string, which will be internally UTF-8, not stored
at the original buffer location. This is slightly awkward, but what you
need most of the time.
=item initialize the read/write buffer
Some functions don't expect empty null padded buffers though, in this
case you will want to initialize the buffer.
my $ffi = FFI::Platypus->new( api => 2, lib => [undef] );
$ffi->load_custom_type('::WideString' => 'wstring', access => 'read' );
$ffi->load_custom_type('::WideString' => 'wstring_w', access => 'write' );
$ffi->attach( wcscat => ['wstring_w', 'wstring'] );
my $buf;
wcscat( [ \$buf, "I ⤠perl" ], " + Platypus");
print $buf, "\n"; # prints "I ⤠perl + Platypus"
B<Discussion>: To initialize we pass in an array reference instead of a
scalar reference. The first element is a scalar reference to the buffer
(which can be pre-allocated or not; if it is not allocated then it will
be allocated to the default size for the type). The second argument is
what the buffer should be initialized to before the underlying C function
is called. The Perl string is encoded into wide string format before
being used to initialize the buffer.
As before a reference to the translated string is returned, and the
buffer that was used to pass in is freed.
=item allocate memory using C<malloc> or C<wcsdup> etc.
You can also allocate memory using C<malloc> or C<wcsdup> to return
an opaque type and manipulate it using the libc C<wcs*> functions.
It will still probably be useful to use this plugin to cast the
opaque back to a Perl string. The CAVEATS section below includes
several examples.
=back
This is the mode that you want to use when you are calling a function that
takes a <wchar_t*> or a C<LPWSTR>.
=head1 CAVEATS
As with the Platypus built in C<string> type, return values are copied into
a Perl scalar. This is usually what you want anyway, but some APIs expect
the caller to take responsibility for freeing the pointer to the wide string
that it returns. For example, C<wcsdup> works in this way. The workaround
is to return an opaque pointer, cast it from a wide string and free the
pointer.
use FFI::Platypus::Memory qw( free );
$ffi->load_custom_type('::WideString' => 'wstring' );
my $ptr = $ffi->function( wcsdup => [ 'wstring' ] => 'opaque' )
->call("I ⤠perl + Platypus");
my $str = $ffi->cast('opaque', 'wstring', $ptr);
free $ptr;
Because of the order in which objects are freed you cannot return a wide
string if it is also a wide string argument to a function. For example
C<wcscpy> may crash if you specify the return value as a wide string:
# wchar_t *wcscpy(wchar_t *dest, const wchar_t *src);
$ffi->attach( wcscpy => [ 'wstring_w', 'wstring' ] => 'wstring' ); # no
my $str;
wcscpy( \$str, "I ⤠perl + Platypus"); # may crash on memory error
This is because the order in which things are done here are 1. C<$str> is allocated
2. C<$str> is re-encoded as utf and the old buffer is freed 3. the return value
is computed based on the C<$str> buffer that was freed.
If you look at C<wcscpy> though you don't actually need the return value.
To make this code work, you can just ignore the return value:
$ffi->attach( wcscpy => [ 'wstring_w', 'wstring' ] => 'void' ); # yes
my $str;
wcscpy( \$str, "I ⤠perl + Platypus"); # good!
On the other hand you do care about the return value from C<wcschr>, which returns
a pointer to the first occurrence of a character in an argument string:
# wchar_t *wcschr(const wchar_t *wcs, wchar_t wc);
$ffi->attach( wcschr => [ 'wstring', 'wchar_t' ] => 'wstring' ); # no
# this may crash on memory error or return the wrong value
my $str = wcschr("I ⤠perl + Platypus", ord("â¤"));
Instead you need to work with pointers and casts to use this function:
use FFI::Platypus 2.00;
use FFI::Platypus::Memory qw( free );
my $ffi = FFI::Platypus->new( api => 2, lib => [undef] );
$ffi->attach( wcsdup => ['wstring'] => 'opaque' );
$ffi->attach( strchr => [ opaque', 'wchar_t' ] => 'wstring' );
# create a wcs string in memory using wcsdup
my $haystack = wcsdup("I ⤠perl + Platypus");
# find the heart and return as a wide string
my $needle = strchr($haystack, ord("â¤"));
# safe to free the pointer to the larger string now
free $haystack;
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Core Platypus documentation.
=item L<FFI::Platypus::Type>
Includes documentation on handling "normal" 8 bit C strings among others.
=item L<FFI::Platypus::Lang::Win32>
Documentation for using Platypus with C<LPWSTR> and C<LPCWSTR> types on
Microsoft Windows. These types are just aliases for the standard C wide
strings.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/TypeParser.pm 000644 000000 000000 00000006457 15251066120 021300 0 ustar 00root root 000000 000000 package FFI::Platypus::TypeParser;
use strict;
use warnings;
use 5.008004;
use List::Util 1.45 qw( uniqstr );
use Carp qw( croak );
# ABSTRACT: FFI Type Parser
our $VERSION = '2.12'; # VERSION
# The TypeParser and Type classes are used internally ONLY and
# are not to be exposed to the user. External users should
# not under any circumstances rely on the implementation of
# these classes.
sub new
{
my($class) = @_;
my $self = bless { types => {}, type_map => {}, abi => -1 }, $class;
$self->build;
$self;
}
sub build {}
our %basic_type;
# this just checks if the underlying libffi/platypus implementation
# has the basic type. It is used mainly to verify that exotic types
# like longdouble and complex_float are available before the test
# suite tries to use them.
sub have_type
{
my(undef, $name) = @_;
!!$basic_type{$name};
}
sub create_type_custom
{
my($self, $name, @rest) = @_;
$name = 'opaque' unless defined $name;
my $type = $self->parse($name);
unless($type->is_customizable)
{
croak "$name is not a legal basis for a custom type"
}
$self->_create_type_custom($type, @rest);
}
# this is the type map provided by the language plugin, if any
# in addition to the basic types (which map to themselves).
sub type_map
{
my($self, $new) = @_;
if(defined $new)
{
$self->{type_map} = $new;
}
$self->{type_map};
}
# this stores the types that have been mentioned so far. It also
# usually includes aliases.
sub types
{
shift->{types};
}
# The type parser needs to know the ABI when creating closures
sub abi
{
my($self, $new) = @_;
$self->{abi} = $new if defined $new;
$self->{abi};
}
{
my %store;
foreach my $name (keys %basic_type)
{
my $type_code = $basic_type{$name};
$store{basic}->{$name} = __PACKAGE__->create_type_basic($type_code);
$store{ptr}->{$name} = __PACKAGE__->create_type_pointer($type_code);
$store{rev}->{$type_code} = $name;
}
sub global_types
{
\%store;
}
}
# list all the types that this type parser knows about, including
# those provided by the language plugin (if any), those defined
# by the user, and the basic types that everyone gets.
sub list_types
{
my($self) = @_;
uniqstr( ( keys %{ $self->type_map } ), ( keys %{ $self->types } ) );
}
our @CARP_NOT = qw( FFI::Platypus );
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::TypeParser - FFI Type Parser
=head1 VERSION
version 2.12
=head1 DESCRIPTION
This class is private to FFI::Platypus. See L<FFI::Platypus> for
the public interface to Platypus types.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/TypeParser/ 000755 000000 000000 00000000000 15251066120 020726 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Platypus/TypeParser/Version0.pm 000644 000000 000000 00000015203 15251066120 022772 0 ustar 00root root 000000 000000 package FFI::Platypus::TypeParser::Version0;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use parent qw( FFI::Platypus::TypeParser );
# ABSTRACT: FFI Type Parser Version Zero
our $VERSION = '2.12'; # VERSION
our @CARP_NOT = qw( FFI::Platypus FFI::Platypus::TypeParser );
# The type parser is responsible for deciding if something is a legal
# alias name. Since this needs to be checked before the type is parsed
# it is separate from set_alias below.
sub check_alias
{
my($self, $alias) = @_;
croak "spaces not allowed in alias" if $alias =~ /\s/;
croak "allowed characters for alias: [A-Za-z0-9_]" if $alias !~ /^[A-Za-z0-9_]+$/;
croak "alias \"$alias\" conflicts with existing type"
if defined $self->type_map->{$alias}
|| $self->types->{$alias};
return 1;
}
sub set_alias
{
my($self, $alias, $type) = @_;
$self->types->{$alias} = $type;
}
# This method takes a string representation of the a type and
# returns the internal platypus type representation.
sub parse
{
my($self, $name) = @_;
return $self->types->{$name} if defined $self->types->{$name};
# Darmock and Legacy Code at Tanagra
unless($name =~ /-\>/ || $name =~ /^record\s*\([0-9A-Z:a-z_]+\)$/
|| $name =~ /^string(_rw|_ro|\s+rw|\s+ro|\s*\([0-9]+\))$/)
{
my $basic = $name;
my $extra = '';
if($basic =~ s/\s*((\*|\[|\<).*)$//)
{
$extra = " $1";
}
if(defined $self->type_map->{$basic})
{
my $new_name = $self->type_map->{$basic} . $extra;
if($new_name ne $name)
{
# hopefully no recursion here.
return $self->types->{$name} = $self->parse($new_name);
}
}
}
if($name =~ m/^ \( (.*) \) \s* -\> \s* (.*) \s* $/x)
{
my @argument_types = map { $self->parse($_) } map { my $t = $_; $t =~ s/^\s+//; $t =~ s/\s+$//; $t } split /,/, $1;
my $return_type = $self->parse($2);
return $self->types->{$name} = $self->create_type_closure($self->abi, $return_type, @argument_types);
}
if($name =~ /^ string \s* \( ([0-9]+) \) $/x)
{
return $self->types->{$name} = $self->create_type_record(
0,
$1, # size
);
}
if($name =~ /^ string ( _rw | _ro | \s+ro | \s+rw | ) $/x)
{
return $self->types->{$name} = $self->create_type_string(
defined $1 && $1 =~ /rw/ ? 1 : 0, # rw
);
}
if($name =~ /^ record \s* \( ([0-9]+) \) $/x)
{
return $self->types->{$name} = $self->create_type_record(
0,
$1, # size
);
}
if($name =~ /^ record \s* \( ([0-9:A-Za-z_]+) \) $/x)
{
my $size;
my $classname = $1;
unless($classname->can('ffi_record_size') || $classname->can('_ffi_record_size'))
{
my $pm = "$classname.pm";
$pm =~ s/\//::/g;
require $pm;
}
if($classname->can('ffi_record_size'))
{
$size = $classname->ffi_record_size;
}
elsif($classname->can('_ffi_record_size'))
{
$size = $classname->_ffi_record_size;
}
else
{
croak "$classname has not ffi_record_size or _ffi_record_size method";
}
return $self->global_types->{record}->{$classname} ||= $self->create_type_record(
0,
$size, # size
$classname, # record_class
);
}
# array types
if($name =~ /^([\S]+)\s+ \[ ([0-9]*) \] $/x)
{
my $size = $2 || '';
my $basic = $self->global_types->{basic}->{$1} || croak("unknown ffi/platypus type $name [$size]");
if($size)
{
return $self->types->{$name} = $self->create_type_array(
$basic->type_code,
$size,
);
}
else
{
return $self->global_types->{array}->{$name} ||= $self->create_type_array(
$basic->type_code,
0
);
}
}
# pointer types
if($name =~ s/\s+\*$//)
{
return $self->global_types->{ptr}->{$name} || croak("unknown ffi/platypus type $name *");
}
# basic types
return $self->global_types->{basic}->{$name} || croak("unknown ffi/platypus type $name");
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::TypeParser::Version0 - FFI Type Parser Version Zero
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 0 );
$ffi->type('record(Foo::Bar)' => 'foo_bar_t');
$ffi->type('opaque' => 'baz_t');
$ffi->type('opaque*' => 'baz_ptr');
=head1 DESCRIPTION
This documents the original L<FFI::Platypus> type parser. It was the default and only
type parser used by L<FFI::Platypus> starting with version C<0.02>. Starting with
version C<1.00> L<FFI::Platypus> comes with a new type parser with design fixes that
are not backward compatibility.
=head2 Interface differences
=over
=item Pass-by-value records are not allowed
Originally L<FFI::Platypus> only supported passing records as a pointer. The type
C<record(Foo::Bar)> actually passes a pointer to the record. In the version 1.00 parser
allows C<record(Foo::Bar)> which is pass-by-value (the contents of the record is copied
onto the stack) and C<record(Foo::Bar)*> which is pass-by-reference or pointer (a pointer
to the record is passed to the callee so that it can make modifications to the record).
TL;DR C<record(Foo::Bar)> in version 0 is equivalent to C<record(Foo::Bar)*> in the
version 1 API. There is no equivalent to C<record(Foo::Bar)*> in the version 0 API.
=item decorate aliases of basic types
This is not allowed in the version 0 API:
$ffi->type('opaque' => 'foo_t'); # ok!
$ffi->type('foo_t*' => 'foo_ptr'); # not ok! in version 0, ok! in version 1
Instead you need to use the basic type in the second type definition:
$ffi->type('opaque' => 'foo_t'); # ok!
$ffi->type('opaque*' => 'foo_ptr'); # ok!
=item object types are not allowed
$ffi->type('object(Foo::Bar)'); # not ok! in version 0, ok! in version 1
=back
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The core L<FFI::Platypus> documentation.
=item L<FFI::Platypus::TypeParser::Version1>
The API C<1.00> type parser.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/TypeParser/Version1.pm 000644 000000 000000 00000030313 15251066120 022772 0 ustar 00root root 000000 000000 package FFI::Platypus::TypeParser::Version1;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use parent qw( FFI::Platypus::TypeParser );
use constant _version => 1;
# ABSTRACT: FFI Type Parser Version One
our $VERSION = '2.12'; # VERSION
our @CARP_NOT = qw( FFI::Platypus FFI::Platypus::TypeParser );
my %reserved = map { $_ => 1 } qw(
string
object
type
role
union
class
struct
record
array
senum
enum
);
# The type parser is responsible for deciding if something is a legal
# alias name. Since this needs to be checked before the type is parsed
# it is separate from set_alias below.
sub check_alias
{
my($self, $alias) = @_;
croak "spaces not allowed in alias" if $alias =~ /\s/;
croak "allowed characters for alias: [A-Za-z0-9_]" if $alias !~ /^[A-Za-z0-9_]+$/;
croak "reserved world \"$alias\" cannot be used as an alias"
if $reserved{$alias};
croak "alias \"$alias\" conflicts with existing type"
if defined $self->type_map->{$alias}
|| $self->types->{$alias}
|| $self->global_types->{basic}->{$alias};
return 1;
}
sub set_alias
{
my($self, $alias, $type) = @_;
$self->types->{$alias} = $type;
}
use constant type_regex =>
qr/^ #
#
\s* # prefix white space
#
(?: #
#
\( ([^)]*) \) -> (.*) # closure, argument types $1, return type $2
| #
( string | record ) \s* \( \s* ([0-9]+) \s* \) (?: \s* (\*) | ) # fixed record $3, fixed string $4, ponter $5
| #
record \s* \( ( \s* (?: [A-Za-z_] [A-Za-z_0-9]* :: )* [A-Za-z_] [A-Za-z_0-9]* ) \s* \) (?: \s* (\*) | ) # record class $6, pointer $7
| #
( (?: [A-Za-z_] [A-Za-z_0-9]* \s+ )* [A-Za-z_] [A-Za-z_0-9]* ) \s* # unit type name $8
#
(?: (\*) | \[ ([0-9]*) \] | ) # pointer $9, array $10
| #
object \s* \( \s* ( (?: [A-Za-z_] [A-Za-z_0-9]* :: )* [A-Za-z_] [A-Za-z_0-9]* ) # object class $11
(?: \s*,\s* ( (?: [A-Za-z_] [A-Za-z_0-9]* \s+ )* [A-Za-z_] [A-Za-z_0-9]* ) )? # type $12
\s* \) #
) #
#
\s* # trailing white space
#
$/x; #
sub parse
{
my($self, $name, $opt) = @_;
$opt ||= {};
return $self->types->{$name} if $self->types->{$name};
$name =~ type_regex or croak "bad type name: $name";
if(defined (my $at = $1)) # closure
{
my $rt = $2;
return $self->types->{$name} = $self->create_type_closure(
$self->abi,
$self->parse($rt, $opt),
map { $self->parse($_, $opt) } map { my $t = $_; $t =~ s/^\s+//; $t =~ s/\s+$//; $t } split /,/, $at,
);
}
if(defined (my $size = $4)) # fixed record / fixed string
{
croak "fixed record / fixed string size must be larger than 0"
unless $size > 0;
if(my $pointer = $5)
{
return $self->types->{$name} = $self->create_type_record(
0,
$size,
);
}
elsif($opt->{member} || ($3 eq 'string' && $self->_version > 1))
{
return $self->types->{"$name *"} = $self->create_type_record(
0,
$size,
);
}
else
{
if($self->_version > 1)
{
croak "classless record not allowed as value type";
}
else
{
croak "fixed string / classless record not allowed as value type";
}
}
}
if(defined (my $class = $6)) # class record
{
my $size_method = $class->can('ffi_record_size') || $class->can('_ffi_record_size') || croak "$class has no ffi_record_size or _ffi_record_size method";
if(my $pointer = $7)
{
return $self->types->{$name} = $self->create_type_record(
0,
$class->$size_method,
$class,
);
}
else
{
return $self->types->{$name} = $self->create_type_record(
1,
$class->$size_method,
$class,
$class->_ffi_meta->ptr,
);
}
}
if(defined (my $unit_name = $8)) # basic type
{
if($self->global_types->{basic}->{$unit_name})
{
if(my $pointer = $9)
{
croak "void pointer not allowed" if $unit_name eq 'void';
return $self->types->{$name} = $self->global_types->{ptr}->{$unit_name};
}
if(defined (my $size = $10)) # array
{
croak "void array not allowed" if $unit_name eq 'void';
if($size ne '')
{
croak "array size must be larger than 0" if $size < 1;
return $self->types->{$name} = $self->create_type_array(
$self->global_types->{basic}->{$unit_name}->type_code,
$size,
);
}
else
{
return $self->global_types->{array}->{$unit_name} ||= $self->create_type_array(
$self->global_types->{basic}->{$unit_name}->type_code,
0,
);
}
}
# basic type with no decorations
return $self->global_types->{basic}->{$unit_name};
}
if(my $map_name = $self->type_map->{$unit_name})
{
if(my $pointer = $9)
{
return $self->types->{$name} = $self->parse("$map_name *", $opt);
}
if(defined (my $size = $10))
{
if($size ne '')
{
croak "array size must be larger than 0" if $size < 1;
return $self->types->{$name} = $self->parse("$map_name [$size]", $opt);
}
else
{
return $self->types->{$name} = $self->parse("$map_name []", $opt);
}
}
return $self->types->{$name} = $self->parse("$map_name", $opt);
}
if(my $pointer = $9)
{
my $unit_type = $self->parse($unit_name, $opt);
if($unit_type->is_record_value)
{
my $meta = $unit_type->meta;
return $self->types->{$name} = $self->create_type_record(
0,
$meta->{size},
$meta->{class},
);
}
my $basic_name = $self->global_types->{rev}->{$unit_type->type_code};
if($basic_name)
{
return $self->types->{$name} = $self->parse("$basic_name *", $opt);
}
else
{
croak "cannot make a pointer to $unit_name";
}
}
if(defined (my $size = $10))
{
my $unit_type = $self->parse($unit_name, $opt);
my $basic_name = $self->global_types->{rev}->{$unit_type->type_code};
if($basic_name)
{
if($size ne '')
{
croak "array size must be larger than 0" if $size < 1;
return $self->types->{$name} = $self->parse("$basic_name [$size]", $opt);
}
else
{
return $self->types->{$name} = $self->parse("$basic_name []", $opt);
}
}
else
{
croak "cannot make an array of $unit_name";
}
}
if($name eq 'string ro')
{
return $self->global_types->{basic}->{string};
}
elsif($name eq 'string rw')
{
return $self->global_types->{v2}->{string_rw} ||= $self->create_type_string(1);
}
return $self->types->{$name} || croak "unknown type: $unit_name";
}
if(defined (my $class = $11)) # object type
{
my $basic_name = $12 || 'opaque';
my $basic_type = $self->parse($basic_name);
if($basic_type->is_object_ok)
{
return $self->types->{$name} = $self->create_type_object(
$basic_type->type_code,
$class,
);
}
else
{
croak "cannot make an object of $basic_name";
}
}
croak "internal error parsing: $name";
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::TypeParser::Version1 - FFI Type Parser Version One
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 1.00;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->type('record(Foo::Bar)' => 'foo_bar_t');
$ffi->type('record(Foo::Bar)*' => 'foo_bar_ptr');
$ffi->type('opaque' => 'baz_t');
$ffi->type('bar_t*' => 'baz_ptr');
=head1 DESCRIPTION
This documents the second (version 1) type parser for L<FFI::Platypus>.
This type parser was included with L<FFI::Platypus> starting with version
C<0.91> in an experimental capability, and C<1.00> as a stable interface.
Starting with version C<1.00> the main L<FFI::Platypus> documentation
describes the version 1 API and you can refer to
L<FFI::Platypus::TypeParser::Version0> for details on the version0 API.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The core L<FFI::Platypus> documentation.
=item L<FFI::Platypus::TypeParser::Version0>
The API C<0.02> type parser.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Platypus/TypeParser/Version2.pm 000644 000000 000000 00000003677 15251066120 023010 0 ustar 00root root 000000 000000 package FFI::Platypus::TypeParser::Version2;
use strict;
use warnings;
use 5.008004;
use parent qw( FFI::Platypus::TypeParser::Version1 );
use constant _version => 2;
# ABSTRACT: FFI Type Parser Version Two
our $VERSION = '2.12'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::TypeParser::Version2 - FFI Type Parser Version Two
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Platypus 2.00;
my $ffi = FFI::Platypus->new( api => 2 );
$ffi->type('string(10)');
=head1 DESCRIPTION
This documents the third (version 2) type parser for L<FFI::Platypus>.
This type parser was included with L<FFI::Platypus> starting with version
C<1.58> in an experimental capability, and C<2.00> as a stable interface.
Starting with version C<1.00> the main L<FFI::Platypus> documentation
describes the version 2 API and you can refer to
L<FFI::Platypus::TypeParser::Version1> for details on the version1 API.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The core L<FFI::Platypus> documentation.
=item L<FFI::Platypus::TypeParser::Version0>
The API C<0.02> type parser.
=item L<FFI::Platypus::TypeParser::Version1>
The API C<1.00> type parser.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Probe.pm 000644 000000 000000 00000031014 15251066120 016413 0 ustar 00root root 000000 000000 package FFI::Probe;
use strict;
use warnings;
use 5.008004;
use File::Basename qw( dirname );
use Data::Dumper ();
use FFI::Probe::Runner;
use FFI::Build;
use FFI::Build::File::C;
use Capture::Tiny qw( capture_merged capture );
use FFI::Temp;
# ABSTRACT: System detection and probing for FFI extensions.
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, %args) = @_;
$args{log} ||= "ffi-probe.log";
$args{data_filename} ||= "ffi-probe.pl";
unless(ref $args{log})
{
my $fn = $args{log};
my $fh;
open $fh, '>>', $fn;
$args{log} = $fh;
}
my $data;
if(-r $args{data_filename})
{
my $fn = $args{data_filename};
unless($data = do $fn)
{
die "couldn't parse configuration $fn $@" if $@;
die "couldn't do $fn $!" if $!;
die "bad or missing config file $fn";
}
}
$data ||= {};
my $self = bless {
headers => [],
log => $args{log},
data_filename => $args{data_filename},
data => $data,
dir => FFI::Temp->newdir( TEMPLATE => 'ffi-probe-XXXXXX' ),
counter => 0,
runner => $args{runner},
alien => $args{alien} || [],
cflags => $args{cflags},
libs => $args{libs},
}, $class;
$self;
}
sub _runner
{
my($self) = @_;
$self->{runner} ||= FFI::Probe::Runner->new;
}
sub check_header
{
my($self, $header) = @_;
return if defined $self->{data}->{header}->{$header};
my $code = '';
$code .= "#include <$_>\n" for @{ $self->{headers} }, $header;
my $build = FFI::Build->new("hcheck@{[ ++$self->{counter} ]}",
verbose => 2,
dir => $self->{dir},
alien => $self->{alien},
cflags => $self->{cflags},
libs => $self->{libs},
);
my $file = FFI::Build::File::C->new(
\$code,
dir => $self->{dir},
build => $build,
);
my($out, $o) = capture_merged {
eval { $file->build_item };
};
$self->log_code($code);
$self->log($out);
if($o)
{
$self->set('header', $header => 1);
push @{ $self->{headers} }, $header;
return 1;
}
else
{
$self->set('header', $header => 0);
return;
}
}
sub check_cpp
{
my($self, $code) = @_;
my $build = FFI::Build->new("hcheck@{[ ++$self->{counter} ]}",
verbose => 2,
dir => $self->{dir},
alien => $self->{alien},
cflags => $self->{cflags},
libs => $self->{libs},
);
my $file = FFI::Build::File::C->new(
\$code,
dir => $self->{dir},
build => $build,
);
my($out, $i) = capture_merged {
eval { $file->build_item_cpp };
};
$self->log_code($code);
$self->log($out);
if($i && -f $i->path)
{
return $i->slurp;
}
else
{
return;
}
}
sub check_eval
{
my($self, %args) = @_;
my $code = $args{_template} || $self->template;
my $headers = join "", map { "#include <$_>\n" } (@{ $self->{headers} }, @{ $args{headers} || [] });
my @decl = @{ $args{decl} || [] };
my @stmt = @{ $args{stmt} || [] };
my %eval = %{ $args{eval} || {} };
$code =~ s/##HEADERS##/$headers/;
$code =~ s/##DECL##/join "\n", @decl/e;
$code =~ s/##STMT##/join "\n", @stmt/e;
my $eval = '';
my $i=0;
my %map;
foreach my $key (sort keys %eval)
{
$i++;
$map{$key} = "eval$i";
my($format,$expression) = @{ $eval{$key} };
$eval .= " printf(\"eval$i=<<<$format>>>\\n\", $expression);\n";
}
$code =~ s/##EVAL##/$eval/;
my $build = FFI::Build->new("eval@{[ ++$self->{counter} ]}",
verbose => 2,
dir => $self->{dir},
alien => $self->{alien},
cflags => $self->{cflags},
libs => $self->{libs},
export => ['dlmain'],
);
$build->source(
FFI::Build::File::C->new(
\$code,
dir => $self->{dir},
build => $build,
),
);
my $lib = do {
my($out, $lib, $error) = capture_merged {
my $lib = eval {
$build->build;
};
($lib, $@);
};
$self->log_code($code);
$self->log("[build]");
$self->log($out);
if($error)
{
$self->log("exception: $error");
return;
}
elsif(!$lib)
{
$self->log("failed");
return;
}
$lib;
};
my $result = $self->_runner->run($lib->path);
$self->log("[stdout]");
$self->log($result->stdout);
$self->log("[stderr]");
$self->log($result->stderr);
$self->log("rv = @{[ $result->rv ]}");
$self->log("sig = @{[ $result->signal ]}") if $result->signal;
if($result->pass)
{
foreach my $key (sort keys %eval)
{
my $eval = $map{$key};
if($result->stdout =~ /$eval=<<<(.*?)>>>/)
{
my $value = $1;
my @key = split /\./, $key;
$self->set(@key, $value);
}
}
return 1;
}
else
{
return;
}
}
sub check
{
my($self, $name, $code) = @_;
if($self->check_eval(_template => $code))
{
$self->set('probe', $name, 1);
return 1;
}
else
{
$self->set('probe', $name, 0);
return;
}
}
sub check_type_int
{
my($self, $type) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
'#define signed(type) (((type)-1) < 0) ? "signed" : "unsigned"',
"struct align { char a; $type b; };",
],
eval => {
"type.$type.size" => [ '%d' => "(int)sizeof($type)" ],
"type.$type.sign" => [ '%s' => "signed($type)" ],
"type.$type.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{$type}->{size};
my $sign = $self->data->{type}->{$type}->{sign};
sprintf("%sint%d", $sign eq 'signed' ? 's' : 'u', $size*8);
}
sub check_type_enum
{
my($self) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
'#define signed(type) (((type)-1) < 0) ? "signed" : "unsigned"',
"typedef enum { ONE, TWO } myenum;",
"struct align { char a; myenum b; };",
],
eval => {
"type.enum.size" => [ '%d' => '(int)sizeof(myenum)' ],
"type.enum.sign" => [ '%s' => 'signed(myenum)' ],
"type.enum.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{enum}->{size};
my $sign = $self->data->{type}->{enum}->{sign};
sprintf("%sint%d", $sign eq 'signed' ? 's' : 'u', $size*8);
}
sub check_type_signed_enum
{
my($self) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
'#define signed(type) (((type)-1) < 0) ? "signed" : "unsigned"',
"typedef enum { NEG = -1, ONE = 1, TWO = 2 } myenum;",
"struct align { char a; myenum b; };",
],
eval => {
"type.senum.size" => [ '%d' => '(int)sizeof(myenum)' ],
"type.senum.sign" => [ '%s' => 'signed(myenum)' ],
"type.senum.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{senum}->{size};
my $sign = $self->data->{type}->{senum}->{sign};
sprintf("%sint%d", $sign eq 'signed' ? 's' : 'u', $size*8);
}
sub check_type_float
{
my($self, $type) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
"struct align { char a; $type b; };",
],
eval => {
"type.$type.size" => [ '%d' => "(int)sizeof($type)" ],
"type.$type.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{$type}->{size};
my $complex = !!($type =~ /complex/);
if($complex) {
$size /= 2;
}
my $t;
if($size == 4)
{ $t = 'float' }
elsif($size == 8)
{ $t = 'double' }
elsif($size > 9)
{ $t = 'longdouble' }
$t = "complex_$t" if $complex;
$t;
}
sub check_type_pointer
{
my($self) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
"struct align { char a; void* b; };",
],
eval => {
"type.pointer.size" => [ '%d' => '(int)sizeof(void *)' ],
"type.pointer.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
'pointer';
}
sub _set
{
my($data, $value, @key) = @_;
my $key = shift @key;
if(@key > 0)
{
_set($data->{$key} ||= {}, $value, @key);
}
else
{
$data->{$key} = $value;
}
}
sub set
{
my $self = shift;
my $value = pop;
my @key = @_;
my $print_value = $value;
if(ref $print_value)
{
my $d = Data::Dumper->new([$value], [qw($value)]);
$d->Indent(0);
$d->Terse(1);
$print_value = $d->Dump;
}
my $key = join ".", map { /\./ ? "\"$_\"" : $_ } @key;
print "PR $key=$print_value\n";
$self->log("$key=$print_value");
_set($self->{data}, $value, @key);
}
sub save
{
my($self) = @_;
my $dir = dirname($self->{data_filename});
my $dd = Data::Dumper->new([$self->{data}],['x'])
->Indent(1)
->Terse(0)
->Purity(1)
->Sortkeys(1)
->Dump;
mkpath( $dir, 0, oct(755) ) unless -d $dir;
my $fh;
open($fh, '>', $self->{data_filename}) || die "error writing @{[ $self->{data_filename} ]}";
print $fh 'do { my ';
print $fh $dd;
print $fh '$x;}';
close $fh;
}
sub data { shift->{data} }
sub log
{
my($self, $string) = @_;
my $fh = $self->{log};
chomp $string;
print $fh $string, "\n";
}
sub log_code
{
my($self, $code) = @_;
my @code = split /\n/, $code;
chomp for @code;
$self->log("code: $_") for @code;
}
sub DESTROY
{
my($self) = @_;
$self->save;
my $fh = $self->{log};
return unless defined $fh;
close $fh;
}
my $template;
sub template
{
unless(defined $template)
{
local $/;
$template = <DATA>;
}
$template;
}
1;
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe - System detection and probing for FFI extensions.
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Probe;
my $probe = FFI::Probe->new;
$probe->check_header('foo.h');
...
=head1 DESCRIPTION
This class provides an interface for probing for system
capabilities. It is used internally as part of the
L<FFI::Platypus> build process, but it may also be useful
for extensions that use Platypus as well.
=head1 CONSTRUCTOR
=head2 new
my $probe = FFI::Probe->new(%args);
Creates a new instance.
=over 4
=item log
Path to a log or file handle to write to.
=item data_filename
Path to a file which will be used to store/cache results.
=back
=head1 METHODS
=head2 check_header
my $bool = $probe->check_header($header);
Checks that the given C header file is available.
Stores the result, and returns a true/false value.
=head2 check_cpp
=head2 check_eval
my $bool = $probe>check_eval(%args);
=over 4
=item headers
Any additional headers.
=item decl
Any C declarations that need to be made before the C<dlmain> function.
=item stmt
Any C statements that should be made before the evaluation.
=item eval
Any evaluations that should be returned.
=back
=head2 check
=head2 check_type_int
my $type = $probe->check_type_int($type);
=head2 check_type_enum
my $type = $probe->check_type_enum;
=head2 check_type_enum
my $type = $probe->check_type_enum;
=head2 check_type_float
my $type = $probe->check_type_float($type);
=head2 check_type_pointer
my $type = $probe->check_type_pointer;
=head2 set
$probe->set(@key, $value);
Used internally to store a value.
=head2 save
$probe->save;
Saves the values already detected.
=head2 data
my $data = $probe->data;
Returns a hashref of the data already detected.
=head2 log
$probe->log($string);
Sends the given string to the log.
=head2 log_code
$prbe->log_code($string);
Sends the given multi-line code block to the log.
=head2 template
my $template = $probe->template;
Returns the C code template used for C<check_eval> and other
C<check_> methods.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__DATA__
#include <stdio.h>
##HEADERS##
##DECL##
int
dlmain(int argc, char *argv[])
{
##STMT##
##EVAL##
return 0;
}
FFI-Platypus-2.12/lib/FFI/Probe/ 000755 000000 000000 00000000000 15251066120 016056 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Probe/Runner.pm 000644 000000 000000 00000006366 15251066120 017700 0 ustar 00root root 000000 000000 package FFI::Probe::Runner;
use strict;
use warnings;
use 5.008004;
use Capture::Tiny qw( capture );
use FFI::Probe::Runner::Result;
# ABSTRACT: Probe runner for FFI
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, %args) = @_;
$args{exe} ||= do {
require FFI::Platypus::ShareConfig;
require File::Spec;
require Config;
File::Spec->catfile(FFI::Platypus::ShareConfig::dist_dir('FFI::Platypus'), 'probe', 'bin', "dlrun$Config::Config{exe_ext}");
};
defined $args{flags} or $args{flags} = '-';
die "probe runner executable not found at: $args{exe}" unless -f $args{exe};
my $self = bless {
exe => $args{exe},
flags => $args{flags},
}, $class;
$self;
}
sub exe { shift->{exe} }
sub flags { shift->{flags} }
sub verify
{
my($self) = @_;
my $exe = $self->exe;
my($out, $err, $ret) = capture {
$! = 0;
system $exe, 'verify', 'self';
};
return 1 if $ret == 0 && $out =~ /dlrun verify self ok/;
print $out;
print STDERR $err;
die "verify failed";
}
sub run
{
my($self, $dll, @args) = @_;
my $exe = $self->exe;
my $flags = $self->flags;
my($out, $err, $ret) = capture {
my @cmd = ($exe, $dll, $flags, @args);
$! = 0;
system @cmd;
$?;
};
FFI::Probe::Runner::Result->new(
stdout => $out,
stderr => $err,
rv => $ret >> 8,
signal => $ret & 127,
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe::Runner - Probe runner for FFI
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Probe::Runner;
my $runner = FFI::Probe::Runner->new;
$runner->run('foo.so');
=head1 DESCRIPTION
This class executes code in a dynamic library for probing and detecting platform
properties.
=head1 CONSTRUCTOR
=head2 new
my $runner = FFI::Probe::Runner->new(%args);
Creates a new instance.
=over 4
=item exe
The path to the dlrun wrapper. The default is usually correct.
=item flags
The flags to pass into C<dlopen>. The default is C<RTLD_LAZY> on Unix
and C<0> on windows..
=back
=head1 METHODS
=head2 exe
my $exe = $runner->exe;
The path to the dlrun wrapper.
=head2 flags
my $flags = $runner->flags;
The flags to pass into C<dlopen>.
=head2 verify
$runner->verify;
Verifies the dlrun wrapper is working. Throws an exception in the event of failure.
=head2 run
$runner->run($dll, @args);
Runs the C<dlmain> function in the given dynamic library, passing in the
given arguments. Returns a L<FFI::Probe::Runner::Result> object which
contains the results.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Probe/Runner/ 000755 000000 000000 00000000000 15251066120 017327 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/lib/FFI/Probe/Runner/Builder.pm 000644 000000 000000 00000022457 15251066120 021265 0 ustar 00root root 000000 000000 package FFI::Probe::Runner::Builder;
use strict;
use warnings;
use 5.008004;
use Config;
use Capture::Tiny qw( capture_merged );
use Text::ParseWords ();
use FFI::Build::Platform;
# ABSTRACT: Probe runner builder for FFI
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, %args) = @_;
$args{dir} ||= 'blib/lib/auto/share/dist/FFI-Platypus/probe';
my $platform = FFI::Build::Platform->new;
my $self = bless {
dir => $args{dir},
platform => $platform,
# we don't use the platform ccflags, etc because they are geared
# for building dynamic libs not exes
cc => [$platform->shellwords($Config{cc})],
ld => [$platform->shellwords($Config{ld})],
ccflags => [$platform->shellwords($Config{ccflags})],
optimize => [$platform->shellwords($Config{optimize})],
ldflags => [$platform->shellwords($Config{ldflags})],
libs =>
$^O eq 'MSWin32'
? [[]]
: [['-ldl'], [], map { [$_] } grep !/^-ldl/, $platform->shellwords($Config{perllibs})],
}, $class;
$self;
}
sub dir
{
my($self, @subdirs) = @_;
my $dir = $self->{dir};
if(@subdirs)
{
require File::Spec;
$dir = File::Spec->catdir($dir, @subdirs);
}
unless(-d $dir)
{
require File::Path;
File::Path::mkpath($dir, 0, oct(755));
}
$dir;
}
sub cc { shift->{cc} }
sub ccflags { shift->{ccflags} }
sub optimize { shift->{optimize} }
sub ld { shift->{ld} }
sub ldflags { shift->{ldflags} }
sub libs { shift->{libs} }
sub file
{
my($self, @sub) = @_;
@sub >= 1 or die 'usage: $builder->file([@subdirs], $filename)';
my $filename = pop @sub;
require File::Spec;
File::Spec->catfile($self->dir(@sub), $filename);
}
my $source;
sub exe
{
my($self) = @_;
my $xfn = $self->file('bin', "dlrun$Config{exe_ext}");
}
sub source
{
unless($source)
{
local $/;
$source = <DATA>;
}
$source;
}
our $VERBOSE = !!$ENV{V};
sub extract
{
my($self) = @_;
# the source src/dlrun.c
{
print "XX src/dlrun.c\n" unless $VERBOSE;
my $fh;
my $fn = $self->file('src', 'dlrun.c');
my $source = $self->source;
open $fh, '>', $fn or die "unable to write $fn $!";
print $fh $source;
close $fh;
}
# the bin directory bin
{
print "XX bin/\n" unless $VERBOSE;
$self->dir('bin');
}
}
sub run
{
my($self, $type, @cmd) = @_;
@cmd = map { ref $_ ? @$_ : $_ } @cmd;
my($out, $ret) = capture_merged {
$self->{platform}->run(@cmd);
};
if($ret)
{
print STDERR $out;
die "$type failed";
}
print $out if $VERBOSE;
$out;
}
sub run_list
{
my($self, $type, @commands) = @_;
my $log = '';
foreach my $cmd (@commands)
{
my($out, $ret) = capture_merged {
$self->{platform}->run(@$cmd);
};
if($VERBOSE)
{
print $out;
}
else
{
$log .= $out;
}
return if !$ret;
}
print $log;
die "$type failed";
}
sub build
{
my($self) = @_;
$self->extract;
# this should really be done in `new` but the build
# scripts for FFI-Platypus edit the ldfalgs from there
# so. Also this may actually belong in FFI::Build::Platform
# which would resolve the problem.
if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
{
$self->{ldflags} = [
grep !/^-nodefaultlib$/i,
@{ $self->{ldflags} }
];
}
my $cfn = $self->file('src', 'dlrun.c');
my $ofn = $self->file('src', "dlrun$Config{obj_ext}");
my $xfn = $self->exe;
# compile
print "CC src/dlrun.c\n" unless $VERBOSE;
$self->run(
compile =>
$self->cc,
$self->ccflags,
$self->optimize,
'-c',
$self->{platform}->flag_object_output($ofn),
$cfn,
);
# link
print "LD src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
$self->run_list(link =>
map { [
$self->ld,
$self->ldflags,
$self->{platform}->flag_exe_output($xfn),
$ofn,
@$_
] } @{ $self->libs },
);
## FIXME
if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
{
if(-f 'dlrun.exe' && ! -f $xfn)
{
rename 'dlrun.exe', $xfn;
}
}
# verify
print "VV bin/dlrun$Config{exe_ext}\n" unless $VERBOSE;
my $out = $self->run(verify => $xfn, 'verify', 'self');
if($out !~ /dlrun verify self ok/)
{
print $out;
die "verify failed string match";
}
# remove object
print "UN src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
unlink $ofn;
$xfn;
}
1;
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe::Runner::Builder - Probe runner builder for FFI
=head1 VERSION
version 2.12
=head1 SYNOPSIS
use FFI::Probe::Runner::Builder;
my $builder = FFI::Probe::Runner::Builder->new
dir => "/foo/bar",
);
my $exe = $builder->build;
=head1 DESCRIPTION
This is a builder class for the FFI probe runner. It is mostly only of
interest if you are hacking on L<FFI::Platypus> itself.
The interface may and will change over time without notice. Use in
external dependencies at your own peril.
=head1 CONSTRUCTORS
=head2 new
my $builder = FFI::Probe::Runner::Builder->new(%args);
Create a new instance.
=over 4
=item dir
The root directory for where to place the probe runner files.
Will be created if it doesn't already exist. The default
makes sense for when L<FFI::Platypus> is being built.
=back
=head1 METHODS
=head2 dir
my $dir = $builder->dir(@subdirs);
Returns a subdirectory from the builder root. Directory
will be created if it doesn't already exist.
=head2 cc
my @cc = @{ $builder->cc };
The C compiler to use. Returned as an array reference so that it may be modified.
=head2 ccflags
my @ccflags = @{ $builder->ccflags };
The C compiler flags to use. Returned as an array reference so that it may be modified.
=head2 optimize
The C optimize flags to use. Returned as an array reference so that it may be modified.
=head2 ld
my @ld = @{ $builder->ld };
The linker to use. Returned as an array reference so that it may be modified.
=head2 ldflags
my @ldflags = @{ $builder->ldflags };
The linker flags to use. Returned as an array reference so that it may be modified.
=head2 libs
my @libs = @{ $builder->libs };
The library flags to use. Returned as an array reference so that it may be modified.
=head2 file
my $file = $builder->file(@subdirs, $filename);
Returns a file in a subdirectory from the builder root.
Directory will be created if it doesn't already exist.
File will not be created.
=head2 exe
my $exe = $builder->exe;
The name of the executable, once it is built.
=head2 source
my $source = $builder->source;
The C source for the probe runner.
=head2 extract
$builder->extract;
Extract the source for the probe runner.
=head2 run
$builder->run($type, @command);
Runs the given command. Dies if the command fails.
=head2 run_list
$builder->run($type, \@command, \@command, ...);
Runs the given commands in order until one succeeds.
Dies if they all fail.
=head2 build
my $exe = $builder->build;
Builds the probe runner. Returns the path to the executable.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__DATA__
#if defined __CYGWIN__
#include <dlfcn.h>
#elif defined _WIN32
#include <windows.h>
#else
#include <dlfcn.h>
#endif
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#if defined __CYGWIN__
typedef void * dlib;
#elif defined _WIN32
#define RTLD_LAZY 0
typedef HMODULE dlib;
dlib
dlopen(const char *filename, int flags)
{
(void)flags;
return LoadLibrary(filename);
}
void *
dlsym(dlib handle, const char *symbol_name)
{
return GetProcAddress(handle, symbol_name);
}
int
dlclose(dlib handle)
{
FreeLibrary(handle);
return 0;
}
const char *
dlerror()
{
return "an error";
}
#else
typedef void * dlib;
#endif
int
main(int argc, char **argv)
{
char *filename;
int flags;
int (*dlmain)(int, char **);
char **dlargv;
dlib handle;
int n;
int ret;
if(argc < 3)
{
fprintf(stderr, "usage: %s dlfilename dlflags [ ... ]\n", argv[0]);
return 1;
}
if(!strcmp(argv[1], "verify") && !strcmp(argv[2], "self"))
{
printf("dlrun verify self ok\n");
return 0;
}
#if defined WIN32
SetErrorMode(SetErrorMode(0) | SEM_NOGPFAULTERRORBOX);
#endif
dlargv = malloc(sizeof(char*)*(argc-2));
dlargv[0] = argv[0];
filename = argv[1];
flags = !strcmp(argv[2], "-") ? RTLD_LAZY : atoi(argv[2]);
for(n=3; n<argc; n++)
dlargv[n-2] = argv[n];
handle = dlopen(filename, flags);
if(handle == NULL)
{
fprintf(stderr, "error loading %s (%d|%s): %s", filename, flags, argv[2], dlerror());
return 1;
}
dlmain = dlsym(handle, "dlmain");
if(dlmain == NULL)
{
fprintf(stderr, "no dlmain symbol");
return 1;
}
ret = dlmain(argc-2, dlargv);
dlclose(handle);
return ret;
}
FFI-Platypus-2.12/lib/FFI/Probe/Runner/Result.pm 000644 000000 000000 00000003351 15251066120 021145 0 ustar 00root root 000000 000000 package FFI::Probe::Runner::Result;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: The results from a probe run.
our $VERSION = '2.12'; # VERSION
sub new
{
my($class, %args) = @_;
my $self = bless \%args, $class;
$self;
}
sub stdout { shift->{stdout} }
sub stderr { shift->{stderr} }
sub rv { shift->{rv} }
sub signal { shift->{signal} }
sub pass
{
my($self) = @_;
$self->rv == 0 && $self->signal == 0;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe::Runner::Result - The results from a probe run.
=head1 VERSION
version 2.12
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 CONSTRUCTOR
=head2 new
my $result = FFI::Probe::Runner::Result->new(%args);
Creates a new instance of the class.
=head1 METHODS
=head2 stdout
my $stdout = $result->stdout;
=head2 stderr
my $stderr = $result->stderr;
=head2 rv
my $rv = $result->rv;
=head2 signal
my $signal = $result->signal;
=head2 pass
my $pass = $result->pass;
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/Temp.pm 000644 000000 000000 00000005212 15251066120 016252 0 ustar 00root root 000000 000000 package FFI::Temp;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use File::Spec;
use File::Temp qw( tempdir );
# ABSTRACT: Temp Dir support for FFI::Platypus
our $VERSION = '2.12'; # VERSION
# problem with vanilla File::Temp is that is often uses
# as /tmp that has noexec turned on. Workaround is to
# create a temp directory in the build directory, but
# we have to be careful about cleanup. This puts all that
# (attempted) carefulness in one place so that when we
# later discover it isn't so careful we can fix it in
# one place rather thabn alllll the places that we need
# temp directories.
my %root;
sub _root
{
my $root = File::Spec->rel2abs(File::Spec->catdir(".tmp"));
my $lock = File::Spec->catfile($root, "l$$");
foreach my $try (0..9)
{
sleep $try if $try != 0;
mkdir $root or die "unable to create temp root $!" unless -d $root;
# There is a race condition here if the FFI::Temp is
# used in parallel. To work around we run this 10
# times until it works. There is still a race condition
# if it fails 10 times, but hopefully that is unlikely.
# ??: doesn't account for fork, but probably doesn't need to.
open my $fh, '>', $lock or next;
close $fh or next;
$root{$root} = 1;
return $root;
}
}
END {
foreach my $root (keys %root)
{
my $lock = File::Spec->catfile($root, "l$$");
unlink $lock;
# try to delete if possible.
# if not possible then punt
rmdir $root if -d $root;
}
}
sub newdir
{
my $class = shift;
croak "uneven" if @_ % 2;
File::Temp->newdir(DIR => _root, @_);
}
sub new
{
my $class = shift;
croak "uneven" if @_ % 2;
File::Temp->new(DIR => _root, @_);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Temp - Temp Dir support for FFI::Platypus
=head1 VERSION
version 2.12
=head1 DESCRIPTION
This class is private to L<FFI::Platypus>.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr PÃsaÅ™ (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
Eric Brine (IKEGAMI)
szTheory
José JoaquÃn Atria (JJATRIA)
Pete Houston (openstrike, HOUSTON)
Lukas Mai (MAUKE)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
FFI-Platypus-2.12/lib/FFI/typemap 000644 000000 000000 00000003021 15251066120 016405 0 ustar 00root root 000000 000000 ffi_pl_string T_FFI_PL_STRING
ffi_pl_type* T_FFI_PL_TYPE
ffi_pl_function* T_FFI_PL_FUNCTION
ffi_pl_closure* T_FFI_PL_CLOSURE_DATA
ffi_pl_arguments* T_FFI_PL_ARGUMENTS
OUTPUT
T_FFI_PL_STRING
$var != NULL ? sv_setpv((SV*)$arg, $var) : sv_setsv((SV*)$arg, &PL_sv_undef);
T_FFI_PL_TYPE
sv_setref_pv($arg, \"FFI::Platypus::Type\", (void *) $var);
T_FFI_PL_FUNCTION
sv_setref_pv($arg, \"FFI::Platypus::Function::Function\", (void *) $var);
T_FFI_PL_CLOSURE_DATA
sv_setref_pv($arg, \"FFI::Platypus::ClosureData\", (void *) $var);
INPUT
T_FFI_PL_STRING
$var = SvOK($arg) ? ($type)SvPV_nolen($arg) : NULL;
T_FFI_PL_TYPE
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::Type\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::Type\");
T_FFI_PL_FUNCTION
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::Function::Function\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::Function::Function\");
T_FFI_PL_CLOSURE_DATA
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::ClosureData\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::ClosureData\");
T_FFI_PL_ARGUMENTS
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::API::ARGV\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::API::ARGV\");
FFI-Platypus-2.12/maint/ 000755 000000 000000 00000000000 15251066120 014745 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/maint/cip-before-install 000755 000000 000000 00000000410 15251066120 020345 0 ustar 00root root 000000 000000 #!/bin/bash
set -ex
cip sudo apt-get update
cip sudo apt-get install libffi-dev
cip exec cpanm -n version
if [ "$CIP_TAG" == "5.34" ]; then
cip exec cpanm -n forks
fi
if [[ "$CIP_TAG" =~ ^5\.[0-9]+-debug(32)?$ ]]; then
cip exec cpanm -n Test::LeakTrace
fi
FFI-Platypus-2.12/maint/cip-test-examples 000755 000000 000000 00000000564 15251066120 020244 0 ustar 00root root 000000 000000 #!/bin/sh
if echo $CIP_ENV | grep -q FFI_PLATYPUS_TEST_EXAMPLES ; then
dir=$(ls -1d FFI-Platypus-* | grep -v tar.gz)
cip sudo apt-get install libtcod1 libnotify4 libzmq5
cip exec cpanm -n Capture::Tiny Test::Script Path::Tiny Convert::Binary::C YAML File::chdir Alien::Libbz2 FFI::Platypus FFI::C
cip exec bash -c "cd $dir && prove -vm xt/author/example.t"
fi
FFI-Platypus-2.12/maint/generate-abw 000755 000000 000000 00000000477 15251066120 017244 0 ustar 00root root 000000 000000 #!/usr/bin/env perl
use strict;
use warnings;
use Alien::Base::Wrapper 1.49;
use File::Path qw( mkpath );
use File::Copy qw( copy );
mkpath 'inc/Alien/Base', 0, 0755;
my $from = $INC{'Alien/Base/Wrapper.pm'};
my $to = 'inc/Alien/Base/Wrapper.pm';
print "+cp $from $to\n";
copy $from, $to or die "copy failed: $!";
FFI-Platypus-2.12/maint/generate-readme 000755 000000 000000 00000000770 15251066120 017724 0 ustar 00root root 000000 000000 #!/usr/bin/env perl
use strict;
use warnings;
use Pod::Abstract;
use Pod::Simple::Text;
my $root = Pod::Abstract->load_file("lib/FFI/Platypus.pm");
foreach my $name (qw( SUPPORT SECURITY CONTRIBUTING ))
{
my($pod) = $root->select("/head1[\@heading=~{$name}]");
$_->detach for $pod->select('//#cut');
my $parser = Pod::Simple::Text->new;
my $text;
$parser->output_string( \$text );
$parser->parse_string_document( $pod->pod );
open my $fh, '>', $name;
print $fh $text;
close $fh;
}
FFI-Platypus-2.12/maint/generate-record-accessor 000755 000000 000000 00000001271 15251066120 021542 0 ustar 00root root 000000 000000 #!/usr/bin/env perl
use strict;
use warnings;
use autodie;
use Template;
my $tt2 = Template->new(
INCLUDE_PATH => 'maint/tt',
);
my @list = map {
(
{ ffi_type => "uint$_", c_type => "uint${_}_t", perl_type => "UV", zero => "0" },
{ ffi_type => "sint$_", c_type => "int${_}_t", perl_type => "IV", zero => "0" },
)
} (8,16,32,64);
push @list, map { { ffi_type => $_, c_type => $_, perl_type => "NV", zero => "0.0" } } qw( float double );
my $content = '';
foreach my $config (@list)
{
$tt2->process("accessor.tt", $config, \$content) || die $tt2->error;
}
open my $fh, '>', 'xs/record_simple.c';
$tt2->process("accessor_wrapper.tt", { content => $content }, $fh);
close $fh;
FFI-Platypus-2.12/maint/run-after_build.pl 000644 000000 000000 00000000477 15251066120 020374 0 ustar 00root root 000000 000000 use strict;
use warnings;
use autodie qw( :all );
my $content;
open my $in, '<', 'Makefile.PL';
while(<$in>)
{
s/^(# This file was automatically generated by Dist::Zilla::Plugin::Author::Plicease::MakeMaker).*$/$1/;
$content .= $_;
}
close $in;
open my $out, '>', 'Makefile.PL';
print $out $content;
close $out;
FFI-Platypus-2.12/maint/run-before_build.pl 000644 000000 000000 00000005444 15251066120 020534 0 ustar 00root root 000000 000000 use strict;
use warnings;
use lib 'inc';
use My::Config;
use File::Spec;
use File::Spec ();
use File::Find ();
if(@ARGV > 0)
{
if(-e 'Makefile')
{
if($^O eq 'MSWin32')
{
print "> gmake realclean\n";
system 'gmake', 'realclean';
}
else
{
print "% make realclean\n";
system 'make', 'realclean';
}
}
My::Config->new->clean;
}
foreach my $bits (qw( 16 32 64 ))
{
foreach my $orig (qw( t/ffi/uint8.c t/ffi/sint8.c t/type_uint8.t t/type_sint8.t ))
{
my $new = $orig;
$new =~ s/8/$bits/;
open my $in, '<', $orig or die "unable to read $orig";
open my $out, '>', $new or die "unable to write $new";
if($orig =~ /\.c$/)
{
print $out join "\n", "/*",
" * DO NOT MODIFY THIS FILE.",
" * This file generated from similar file $orig",
" * all instances of \"int8\" have been changed to \"int$bits\"",
" */",
"";
}
else
{
print $out join "\n", "#",
"# DO NOT MODIFY THIS FILE.",
"# This file generated from similar file $orig",
"# all instances of \"int8\" have been changed to \"int$bits\"",
"#",
"";
}
while(<$in>)
{
s/int8/"int$bits"/eg;
print $out $_;
}
close $out;
close $in;
}
}
foreach my $type (qw( double ))
{
foreach my $orig (qw( t/ffi/float.c t/type_float.t t/type_complex_float.t t/ffi/complex_float.c ))
{
my $new = $orig;
$new =~ s/float/$type/;
open my $in, '<', $orig or die "unable to read $orig $!";
open my $out, '>', $new or die "unable to write $new $!";
if($orig =~ /\.c$/)
{
print $out join "\n", "/*",
" * DO NOT MODIFY THIS FILE.",
" * This file generated from similar file $orig",
" * all instances of \"float\" have been changed to \"$type\"",
" */",
"";
}
else
{
print $out join "\n", "#",
"# DO NOT MODIFY THIS FILE.",
"# This file generated from similar file $orig",
"# all instances of \"float\" have been changed to \"$type\"",
"#",
"";
}
while(<$in>)
{
s/float/$type/eg;
s/SIZEOF_FLOAT_COMPLEX/"SIZEOF_@{[ uc $type ]}_COMPLEX"/eg;
if($type eq 'double')
{
s/crealf/creal/g;
s/cimagf/cimag/g;
}
else
{
die 'todo';
}
print $out $_;
}
close $out;
close $in;
}
}
FFI-Platypus-2.12/maint/tt/ 000755 000000 000000 00000000000 15251066120 015374 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/maint/tt/accessor.tt 000644 000000 000000 00000004532 15251066120 017553 0 ustar 00root root 000000 000000
XS(ffi_pl_record_accessor_[% ffi_type %])
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
[% c_type %] *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = ([% c_type %]*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = ([% c_type %]) Sv[% perl_type %](ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_[% perl_type %](*ptr2);
}
XS(ffi_pl_record_accessor_[% ffi_type %]_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
[% c_type %] *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = ([% c_type %]*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = Sv[% perl_type %](arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = Sv[% perl_type %](*item);
}
else
{
ptr2[i] = [% zero %];
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_[% perl_type %](ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_set[% perl_type | lower %](*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
FFI-Platypus-2.12/maint/tt/accessor_wrapper.tt 000644 000000 000000 00000000476 15251066120 021316 0 ustar 00root root 000000 000000 /* DO NOT MODIFY THIS FILE it is generated from these files:
* inc/template/accessor.tt
* inc/template/accessor_wrapper.tt
* inc/run/generate_record_accessor.pl
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
[% content %]
FFI-Platypus-2.12/perlcriticrc 000644 000000 000000 00000003670 15251066120 016253 0 ustar 00root root 000000 000000 severity = 1
only = 1
[Community::ArrayAssignAref]
[Community::BarewordFilehandles]
[Community::ConditionalDeclarations]
[Community::ConditionalImplicitReturn]
[Community::DeprecatedFeatures]
[Community::DiscouragedModules]
[Community::DollarAB]
[Community::Each]
[Community::IndirectObjectNotation]
[Community::LexicalForeachIterator]
[Community::LoopOnHash]
[Community::ModPerl]
[Community::OpenArgs]
[Community::OverloadOptions]
[Community::POSIXImports]
[Community::PackageMatchesFilename]
[Community::PreferredAlternatives]
[Community::StrictWarnings]
extra_importers = Test2::V0
[Community::Threads]
[Community::Wantarray]
[Community::WarningsSwitch]
[Community::WhileDiamondDefaultAssignment]
[BuiltinFunctions::ProhibitBooleanGrep]
;[BuiltinFunctions::ProhibitStringyEval]
[BuiltinFunctions::ProhibitStringySplit]
[BuiltinFunctions::ProhibitVoidGrep]
[BuiltinFunctions::ProhibitVoidMap]
[ClassHierarchies::ProhibitExplicitISA]
[ClassHierarchies::ProhibitOneArgBless]
[CodeLayout::ProhibitHardTabs]
allow_leading_tabs = 0
[CodeLayout::ProhibitTrailingWhitespace]
[CodeLayout::RequireConsistentNewlines]
[ControlStructures::ProhibitLabelsWithSpecialBlockNames]
[ControlStructures::ProhibitMutatingListFunctions]
[ControlStructures::ProhibitUnreachableCode]
[InputOutput::ProhibitBarewordFileHandles]
[InputOutput::ProhibitJoinedReadline]
[InputOutput::ProhibitTwoArgOpen]
[Miscellanea::ProhibitFormats]
[Miscellanea::ProhibitUselessNoCritic]
[Modules::ProhibitConditionalUseStatements]
;[Modules::RequireEndWithOne]
[Modules::RequireNoMatchVarsWithUseEnglish]
[Objects::ProhibitIndirectSyntax]
[RegularExpressions::ProhibitUselessTopic]
[Subroutines::ProhibitNestedSubs]
[ValuesAndExpressions::ProhibitLeadingZeros]
[ValuesAndExpressions::ProhibitMixedBooleanOperators]
[ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator]
[ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
[Variables::ProhibitPerl4PackageNames]
[Variables::ProhibitUnusedVariables]
FFI-Platypus-2.12/t/ 000755 000000 000000 00000000000 15251066120 014100 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/t/00_diag.t 000644 000000 000000 00000010414 15251066120 015470 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use Config;
eval { require 'Test/More.pm' };
# This .t file is generated.
# make changes instead to dist.ini
my %modules;
my $post_diag;
$modules{$_} = $_ for qw(
Alien::Base
Alien::FFI
Capture::Tiny
Devel::Hide
ExtUtils::CBuilder
ExtUtils::MakeMaker
ExtUtils::ParseXS
FFI::CheckLib
File::Spec::Functions
IPC::Cmd
JSON::PP
List::Util
Math::LongDouble
PkgConfig
Test2::API
Test2::V0
autodie
constant
forks
parent
);
$post_diag = sub {
eval {
require lib;
lib->import('inc');
require FFI::Platypus::ShareConfig;
require My::BuildConfig;
my $build_config = My::BuildConfig->new;
my $share_config = 'FFI::Platypus::ShareConfig';
my $class = $build_config->get('alien')->{class};
my $pm = "$class.pm";
$pm =~ s/::/\//g;
require $pm;
$Alien::FFI::pkgconfig::VERBOSE =
$Alien::FFI::pkgconfig::VERBOSE = 0;
require FFI::Platypus;
require FFI::Platypus::Memory;
diag "mode : ", $build_config->get('alien')->{mode};
diag "$class->VERSION = ", $class->VERSION;
diag "$class->install_type = ", $class->install_type;
diag "$class->cflags = ", $class->cflags;
diag "$class->libs = ", $class->libs;
diag "$class->version = ", $class->config('version');
diag "my_configure = ", $class->runtime_prop->{my_configure} if defined $class->runtime_prop->{my_configure};
spacer();
my %type_map = %{ $share_config->get('type_map') };
my $diag = $build_config->get('diag');
foreach my $key (sort keys %{ $diag->{args} })
{
diag "mb.args.$key=", $diag->{args}->{$key};
}
foreach my $key (sort keys %{ $diag->{config} })
{
diag "config.$key=", $diag->{config}->{$key};
}
diag "ffi.platypus.memory.strdup_impl =@{[ FFI::Platypus::Memory->_strdup_impl ]}";
diag "ffi.platypus.memory.strndup_impl=@{[ FFI::Platypus::Memory->_strndup_impl ]}";
spacer();
my %r;
foreach my $k (keys %type_map)
{
my $v = $type_map{$k};
push @{ $r{$v} }, $k;
}
diag "Types:";
foreach my $type (sort keys %r)
{
diag sprintf(" %-8s : %s", $type, join(', ', sort @{ $r{$type} }));
}
spacer();
my $abi = FFI::Platypus->abis;
diag "ABIs:";
foreach my $key (sort keys %$abi)
{
diag sprintf(" %-20s %s", $key, $abi->{$key});
}
spacer();
diag "Probes:";
my $probe = $share_config->get("probe");
diag sprintf(" %-20s %s", $_, $probe->{$_}) for keys %$probe;
};
diag "extended diagnostic failed: $@" if $@;
if(-f "/proc/cpuinfo")
{
open my $fh, '<', '/proc/cpuinfo';
my @lines = <$fh>;
close $fh;
my($model_name) = grep /^model name/, @lines;
my($flags) = grep /^flags/, @lines;
my($address_sizes) = grep /^address sizes/, @lines;
spacer();
diag "CPU Info:";
diag " $model_name";
diag " $flags" if $flags;;
diag " $address_sizes" if $address_sizes;
}
require IPC::Cmd;
require Capture::Tiny;
if(IPC::Cmd::can_run('lsb_release'))
{
spacer();
diag Capture::Tiny::capture_merged(sub {
system 'lsb_release', '-a';
();
});
}
require FFI::Build::Platform;
spacer();
diag "[PLATFORM]\n";
diag(FFI::Build::Platform->diag);
};
my @modules = sort keys %modules;
sub spacer ()
{
diag '';
diag '';
diag '';
}
pass 'okay';
my $max = 1;
$max = $_ > $max ? $_ : $max for map { length $_ } @modules;
our $format = "%-${max}s %s";
spacer;
my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV;
if(@keys > 0)
{
diag "$_=$ENV{$_}" for @keys;
if($ENV{PERL5LIB})
{
spacer;
diag "PERL5LIB path";
diag $_ for split $Config{path_sep}, $ENV{PERL5LIB};
}
elsif($ENV{PERLLIB})
{
spacer;
diag "PERLLIB path";
diag $_ for split $Config{path_sep}, $ENV{PERLLIB};
}
spacer;
}
diag sprintf $format, 'perl', "$] $^O $Config{archname}";
foreach my $module (sort @modules)
{
my $pm = "$module.pm";
$pm =~ s{::}{/}g;
if(eval { require $pm; 1 })
{
my $ver = eval { $module->VERSION };
$ver = 'undef' unless defined $ver;
diag sprintf $format, $module, $ver;
}
else
{
diag sprintf $format, $module, '-';
}
}
if($post_diag)
{
spacer;
$post_diag->();
}
spacer;
done_testing;
FFI-Platypus-2.12/t/ffi/ 000755 000000 000000 00000000000 15251066120 014644 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/t/ffi/align.c 000644 000000 000000 00000002565 15251066120 016112 0 ustar 00root root 000000 000000 #include "libtest.h"
typedef struct _my_struct {
char x1;
uint64_t my_uint64;
char x2;
uint32_t my_uint32;
char x3;
uint16_t my_uint16;
char x4;
uint8_t my_uint8;
char x5;
int64_t my_sint64;
char x6;
int32_t my_sint32;
char x7;
int16_t my_sint16;
char x8;
int8_t my_sint8;
char x9;
float my_float;
char x10;
double my_double;
char x11;
void *my_opaque;
} my_struct;
EXTERN uint64_t
align_get_uint64(my_struct *my_struct)
{
return my_struct->my_uint64;
}
EXTERN uint32_t
align_get_uint32(my_struct *my_struct)
{
return my_struct->my_uint32;
}
EXTERN uint16_t
align_get_uint16(my_struct *my_struct)
{
return my_struct->my_uint16;
}
EXTERN uint8_t
align_get_uint8(my_struct *my_struct)
{
return my_struct->my_uint8;
}
EXTERN int64_t
align_get_sint64(my_struct *my_struct)
{
return my_struct->my_sint64;
}
EXTERN int32_t
align_get_sint32(my_struct *my_struct)
{
return my_struct->my_sint32;
}
EXTERN int16_t
align_get_sint16(my_struct *my_struct)
{
return my_struct->my_sint16;
}
EXTERN int8_t
align_get_sint8(my_struct *my_struct)
{
return my_struct->my_sint8;
}
EXTERN float
align_get_float(my_struct *my_struct)
{
return my_struct->my_float;
}
EXTERN double
align_get_double(my_struct *my_struct)
{
return my_struct->my_double;
}
EXTERN void *
align_get_opaque(my_struct *my_struct)
{
return my_struct->my_opaque;
}
FFI-Platypus-2.12/t/ffi/align_array.c 000644 000000 000000 00000002755 15251066120 017311 0 ustar 00root root 000000 000000 #include "libtest.h"
typedef struct _my_struct {
char x1;
uint64_t my_uint64[3];
char x2;
uint32_t my_uint32[3];
char x3;
uint16_t my_uint16[3];
char x4;
uint8_t my_uint8[3];
char x5;
int64_t my_sint64[3];
char x6;
int32_t my_sint32[3];
char x7;
int16_t my_sint16[3];
char x8;
int8_t my_sint8[3];
char x9;
float my_float[3];
char x10;
double my_double[3];
char x11;
void *my_opaque[3];
} my_struct;
EXTERN uint64_t *
align_array_get_uint64(my_struct *my_struct)
{
return my_struct->my_uint64;
}
EXTERN uint32_t *
align_array_get_uint32(my_struct *my_struct)
{
return my_struct->my_uint32;
}
EXTERN uint16_t *
align_array_get_uint16(my_struct *my_struct)
{
return my_struct->my_uint16;
}
EXTERN uint8_t *
align_array_get_uint8(my_struct *my_struct)
{
return my_struct->my_uint8;
}
EXTERN int64_t *
align_array_get_sint64(my_struct *my_struct)
{
return my_struct->my_sint64;
}
EXTERN int32_t *
align_array_get_sint32(my_struct *my_struct)
{
return my_struct->my_sint32;
}
EXTERN int16_t *
align_array_get_sint16(my_struct *my_struct)
{
return my_struct->my_sint16;
}
EXTERN int8_t *
align_array_get_sint8(my_struct *my_struct)
{
return my_struct->my_sint8;
}
EXTERN float *
align_array_get_float(my_struct *my_struct)
{
return my_struct->my_float;
}
EXTERN double *
align_array_get_double(my_struct *my_struct)
{
return my_struct->my_double;
}
EXTERN void **
align_array_get_opaque(my_struct *my_struct)
{
return my_struct->my_opaque;
}
FFI-Platypus-2.12/t/ffi/align_fixed.c 000644 000000 000000 00000000262 15251066120 017261 0 ustar 00root root 000000 000000 #include "libtest.h"
typedef struct {
char mess_up_alignment;
const char value[10];
} foo_t;
EXTERN const char *
align_fixed_get_value(foo_t *foo)
{
return foo->value;
}
FFI-Platypus-2.12/t/ffi/align_string.c 000644 000000 000000 00000000610 15251066120 017465 0 ustar 00root root 000000 000000 #include "libtest.h"
typedef struct {
char mess_up_alignment;
const char *value;
} foo_t;
EXTERN const char *
align_string_get_value(foo_t *foo)
{
return foo->value;
}
EXTERN void
align_string_set_value(foo_t *foo, const char *value)
{
static char buffer[512];
if(value != NULL)
{
strcpy(buffer, value);
foo->value = buffer;
}
else
{
foo->value = NULL;
}
}
FFI-Platypus-2.12/t/ffi/basic.c 000644 000000 000000 00000000410 15251066120 016064 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN uint8_t
f0(uint8_t input)
{
return input;
}
EXTERN int
my_atoi(const char *string)
{
return atoi(string);
}
EXTERN void
f1(void)
{
}
EXTERN void
f2(int *i)
{
*i = *i+1;
}
EXTERN int
mystrangeprefix_bar(void)
{
return 42;
}
FFI-Platypus-2.12/t/ffi/closure.c 000644 000000 000000 00000002777 15251066120 016501 0 ustar 00root root 000000 000000 #include "libtest.h"
typedef int (*closure1_t)(void);
typedef int (*closure2_t)(int);
static closure1_t my_closure1;
static closure2_t my_closure2;
EXTERN void
closure_set_closure1(closure1_t closure)
{
my_closure1 = closure;
}
EXTERN void
closure_set_closure2(closure2_t closure)
{
my_closure2 = closure;
}
EXTERN int
closure_call_closure1(void)
{
return my_closure1();
}
EXTERN int
closure_call_closure2(int arg)
{
return my_closure2(arg);
}
EXTERN int
closure_call_closure_immediate(closure2_t closure, int arg)
{
return closure(arg);
}
typedef struct {
const char *one;
const char *two;
int three;
const char *four;
int myarray1[2];
void *opaque1;
void *myarray2[2];
char fixedfive[5];
} cx_struct_t;
typedef void (*cx_closure_t)(cx_struct_t *, int);
static cx_closure_t my_cx_closure;
EXTERN void
cx_closure_set(cx_closure_t closure)
{
my_cx_closure = closure;
}
EXTERN void
cx_closure_call(cx_struct_t *s, int i)
{
my_cx_closure(s, i);
}
typedef void (*cxv_closure_t)(cx_struct_t, int);
static cxv_closure_t my_cxv_closure;
EXTERN void
cxv_closure_set(cxv_closure_t closure)
{
my_cxv_closure = closure;
}
EXTERN void
cxv_closure_call(cx_struct_t s, int i)
{
my_cxv_closure(s, i);
}
typedef struct {
char foo;
short bar;
int baz;
} cx_struct_simple_t;
typedef cx_struct_simple_t (*cxv_closure_simple_t)(void);
EXTERN cx_struct_simple_t*
cxv_closure_simple_call(cxv_closure_simple_t closure)
{
static cx_struct_simple_t simple;
simple = closure();
return &simple;
}
FFI-Platypus-2.12/t/ffi/color.c 000644 000000 000000 00000001471 15251066120 016131 0 ustar 00root root 000000 000000 #include "libtest.h"
typedef struct _color {
uint8_t red, green, blue;
} color;
EXTERN color *
color_new(int red, int green, int blue)
{
static color _self;
color *self = &_self;
self->red = red;
self->green = green;
self->blue = blue;
return self;
}
EXTERN int
color_get_red(color *self)
{
return self->red;
}
EXTERN void
color_set_red(color *self, int value)
{
self->red = value;
}
EXTERN int
color_get_green(color *self)
{
return self->green;
}
EXTERN void
color_set_green(color *self, int value)
{
self->green = value;
}
EXTERN int
color_get_blue(color *self)
{
return self->blue;
}
EXTERN void
color_set_blue(color *self, int value)
{
self->blue = value;
}
EXTERN void
color_DESTROY(color *self)
{
free(self);
}
EXTERN size_t
color_ffi_record_size()
{
return sizeof(color);
}
FFI-Platypus-2.12/t/ffi/complex_double.c 000644 000000 000000 00000002603 15251066120 020012 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/complex_float.c
* all instances of "float" have been changed to "double"
*/
#include "libtest.h"
#if SIZEOF_DOUBLE_COMPLEX
EXTERN double
complex_double_get_real(double complex f)
{
return creal(f);
}
EXTERN double
complex_double_get_imag(double complex f)
{
return cimag(f);
}
EXTERN const char *
complex_double_to_string(double complex f)
{
static char buffer[1024];
sprintf(buffer, "%g + %g * i", creal(f), cimag(f));
return buffer;
}
EXTERN double
complex_double_ptr_get_real(double complex *f)
{
return creal(*f);
}
EXTERN double
complex_double_ptr_get_imag(double complex *f)
{
return cimag(*f);
}
EXTERN void
complex_double_ptr_set(double complex *f, double r, double i)
{
*f = r + i*I;
}
EXTERN double complex
complex_double_ret(double r, double i)
{
return r + i*I;
}
EXTERN double complex *
complex_double_ptr_ret(double r, double i)
{
static double complex f;
f = r + i*I;
return &f;
}
EXTERN double complex
complex_double_array_get(double complex *f, int index)
{
return f[index];
}
EXTERN void
complex_double_array_set(double complex *f, int index, double r, double i)
{
f[index] = r + i*I;
}
EXTERN double complex *
complex_double_array_ret(void)
{
static double complex ret[3];
ret[0] = 0.0 + 0.0*I;
ret[1] = 1.0 + 2.0*I;
ret[2] = 3.0 + 4.0*I;
return ret;
}
#endif
FFI-Platypus-2.12/t/ffi/complex_float.c 000644 000000 000000 00000002307 15251066120 017646 0 ustar 00root root 000000 000000 #include "libtest.h"
#if SIZEOF_FLOAT_COMPLEX
EXTERN float
complex_float_get_real(float complex f)
{
return crealf(f);
}
EXTERN float
complex_float_get_imag(float complex f)
{
return cimagf(f);
}
EXTERN const char *
complex_float_to_string(float complex f)
{
static char buffer[1024];
sprintf(buffer, "%g + %g * i", crealf(f), cimagf(f));
return buffer;
}
EXTERN float
complex_float_ptr_get_real(float complex *f)
{
return crealf(*f);
}
EXTERN float
complex_float_ptr_get_imag(float complex *f)
{
return cimagf(*f);
}
EXTERN void
complex_float_ptr_set(float complex *f, float r, float i)
{
*f = r + i*I;
}
EXTERN float complex
complex_float_ret(float r, float i)
{
return r + i*I;
}
EXTERN float complex *
complex_float_ptr_ret(float r, float i)
{
static float complex f;
f = r + i*I;
return &f;
}
EXTERN float complex
complex_float_array_get(float complex *f, int index)
{
return f[index];
}
EXTERN void
complex_float_array_set(float complex *f, int index, float r, float i)
{
f[index] = r + i*I;
}
EXTERN float complex *
complex_float_array_ret(void)
{
static float complex ret[3];
ret[0] = 0.0 + 0.0*I;
ret[1] = 1.0 + 2.0*I;
ret[2] = 3.0 + 4.0*I;
return ret;
}
#endif
FFI-Platypus-2.12/t/ffi/double.c 000644 000000 000000 00000002156 15251066120 016266 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/float.c
* all instances of "float" have been changed to "double"
*/
#include "libtest.h"
EXTERN double
double_add(double a, double b)
{
return a + b;
}
EXTERN double*
double_inc(double *a, double b)
{
static double keeper;
keeper = *a += b;
return &keeper;
}
EXTERN double
double_sum(double list[10])
{
int i;
double total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN double
double_sum2(double *list, size_t size)
{
int i;
double total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
double_array_inc(double list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN double *
double_static_array(void)
{
static double foo[] = { -5.5, 5.5, -10, 10, -15.5, 15.5, 20, -20, 25.5, -25.5 };
return foo;
}
typedef double (*closure_t)(double);
static closure_t my_closure;
EXTERN void
double_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN double
double_call_closure(double value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/float.c 000644 000000 000000 00000001676 15251066120 016127 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN float
float_add(float a, float b)
{
return a + b;
}
EXTERN float*
float_inc(float *a, float b)
{
static float keeper;
keeper = *a += b;
return &keeper;
}
EXTERN float
float_sum(float list[10])
{
int i;
float total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN float
float_sum2(float *list, size_t size)
{
int i;
float total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
float_array_inc(float list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN float *
float_static_array(void)
{
static float foo[] = { -5.5, 5.5, -10, 10, -15.5, 15.5, 20, -20, 25.5, -25.5 };
return foo;
}
typedef float (*closure_t)(float);
static closure_t my_closure;
EXTERN void
float_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN float
float_call_closure(float value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/gh117.c 000644 000000 000000 00000000111 15251066120 015630 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN uint64_t
gh117()
{
return 0xffffffffff;
}
FFI-Platypus-2.12/t/ffi/gh174.c 000644 000000 000000 00000000166 15251066120 015645 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN void
gh174_func1 (void (*callback)())
{
printf( "Inside func..\n");
(*callback)();
}
FFI-Platypus-2.12/t/ffi/longdouble.c 000644 000000 000000 00000001571 15251066120 017146 0 ustar 00root root 000000 000000 #include "libtest.h"
#ifdef FFI_PL_PROBE_LONGDOUBLE
EXTERN long double
longdouble_add(long double a, long double b)
{
return a + b;
}
EXTERN int
longdouble_pointer_test(long double *a, long double *b)
{
if(*a + *b != 4.0L)
return 0;
*a = 4.0L;
*b = 8.0L;
return 1;
}
EXTERN long double *
longdouble_pointer_return_test(long double a)
{
static long double *keep = NULL;
if(keep == NULL)
keep = malloc(sizeof(long double));
*keep = a;
return keep;
}
EXTERN int
longdouble_array_test(long double *a, int n)
{
long double sum;
int i;
int ret;
for(sum=0.0,i=0; i < n; i++)
{
sum += a[i];
}
if(sum == 100.00)
ret = 1;
else
ret = 0;
for(i=0; i < n; i++)
a[i] = (long double) i+1;
return ret;
}
EXTERN long double *
longdouble_array_return_test()
{
static long double keep[3] = { 1.0, 2.0, 3.0 };
return keep;
}
#endif
FFI-Platypus-2.12/t/ffi/memcmp4.c 000644 000000 000000 00000000233 15251066120 016350 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN int
memcmp4(void *buf1, size_t n1, void *buf2, size_t n2)
{
if (n1 != n2)
return 1;
return memcmp(buf1, buf2, n1);
}
FFI-Platypus-2.12/t/ffi/meta.c 000644 000000 000000 00000001247 15251066120 015742 0 ustar 00root root 000000 000000 #include "libtest.h"
struct mymeta_t {
int foo;
char *bar;
};
EXTERN struct mymeta_t*
mymeta_new(int foo, const char *bar)
{
struct mymeta_t *self;
self = malloc(sizeof(struct mymeta_t));
self->foo = foo;
self->bar = malloc(strlen(bar)+1);
strcpy(self->bar, bar);
return self;
}
EXTERN void
mymeta_delete(struct mymeta_t *self)
{
free(self->bar);
free(self);
}
EXTERN const char *
mymeta_test(struct mymeta_t *self, int count, const char *baz)
{
static char buffer[1024];
sprintf(buffer,
"foo = %d, bar = %s, baz = %s, count = %d",
self->foo, self->bar != NULL ? self->bar : "undef", baz != NULL ? baz : "undef", count
);
return buffer;
}
FFI-Platypus-2.12/t/ffi/pointer.c 000644 000000 000000 00000003451 15251066120 016473 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN void *
pointer_null(void)
{
return NULL;
}
EXTERN int
pointer_is_null(void *ptr)
{
return ptr == NULL;
}
EXTERN int
pointer_pointer_is_null(void **ptr)
{
return *ptr == NULL;
}
static void *my_pointer;
EXTERN void
pointer_set_my_pointer(void *ptr)
{
my_pointer = ptr;
}
EXTERN void *
pointer_get_my_pointer(void)
{
return my_pointer;
}
EXTERN void
pointer_get_my_pointer_arg(void **ret)
{
*ret = my_pointer;
}
EXTERN int
pointer_arg_array_in(char *array[3])
{
return !strcmp(array[0], "one") && !strcmp(array[1], "two") && !strcmp(array[2], "three");
}
EXTERN int
pointer_arg_array_null_in(char *array[3])
{
return array[0] == NULL && array[1] == NULL && array[2] == NULL;
}
EXTERN void
pointer_arg_array_out(char *array[3])
{
array[0] = "four";
array[1] = "five";
array[2] = "six";
}
EXTERN void
pointer_arg_array_null_out(char *array[3])
{
array[0] = NULL;
array[1] = NULL;
array[2] = NULL;
}
EXTERN char **
pointer_ret_array_out(void)
{
static char *array[3] = { "seven", "eight", "nine" };
return array;
}
EXTERN char **
pointer_ret_array_out_null_terminated(void)
{
static char *array[4] = { "seven", "eight", "nine", NULL };
return array;
}
EXTERN char **
pointer_ret_array_null_out(void)
{
static char *array[3] = { NULL, NULL, NULL };
return array;
}
EXTERN void *
pointer_pointer_pointer_to_pointer(void **pointer_pointer)
{
return *pointer_pointer;
}
EXTERN void**
pointer_pointer_to_pointer_pointer(void *pointer)
{
static void *pointer_pointer[1];
pointer_pointer[0] = pointer;
return pointer_pointer;
}
typedef void *(*closure_t)(void*);
static closure_t my_closure;
EXTERN void
pointer_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN void*
pointer_call_closure(void *value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/record.c 000644 000000 000000 00000002472 15251066120 016273 0 ustar 00root root 000000 000000 #include <string.h>
#include "libtest.h"
typedef struct {
char name[16];
int32_t value;
} foo_record_t;
EXTERN const char *
foo_get_name(foo_record_t *self)
{
static char ret[16];
if(self == NULL)
return NULL;
/*
* TODO: we need to copy the name because the record
* could fall out of scope before we start processing
* the return values in ffi_platypus_call.h. If we
* can rework that code to delay until after the SV*
* is created for the return value then we wouldn't
* need to do this.
*/
memcpy(ret, self->name, 16);
return ret;
}
EXTERN const char *
foo_value_get_name(foo_record_t self)
{
static char name[16];
strcpy(name, self.name);
return name;
}
EXTERN int32_t
foo_get_value(foo_record_t *self)
{
if(self == NULL)
return 0;
return self->value;
}
EXTERN int32_t
foo_value_get_value(foo_record_t self)
{
return self.value;
}
EXTERN foo_record_t *
foo_create(const char *name, int32_t value)
{
static foo_record_t self;
int i;
for(i=0; i<16; i++)
self.name[i] = '\0';
strcpy(self.name, name);
self.value = value;
return &self;
}
EXTERN foo_record_t
foo_value_create(const char *name, int32_t value)
{
foo_record_t self;
int i;
for(i=0; i<16; i++)
self.name[i] = '\0';
strcpy(self.name, name);
self.value = value;
return self;
}
FFI-Platypus-2.12/t/ffi/sint16.c 000644 000000 000000 00000002144 15251066120 016135 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/sint8.c
* all instances of "int8" have been changed to "int16"
*/
#include "libtest.h"
EXTERN int16_t
sint16_add(int16_t a, int16_t b)
{
return a + b;
}
EXTERN int16_t*
sint16_inc(int16_t *a, int16_t b)
{
static int16_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN int16_t
sint16_sum(int16_t list[10])
{
int i;
int16_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN int16_t
sint16_sum2(int16_t *list, size_t size)
{
int i;
int16_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
sint16_array_inc(int16_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN int16_t *
sint16_static_array(void)
{
static int16_t foo[] = { -1,2,-3,4,-5,6,-7,8,-9,10 };
return foo;
}
typedef int16_t (*closure_t)(int16_t);
static closure_t my_closure;
EXTERN void
sint16_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN int16_t
sint16_call_closure(int16_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/sint32.c 000644 000000 000000 00000002144 15251066120 016133 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/sint8.c
* all instances of "int8" have been changed to "int32"
*/
#include "libtest.h"
EXTERN int32_t
sint32_add(int32_t a, int32_t b)
{
return a + b;
}
EXTERN int32_t*
sint32_inc(int32_t *a, int32_t b)
{
static int32_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN int32_t
sint32_sum(int32_t list[10])
{
int i;
int32_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN int32_t
sint32_sum2(int32_t *list, size_t size)
{
int i;
int32_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
sint32_array_inc(int32_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN int32_t *
sint32_static_array(void)
{
static int32_t foo[] = { -1,2,-3,4,-5,6,-7,8,-9,10 };
return foo;
}
typedef int32_t (*closure_t)(int32_t);
static closure_t my_closure;
EXTERN void
sint32_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN int32_t
sint32_call_closure(int32_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/sint64.c 000644 000000 000000 00000002144 15251066120 016140 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/sint8.c
* all instances of "int8" have been changed to "int64"
*/
#include "libtest.h"
EXTERN int64_t
sint64_add(int64_t a, int64_t b)
{
return a + b;
}
EXTERN int64_t*
sint64_inc(int64_t *a, int64_t b)
{
static int64_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN int64_t
sint64_sum(int64_t list[10])
{
int i;
int64_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN int64_t
sint64_sum2(int64_t *list, size_t size)
{
int i;
int64_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
sint64_array_inc(int64_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN int64_t *
sint64_static_array(void)
{
static int64_t foo[] = { -1,2,-3,4,-5,6,-7,8,-9,10 };
return foo;
}
typedef int64_t (*closure_t)(int64_t);
static closure_t my_closure;
EXTERN void
sint64_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN int64_t
sint64_call_closure(int64_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/sint8.c 000644 000000 000000 00000001666 15251066120 016066 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN int8_t
sint8_add(int8_t a, int8_t b)
{
return a + b;
}
EXTERN int8_t*
sint8_inc(int8_t *a, int8_t b)
{
static int8_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN int8_t
sint8_sum(int8_t list[10])
{
int i;
int8_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN int8_t
sint8_sum2(int8_t *list, size_t size)
{
int i;
int8_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
sint8_array_inc(int8_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN int8_t *
sint8_static_array(void)
{
static int8_t foo[] = { -1,2,-3,4,-5,6,-7,8,-9,10 };
return foo;
}
typedef int8_t (*closure_t)(int8_t);
static closure_t my_closure;
EXTERN void
sint8_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN int8_t
sint8_call_closure(int8_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/string.c 000644 000000 000000 00000003123 15251066120 016315 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN int
string_matches_foobarbaz(const char *value)
{
return !strcmp(value, "foobarbaz");
}
EXTERN const char *
string_return_foobarbaz(void)
{
return "foobarbaz";
}
typedef const char *my_string_t;
typedef void (*closure_t)(my_string_t);
static closure_t my_closure;
EXTERN void
string_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN void
string_call_closure(const char *value)
{
my_closure(value);
}
EXTERN const char *
string_pointer_pointer_get(const char **ptr)
{
return *ptr;
}
EXTERN void
string_pointer_pointer_set(const char **ptr, const char *value)
{
*ptr = value;
}
EXTERN char **
string_pointer_pointer_return(char *value)
{
static char buffer[512];
static char *tmp;
if(value != NULL)
{
strcpy(buffer, value);
tmp = buffer;
}
else
{
tmp = value;
}
return &tmp;
}
EXTERN const char *
string_fixed_test(int i)
{
static char buffer[] = "zero one two threefour ";
return &buffer[i*5];
}
EXTERN const char *
string_test_pointer_arg(char **arg)
{
static char buffer[512];
if(arg == NULL)
return "arg==NULL";
if(*arg == NULL)
sprintf(buffer, "*arg==NULL");
else
sprintf(buffer, "*arg==%s", *arg);
*arg = "out";
return buffer;
}
EXTERN char **
string_test_pointer_ret(char *arg)
{
static char buffer[512];
static char *null = NULL;
if(arg == NULL)
return &null;
else
sprintf(buffer, "%s", arg);
return (char**) &buffer;
}
EXTERN void
string_write_to_string(char *dst, char *src)
{
int i=0;
while(src[i] != '\0')
{
dst[i]=src[i];
i++;
}
dst[i]=0;
}
FFI-Platypus-2.12/t/ffi/string_array.c 000644 000000 000000 00000001554 15251066120 017521 0 ustar 00root root 000000 000000 #include "libtest.h"
#include <string.h>
EXTERN const char *
get_string_from_array(const char **array, int index)
{
static char buffer[512];
if(array[index] == NULL)
return NULL;
strcpy(buffer, array[index]);
return buffer;
}
EXTERN const char **
onetwothree3()
{
static char *buffer[4] = {
"one",
"two",
"three"
};
return (const char **) buffer;
}
EXTERN const char **
onetwothree4()
{
static char *buffer[4] = {
"one",
"two",
"three",
NULL
};
return (const char **) buffer;
}
EXTERN const char **
onenullthree3()
{
static char *buffer[3] = {
"one",
NULL,
"three"
};
return (const char **) buffer;
}
EXTERN const char **
ptrnull()
{
static char *buffer[1] = {
NULL
};
return (const char **) buffer;
}
EXTERN void
string_array_arg_update(char **arg)
{
arg[0] = "one";
arg[1] = "two";
}
FFI-Platypus-2.12/t/ffi/uint16.c 000644 000000 000000 00000002170 15251066120 016136 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/uint8.c
* all instances of "int8" have been changed to "int16"
*/
#include "libtest.h"
EXTERN uint16_t
uint16_add(uint16_t a, uint16_t b)
{
return a + b;
}
EXTERN uint16_t*
uint16_inc(uint16_t *a, uint16_t b)
{
static uint16_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN uint16_t
uint16_sum(uint16_t list[10])
{
int i;
uint16_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN uint16_t
uint16_sum2(uint16_t *list, size_t size)
{
int i;
uint16_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
uint16_array_inc(uint16_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN uint16_t *
uint16_static_array(void)
{
static uint16_t foo[] = { 1,4,6,8,10,12,14,16,18,20 };
return foo;
}
typedef uint16_t (*closure_t)(uint16_t);
static closure_t my_closure;
EXTERN void
uint16_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN uint16_t
uint16_call_closure(uint16_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/uint32.c 000644 000000 000000 00000002170 15251066120 016134 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/uint8.c
* all instances of "int8" have been changed to "int32"
*/
#include "libtest.h"
EXTERN uint32_t
uint32_add(uint32_t a, uint32_t b)
{
return a + b;
}
EXTERN uint32_t*
uint32_inc(uint32_t *a, uint32_t b)
{
static uint32_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN uint32_t
uint32_sum(uint32_t list[10])
{
int i;
uint32_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN uint32_t
uint32_sum2(uint32_t *list, size_t size)
{
int i;
uint32_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
uint32_array_inc(uint32_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN uint32_t *
uint32_static_array(void)
{
static uint32_t foo[] = { 1,4,6,8,10,12,14,16,18,20 };
return foo;
}
typedef uint32_t (*closure_t)(uint32_t);
static closure_t my_closure;
EXTERN void
uint32_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN uint32_t
uint32_call_closure(uint32_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/uint64.c 000644 000000 000000 00000002170 15251066120 016141 0 ustar 00root root 000000 000000 /*
* DO NOT MODIFY THIS FILE.
* This file generated from similar file t/ffi/uint8.c
* all instances of "int8" have been changed to "int64"
*/
#include "libtest.h"
EXTERN uint64_t
uint64_add(uint64_t a, uint64_t b)
{
return a + b;
}
EXTERN uint64_t*
uint64_inc(uint64_t *a, uint64_t b)
{
static uint64_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN uint64_t
uint64_sum(uint64_t list[10])
{
int i;
uint64_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN uint64_t
uint64_sum2(uint64_t *list, size_t size)
{
int i;
uint64_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
uint64_array_inc(uint64_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN uint64_t *
uint64_static_array(void)
{
static uint64_t foo[] = { 1,4,6,8,10,12,14,16,18,20 };
return foo;
}
typedef uint64_t (*closure_t)(uint64_t);
static closure_t my_closure;
EXTERN void
uint64_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN uint64_t
uint64_call_closure(uint64_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/uint8.c 000644 000000 000000 00000001712 15251066120 016060 0 ustar 00root root 000000 000000 #include "libtest.h"
EXTERN uint8_t
uint8_add(uint8_t a, uint8_t b)
{
return a + b;
}
EXTERN uint8_t*
uint8_inc(uint8_t *a, uint8_t b)
{
static uint8_t keeper;
keeper = *a += b;
return &keeper;
}
EXTERN uint8_t
uint8_sum(uint8_t list[10])
{
int i;
uint8_t total;
for(i=0,total=0; i<10; i++)
{
total += list[i];
}
return total;
}
EXTERN uint8_t
uint8_sum2(uint8_t *list, size_t size)
{
int i;
uint8_t total;
for(i=0,total=0; i<size; i++)
{
total += list[i];
}
return total;
}
EXTERN void
uint8_array_inc(uint8_t list[10])
{
int i;
for(i=0; i<10; i++)
{
list[i]++;
}
}
EXTERN uint8_t *
uint8_static_array(void)
{
static uint8_t foo[] = { 1,4,6,8,10,12,14,16,18,20 };
return foo;
}
typedef uint8_t (*closure_t)(uint8_t);
static closure_t my_closure;
EXTERN void
uint8_set_closure(closure_t closure)
{
my_closure = closure;
}
EXTERN uint8_t
uint8_call_closure(uint8_t value)
{
return my_closure(value);
}
FFI-Platypus-2.12/t/ffi/variadic.c 000644 000000 000000 00000002125 15251066120 016572 0 ustar 00root root 000000 000000 #include <ffi_platypus.h>
#ifdef FFI_PL_PROBE_VARIADIC
#include <stdio.h>
#include <stdarg.h>
#include "libtest.h"
EXTERN int
variadic_return_arg(int which, ...)
{
va_list ap;
int i, val;
va_start(ap, which);
for(i=0; i<which; i++)
{
val = va_arg(ap, int);
}
va_end(ap);
return val;
}
EXTERN const char *
xprintf(const char *fmt, ...)
{
va_list ap;
static char buffer[2046];
char *bp=buffer;
va_start(ap, fmt);
while(*fmt != '\0')
{
switch(*fmt)
{
case '%':
{
char buffer2[64];
const char *str=buffer2;
switch(*(++fmt))
{
case 'd':
sprintf(buffer2, "%d", va_arg(ap, int));
break;
case 's':
str = va_arg(ap, char *);
break;
default:
str = "[fmt error]";
break;
}
strcpy(bp, str);
bp += strlen(str);
}
break;
default:
*(bp++) = *fmt;
break;
}
fmt++;
}
va_end(ap);
*bp = '\0';
return buffer;
}
#endif
FFI-Platypus-2.12/t/ffi_build.t 000644 000000 000000 00000012015 15251066120 016207 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use lib 't/lib';
use Test::Cleanup;
use Test::Platypus;
use FFI::Build;
use FFI::Build::Platform;
use FFI::Temp;
use Capture::Tiny qw( capture_merged );
use File::Spec;
use File::Path qw( rmtree );
use File::Glob qw( bsd_glob );
subtest 'basic' => sub {
my $build = FFI::Build->new('foo');
isa_ok $build, 'FFI::Build';
like $build->file->path, qr/foo/, 'foo is somewhere in the native name for the lib';
note "lib.file.path = @{[ $build->file->path ]}";
ok(-d $build->file->dirname, "dir is a dir" );
isa_ok $build->platform, 'FFI::Build::Platform';
$build->source('corpus/ffi_build/source/*.c');
my($cfile) = $build->source;
isa_ok $cfile, 'FFI::Build::File::C';
};
subtest 'file classes' => sub {
{
package FFI::Build::File::Foo1;
use parent qw( FFI::Build::File::Base );
$INC{'FFI/Build/File/Foo1.pm'} = __FILE__;
}
{
package FFI::Build::File::Foo2;
use parent qw( FFI::Build::File::Base );
}
my @list = FFI::Build::_file_classes();
ok( @list > 0, "at least one" );
note "class = $_" for @list;
};
subtest 'build' => sub {
foreach my $type (qw( name object array ))
{
subtest $type => sub {
my $tempdir = FFI::Temp->newdir;
my $build = FFI::Build->new('foo',
dir => $tempdir,
buildname => "tmpbuild.tmpbuild.$$.@{[ time ]}",
verbose => 2,
);
my @source;
if($type eq 'name')
{
@source = 'corpus/ffi_build/project1/*.c';
}
elsif($type eq 'object')
{
@source = map { FFI::Build::File::C->new($_) } bsd_glob('corpus/ffi_build/project1/*.c');
}
elsif($type eq 'array')
{
@source = map { [ C => $_ ] } bsd_glob('corpus/ffi_build/project1/*.c');
}
$build->source(@source);
note "$_" for $build->source;
my($out, $dll, $error) = capture_merged {
my $dll = eval { $build->build };
($dll, $@);
};
ok $error eq '', 'no error';
if($error)
{
diag $out;
return;
}
else
{
note $out;
}
platypus 2 => sub {
my $ffi = shift;
$ffi->lib($dll);
is(
$ffi->function(foo1 => [] => 'int')->call,
42,
);
is(
$ffi->function(foo2 => [] => 'string')->call,
"42",
);
};
$build->clean;
cleanup(
$build->file->dirname,
File::Spec->catdir(qw( corpus ffi_build project1 ), $build->buildname)
);
};
}
};
subtest 'build c++' => sub {
skip_all 'Test requires C++ compiler'
unless eval { FFI::Build::Platform->which(FFI::Build::Platform->cxx) };
my $tempdir = FFI::Temp->newdir( TEMPLATE => "tmpbuild.XXXXXX" );
my $build = FFI::Build->new('foo',
dir => $tempdir,
buildname => "tmpbuild.$$.@{[ time ]}",,
verbose => 2,
);
$build->source('corpus/ffi_build/project-cxx/*.cxx');
$build->source('corpus/ffi_build/project-cxx/*.cpp');
note "$_" for $build->source;
my($out, $dll, $error) = capture_merged {
my $dll = eval { $build->build };
($dll, $@);
};
ok $error eq '', 'no error';
if($error)
{
diag $out;
return;
}
else
{
note $out;
}
platypus 2 => sub {
my $ffi = shift;
$ffi->lib($dll);
my $foo1 = eval { $ffi->function( foo1 => [] => 'int' ) };
my $foo2 = eval { $ffi->function( foo2 => [] => 'string' ) };
ok defined $foo1, "foo1 found";
ok defined $foo2, "foo2 found";
SKIP: {
if(defined $foo1 && defined $foo2)
{
is(
$ffi->function(foo1 => [] => 'int')->call,
42,
);
is(
$ffi->function(foo2 => [] => 'string')->call,
"42",
);
}
else
{
diag "[build log follows]\n";
diag $out;
skip "foo1 or foo2 not found", 2 unless defined $foo1 && defined $foo2;
}
}
};
$build->clean;
cleanup(
$build->file->dirname,
File::Spec->catdir(qw( corpus ffi_build project-cxx ), $build->buildname)
);
};
subtest 'alien' => sub {
skip_all 'Test requires Acme::Alien::DontPanic 1.03'
unless eval { require Acme::Alien::DontPanic; Acme::Alien::DontPanic->VERSION("1.03") };
my $tempdir = FFI::Temp->newdir( TEMPLATE => "tmpbuild.XXXXXX" );
my $build = FFI::Build->new('bar',
dir => $tempdir,
buildname => "tmpbuild.$$.@{[ time ]}",
verbose => 2,
alien => ['Acme::Alien::DontPanic'],
);
$build->source('corpus/ffi_build/project2/*.c');
note "$_" for $build->source;
my($out, $dll, $error) = capture_merged {
my $dll = eval { $build->build };
($dll, $@);
};
ok $error eq '', 'no error';
if($error)
{
diag $out;
return;
}
else
{
note $out;
}
platypus 1 => sub {
my $ffi = shift;
$ffi->lib($dll);
is(
$ffi->function(myanswer => [] => 'int')->call,
42,
);
};
cleanup(
$build->file->dirname,
File::Spec->catdir(qw( corpus ffi_build project2 ), $build->buildname)
);
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_file_base.t 000644 000000 000000 00000004703 15251066120 020205 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Build::File::Base;
{
package
FFI::Build::File::Foo;
use parent qw( FFI::Build::File::Base );
use constant default_suffix => '.foo';
use constant default_encoding => ':utf8';
}
subtest 'basic' => sub {
subtest 'basic usage' => sub {
eval { FFI::Build::File::Foo->new };
my $error = $@;
like $error, qr/content is required/;
note "error = $error";
};
subtest 'array filename' => sub {
my $file = FFI::Build::File::Foo->new(['corpus', 'ffi_build_file_base', 'basic.foo']);
isa_ok $file, 'FFI::Build::File::Base';
isa_ok $file, 'FFI::Build::File::Foo';
is("$file", $file->path, "stringifies to path");
is($file->slurp, "This is a basic foo.\n");
ok(!$file->is_temp, "is_temp");
is($file->basename, 'basic.foo', 'basename');
ok(-d $file->dirname, 'dirname');
note "dirname = @{[ $file->dirname ]}";
unlike $file->path, qr/\\/, "No forward slashes!";
if($^O eq 'MSWin32')
{
is($file->native, "corpus\\ffi_build_file_base\\basic.foo", "native name");
}
else
{
is($file->native, $file->path, "native name");
}
note "native = @{[ $file->native ]}";
};
subtest 'string filename' => sub {
my $file = FFI::Build::File::Foo->new("corpus/ffi_build_file_base/basic.foo");
isa_ok $file, 'FFI::Build::File::Base';
isa_ok $file, 'FFI::Build::File::Foo';
is($file->slurp, "This is a basic foo.\n");
ok(!$file->is_temp, "is_temp");
unlike $file->path, qr/\\/, "No forward slashes!";
};
subtest 'string ref' => sub {
my $file = FFI::Build::File::Foo->new(\"Something different!\n");
isa_ok $file, 'FFI::Build::File::Base';
isa_ok $file, 'FFI::Build::File::Foo';
like($file->basename, qr/\.foo$/, 'has the correct extension');
ok($file->is_temp, "is_temp");
is($file->slurp, "Something different!\n");
note "path: @{[ $file->path ]}";
unlike $file->path, qr/\\/, "No forward slashes!";
my $path = $file->path;
ok(-f $path, "file exists");
undef $file;
ok(!-f $path, "file is removed after destroy");
};
subtest 'string ref keep' => sub {
my $file = FFI::Build::File::Foo->new(\"Again\n");
$file->keep;
my $path = $file->path;
is($file->slurp, "Again\n");
ok(-f $path, "file exists");
unlike $file->path, qr/\\/, "No forward slashes!";
undef $file;
ok(-f $path, "file exists after undef");
unlink $path;
};
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_file_c.t 000644 000000 000000 00000002156 15251066120 017515 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use lib 't/lib';
use Test::Cleanup;
use FFI::Build::File::C;
use FFI::Build;
use Capture::Tiny qw( capture_merged );
subtest 'basic' => sub {
my $file = FFI::Build::File::C->new(['corpus','ffi_build_file_c','basic.c']);
isa_ok $file, 'FFI::Build::File::C';
isa_ok $file, 'FFI::Build::File::Base';
is($file->default_suffix, '.c');
is($file->default_encoding, ':utf8');
};
subtest 'compile' => sub {
my $file = FFI::Build::File::C->new([qw( corpus ffi_build_file_c foo1.c )]);
my $object = $file->build_item;
isa_ok $object, 'FFI::Build::File::Object';
is
[ $object->build_item ],
[];
cleanup 'corpus/ffi_build_file_c/_build';
};
subtest 'headers' => sub {
my $build = FFI::Build->new('foo',
verbose => 2,
cflags => "-Icorpus/ffi_build_file_c/include",
);
note "cflags=$_" for @{ $build->cflags };
my $file = FFI::Build::File::C->new([qw( corpus ffi_build_file_c foo2.c )], build => $build );
my @deps = eval { $file->_deps };
is $@, '', 'no die';
foreach my $dep (@deps)
{
ok -f "$dep", "dep is a file: $dep";
}
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_file_cxx.t 000644 000000 000000 00000002471 15251066120 020075 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use lib 't/lib';
use Test::Cleanup;
use FFI::Build::File::CXX;
use FFI::Build;
use FFI::Build::Platform;
use Capture::Tiny qw( capture_merged );
skip_all 'Test requires C++ compiler'
unless eval { FFI::Build::Platform->which(FFI::Build::Platform->cxx) };
subtest 'basic' => sub {
my $file = FFI::Build::File::CXX->new(['corpus','ffi_build_file_cxx','basic.cxx']);
isa_ok $file, 'FFI::Build::File::CXX';
isa_ok $file, 'FFI::Build::File::C';
isa_ok $file, 'FFI::Build::File::Base';
is($file->default_suffix, '.cxx');
is($file->default_encoding, ':utf8');
};
subtest 'compile' => sub {
my $file = FFI::Build::File::CXX->new([qw( corpus ffi_build_file_cxx foo1.cxx )]);
my $object = $file->build_item;
isa_ok $object, 'FFI::Build::File::Object';
is
[ $object->build_item ],
[];
cleanup 'corpus/ffi_build_file_cxx/_build';
};
subtest 'headers' => sub {
my $build = FFI::Build->new('foo',
verbose => 2,
cflags => "-Icorpus/ffi_build_file_cxx/include",
);
note "cflags=$_" for @{ $build->cflags };
my $file = FFI::Build::File::C->new([qw( corpus ffi_build_file_cxx foo2.cpp )], build => $build );
my @deps = eval { $file->_deps };
is $@, '', 'no die';
foreach my $dep (@deps)
{
ok -f "$dep", "dep is afile: $dep";
}
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_file_library.t 000644 000000 000000 00000000537 15251066120 020740 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Build::File::Library;
use Config ();
my $dll = FFI::Build::Platform->library_suffix;
subtest 'basic' => sub {
my $file = FFI::Build::File::Library->new(['corpus',"basic$dll"]);
is($file->default_suffix, $dll);
is($file->default_encoding, ':raw');
note "path = @{[ $file->path ]}";
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_file_object.t 000644 000000 000000 00000000507 15251066120 020537 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Build::File::Object;
my $o = FFI::Build::Platform->object_suffix;
subtest 'basic' => sub {
my $file = FFI::Build::File::Object->new(['corpus',"basic$o"]);
is($file->default_suffix, $o);
is($file->default_encoding, ':raw');
note "path = @{[ $file->path ]}";
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_mm.t 000644 000000 000000 00000006762 15251066120 016714 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use 5.008004;
use FFI::Build::MM;
use Capture::Tiny qw( capture_merged );
use File::Glob qw( bsd_glob );
use lib 't/lib';
use Test::Platypus;
sub dont_save_prop (&)
{
my($code) = @_;
sub {
my $save = \&FFI::Build::MM::save_prop;
{
no warnings 'redefine';
*FFI::Build::MM::save_prop = sub {};
};
my $ret = eval { $code->() };
my $error = $@;
{
no warnings 'redefine';
*FFI::Build::MM::save_prop = $save;
}
die $error if $error;
$ret;
};
}
sub slurp ($)
{
my $fn = shift;
open my $fh, '<', $fn;
my $content = do { local $/; <$fh> };
close $fh;
$content;
}
subtest 'basic' => dont_save_prop {
my $mm = FFI::Build::MM->new;
isa_ok $mm, 'FFI::Build::MM';
$mm->mm_args( DISTNAME => 'Foo-Bar-Baz' );
is( $mm->distname, 'Foo-Bar-Baz' );
is( $mm->sharedir, 'blib/lib/auto/share/dist/Foo-Bar-Baz' );
is( $mm->archdir, 'blib/arch/auto/Foo/Bar/Baz' );
subtest 'build with fbx file' => sub {
my $build = $mm->load_build('corpus/ffi_build_mm/lb1', undef, undef);
isa_ok $build, 'FFI::Build';
is [sort map { $_->basename } $build->source], ['hello1.c','hello2.c']
};
subtest 'build with fbx file with errors' => sub {
eval { $mm->load_build('corpus/ffi_build_mm/lb1bad', undef, undef) };
like ( $@, qr/skootch/, "caught compile error in fbx file" );
};
subtest 'build with default' => sub {
my $build = $mm->load_build('corpus/ffi_build_mm/lb2', undef, undef);
isa_ok $build, 'FFI::Build';
is [sort map { $_->basename } $build->source], ['hello1.c','hello2.c']
};
my $postamble = $mm->mm_postamble;
ok $postamble;
note "[postamble]\n$postamble\n";
$mm->sharedir('share');
is( $mm->sharedir, 'share' );
$mm->archdir(0);
ok( !$mm->archdir );
};
subtest 'with a build!' => sub {
chdir 'corpus/ffi_build_mm/project1';
unlink 'fbx.json' if -f 'fbx.json';
subtest 'namespace is clean' => sub {
ok( ! main->can($_), "$_ not imported yet" ) for qw( fbx_build fbx_test fbx_clean );
};
subtest 'do not save on request' => sub {
my $mm = FFI::Build::MM->new( save => 0 );
$mm->mm_args( DISTNAME => 'Crock-O-Stimpy' );
ok !-f 'fbx.json';
};
subtest 'perl Makefile.PL' => sub {
my $mm = FFI::Build::MM->new;
$mm->mm_args( DISTNAME => 'Crock-O-Stimpy' );
ok -f 'fbx.json';
};
subtest 'import' => sub {
FFI::Build::MM->import('cmd');
ok( main->can($_), "$_ not imported yet" ) for qw( fbx_build fbx_test fbx_clean );
};
subtest 'make' => sub {
my($out, $err) = capture_merged {
eval { fbx_build() };
$@;
};
note $out;
is $err, '';
is slurp 'blib/arch/auto/Crock/O/Stimpy/Stimpy.txt', "FFI::Build\@auto/share/dist/Crock-O-Stimpy/lib/@{[ FFI::Build::Platform->library_prefix ]}Crock-O-Stimpy@{[ scalar FFI::Build::Platform->library_suffix]}\n";
platypus 1 => sub {
my $ffi = shift;
$ffi->lib(grep !/\.pdb$/, bsd_glob 'blib/lib/auto/share/dist/Crock-O-Stimpy/lib/*');
note "lib=$_" for $ffi->lib;
is(
$ffi->function('frooble_runtime' => [] => 'int')->call,
47,
);
};
};
subtest 'make test' => sub {
my($out, $err) = capture_merged {
eval { fbx_test() };
$@;
};
note $out;
is $err, '';
};
subtest 'make clean' => sub {
fbx_clean();
ok !-f 'fbx.json';
};
File::Path::rmtree('blib', 0, oct(755));
chdir(File::Spec->updir) for 1..3;
};
subtest 'alien' => sub {
skip_all 'todo';
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_platform.t 000644 000000 000000 00000000757 15251066120 020125 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Build::Platform;
use Capture::Tiny qw( capture_merged );
subtest basic => sub {
my $platform = FFI::Build::Platform->new;
isa_ok $platform, 'FFI::Build::Platform';
note($platform->diag);
};
subtest 'cc mm works' => sub {
my $platform = FFI::Build::Platform->new;
my($out, $cc_mm_works) = capture_merged {
$platform->cc_mm_works(1);
};
note $out;
ok(defined $cc_mm_works);
note "cc_mm_works = $cc_mm_works";
};
done_testing;
FFI-Platypus-2.12/t/ffi_build_plugin.t 000644 000000 000000 00000002051 15251066120 017564 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Build::Plugin;
use File::Spec::Functions qw( catdir rel2abs );
{
note "\@INC[]=$_" for @INC;
is(
FFI::Build::Plugin->new,
object {
call [isa => 'FFI::Build::Plugin'] => T();
},
'works with local config',
);
}
{
local @INC = @INC;
push @INC, rel2abs(catdir(qw( corpus ffi_build_plugin lib2 )));
note "\@INC[]=$_" for @INC;
is(
FFI::Build::Plugin->new,
object {
call [isa => 'FFI::Build::Plugin'] => T();
},
'works with local + empty dir',
);
}
{
local @INC = rel2abs(catdir(qw( corpus ffi_build_plugin lib2 )));
note "\@INC[]=$_" for @INC;
is(
FFI::Build::Plugin->new,
object {
call [isa => 'FFI::Build::Plugin'] => T();
call [call => 'bar', 'one', 'two','three'] => T();
field Foo1 => object {
call [isa => 'FFI::Build::Plugin::Foo1'] => T();
field bar => [qw( one two three )];
};
field Foo2 => object {
call [isa => 'FFI::Build::Plugin::Foo2'] => T();
};
},
);
}
done_testing;
FFI-Platypus-2.12/t/ffi_build_plugindata.t 000644 000000 000000 00000001350 15251066120 020417 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
{ package Foo;
use FFI::Build::PluginData 'plugin_data';
sub new { bless {}, __PACKAGE__ }
}
{ package FFI::Build::Plugin::Bar;
sub new { bless {}, __PACKAGE__ }
sub call_plugin_data
{
my($self, $foo) = @_;
$foo->plugin_data;
}
}
my $foo = Foo->new;
is(
dies { $foo->plugin_data },
match qr/^plugin_data must be called by a plugin/,
);
is(
FFI::Build::Plugin::Bar->new,
object {
call [call_plugin_data => $foo] => {};
call sub {
my $plugin = shift;
$plugin->call_plugin_data($foo)->{baz} = 1;
1;
} => 1;
call [call_plugin_data => $foo] => { baz => 1 };
},
);
is(
$foo,
{ plugin_data => { Bar => { baz => 1 } } },
);
done_testing;
1;
FFI-Platypus-2.12/t/ffi_platypus.t 000644 000000 000000 00000066633 15251066120 017010 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
use Data::Dumper;
use File::Spec;
use FFI::Platypus::TypeParser;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
sub xdump ($)
{
my($object) = @_;
note(Data::Dumper->new([$object])->Indent(0)->Terse(1)->Sortkeys(1)->Dump);
}
subtest 'constructor' => sub {
subtest 'basic' => sub {
my $ffi = eval { FFI::Platypus->new };
diag $@ if $@;
isa_ok $ffi, 'FFI::Platypus';
};
subtest 'no arguments' => sub {
my $ffi = FFI::Platypus->new;
isa_ok $ffi, 'FFI::Platypus';
is [$ffi->lib], [], 'ffi.lib';
};
subtest 'with single lib' => sub {
my $ffi = FFI::Platypus->new( lib => "libfoo.so" );
isa_ok $ffi, 'FFI::Platypus';
is [$ffi->lib], ['libfoo.so'], 'ffi.lib';
};
subtest 'with multiple lib' => sub {
my $ffi = FFI::Platypus->new( lib => ["libfoo.so", "libbar.so", "libbaz.so" ] );
isa_ok $ffi, 'FFI::Platypus';
is [$ffi->lib], ['libfoo.so', 'libbar.so', 'libbaz.so'], 'ffi.lib';
};
};
subtest 'abi' => sub {
my $ffi = FFI::Platypus->new;
my %abis = %{ $ffi->abis };
ok defined $abis{default_abi}, 'has a default ABI';
foreach my $abi (keys %abis)
{
subtest $abi => sub {
eval { $ffi->abi($abi) };
is $@, '', 'string';
is $ffi->{tp}->abi, $abis{$abi}, 'type parser';
eval { $ffi->abi($abis{$abi}) };
is $@, '', 'integer';
is $ffi->{tp}->abi, $abis{$abi}, 'type parser';
};
}
subtest 'bogus' => sub {
eval { $ffi->abi('bogus') };
like $@, qr{no such ABI: bogus}, 'string';
eval { $ffi->abi(999999) };
like $@, qr{no such ABI: 999999}, 'integer';
};
};
subtest 'alignof' => sub {
my $ffi = FFI::Platypus->new;
my $pointer_align = $ffi->alignof('opaque');
subtest 'ffi types' => sub {
foreach my $type (qw( sint8 uint8 sint16 uint16 sint32 uint32 sint64 uint64 float double opaque string ))
{
my $align = $ffi->alignof($type);
like $align, qr{^[0-9]$}, "alignof $type = $align";
is(FFI::Platypus->alignof($type), $align);
next if $type eq 'string';
my $align2 = $ffi->alignof("$type [2]");
is $align2, $align, "alignof $type [2] = $align";
my $align3 = $ffi->alignof("$type *");
is $align3, $pointer_align, "alignof $type * = $pointer_align";
$ffi->custom_type("custom_$type" => {
native_type => $type,
native_to_perl => sub {},
});
my $align4 = $ffi->alignof("custom_$type");
is $align4, $align, "alignof custom_$type = $align";
}
};
subtest 'aliases' => sub {
$ffi->type('ushort' => 'foo');
my $align = $ffi->alignof('ushort');
like $align, qr{^[0-9]$}, "alignof ushort = $align";
my $align2 = $ffi->alignof('foo');
is $align2, $align, "alignof foo = $align";
};
subtest 'closure' => sub {
$ffi->type('(int)->int' => 'closure_t');
my $align = $ffi->alignof('closure_t');
is $align, $pointer_align, "sizeof closure_t = $pointer_align";
};
subtest 'record' => sub {
my $align = $ffi->alignof('record(22)');
is $align, 1;
xdump($ffi->type_meta('record(22)'));
};
};
subtest 'custom type' => sub {
my $ffi = FFI::Platypus->new;
my @basic_types = (qw( float double opaque ), map { ("uint$_", "sint$_") } (8,16,32,64));
foreach my $basic (@basic_types)
{
subtest $basic => sub {
eval { $ffi->custom_type("foo_${basic}_1", { native_type => $basic, perl_to_native => sub {} }) };
is $@, '', 'ffi.custom_type 1';
xdump({ "${basic}_1" => $ffi->type_meta("foo_${basic}_1") });
eval { $ffi->custom_type("bar_${basic}_1", { native_type => $basic, native_to_perl => sub {} }) };
is $@, '', 'ffi.custom_type 1';
xdump({ "${basic}_1" => $ffi->type_meta("bar_${basic}_1") });
eval { $ffi->custom_type("baz_${basic}_1", { native_type => $basic, perl_to_native => sub {}, native_to_perl => sub {} }) };
is $@, '', 'ffi.custom_type 1';
xdump({ "${basic}_1" => $ffi->type_meta("baz_${basic}_1") });
eval { $ffi->custom_type("foo_${basic}_2", { native_type => $basic, perl_to_native => sub {}, perl_to_native_post => sub { } }) };
is $@, '', 'ffi.custom_type 1';
xdump({ "${basic}_1" => $ffi->type_meta("foo_${basic}_2") });
eval { $ffi->custom_type("bar_${basic}_2", { native_type => $basic, native_to_perl => sub {}, perl_to_native_post => sub { } }) };
is $@, '', 'ffi.custom_type 1';
xdump({ "${basic}_1" => $ffi->type_meta("bar_${basic}_2") });
eval { $ffi->custom_type("baz_${basic}_2", { native_type => $basic, perl_to_native => sub {}, native_to_perl => sub {}, perl_to_native_post => sub { } }) };
is $@, '', 'ffi.custom_type 1';
xdump({ "${basic}_1" => $ffi->type_meta("baz_${basic}_2") });
};
}
};
subtest 'find lib' => sub {
subtest 'find_lib' =>sub {
my $ffi = FFI::Platypus->new;
$ffi->find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi');
my $address = $ffi->find_symbol('f0');
ok $address, "found f0 = $address";
};
subtest external => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
my $good = $ffi->find_symbol('f0');
ok $good, "ffi.find_symbol(f0) = $good";
my $bad = $ffi->find_symbol('bogus');
is $bad, undef, 'ffi.find_symbol(bogus) = undef';
};
subtest internal => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $good = $ffi->find_symbol('printf');
ok $good, "ffi.find_symbol(printf) = $good";
my $bad = $ffi->find_symbol('bogus');
is $bad, undef, 'ffi.find_symbol(bogus) = undef';
};
};
subtest 'find symbol' => sub {
subtest external => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
my $good = $ffi->find_symbol('f0');
ok $good, "ffi.find_symbol(f0) = $good";
my $bad = $ffi->find_symbol('bogus');
is $bad, undef, 'ffi.find_symbol(bogus) = undef';
};
subtest internal => sub {
my $ffi = FFI::Platypus->new( lib => [undef] );
my $good = $ffi->find_symbol('printf');
ok $good, "ffi.find_symbol(printf) = $good";
my $bad = $ffi->find_symbol('bogus');
is $bad, undef, 'ffi.find_symbol(bogus) = undef';
};
};
subtest 'lib' => sub {
subtest 'basic' => sub {
my $ffi = FFI::Platypus->new;
my($lib) = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
ok -e $lib, "exists $lib";
eval { $ffi->lib($lib) };
is $@, '', 'ffi.lib (set)';
is [eval { $ffi->lib }], [$lib], 'ffi.lib (get)';
};
subtest 'undef' => sub {
subtest 'baseline' => sub {
my $ffi = FFI::Platypus->new;
is([$ffi->lib], []);
};
subtest 'lib => [undef]' => sub {
my $ffi = FFI::Platypus->new(lib => [undef]);
is([$ffi->lib], [undef]);
};
subtest 'lib => undef' => sub {
my $ffi = FFI::Platypus->new(lib => undef);
is([$ffi->lib], [undef]);
};
};
subtest 'coderef' => sub {
my $ffi = FFI::Platypus->new;
my($lib) = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
ok -e $lib, "exists $lib";
eval { $ffi->lib(sub{ $lib }) };
is $@, '', 'ffi.lib (set)';
is [eval { $ffi->lib }], [$lib], 'ffi.lib (get)';
};
};
subtest 'sizeof' => sub {
my $ffi = FFI::Platypus->new;
subtest integers => sub {
is $ffi->sizeof('uint8'), 1, 'sizeof uint8 = 1';
is $ffi->sizeof('uint16'), 2, 'sizeof uint16 = 2';
is $ffi->sizeof('uint32'), 4, 'sizeof uint32 = 4';
is $ffi->sizeof('uint64'), 8, 'sizeof uint64 = 8';
is $ffi->sizeof('sint8'), 1, 'sizeof sint8 = 1';
is $ffi->sizeof('sint16'), 2, 'sizeof sint16 = 2';
is $ffi->sizeof('sint32'), 4, 'sizeof sint32 = 4';
is $ffi->sizeof('sint64'), 8, 'sizeof sint64 = 8';
};
subtest 'class methods' => sub {
my $class = 'FFI::Platypus';
is $class->sizeof('uint8'), 1, 'sizeof uint8 = 1';
is $class->sizeof('uint16'), 2, 'sizeof uint16 = 2';
is $class->sizeof('uint32'), 4, 'sizeof uint32 = 4';
is $class->sizeof('uint64'), 8, 'sizeof uint64 = 8';
is $class->sizeof('sint8'), 1, 'sizeof sint8 = 1';
is $class->sizeof('sint16'), 2, 'sizeof sint16 = 2';
is $class->sizeof('sint32'), 4, 'sizeof sint32 = 4';
is $class->sizeof('sint64'), 8, 'sizeof sint64 = 8';
};
subtest floats => sub {
is $ffi->sizeof('float'), 4, 'sizeof float = 4';
is $ffi->sizeof('double'), 8, 'sizeof double = 8';
};
subtest pointers => sub {
my $pointer_size = $ffi->sizeof('opaque');
ok $pointer_size == 4 || $pointer_size == 8, "sizeof opaque = $pointer_size";
is $ffi->sizeof('uint8*'), $pointer_size, "sizeof uint8* = $pointer_size";
is $ffi->sizeof('uint16*'), $pointer_size, "sizeof uint16* = $pointer_size";
is $ffi->sizeof('uint32*'), $pointer_size, "sizeof uint32* = $pointer_size";
is $ffi->sizeof('uint64*'), $pointer_size, "sizeof uint64* = $pointer_size";
is $ffi->sizeof('sint8*'), $pointer_size, "sizeof sint8* = $pointer_size";
is $ffi->sizeof('sint16*'), $pointer_size, "sizeof sint16* = $pointer_size";
is $ffi->sizeof('sint32*'), $pointer_size, "sizeof sint32* = $pointer_size";
is $ffi->sizeof('sint64*'), $pointer_size, "sizeof sint64* = $pointer_size";
is $ffi->sizeof('float*'), $pointer_size, "sizeof float* = $pointer_size";
is $ffi->sizeof('double*'), $pointer_size, "sizeof double* = $pointer_size";
is $ffi->sizeof('opaque*'), $pointer_size, "sizeof opaque* = $pointer_size";
is $ffi->sizeof('string'), $pointer_size, "sizeof string = $pointer_size";
is $ffi->sizeof('(int)->int'), $pointer_size, "sizeof (int)->int = $pointer_size";
};
subtest arrays => sub {
foreach my $type (qw( uint8 uint16 uint32 uint64 sint8 sint16 sint32 sint64 float double opaque ))
{
my $unit_size = $ffi->sizeof($type);
foreach my $size (1..10)
{
is $ffi->sizeof("$type [$size]"), $unit_size*$size, "sizeof $type [32] = @{[$unit_size*$size]}";
}
}
};
subtest custom_type => sub {
foreach my $type (qw( uint8 uint16 uint32 uint64 sint8 sint16 sint32 sint64 float double opaque ))
{
my $expected = $ffi->sizeof($type);
$ffi->custom_type( "my_$type" => { native_type => $type, native_to_perl => sub {} } );
is $ffi->sizeof("my_$type"), $expected, "sizeof my_$type = $expected";
}
};
};
subtest 'type' => sub {
subtest 'simple type' => sub {
my $ffi = FFI::Platypus->new;
eval { $ffi->type('sint8') };
is $@, '', 'ffi.type(sint8)';
};
subtest 'aliased type' => sub {
my $ffi = FFI::Platypus->new;
eval { $ffi->type('sint8', 'my_integer_8') };
is $@, '', 'ffi.type(sint8 => my_integer_8)';
isa_ok $ffi->{tp}->types->{my_integer_8}, 'FFI::Platypus::Type';
ok scalar(grep { $_ eq 'my_integer_8' } $ffi->types), 'ffi.types returns my_integer_8';
};
my @list = grep { FFI::Platypus::TypeParser->new->have_type($_) } qw( sint8 uint8 sint16 uint16 sint32 uint32 sint64 uint64 float double opaque string longdouble complex_float complex_double );
subtest 'ffi basic types' => sub {
foreach my $name (@list)
{
subtest $name => sub {
my $ffi = FFI::Platypus->new;
eval { $ffi->type($name) };
is $@, '', "ffi.type($name)";
my $meta = $ffi->type_meta($name);
note xdump( $meta);
cmp_ok $meta->{size}, '>', 0, "size = " . $meta->{size};
};
}
};
subtest 'ffi pointer types' => sub {
foreach my $name (map { "$_ *" } @list)
{
subtest $name => sub {
skip_all 'ME GRIMLOCK SAY STRING CAN NO BE POINTER' if $name eq 'string *';
my $ffi = FFI::Platypus->new;
eval { $ffi->type($name) };
is $@, '', "ffi.type($name)";
my $meta = $ffi->type_meta($name);
note xdump( $meta);
cmp_ok $meta->{size}, '>', 0, "size = " . $meta->{size};
}
}
};
subtest 'ffi array types' => sub {
my $size = 5;
foreach my $basic (@list)
{
my $name = "$basic [$size]";
subtest $name => sub {
skip_all 'ME GRIMLOCK SAY STRING CAN NO BE ARRAY' if $name =~ /^string \[[0-9]+\]$/; # TODO: actually this should be doable
my $ffi = FFI::Platypus->new;
eval { $ffi->type($name) };
is $@, '', "ffi.type($name)";
my $meta = $ffi->type_meta($name);
note xdump( $meta);
cmp_ok $meta->{size}, '>', 0, "size = " . $meta->{size};
is $meta->{element_count}, $size, "size = $size";
};
$size += 2;
}
};
subtest 'closure types' => sub {
my $ffi = FFI::Platypus->new;
$ffi->type('int[22]' => 'my_int_array');
$ffi->type('int' => 'myint');
$ffi->type('(int)->int' => 'foo');
is $ffi->type_meta('foo')->{type}, 'closure', '(int)->int is a legal closure type';
note xdump($ffi->type_meta('foo'));
SKIP: {
skip "arrays not currently supported as closure argument types", 1;
$ffi->type('(my_int_array)->myint' => 'bar');
is $ffi->type_meta('bar')->{type}, 'closure', '(int)->int is a legal closure type';
note xdump($ffi->type_meta('bar'));
}
eval { $ffi->type('((int)->int)->int') };
isnt $@, '', 'inline closure illegal';
eval { $ffi->type('(foo)->int') };
isnt $@, '', 'argument type closure illegal';
eval { $ffi->type('(int)->foo') };
isnt $@, '', 'return type closure illegal';
$ffi->type('(int,int,int,char,string,opaque)->void' => 'baz');
is $ffi->type_meta('baz')->{type}, 'closure', 'a more complicated closure';
note xdump($ffi->type_meta('baz'));
};
subtest 'record' => sub {
{ package My::Record22; use constant ffi_record_size => 22 }
{ package My::Record44; use constant _ffi_record_size => 44 }
my $ffi = FFI::Platypus->new;
$ffi->type('record(1)' => 'my_record_1');
note xdump($ffi->type_meta('my_record_1'));
$ffi->type('record (32)' => 'my_record_32');
note xdump($ffi->type_meta('my_record_32'));
is $ffi->type_meta('my_record_1')->{size}, 1, "sizeof my_record_1 = 1";
is $ffi->type_meta('my_record_32')->{size}, 32, "sizeof my_record_32 = 32";
$ffi->type('record(My::Record22)' => 'my_record_22');
note xdump($ffi->type_meta('my_record_22'));
$ffi->type('record (My::Record44)' => 'my_record_44');
note xdump($ffi->type_meta('my_record_44'));
is $ffi->type_meta('my_record_22')->{size}, 22, "sizeof my_record_22 = 22";
is $ffi->type_meta('my_record_44')->{size}, 44, "sizeof my_record_44 = 44";
};
subtest 'string' => sub {
my $ffi = FFI::Platypus->new;
my $ptr_size = $ffi->sizeof('opaque');
foreach my $type ('string', 'string_rw', 'string_ro', 'string rw', 'string ro')
{
subtest $type => sub {
my $meta = $ffi->type_meta($type);
is $meta->{size}, $ptr_size, "sizeof $type = $ptr_size";
my $access = $type =~ /rw$/ ? 'rw' : 'ro';
is $meta->{access}, $access, "access = $access";
note xdump($meta);
}
}
foreach my $type ('string (10)', 'string(10)')
{
subtest $type => sub {
my $meta = $ffi->type_meta($type);
is $meta->{type}, 'record', 'is actually a record type';
is $meta->{size}, 10, "sizeof $type = 10";
note xdump($meta);
};
}
};
subtest 'private' => sub {
# this tests the private OO type API used only internally
# to FFI::Platypus. DO NOT USE FFI::Platypus::Type
# its interface can and WILL change.
my @names = qw(
void
uint8
sint8
uint16
sint16
uint32
sint32
uint64
sint64
float
double
longdouble
opaque
pointer
);
foreach my $name (@names)
{
subtest $name => sub {
skip_all 'test requires longdouble support'
unless FFI::Platypus::TypeParser->new->have_type($name);
my $type = eval { FFI::Platypus::TypeParser::Version0->new->parse($name) };
is $@, '', "type = FFI::Platypus::TypeParser::Version0->new->parse($name)";
isa_ok $type, 'FFI::Platypus::Type';
my $expected = $name eq 'opaque' ? 'pointer' : $name;
is eval { $type->meta->{ffi_type} }, $expected, "type.meta.ffi_type = $expected";
}
}
subtest string => sub {
my $type = eval { FFI::Platypus::TypeParser::Version0->new->parse('string') };
is $@, '', "type = FFI::Platypus::TypeParser::Version0->new->parse(string)";
isa_ok $type, 'FFI::Platypus::Type';
is eval { $type->meta->{ffi_type} }, 'pointer', 'type.meta.ffi_type = pointer';
};
};
};
subtest 'class or instance method' => sub {
my @class = FFI::Platypus->types;
my @instance = FFI::Platypus->new->types;
is \@class, \@instance, 'class and instance methods are identical';
note "type: $_" foreach sort @class;
};
subtest 'cast' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
subtest 'cast from string to pointer' => sub {
my $string = "foobarbaz";
my $pointer = $ffi->cast(string => opaque => $string);
is $ffi->function(string_matches_foobarbaz => ['opaque'] => 'int')->call($pointer), 1, 'dynamic';
$ffi->attach_cast(cast1 => string => 'opaque');
my $pointer2 = cast1($string);
is $ffi->function(string_matches_foobarbaz => ['opaque'] => 'int')->call($pointer2), 1, 'static';
};
subtest 'cast from pointer to string' => sub {
my $pointer = $ffi->function(string_return_foobarbaz => [] => 'opaque')->call();
my $string = $ffi->cast(opaque => string => $pointer);
is $string, "foobarbaz", "dynamic";
$ffi->attach_cast(cast2 => pointer => 'string');
my $string2 = cast2($pointer);
is $string2, "foobarbaz", "static";
};
subtest 'cast closure to opaque' => sub {
my $testname = 'dynamic';
my $closure = $ffi->closure(sub { is $_[0], "testvalue", $testname });
my $pointer = $ffi->cast('(string)->void' => opaque => $closure);
$ffi->function(string_set_closure => ['opaque'] => 'void')->call($pointer);
$ffi->function(string_call_closure => ['string'] => 'void')->call("testvalue");
$ffi->function(string_set_closure => ['(string)->void'] => 'void')->call($pointer);
$ffi->function(string_call_closure => ['string'] => 'void')->call("testvalue");
$ffi->attach_cast('cast3', '(string)->void' => 'opaque');
my $pointer2 = cast3($closure);
$testname = 'static';
$ffi->function(string_set_closure => ['opaque'])->call($pointer2);
$ffi->function(string_call_closure => ['string'])->call("testvalue");
$ffi->function(string_set_closure => ['(string)->void'])->call($pointer2);
$ffi->function(string_call_closure => ['string'])->call("testvalue");
};
subtest 'attach cast with wrapper' => sub {
$ffi->attach_cast('cast4', 'int', 'int', sub {
my($xsub, $in) = @_;
my $out = $xsub->($in);
return $out + 4;
});
is(cast4(4), 8);
is(prototype \&cast4, '$');
};
};
subtest 'ignore_not_found' => sub {
subtest 'ignore_not_found=undef' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
my $f1 = eval { $ffi->function(f1 => [] => 'void') };
is $@, '', 'no exception';
ok ref($f1), 'returned a function';
note "f1 isa ", ref($f1);
my $f2 = eval { $ffi->function(bogus => [] => 'void') };
isnt $@, '', 'function exception';
note "exception=$@";
eval { $ffi->attach(bogus => [] => 'void') };
isnt $@, '', 'attach exception';
note "exception=$@";
};
subtest 'ignore_not_found=0' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->ignore_not_found(0);
my $f1 = eval { $ffi->function(f1 => [] => 'void') };
is $@, '', 'no exception';
ok ref($f1), 'returned a function';
note "f1 isa ", ref($f1);
my $f2 = eval { $ffi->function(bogus => [] => 'void') };
isnt $@, '', 'function exception';
note "exception=$@";
eval { $ffi->attach(bogus => [] => 'void') };
isnt $@, '', 'attach exception';
note "exception=$@";
};
subtest 'ignore_not_found=0 (constructor)' => sub {
my $ffi = FFI::Platypus->new( ignore_not_found => 0, lib => [@lib] );
my $f1 = eval { $ffi->function(f1 => [] => 'void') };
is $@, '', 'no exception';
ok ref($f1), 'returned a function';
note "f1 isa ", ref($f1);
my $f2 = eval { $ffi->function(bogus => [] => 'void') };
isnt $@, '', 'function exception';
note "exception=$@";
eval { $ffi->attach(bogus => [] => 'void') };
isnt $@, '', 'attach exception';
note "exception=$@";
};
subtest 'ignore_not_found=1' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->ignore_not_found(1);
my $f1 = eval { $ffi->function(f1 => [] => 'void') };
is $@, '', 'no exception';
ok ref($f1), 'returned a function';
note "f1 isa ", ref($f1);
my $f2 = eval { $ffi->function(bogus => [] => 'void') };
is $@, '', 'function no exception';
is $f2, undef, 'f2 is undefined';
eval { $ffi->attach(bogus => [] => 'void') };
is $@, '', 'attach no exception';
};
subtest 'ignore_not_found=1 (constructor)' => sub {
my $ffi = FFI::Platypus->new( ignore_not_found => 1, lib => [@lib] );
my $f1 = eval { $ffi->function(f1 => [] => 'void') };
is $@, '', 'no exception';
ok ref($f1), 'returned a function';
note "f1 isa ", ref($f1);
my $f2 = eval { $ffi->function(bogus => [] => 'void') };
is $@, '', 'function no exception';
is $f2, undef, 'f2 is undefined';
eval { $ffi->attach(bogus => [] => 'void') };
is $@, '', 'attach no exception';
};
subtest 'ignore_not_found bool context' => sub {
my $ffi = FFI::Platypus->new( ignore_not_found => 1, lib => [@lib] );
my $f1 = eval { $ffi->function(f1 => [] => 'void') };
ok $f1, 'f1 exists and resolved to boolean true';
my $f2 = eval { $ffi->function(bogus => [] => 'void') };
ok !$f2, 'f2 does not exist and resolved to boolean false';
};
};
subtest 'attach basic' => sub {
package
attach_basic;
use FFI::Platypus;
use Test2::V0 -no_srand => 1;
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->attach('f0' => ['uint8'] => 'uint8');
$ffi->attach([f0=>'f1'] => ['uint8'] => 'uint8');
$ffi->attach([f0=>'Roger::f1'] => ['uint8'] => 'uint8');
is f0(22), 22, 'f0(22) = 22';
is f1(22), 22, 'f1(22) = 22';
is Roger::f1(22), 22, 'Roger::f1(22) = 22';
$ffi->attach([f0 => 'f0_wrap'] => ['uint8'] => uint8 => sub {
my($inner, $value) = @_;
return $inner->($value+1)+2;
});
$ffi->attach([f0 => 'f0_wrap2'] => ['uint8'] => uint8 => '$' => sub {
my($inner, $value) = @_;
return $inner->($value+1)+2;
});
is f0_wrap(22), 25, 'f0_wrap(22) = 25';
is f0_wrap2(22), 25, 'f0_wrap(22) = 25';
};
subtest 'attach void' => sub {
package
attach_void;
use FFI::Platypus;
use Test2::V0 -no_srand => 1;
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->attach('f2' => ['int*'] => 'void');
$ffi->attach([f2=>'f2_implicit'] => ['int*']);
my $i_ptr = 42;
f2(\$i_ptr);
is $i_ptr, 43, '$i_ptr = 43 after f2(\$i_ptr)';
f2_implicit(\$i_ptr);
is $i_ptr, 44, '$i_ptr = 44 after f2_implicit(\$i_ptr)';
};
subtest 'customer mangler' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->mangler( sub { "mystrangeprefix_$_[0]" });
is($ffi->function(bar => [] => 'int')->call, 42 );
};
subtest '->package is only allowed for api = 0' => sub {
my @warnings;
local $SIG{__WARN__} = sub {
note "[warning]\n", $_[0];
push @warnings, $_[0];
};
subtest 'api = 0' => sub {
my $ffi = FFI::Platypus->new( api => 0 );
local $@ = '';
eval { $ffi->package };
is "$@", "";
};
subtest 'api = 1' => sub {
my $ffi = FFI::Platypus->new( api => 1 );
local $@ = '';
eval { $ffi->package };
like "$@", qr/^package method only available with api => 0/;
};
};
subtest 'warning defaults' => sub {
my @warnings;
local $SIG{__WARN__} = sub {
note "[warning]\n", $_[0];
push @warnings, $_[0] if $_[0] =~ /^warning: error loading/;
};
subtest 'api = 0' => sub {
@warnings = ();
my $ffi = FFI::Platypus->new( api => 0, lib => ['corpus/bogus.so'] );
is $ffi->find_symbol('foo'), undef;
is \@warnings, [];
};
subtest 'api = 1' => sub {
@warnings = ();
my $ffi = FFI::Platypus->new( api => 1, lib => ['corpus/bogus.so'] );
local $@ = '';
is $ffi->find_symbol('foo'), undef;
like $warnings[0], qr/^warning: error loading corpus\/bogus\.so/;
};
};
subtest 'language plugin api version' => sub {
my %args;
my $native_type_map = sub
{
my $class = shift;
%args = @_;
{};
};
{
package FFI::Platypus::Lang::Frooble;
no warnings 'once';
*native_type_map = $native_type_map;
}
subtest 'api = 0' => sub {
my $ffi = FFI::Platypus->new( lang => 'Frooble' );
is $args{api}, undef;
};
subtest 'api = 1' => sub {
my $ffi = FFI::Platypus->new( lang => 'Frooble', api => 1 );
is $args{api}, 1;
};
};
subtest 'language load_custom_types hook' => sub {
my @args;
{
package FFI::Platypus::Lang::Frooble2;
sub native_type_map {}
no warnings 'once';
*load_custom_types = sub {
@args = @_;
};
}
FFI::Platypus->new( lang => 'Frooble2', api => 1 );
is($args[0], 'FFI::Platypus::Lang::Frooble2');
isa_ok $args[1], 'FFI::Platypus';
};
subtest 'api attribute' => sub {
is(
FFI::Platypus->new->api,
0,
'default is zero',
);
is(
FFI::Platypus->new( api => 0 )->api,
0,
'explicit zero',
);
is(
FFI::Platypus->new( api => 1 )->api,
1,
'explicit one',
);
};
subtest 'kindof' => sub {
is(
FFI::Platypus->kindof('void'),
'void',
'void',
);
is(
FFI::Platypus->kindof('sint8'),
'scalar',
'scalar',
);
is(
FFI::Platypus->kindof('sint8*'),
'pointer',
'pointer',
);
is(
FFI::Platypus->kindof('sint8[10]'),
'array',
'array (fixed)',
);
is(
FFI::Platypus->kindof('sint8[]'),
'array',
'array (var)',
);
is(
FFI::Platypus->kindof('string'),
'string',
'string',
);
};
subtest 'countof' => sub {
is(
FFI::Platypus->countof('void'),
0,
'void',
);
is(
FFI::Platypus->countof('sint8'),
1,
'scalar',
);
is(
FFI::Platypus->countof('sint8*'),
1,
'pointer',
);
is(
FFI::Platypus->countof('sint8[10]'),
10,
'array (fixed)',
);
is(
FFI::Platypus->countof('sint8[]'),
0,
'array (var)',
);
is(
FFI::Platypus->countof('string'),
1,
'string',
);
};
subtest 'def' => sub {
my $ffi = FFI::Platypus->new( api => 1 );
subtest 'needs to be a real type' => sub {
local $@;
eval { $ffi->def(undef, '[] illegal (', 'value') };
like $@, qr/bad type name/;
};
is
$ffi->def(undef, '[] illegal (',),
undef,
;
is
$ffi->def(undef, 'int', 'roger'),
'roger',
;
is
$ffi->def('main', 'int'),
'roger',
;
is
$ffi->def(undef, 'int'),
'roger',
;
is
$ffi->def('foo', 'int'),
undef,
;
is
$ffi->def('foo', 'int', 'prime'),
'prime',
;
is
$ffi->def('foo', 'int'),
'prime',
;
is
$ffi->def('foo', 'int', undef),
undef,
;
is
$ffi->def('foo', 'int'),
undef,
;
};
subtest 'unitof' => sub {
is(
FFI::Platypus->unitof('void'),
undef,
'void',
);
is(
FFI::Platypus->unitof('sint8'),
undef,
'scalar',
);
is(
FFI::Platypus->unitof('sint8*'),
'sint8',
'pointer',
);
is(
FFI::Platypus->unitof('sint8[10]'),
'sint8',
'array (fixed)',
);
is(
FFI::Platypus->unitof('sint8[]'),
'sint8',
'array (var)',
);
is(
FFI::Platypus->unitof('string'),
undef,
'string',
);
};
subtest 'pass undef into closure method should just return undef' => sub {
my $ret = eval { FFI::Platypus->closure(undef) };
is "$@", '', 'no error';
is $ret, U(), 'returns undef';
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_api.t 000644 000000 000000 00000000666 15251066120 017633 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::API;
subtest 'basic' => sub {
{
package FFI::Platypus::Type::C1;
sub ffi_custom_type_api_1
{
return {
native_type => 'sint8',
perl_to_native => sub { $_[0] * 2 },
}
}
}
my $ffi = FFI::Platypus->new;
$ffi->load_custom_type('::C1' => 'c1');
is(
$ffi->function( 0 => ['c1'] => 'sint8' )->call(10),
20,
);
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_buffer.t 000644 000000 000000 00000014633 15251066120 020332 0 ustar 00root root 000000 000000 # see https://github.com/PerlFFI/FFI-Platypus/issues/85
use if $^O ne 'MSWin32' || $] >= 5.018, 'open', ':std', ':encoding(utf8)';
use Test2::V0 -no_srand => 1;
use Encode qw( decode );
use FFI::Platypus::Buffer;
use FFI::Platypus::Buffer qw( scalar_to_pointer grow set_used_length window raw_scalar );
use utf8;
use B;
subtest simple => sub {
my $orig = 'me grimlock king';
my($ptr, $size) = scalar_to_buffer($orig);
ok $ptr, "ptr = $ptr";
my $ptr2 = scalar_to_pointer($orig);
is $ptr2, $ptr, "scalar to pointer matches";
is $size, 16, 'size = 16';
my $scalar = buffer_to_scalar($ptr, $size);
is $scalar, 'me grimlock king', "scalar = $scalar";
};
subtest unicode => sub {
my $orig = 'привет';
my($ptr, $size) = scalar_to_buffer($orig);
ok $ptr, "ptr = $ptr";
ok $size, "size = $size";
my $scalar = decode('UTF-8', buffer_to_scalar($ptr, $size));
is $scalar, 'привет', "scalar = $scalar";
};
subtest grow => sub {
my $orig = 'me grimlock king';
my($ptr, $size) = scalar_to_buffer($orig);
my $sv = B::svref_2object( \$orig );
is $sv->CUR, $size, "B::PV returns consistent string length";
my $required = 100;
ok $sv->LEN < $required, "initial buffer size is smaler than required";
subtest 'default options' => sub {
my $str = $orig;
grow( $str, $required );
my $sv = B::svref_2object( \$str );
ok $sv->LEN >= $required, "buffer grew as expected";
isnt substr( $str, 0, length($orig) ), $orig, "original contents cleared";
is $sv->CUR, $required, "string length == requested buffer length";
};
subtest clear => sub {
subtest 'on' => sub {
my $str = $orig;
grow( $str, $required, { clear => 1, set_length => 0 } );
my $sv = B::svref_2object( \$str );
ok $sv->LEN >= $required, "buffer grew as expected";
is $sv->CUR, 0, "buffer contents cleared";
};
subtest 'off' => sub {
my $str = $orig;
grow( $str, $required, { clear => 0, set_length => 0 } );
my $sv = B::svref_2object( \$str );
ok $sv->LEN >= $required, "buffer grew as expected";
is $str, $orig, "buffer contents not cleared";
};
};
subtest set_length => sub {
subtest 'on' => sub {
my $str = $orig;
grow( $str, $required, { set_length => 1 } );
my $sv = B::svref_2object( \$str );
ok $sv->LEN >= $required, "buffer grew as expected";
is $sv->CUR, $required, "buffer length set";
};
subtest 'off' => sub {
my $str = $orig;
grow( $str, $required, { set_length => 0, clear => 1 } );
my $sv = B::svref_2object( \$str );
ok $sv->LEN >= $required, "buffer grew as expected";
is $sv->CUR, 0, "buffer length not cleared";
};
};
subtest "bad option" => sub {
my $str;
eval{ grow( $str, 100, { 'bad option' => 1 } ) };
my $err = $@;
like ( $err, qr/bad option/, "croaked" );
};
subtest "fail on reference" => sub {
my $ref = \$orig;
eval { grow( $ref, 0 ); };
my $err = $@;
like ( $err, qr/must be a scalar/, "croaked" );
};
subtest '$str = undef' => sub {
my $str;
grow( $str, $required );
my $sv = B::svref_2object( \$str );
ok $sv->LEN >= $required, "buffer grew as expected";
};
subtest 'undef' => sub {
eval { grow( undef, $required ) };
my $err = $@;
like ( $err, qr/read-only/, "croaked" );
};
};
subtest set_used_length => sub {
my $orig = 'me grimlock king';
subtest 'length < max' => sub {
my $str = $orig;
my $len = set_used_length( $str, 3 );
is( $len, 3, "requested length" );
is( $str, "me ", "requested string" );
};
subtest 'length == max' => sub {
my $str = $orig;
my $sv = B::svref_2object( \$str );
my $len = set_used_length( $str, $sv->LEN );
is( $len, $sv->LEN, "requested length" );
};
subtest 'length > max' => sub {
my $str = $orig;
my $sv = B::svref_2object( \$str );
my $len = set_used_length( $str, $sv->LEN + 10);
is( $len, $sv->LEN, "maxed out length" );
};
subtest "fail on reference" => sub {
my $ref = \$orig;
eval { set_used_length( $ref, 0 ); };
my $err = $@;
like ( $err, qr/must be a scalar/, "croaked" );
};
{
my $todo = todo "is set_used_length undef behavior correct?";
subtest '$str = undef' => sub {
my $str;
my $len = set_used_length( $str, 100);
my $sv = B::svref_2object( \$str );
is ( $len, 0, "no added length" );
is( $len, $sv->LEN, "maxed out length" );
};
}
subtest 'undef' => sub {
eval { set_used_length( undef, 0 ) };
my $err = $@;
like ( $err, qr/read-only/, "croaked" );
};
};
subtest 'hardwire' => sub {
# hardwire is experimental, do not use outside
# of testing
subtest 'ascii' => sub {
my $stuff = "my stuff";
my($ptr, $len) = scalar_to_buffer $stuff;
my $ro;
window $ro, $ptr, $len;
is($ro, "my stuff");
is(length($ro), 8);
is([scalar_to_buffer $ro], [$ptr,$len]);
local $@ = '';
eval { $ro .= "foo" };
like "$@", qr/Modification of a read-only value attempted/;
is([scalar_to_buffer $ro], [$ptr,$len]);
};
subtest 'unicode' => sub {
my $stuff = "привет";
my($ptr, $len) = scalar_to_buffer $stuff;
my $ro;
window $ro, $ptr, $len, 1;
is($ro, "привет");
is(length($ro), 6);
is([scalar_to_buffer $ro], [$ptr,$len]);
local $@ = '';
eval { $ro .= "foo" };
like "$@", qr/Modification of a read-only value attempted/;
is([scalar_to_buffer $ro], [$ptr,$len]);
};
subtest 'strlen' => sub {
my $stuff = "foo\0bar";
my($ptr) = scalar_to_pointer $stuff;
my $ro;
window $ro, $ptr;
is($ro, "foo");
is(length($ro), 3);
is([scalar_to_pointer $ro], [$ptr]);
};
};
subtest 'raw_scalar' => sub {
subtest 'basic' => sub {
my $buffer = raw_scalar(100);
is length($buffer), 100, 'length is exactly as requested';
my $sv = B::svref_2object( \$buffer );
is $sv->CUR, 100, 'used length is as requested';
ok $sv->LEN > 100, 'allocated length has room for the trailing NUL';
ok scalar_to_pointer($buffer), 'has a pointer';
substr($buffer, 0, 5) = 'hello';
is substr($buffer, 0, 5), 'hello', 'writable';
is length($buffer), 100, 'length unchanged by writing to it';
};
subtest 'zero length' => sub {
my $buffer = raw_scalar(0);
is $buffer, '', 'is the empty string';
ok scalar_to_pointer($buffer), 'still has a pointer';
};
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_bundle.t 000644 000000 000000 00000013467 15251066120 020336 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use lib 't/lib';
use Test::Cleanup;
use FFI::Platypus;
use FFI::Temp;
use FFI::Build;
use File::Basename qw( dirname );
use File::Path qw( mkpath );
use File::Spec;
use Capture::Tiny qw( capture_merged );
subtest 'from installed' => sub {
local @INC = @INC;
my $root = FFI::Temp->newdir;
spew("$root/lib/Foo/Bar1.pm", <<'EOF');
package Foo::Bar1;
use strict;
use warnings;
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
$ffi->bundle;
$ffi->attach("bar1" => [] => 'sint32');
1;
EOF
my $build = FFI::Build->new(
'bar1',
source => [ [ C => \"int bar1(void) { return 42; }\n" ]],
verbose => 2,
dir => "$root/lib/auto/share/dist/Foo-Bar1",
export => ["bar1"],
);
my($build_out,$lib) = capture_merged {
$build->build;
};
note $build_out;
spew("$root/lib/auto/Foo/Bar1/Bar1.txt",
'FFI::Build@' . File::Spec->abs2rel("$lib", "$root/lib"));
ok( ! FFI::Platypus->can('_bundle') );
unshift @INC, "$root/lib";
local $@ = '';
eval " require Foo::Bar1; ";
is "$@", '';
is( Foo::Bar1::bar1(), 42 );
ok( !! FFI::Platypus->can('_bundle') );
cleanup(
sub { $build->clean },
$root,
);
};
subtest 'from blib' => sub {
local @INC = @INC;
my $root = FFI::Temp->newdir;
spew("$root/lib/Foo/Bar2.pm", <<'EOF');
package Foo::Bar2;
use strict;
use warnings;
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
$ffi->bundle;
$ffi->attach("bar2" => [] => 'sint32');
1;
EOF
my $build = FFI::Build->new(
'bar2',
source => [ [ C => \"int bar2(void) { return 43; }\n" ]],
verbose => 2,
dir => "$root/lib/auto/share/dist/Foo-Bar2",
export => ['bar2'],
);
my($build_out,$lib) = capture_merged {
$build->build;
};
note $build_out;
spew("$root/arch/auto/Foo/Bar2/Bar2.txt",
'FFI::Build@' . File::Spec->abs2rel("$lib", "$root/lib"));
unshift @INC, "$root/lib";
local $@ = '';
eval " require Foo::Bar2; ";
is "$@", '';
is( Foo::Bar2::bar2(), 43 );
cleanup(
sub { $build->clean },
$root,
);
};
subtest 'not loaded yet' => sub {
local @INC = @INC;
my $root = FFI::Temp->newdir;
spew("$root/lib/Foo/Bar3.pm", <<'EOF');
package Foo::Bar3;
die;
1;
EOF
my $build = FFI::Build->new(
'bar3',
source => [ [ C => \"int bar3(void) { return 44; }\n" ]],
verbose => 2,
dir => "$root/lib/auto/share/dist/Foo-Bar3",
export => ['bar3'],
);
my($build_out,$lib) = capture_merged {
$build->build;
};
note $build_out;
spew("$root/lib/auto/Foo/Bar3/Bar3.txt",
'FFI::Build@' . File::Spec->abs2rel("$lib", "$root/lib"));
unshift @INC, "$root/lib";
my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
$ffi->bundle('Foo::Bar3');
$ffi->attach("bar3" => [] => 'sint32');
is( bar3(), 44 );
cleanup(
sub { $build->clean },
$root,
);
};
subtest 'with a ffi dir' => sub {
local @INC = @INC;
my $root = FFI::Temp->newdir;
cleanup($root);
spew("$root/lib/Foo/Bar4.pm", <<'EOF');
package Foo::Bar4;
use strict;
use warnings;
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
$ffi->bundle;
$ffi->attach("bar4" => [] => 'sint32');
1;
EOF
spew("$root/ffi/foo.c", "int bar4(void) { return 45; }" );
spew("$root/ffi/foo.fbx", <<'EOF');
use strict;
use warnings;
our $DIR;
{ export => ['bar4'], source => ["$DIR/*.c"] };
EOF
unshift @INC, "$root/lib";
eval " require Foo::Bar4; ";
is "$@", '';
is( Foo::Bar4::bar4(), 45 );
};
subtest 'entry points' => sub {
my $root = FFI::Temp->newdir;
cleanup($root);
our @log;
our $log_closure = do {
my $ffi = FFI::Platypus->new;
$ffi->closure(sub {
my($str) = @_;
push @log, $str;
});
};
spew("$root/lib/Foo/Bar5.pm", <<'EOF');
package Foo::Bar5;
use strict;
use warnings;
use FFI::Platypus;
our $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
$ffi->bundle([$ffi->cast('(string)->void' => 'opaque', $main::log_closure)]);
1;
EOF
spew("$root/ffi/foo.c", <<'EOF');
#include <ffi_platypus_bundle.h>
#include <stdio.h>
typedef void (*log_t)(const char *);
log_t logit;
char buffer[1024];
void
ffi_pl_bundle_init(const char *package, int c, void **args)
{
int i;
logit = (log_t) args[0];
logit("ffi_pl_bundle_init (enter)");
sprintf(buffer, "package = %s", package);
logit(buffer);
sprintf(buffer, "c = %d", c);
logit(buffer);
for(i=0; args[i] != NULL; i++)
{
sprintf(buffer, "args[%d] = %d", i, args[i]);
logit(buffer);
}
logit("ffi_pl_bundle_init (leave)");
}
void
ffi_pl_bundle_fini(const char *package)
{
logit("ffi_pl_bundle_fini (enter)");
sprintf(buffer, "package = %s", package);
logit(buffer);
logit("ffi_pl_bundle_fini (leave)");
}
EOF
spew("$root/ffi/foo.fbx", <<'EOF');
use strict;
use warnings;
our $DIR;
{ export => ['ffi_pl_bundle_init','ffi_pl_bundle_fini'], source => ["$DIR/*.c"] };
EOF
unshift @INC, "$root/lib";
local $@ = '';
eval " require Foo::Bar5; ";
is "$@", '';
note "log:$_" for @log;
is(scalar(@log), 5);
is($log[0], 'ffi_pl_bundle_init (enter)');
is($log[1], 'package = Foo::Bar5');
is($log[2], 'c = 1');
like($log[3], qr/^args\[0\] = -?[0-9]+$/);
is($log[4], 'ffi_pl_bundle_init (leave)');
@log = ();
ok 1;
{
no warnings 'once';
undef $Foo::Bar5::ffi;
}
note "log:$_" for @log;
is(
\@log,
[
'ffi_pl_bundle_fini (enter)',
'package = Foo::Bar5',
'ffi_pl_bundle_fini (leave)',
],
);
@log = ();
};
done_testing;
sub spew
{
my($fn, $content) = @_;
note "spew(start)[$fn]\n";
note $content;
note "spew(end)\n";
my $dir = dirname $fn;
mkpath $dir, 0, oct(755) unless -d $dir;
open my $fh, '>', $fn;
print $fh $content;
close $fh;
}
FFI-Platypus-2.12/t/ffi_platypus_closure.t 000644 000000 000000 00000007340 15251066120 020532 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::Closure;
use FFI::CheckLib;
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
subtest 'basic' => sub {
my $ffi = FFI::Platypus->new;
my $closure = $ffi->closure(sub { $_[0] + 1});
isa_ok $closure, 'FFI::Platypus::Closure';
is $closure->(1), 2, 'closure.(1) = 2';
my $c = sub { $_[0] + 2 };
$closure = $ffi->closure($c);
isa_ok $closure, 'FFI::Platypus::Closure';
is $closure->(1), 3, 'closure.(1) = 3';
is $closure->call(1), 3, 'closure.call(1) = 3';
$closure = $ffi->closure($c);
isa_ok $closure, 'FFI::Platypus::Closure';
is $closure->(1), 3, 'closure.(1) = 3';
is $closure->call(1), 3, 'closure.call(1) = 3';
};
subtest 'sticky' => sub {
my $closure = FFI::Platypus::Closure->new(sub { 'foo' });
isa_ok $closure, 'FFI::Platypus::Closure';
my $refcnt = $closure->_svrefcnt;
note "_svrefcnt = $refcnt";
eval { $closure->sticky };
is $@, '', 'called $closure->sticky';
is($closure->_svrefcnt, $refcnt+2);
eval { $closure->sticky };
is $@, '', 'called $closure->sticky';
is($closure->_svrefcnt, $refcnt+2);
eval { $closure->unstick };
is $@, '', 'called $closure->unstick';
is($closure->_svrefcnt, $refcnt);
};
subtest 'sticky and unstick return $self' => sub {
my $closure = FFI::Platypus::Closure->new(sub { 'foo' });
isa_ok $closure, 'FFI::Platypus::Closure';
is($closure->sticky, $closure, '$closure->sticky returns $closure');
is($closure->unstick, $closure, '$closure->unstick returns $closure');
is(
$closure->sticky->unstick, $closure,
'$closure->sticky->unstick can be chained',
);
};
subtest 'private' => sub {
my $closure = FFI::Platypus::Closure->new(sub { $_[0] + 1});
isa_ok $closure, 'FFI::Platypus::Closure';
is $closure->(1), 2, 'closure.(1) = 2';
};
subtest 'space' => sub {
my $ffi = FFI::Platypus->new;
eval { $ffi->type('(int,int)->void') };
is $@, '', 'good without space';
eval { $ffi->type('(int, int) -> void') };
is $@, '', 'good with space';
};
subtest 'die' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $closure = $ffi->closure(sub {
die "omg i don't want to die!";
});
my $set_closure = $ffi->function(pointer_set_closure => ['(opaque)->opaque'] => 'void');
my $call_closure = $ffi->function(pointer_call_closure => ['opaque'] => 'opaque');
$set_closure->($closure);
my $warning;
do {
local $SIG{__WARN__} = sub { $warning = $_[0] };
$call_closure->(undef);
};
like $warning, qr{omg i don't want to die};
pass 'does not exit';
note "warning = '$warning'";
};
subtest 'reuse' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $closure = $ffi->closure(sub {
if (@_) {
return $_[0] * 7;
}
return 21;
});
my $set_closure1 = $ffi->function( closure_set_closure1 => ['()->int'] => 'void');
my $set_closure2 = $ffi->function( closure_set_closure2 => ['(int)->int'] => 'void');
my $call_closure1 = $ffi->function( closure_call_closure1 => [] => 'int');
my $call_closure2 = $ffi->function( closure_call_closure2 => ['int'] => 'int');
$set_closure1->($closure);
$set_closure2->($closure);
is $call_closure1->(), 21;
is $call_closure2->(42), 294;
};
subtest 'immediate' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $ret = $ffi->function( closure_call_closure_immediate => ['()->int'] => 'int')->call(
$ffi->closure(sub { return 42; })
);
is $ret, 42;
};
subtest 'closure passing into a closure' => sub {
my $ffi = FFI::Platypus->new;
eval { $ffi->type('((int)->int)->int') };
isnt "$@", "";
note "error = $@";
$ffi->type('(int)->int' => 'foo_t');
eval { $ffi->type('()->foo_t') };
isnt "$@", "";
note "error = $@";
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_constant.t 000644 000000 000000 00000003040 15251066120 020700 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::Constant;
use File::Path qw( mkpath );
use File::Basename qw( dirname );
use FFI::Temp;
subtest 'very very basic...' => sub {
my $api = FFI::Platypus::Constant->new;
isa_ok $api, 'FFI::Platypus::Constant';
undef $api;
ok 'did not appear to crash :tada:';
};
subtest 'create constants' => sub {
my $root = FFI::Temp->newdir;
spew("$root/lib/Foo/Bar1.pm", <<'EOF');
package Foo::Bar1;
use strict;
use warnings;
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
$ffi->bundle;
1;
EOF
spew("$root/ffi/bar1.c", <<'EOF');
#include <ffi_platypus_bundle.h>
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *b)
{
b->set_str("FOO1", "VAL1");
b->set_str("Foo::Bar1::Baz::FOO2", "VAL2");
b->set_sint("FOO3", -42);
b->set_uint("FOO4", 512);
b->set_double("FOO5", 2.5);
b->set_str("FOO6", package);
}
EOF
local @INC = @INC;
unshift @INC, "$root/lib";
local $@ = '';
eval " require Foo::Bar1; ";
is "$@", '';
is( Foo::Bar1::FOO1(), "VAL1" );
is( Foo::Bar1::Baz::FOO2(), "VAL2" );
is( Foo::Bar1::FOO3(), -42 );
is( Foo::Bar1::FOO4(), 512 );
is( Foo::Bar1::FOO5(), 2.5 );
is( Foo::Bar1::FOO6(), "Foo::Bar1" );
};
done_testing;
sub spew
{
my($fn, $content) = @_;
note "spew(start)[$fn]\n";
note $content;
note "spew(end)\n";
my $dir = dirname $fn;
mkpath $dir, 0, oct(755) unless -d $dir;
open my $fh, '>', $fn;
print $fh $content;
close $fh;
}
FFI-Platypus-2.12/t/ffi_platypus_dl.t 000644 000000 000000 00000002372 15251066120 017455 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::DL;
use FFI::CheckLib qw( find_lib );
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
subtest 'flags' => sub {
ok(FFI::Platypus::DL->can('RTLD_PLATYPUS_DEFAULT'), "RTLD_PLATYPUS_DEFAULT is defined");
note sprintf "%-25s %04x %s", $_, FFI::Platypus::DL->can($_)->(), FFI::Platypus::DL->can($_)->() for sort { FFI::Platypus::DL->can($a)->() <=> FFI::Platypus::DL->can($b)->() } grep /^RTLD_/, keys %main::;
};
subtest 'dlopen' => sub {
subtest 'bad library' => sub {
is dlopen("t/ffi/libbogus.so", RTLD_PLATYPUS_DEFAULT), undef, 'Returns undef on fail';
note "dlerror = @{[ dlerror ]}";
};
subtest 'good library' => sub {
my $h = dlopen $libtest, RTLD_PLATYPUS_DEFAULT;
ok($h, "Returns handle on good");
note "h = $h";
dlclose $h;
};
};
subtest 'dlsym' => sub {
my $h = dlopen $libtest, RTLD_PLATYPUS_DEFAULT;
subtest 'good symbol' => sub {
my $address = dlsym $h, 'f0';
ok $address, 'returns an address';
note "address = $address";
};
subtest 'bad symbol' => sub {
my $address = dlsym $h, 'bogus';
is $address, undef, 'bad symbol returns undef';
note "dlerror = @{[ dlerror ]}";
};
dlclose $h;
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_function.t 000644 000000 000000 00000013352 15251066120 020703 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::Function;
use FFI::Platypus;
use FFI::CheckLib;
use FFI::Platypus::TypeParser::Version0;
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
subtest 'built in type' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $function = eval { $ffi->function('f0', [ 'uint8' ] => 'uint8') };
is $@, '', 'ffi.function(f0, [uint8] => uint8)';
isa_ok $function, 'FFI::Platypus::Function';
isa_ok $function, 'FFI::Platypus::Function::Function';
is $function->call(22), 22, 'function.call(22) = 22';
is $function->(22), 22, 'function.(22) = 22';
};
subtest 'custom type' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
$ffi->type('uint8' => 'my_int_8');
my $function = eval { $ffi->function('f0', [ 'my_int_8' ] => 'my_int_8') };
is $@, '', 'ffi.function(f0, [my_int_8] => my_int_8)';
isa_ok $function, 'FFI::Platypus::Function';
isa_ok $function, 'FFI::Platypus::Function::Function';
is $function->call(22), 22, 'function.call(22) = 22';
is $function->(22), 22, 'function.(22) = 22';
};
subtest 'private' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $address = $ffi->find_symbol('f0');
my $uint8 = FFI::Platypus::TypeParser::Version0->new->parse('uint8');
my $function = eval { FFI::Platypus::Function::Function->new($ffi, $address, -1, -1, $uint8, $uint8) };
is $@, '', 'FFI::Platypus::Function->new';
isa_ok $function, 'FFI::Platypus::Function';
isa_ok $function, 'FFI::Platypus::Function::Function';
is $function->call(22), 22, 'function.call(22) = 22';
$function->attach('main::fooble', 'whatever.c', undef);
is fooble(22), 22, 'fooble(22) = 22';
};
subtest 'meta' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
$ffi->attach(mymeta_new => [ 'int', 'string' ] => 'opaque');
$ffi->attach(mymeta_delete => [ 'opaque' ] => 'void' );
subtest 'unattached' => sub {
my $meta = mymeta_new(4, "prime");
my $f = $ffi->_function_meta('mymeta_test' => $meta => [ 'string' ] => 'string' );
is($f->call(), "foo = 4, bar = prime, baz = undef, count = 0");
is($f->call("just one"), "foo = 4, bar = prime, baz = just one, count = 1");
mymeta_delete($meta);
};
subtest 'attached' => sub {
my $meta = mymeta_new(6, "magnus");
$ffi->_function_meta('mymeta_test' => $meta => [ 'string' ] => 'string' )->attach('mymeta_test1');
is(mymeta_test1(), "foo = 6, bar = magnus, baz = undef, count = 0");
is(mymeta_test1("stella"), "foo = 6, bar = magnus, baz = stella, count = 1");
};
};
subtest 'sub_ref' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $sub_ref = $ffi->function('f0', [ 'uint8' ] => 'uint8')->sub_ref;
is $sub_ref->(99), 99, 'calls okay';
is ref($sub_ref), 'CODE', 'it is a code reference';
if(eval { require Sub::Identify; 1 })
{
my $name = Sub::Identify::sub_name($sub_ref);
my $package = Sub::Identify::stash_name($sub_ref);
note "name = ${package}::$name";
}
};
subtest 'prototype' => sub {
subtest one => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $sub_ref = $ffi->attach(['f0' => 'f0_prototyped1'], [ 'uint8' ] => 'uint8', '$');
is(f0_prototyped1(2), 2); # just make sure it attached okay
is(prototype(\&f0_prototyped1), '$');
};
subtest two => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $sub_ref = $ffi->function('f0', [ 'uint8' ] => 'uint8')->attach('f0_prototyped2', '$');
is(f0_prototyped2(2), 2); # just make sure it attached okay
is(prototype(\&f0_prototyped2), '$');
};
};
subtest 'variadic' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
skip_all 'test requires variadic function support'
unless eval { $ffi->function('variadic_return_arg' => ['int'] => ['int'] => 'int') };
my $wrapper = sub {
my($xsub, @args) = @_;
my $ret = $xsub->(@args);
$ret*2;
};
subtest 'unattached' => sub {
foreach my $i (1..7)
{
is(
$ffi->function(variadic_return_arg => ['int'] => ['int','int','int','int','int','int','int'] => 'int')->call($i,10,20,30,40,50,60,70),
$i*10,
'sans wrapper'
);
is(
$ffi->function(variadic_return_arg => ['int'] => ['int','int','int','int','int','int','int'] => 'int', $wrapper)->call($i,10,20,30,40,50,60,70),
$i*10*2,
'with wrapper'
);
}
};
subtest 'attached' => sub {
$ffi->attach([variadic_return_arg => 'y1'] => ['int'] => ['int','int','int','int','int','int','int'] => 'int');
$ffi->attach([variadic_return_arg => 'y2'] => ['int'] => ['int','int','int','int','int','int','int'] => 'int', $wrapper);
foreach my $i (1..7)
{
is(y1($i,10,20,30,40,50,60,70), $i*10, 'sans wrapper');
is(y2($i,10,20,30,40,50,60,70), $i*10*2, 'with wrapper');
}
};
subtest 'examples' => sub {
is(
$ffi->function( xprintf => ['string'] => ['int'] => 'string' )->call("print integer %d\n", 42),
"print integer 42\n",
);
is(
$ffi->function( xprintf => ['string'] => ['string'] => 'string' )->call("print string %s\n", 'platypus'),
"print string platypus\n",
);
is(
$ffi->function( xprintf => ['string'] => ['int','string'] => 'string' )->call("print integer %d and string %s\n", 42, 'platypus'),
"print integer 42 and string platypus\n",
);
};
};
subtest 'void as arg should fail is arg count > 1' => sub {
my $ffi = FFI::Platypus->new;
eval { $ffi->function( 0 => ['int','void'] => 'void' ) };
like "$@", qr/^void not allowed as argument type/;
};
subtest 'single void arg treated as no args' => sub {
my $ffi = FFI::Platypus->new;
eval { $ffi->function( 0 => ['void'] => 'void' ) };
is "$@", "";
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_function_wrapper.t 000644 000000 000000 00000003630 15251066120 022441 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::Function;
use FFI::Platypus;
use FFI::CheckLib;
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
subtest 'built in type' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $wrapper = sub {
my($xsub, $arg1) = @_;
$xsub->( $arg1 * 2 );
};
my $function = eval { $ffi->function('f0', [ 'uint8' ] => 'uint8', $wrapper ) };
is $@, '', 'ffi.function(f0, [uint8] => uint8)';
isa_ok $function, 'FFI::Platypus::Function';
isa_ok $function, 'FFI::Platypus::Function::Wrapper';
is $function->call(22), 44, 'function.call(22) = 44';
is $function->(22), 44, 'function.(22) = 44';
$function->attach('baboon');
is( baboon(11), 22, "baboon(11) = 22" );
};
subtest 'sub_ref' => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $sub_ref = $ffi->function('f0', [ 'uint8' ] => 'uint8', sub { my($xsub, $arg) = @_; $arg*2})->sub_ref;
is $sub_ref->(99), 99*2, 'calls okay';
is ref($sub_ref), 'CODE', 'it is a code reference';
if(eval { require Sub::Identify; 1 })
{
my $name = Sub::Identify::sub_name($sub_ref);
my $package = Sub::Identify::stash_name($sub_ref);
note "name = ${package}::$name";
}
};
subtest 'prototype' => sub {
subtest one => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $sub_ref = $ffi->attach(['f0' => 'f0_prototyped1'], [ 'uint8' ] => 'uint8', '$', sub { my($xsub, $arg) = @_; $arg*2});
is(f0_prototyped1(2), 4); # just make sure it attached okay
is(prototype(\&f0_prototyped1), '$');
};
subtest two => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $sub_ref = $ffi->function('f0', [ 'uint8' ] => 'uint8', sub { my($xsub, $arg) = @_; $arg*2})->attach('f0_prototyped2', '$');
is(f0_prototyped2(2), 4); # just make sure it attached okay
is(prototype(\&f0_prototyped2), '$');
};
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_internal.t 000644 000000 000000 00000000710 15251066120 020664 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::Internal;
subtest 'basic' => sub {
note "alpha order:";
foreach my $const (sort @FFI::Platypus::Internal::EXPORT)
{
pass sprintf("%-30s 0x%04x", $const, __PACKAGE__->$const);
}
note "value order:";
foreach my $const (sort { __PACKAGE__->$a <=> __PACKAGE__->$b } @FFI::Platypus::Internal::EXPORT)
{
pass sprintf("%-30s 0x%04x", $const, __PACKAGE__->$const);
}
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_lang.t 000644 000000 000000 00000004003 15251066120 017770 0 ustar 00root root 000000 000000 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];
};
}
FFI-Platypus-2.12/t/ffi_platypus_lang_asm.t 000644 000000 000000 00000001114 15251066120 020630 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib;
use FFI::Platypus;
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
subtest ASM => sub {
my $ffi = FFI::Platypus->new(lang => 'ASM');
$ffi->lib($libtest);
eval { $ffi->type('int') };
isnt $@, '', 'int is not an okay type';
note $@;
eval { $ffi->type('foo_t') };
isnt $@, '', 'foo_t is not an okay type';
note $@;
eval { $ffi->type('sint16') };
is $@, '', 'sint16 is an okay type';
is $ffi->find_symbol('UnMangled::Name(int i)'), undef, 'unable to find unmangled name';
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_lang_c.t 000644 000000 000000 00000001052 15251066120 020273 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib;
use FFI::Platypus;
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
subtest C => sub {
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
eval { $ffi->type('int') };
is $@, '', 'int is an okay type';
eval { $ffi->type('foo_t') };
isnt $@, '', 'foo_t is not an okay type';
note $@;
eval { $ffi->type('sint16') };
is $@, '', 'sint16 is an okay type';
is $ffi->find_symbol('UnMangled::Name(int i)'), undef, 'unable to find unmangled name';
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_lang_win32.t 000644 000000 000000 00000003200 15251066120 021010 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::Lang::Win32;
{
require FFI::Platypus::Type::WideString;
my($encoding,$width) = eval { FFI::Platypus::Type::WideString->_compute_wide_string_encoding() };
if(my $error = $@)
{
$error =~ s/ at .*$//;
skip_all "Unable to detect wide string details: $error\n";
}
note "encoding = $encoding";
note "width = $width";
}
subtest 'native type map diagnostic' => sub {
my $map = FFI::Platypus::Lang::Win32->native_type_map;
foreach my $alias (sort keys %$map)
{
my $type = $map->{$alias};
note sprintf("%-30s %s", $alias, $type);
}
pass 'good';
};
my $ffi = FFI::Platypus->new( api => 1, lib => [undef] );
subtest 'load' => sub {
local $@ = "";
eval { $ffi->lang('Win32') };
is "$@", "";
};
my @strings = (
[ "trivial" => "" ],
[ "simple" => "abcde" ],
[ "fancy" => "abcd\x{E9}" ],
[ "complex" => "I \x{2764} Platypus" ],
);
subtest 'LPCWSTR' => sub {
skip_all 'Test only works on Windows' unless $^O eq 'MSWin32';
my $lstrlenW = $ffi->function( lstrlenW => [ 'LPCWSTR' ] => 'int' );
foreach my $test (@strings)
{
my($name, $string) = @$test;
is($lstrlenW->call($string), length($string), $name);
}
};
subtest 'LPWSTR' => sub {
skip_all 'Test only works on Windows' unless $^O eq 'MSWin32';
my $GetCurrentDirectoryW = $ffi->function( GetCurrentDirectoryW => ['DWORD','LPWSTR'] => 'DWORD' );
my $size = $GetCurrentDirectoryW->call(0, undef);
cmp_ok $size, '>', 0;
my $buf = "\0" x ($size*2);
$GetCurrentDirectoryW->call($size, \$buf);
note "buf = $buf";
ok( -d $buf, "returned directory exists");
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_legacy.t 000644 000000 000000 00000000367 15251066120 020324 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
subtest 'only load as needed' => sub {
my $ffi = FFI::Platypus->new;
ok( ! FFI::Platypus->can('_package') );
$ffi->package;
ok( !! FFI::Platypus->can('_package') );
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_memory.t 000644 000000 000000 00000005142 15251066120 020364 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::Memory;
note "lib=@{[ $_ || 'undef' ]}" for FFI::Platypus::Memory->_ffi->lib;
my $ffi = FFI::Platypus->new;
$ffi->lib(undef);
# TODO: break this subtest up into one for
# malloc, calloc, memset and free
subtest 'malloc calloc memset free' => sub {
my $ptr1 = malloc 22;
ok $ptr1, "malloc returns $ptr1";
memset $ptr1, 0, 22;
memset $ptr1, ord 'x', 8;
memset $ptr1, ord 'y', 4;
my $ptr2 = calloc 9, $ffi->sizeof('char');
ok $ptr2, "calloc returns $ptr2";
my $string = $ffi->function(strcpy => ['opaque', 'opaque'] => 'string')->call($ptr2, $ptr1);
is $string, 'yyyyxxxx', 'string = yyyyxxxx';
free $ptr1;
ok 1, 'free $ptr1';
free $ptr2;
ok 1, 'free $ptr2';
};
subtest 'memcpy' => sub {
my $ptr1 = malloc 64;
my $ptr2 = malloc 64;
$ffi->function(strcpy => ['opaque', 'string'] => 'opaque')->call($ptr1, "starscream");
is( $ffi->cast('opaque','string', $ptr1), "starscream", "initial data copied" );
my $ret = memcpy $ptr2, $ptr1, 64;
is( $ffi->cast('opaque','string', $ptr2), "starscream", "copy of copy" );
is $ret, $ptr2, "memcpy returns a pointer";
free $ptr1;
ok 1, 'free $ptr1';
free $ptr2;
ok 1, 'free $ptr2';
};
subtest 'realloc' => sub {
my $ptr = realloc undef, 32;
ok $ptr, "realloc call ptr = @{[ $ptr ]}";
$ffi->function(strcpy => ['opaque', 'string'] => 'opaque')->call($ptr, "hello");
is( $ffi->cast('opaque','string', $ptr), "hello", "initial data copied" );
$ptr = realloc $ptr, 1024*5;
ok $ptr, "realloc call ptr = @{[ $ptr ]} (2)";
is( $ffi->cast('opaque','string', $ptr), "hello", "after realloc data there" );
free $ptr;
ok 1, 'final free';
};
subtest 'strdup' => sub {
note "strdup implementation = @{[ FFI::Platypus::Memory->_strdup_impl ]}";
my $ptr1 = malloc 32;
my $tmp = strdup "this and\0";
memcpy $ptr1, $tmp, 9;
free $tmp;
my $string = $ffi->cast('opaque' => 'string', $ptr1);
is $string, 'this and', 'string = this and';
free $ptr1;
ok 1, 'free $ptr1';
};
subtest 'strndup' => sub {
note "strndup implementation = @{[ FFI::Platypus::Memory->_strndup_impl ]}";
subtest 'full string' => sub {
my $ptr = strndup "this and\0", 512;
is($ffi->cast('opaque' => 'string', $ptr), 'this and');
free $ptr;
};
subtest 'partial string' => sub {
my $ptr = strndup "1234567890", 5;
is($ffi->cast('opaque' => 'string', $ptr), '12345');
free $ptr;
};
};
subtest 'strcpy' => sub {
my $ptr = malloc(5);
strcpy $ptr, "perl";
is($ffi->cast('opaque', 'string', $ptr), "perl", "pointer cast back to string matches");
free $ptr;
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_record.t 000644 000000 000000 00000025576 15251066120 020347 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::Memory qw( malloc free );
use Data::Dumper;
do {
package
Foo1;
use FFI::Platypus::Record;
record_layout(
uint8 => 'first',
uint32 => 'second',
);
};
sub xdump_meta ($)
{
my($type) = @_;
my $ffi = FFI::Platypus->new;
my $object = $ffi->type_meta($type);
note(Data::Dumper->new([$object])->Indent(0)->Terse(1)->Sortkeys(1)->Dump);
}
subtest 'integer accessor' => sub {
my $foo = Foo1->new( first => 1, second => 2 );
isa_ok $foo, 'Foo1';
my $size = $foo->_ffi_record_size;
like $size, qr{^[0-9]+$}, "foo._record_size = $size";
is $foo->first, 1, 'foo.first = 1';
is $foo->second, 2, 'foo.second = 2';
$foo->first(22);
is $foo->first, 22, 'foo.first = 22';
$foo->second(42);
is $foo->second, 42, 'foo.second = 42';
$foo = Foo1->new( { first => 3, second => 4 } );
is $foo->first, 3, 'foo.first = 3';
is $foo->second, 4, 'foo.second = 4';
xdump_meta('record(Foo1)');
xdump_meta('record(8)');
};
do {
package
Color;
use FFI::Platypus;
use FFI::Platypus::Record;
my $ffi = FFI::Platypus->new;
$ffi->find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi');
record_layout($ffi, qw(
uint8 red
uint8 green
uint8 blue
));
$ffi->type('record(Color)' => 'Color');
$ffi->attach( [ color_get_red => 'get_red' ] => [ 'Color' ] => 'int' );
$ffi->attach( [ color_get_green => 'get_green' ] => [ 'Color' ] => 'int' );
$ffi->attach( [ color_get_blue => 'get_blue' ] => [ 'Color' ] => 'int' );
};
subtest 'values match in C' => sub {
my $color = Color->new(
red => 50,
green => 100,
blue => 150,
);
isa_ok $color, 'Color';
is $color->get_red, 50, "color.get_red = 50";
is $color->get_green, 100, "color.get_green = 100";
is $color->get_blue, 150, "color.get_blue = 150";
};
do {
package
Foo2;
use FFI::Platypus::Record;
record_layout(qw(
char :
uint64_t uint64
char :
uint32_t uint32
char :
uint16_t uint16
char :
uint8_t uint8
char :
int64_t sint64
char :
int32_t sint32
char :
int16_t sint16
char :
int8_t sint8
char :
float float
char :
double double
char :
opaque opaque
));
my $ffi = FFI::Platypus->new;
$ffi->find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach(["align_get_$_" => "get_$_"] => [ 'record(Foo2)' ] => $_)
for qw( uint8 sint8 uint16 sint16 uint32 sint32 uint64 sint64 float double opaque );
};
subtest 'complex alignment' => sub {
my $foo = Foo2->new;
isa_ok $foo, 'Foo2';
$foo->uint64(512);
is $foo->get_uint64, 512, "uint64 = 512";
$foo->sint64(-512);
is $foo->get_sint64, -512, "sint64 = -512";
$foo->uint32(1024);
is $foo->get_uint32, 1024, "uint32 = 1024";
$foo->sint32(-1024);
is $foo->get_sint32, -1024, "sint32 = -1024";
$foo->uint16(2048);
is $foo->get_uint16, 2048, "uint16 = 2048";
$foo->sint16(-2048);
is $foo->get_sint16, -2048, "sint16 = -2048";
$foo->uint8(48);
is $foo->get_uint8, 48, "uint8 = 48";
$foo->sint8(-48);
is $foo->get_sint8, -48, "sint8 = -48";
$foo->float(1.5);
is $foo->get_float, 1.5, "float = 1.5";
$foo->double(-1.5);
is $foo->get_double, -1.5, "double = -1.5";
my $ptr = malloc 32;
$foo->opaque($ptr);
is $foo->get_opaque, $ptr, "get_opaque = $ptr";
is $foo->opaque, $ptr, "opaque = $ptr";
$foo->opaque(undef);
is $foo->get_opaque, undef, "get_opaque = undef";
is $foo->opaque, undef, "opaque = undef";
free $ptr;
};
subtest 'same name' => sub {
eval {
package
Foo3;
require FFI::Platypus::Record;
FFI::Platypus::Record->import;
record_layout(
int => 'foo',
int => 'foo',
);
};
isnt $@, '', 'two members of the same name not allowed';
note $@ if $@;
};
do {
package
Foo4;
use FFI::Platypus::Record;
record_layout(qw(
char :
uint64_t[3] uint64
char :
uint32_t[3] uint32
char :
uint16_t[3] uint16
char :
uint8_t[3] uint8
char :
int64_t[3] sint64
char :
int32_t[3] sint32
char :
int16_t[3] sint16
char :
int8_t[3] sint8
char :
float[3] float
char :
double[3] double
char :
opaque[3] opaque
));
my $ffi = FFI::Platypus->new;
$ffi->find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach(["align_array_get_$_" => "get_$_"] => [ 'record(Foo4)' ] => "${_}[3]" )
for qw( uint8 sint8 uint16 sint16 uint32 sint32 uint64 sint64 float double opaque );
};
subtest 'array alignment' => sub {
my $foo = Foo4->new;
isa_ok $foo, 'Foo4';
foreach my $bits (qw( 8 16 32 64 ))
{
subtest "unsigned $bits integer" => sub {
my $acc1 = "uint$bits";
my $acc2 = "get_uint$bits";
$foo->$acc1([1,2,3]);
is $foo->$acc1, [1,2,3], "$acc1 = 1,2,3";
is $foo->$acc2, [1,2,3], "$acc2 = 1,2,3";
is $foo->$acc1(1), 2, "$acc1(1) = 2";
$foo->$acc1(1,20);
is $foo->$acc1, [1,20,3], "$acc1 = 1,20,3";
};
subtest "signed $bits integer" => sub {
my $acc1 = "sint$bits";
my $acc2 = "get_sint$bits";
$foo->$acc1([-1,2,-3]);
is $foo->$acc1, [-1,2,-3], "$acc1 = -1,2,-3";
is $foo->$acc2, [-1,2,-3], "$acc2 = -1,2,-3";
is $foo->$acc1(2), -3, "$acc1(2) = -3";
$foo->$acc1(1,-20);
is $foo->$acc1, [-1,-20,-3], "$acc1 = -1,-20,-3";
};
}
foreach my $type (qw( float double ))
{
subtest $type => sub {
$foo->$type([1.5,undef,-1.5]);
is $foo->$type, [1.5,0.0,-1.5], "$type = 1.5,0,-1.5";
is $foo->$type(0), 1.5;
is $foo->$type(1), 0.0;
is $foo->$type(2), -1.5;
$foo->$type(1,20.0);
is $foo->$type, [1.5,20.0,-1.5], "$type = 1.5,20,-1.5";
};
}
subtest 'opaque' => sub {
my $ptr1 = malloc 32;
my $ptr2 = malloc 64;
$foo->opaque([$ptr1,undef,$ptr2]);
is $foo->opaque, [$ptr1,undef,$ptr2], "opaque = $ptr1,undef,$ptr2";
$foo->opaque(1,$ptr1);
is $foo->opaque, [$ptr1,$ptr1,$ptr2], "opaque = $ptr1,$ptr1,$ptr2";
$foo->opaque(0,undef);
is $foo->opaque, [undef,$ptr1,$ptr2], "opaque = undef,$ptr1,$ptr2";
is $foo->opaque(0), undef;
is $foo->opaque(1), $ptr1;
is $foo->opaque(2), $ptr2;
free $ptr1;
free $ptr2;
};
my $align = $foo->_ffi_record_align;
like $align, qr{^[0-9]+$}, "align = $align";
ok $align > 0, "align is positive";
};
do {
package
Foo5;
use FFI::Platypus::Record;
record_layout(qw(
char :
string value
));
my $ffi = FFI::Platypus->new;
$ffi->find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach(
[align_string_get_value => 'get_value'] => ['record(Foo5)'] => 'string',
);
$ffi->attach(
[align_string_set_value => 'set_value'] => ['record(Foo5)','string'] => 'void',
);
};
subtest 'string ro' => sub {
my $foo = Foo5->new;
isa_ok $foo, 'Foo5';
is $foo->value, undef, 'foo.value = undef';
is $foo->get_value, undef, 'foo.get_value = undef';
$foo->set_value("my value");
is $foo->value, 'my value', 'foo.value = my value';
is $foo->get_value, 'my value', 'foo.get_value = my value';
eval { $foo->value("stuff") };
isnt $@, '', 'value is ro';
note $@ if $@;
$foo->set_value(undef);
is $foo->value, undef, 'foo.value = undef';
is $foo->get_value, undef, 'foo.get_value = undef';
};
do {
package
Foo6;
use FFI::Platypus::Record;
record_layout(qw(
char :
string(10) value
));
my $ffi = FFI::Platypus->new;
$ffi->find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach([align_fixed_get_value=>'get_value'] => ['record(Foo6)'] => 'string');
};
subtest 'fixed string' => sub {
my $foo = Foo6->new;
isa_ok $foo, 'Foo6';
is $foo->value, "\0\0\0\0\0\0\0\0\0\0", 'foo.value = "\\0\\0\\0\\0\\0\\0\\0\\0\\0\\0"';
is $foo->get_value, "", 'foo.get_value = ""';
$foo->value("one two three four five six seven eight");
is $foo->value, "one two th", 'foo.value = "one two th"';
$foo->value("123456789\0");
is $foo->value, "123456789\0", "foo.value = 123456789\\0";
is $foo->get_value, "123456789", "foo.get_value = 123456789";
};
do {
package
Foo7;
use FFI::Platypus::Record;
record_layout(qw(
char :
string_rw value
));
my $ffi = FFI::Platypus->new;
$ffi->find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach(
[align_string_get_value => 'get_value'] =>
['record(Foo7)'] => 'string'
);
};
subtest 'string rw' => sub {
my $foo = Foo7->new;
isa_ok $foo, 'Foo7';
$foo->value('hi there');
is $foo->value, "hi there", "foo.value = hi there";
is $foo->get_value, 'hi there', 'foo.get_value = hi there';
$foo->value(undef);
is $foo->value, undef, 'foo.value = undef';
is $foo->get_value, undef, 'foo.get_value = undef';
$foo->value('starscream!!!');
is $foo->value, "starscream!!!", "foo.value = starscream!!!";
is $foo->get_value, 'starscream!!!', 'foo.get_value = starscream!!!';
};
subtest 'record with custom ffi' => sub {
{
package
Foo8;
use FFI::Platypus::Record;
my $ffi = FFI::Platypus->new;
$ffi->type('string rw' => 'foo_t');
record_layout($ffi, qw(
foo_t foo
));
}
my $foo8 = Foo8->new;
isa_ok $foo8, 'Foo8';
$foo8->foo("yo this is a string");
is( $foo8->foo, "yo this is a string" );
};
subtest 'record with ffi args' => sub {
{ package
FFI::Platypus::Lang::Foo9;
sub native_type_map
{
return { foo_t => 'sint32' };
}
}
{ package
Foo9;
use FFI::Platypus::Record;
record_layout
[ lang => 'Foo9', api => 1 ],
foo_t => 'foo'
;
}
my $foo8 = Foo8->new;
isa_ok $foo8, 'Foo8';
$foo8->foo(-42);
is( $foo8->foo, -42 );
};
subtest 'api_1' => sub {
my $api;
my $ffi = FFI::Platypus->new;
no warnings 'once';
no warnings 'redefine';
local *FFI::Platypus::new = do {
my $orig = FFI::Platypus->can('new');
sub {
my $class = shift;
my %args = @_;
$api = $args{api};
$api = 0 unless defined $args{api};
$class->$orig(@_);
};
};
subtest 'no $ffi or args' => sub {
local $@;
undef $api;
eval q{
package Foo10;
use FFI::Platypus::Record;
record_layout_1(
string => 'a',
);
};
is "$@", '';
is( $api, 2 );
};
subtest 'args' => sub {
local $@;
undef $api;
eval q{
package Foo11;
use FFI::Platypus::Record;
record_layout_1( [],
string => 'a',
);
};
is "$@", '';
is( $api, 2 );
};
subtest '$ffi' => sub {
local $@;
undef $api;
eval q{
package Foo12;
use FFI::Platypus::Record;
record_layout_1( $ffi,
string => 'a',
);
};
is "$@", '';
is( $api, undef );
};
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_record_meta.t 000644 000000 000000 00000002207 15251066120 021337 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::Record::Meta;
use Data::Dumper qw( Dumper );
my $ffi = FFI::Platypus->new;
$ffi->lib(undef);
subtest 'basic' => sub {
my $meta = FFI::Platypus::Record::Meta->new(
[ 'uint8', 'uint8', 'pointer', 'float', 'double' ],
);
isa_ok $meta, 'FFI::Platypus::Record::Meta';
like $meta->ffi_type, qr/^-?[0-9]+$/, "meta->ffi_type = @{[ $meta->ffi_type ]}";
is $meta->size, 0, 'meta->size';
is $meta->alignment, 0, 'meta->alignment';
my $got = $meta->element_pointers;
my $exp = [map { FFI::Platypus::Record::Meta::_find_symbol($_) } qw( uint8 uint8 pointer float double )];
is
$got,
$exp,
'meta->element_pointers'
or diag Dumper([[map { sprintf "0x%x", $_ } @$got],[ map { sprintf "0x%x", $_ } @$exp]]);
};
subtest 'bogus types' => sub {
{
local $@ = '';
eval { FFI::Platypus::Record::Meta->new(qw( completely bogsu )) };
like "$@", qr/passed something other than a array ref/;
}
{
local $@ = '';
eval { FFI::Platypus::Record::Meta->new([qw( completely bogsu )]) };
like "$@", qr/unknown type: completely/;
}
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_record_tiearray.t 000644 000000 000000 00000001202 15251066120 022223 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
do {
package
Foo;
use FFI::Platypus::Record;
use FFI::Platypus::Record::TieArray;
record_layout(qw(
int[20] _bar
));
sub bar
{
my($self) = @_;
tie my @list, 'FFI::Platypus::Record::TieArray', $self, '_bar', 20;
\@list;
}
};
my $foo = Foo->new( _bar => [1..20] );
isa_ok $foo, 'Foo';
is $foo->bar->[1], 2;
$foo->bar->[1] = 22;
is $foo->bar->[1], 22;
is scalar(@{ $foo->bar }), 20;
is $#{ $foo->bar}, 19;
@{ $foo->bar } = ();
is $foo->bar->[$_], 0 for 0..19;
@{ $foo->bar } = (0..5);
is $foo->bar->[$_], $_ for 0..5;
is $foo->bar->[$_], 0 for 6..19;
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_shareconfig.t 000644 000000 000000 00000000565 15251066120 021350 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::ShareConfig;
use Data::Dumper;
sub xdump ($)
{
my($object) = @_;
note(Data::Dumper->new([$object])->Indent(2)->Terse(1)->Sortkeys(1)->Dump);
}
note(xdump(FFI::Platypus::ShareConfig->get));
is(ref(FFI::Platypus::ShareConfig->get), 'HASH');
is(FFI::Platypus::ShareConfig->get('test-key'), 'test-value');
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_type.t 000644 000000 000000 00000014546 15251066120 020045 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus::Internal;
use FFI::Platypus::Type;
use Data::Dumper qw( Dumper );
local $Data::Dumper::Sortkeys = 1;
my $pointer_size = FFI::Platypus->new->sizeof('opaque');
subtest 'basic type' => sub {
my $type = FFI::Platypus::TypeParser->create_type_basic(
FFI_PL_TYPE_SINT8,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_SINT8;
is $type->sizeof, 1;
is $type->is_record, 0;
is $type->is_record_value, 0;
is $type->kindof, "scalar";
is $type->countof, 1;
is $type->unitof, undef;
note Dumper($type->meta);
};
subtest 'fixed string / record (pass by reference)' => sub {
my $type = FFI::Platypus::TypeParser->create_type_record(
0,
22,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_RECORD;
is $type->sizeof, 22;
is $type->is_record, 1;
is $type->is_record_value, 0;
is $type->kindof, "record";
is $type->countof, 1;
is $type->unitof, undef;
note Dumper($type->meta);
my $custom = FFI::Platypus::TypeParser->_create_type_custom(
$type,
sub {},
sub {},
sub {},
1,
);
isa_ok $custom, 'FFI::Platypus::Type';
is $custom->type_code, FFI_PL_TYPE_RECORD | FFI_PL_SHAPE_CUSTOM_PERL;
is $custom->sizeof, 22;
is $custom->is_record, 1;
is $custom->is_record_value, 0;
is $custom->kindof, "record";
is $custom->countof, 1;
is $type->unitof, undef;
note Dumper($custom->meta);
};
subtest 'record' => sub {
{
package Foo::Bar;
use FFI::Platypus::Record;
record_layout(qw(
int foo
));
}
subtest 'record class value (pass by value)' => sub {
my $type = FFI::Platypus::TypeParser->create_type_record(
1,
Foo::Bar->_ffi_record_size,
'Foo::Bar',
Foo::Bar->_ffi_meta->ffi_type,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_RECORD_VALUE;
is $type->meta->{ref}, 1;
is $type->meta->{class}, 'Foo::Bar';
is $type->sizeof, 4;
is $type->is_record, 0;
is $type->is_record_value, 1;
is $type->kindof, "record-value";
is $type->countof, 1;
is $type->unitof, undef;
note Dumper($type->meta);
my $custom = FFI::Platypus::TypeParser->_create_type_custom(
$type,
sub {},
sub {},
sub {},
1,
);
isa_ok $custom, 'FFI::Platypus::Type';
is $custom->type_code, FFI_PL_TYPE_RECORD_VALUE | FFI_PL_SHAPE_CUSTOM_PERL;
is $custom->sizeof, 4;
is $custom->is_record, 0;
is $custom->is_record_value, 1;
is $custom->kindof, "record-value";
is $custom->countof, 1;
is $type->unitof, undef;
note Dumper($custom->meta);
};
subtest 'record class (pass by reference)' => sub {
my $type = FFI::Platypus::TypeParser->create_type_record(
0,
Foo::Bar->_ffi_record_size,
'Foo::Bar',
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_RECORD;
is $type->meta->{ref}, 1;
is $type->sizeof, 4;
is $type->is_record, 1;
is $type->is_record_value, 0;
is $type->kindof, "record";
is $type->unitof, undef;
is $type->countof, 1;
note Dumper($type->meta);
my $custom = FFI::Platypus::TypeParser->_create_type_custom(
$type,
sub {},
sub {},
sub {},
1,
);
isa_ok $custom, 'FFI::Platypus::Type';
is $custom->type_code, FFI_PL_TYPE_RECORD | FFI_PL_SHAPE_CUSTOM_PERL;
is $custom->sizeof, 4;
is $custom->is_record, 1;
is $custom->is_record_value, 0;
is $custom->kindof, "record";
is $custom->countof, 1;
is $type->unitof, undef;
note Dumper($custom->meta);
};
};
subtest 'string rw' => sub {
my $type = FFI::Platypus::TypeParser->create_type_string(
1,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_STRING;
is $type->meta->{access}, 'rw';
is $type->sizeof, $pointer_size;
is $type->is_record, 0;
is $type->is_record_value, 0;
is $type->kindof, "string";
is $type->countof, 1;
is $type->unitof, undef;
note Dumper($type->meta);
};
subtest 'string ro' => sub {
my $type = FFI::Platypus::TypeParser->create_type_string(
0,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_STRING;
is $type->meta->{access}, 'ro';
is $type->sizeof, $pointer_size;
is $type->is_record, 0;
is $type->is_record_value,0;
is $type->kindof, "string";
is $type->countof, 1;
is $type->unitof, undef;
note Dumper($type->meta);
};
subtest 'fixed array' => sub {
my $type = FFI::Platypus::TypeParser->create_type_array(
FFI_PL_TYPE_SINT8,
10,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY;
is $type->meta->{size}, 10;
is $type->sizeof, 10;
is $type->is_record, 0;
is $type->is_record_value,0;
is $type->kindof, "array";
is $type->countof, 10;
is $type->unitof, 'sint8';
note Dumper($type->meta);
};
subtest 'var array' => sub {
my $type = FFI::Platypus::TypeParser->create_type_array(
FFI_PL_TYPE_SINT8,
0,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY;
is $type->meta->{size}, 0;
is $type->is_record, 0;
is $type->is_record_value,0;
is $type->kindof, "array";
is $type->countof, 0;
is $type->unitof, 'sint8';
note Dumper($type->meta);
};
subtest 'pointer' => sub {
my $type = FFI::Platypus::TypeParser->create_type_pointer(
FFI_PL_TYPE_SINT8,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER;
is $type->sizeof, $pointer_size;
is $type->is_record, 0;
is $type->is_record_value,0;
is $type->kindof, "pointer";
is $type->countof, 1;
is $type->unitof, 'sint8';
note Dumper($type->meta);
};
#_create_type_custom(self, type, perl_to_native, native_to_perl, perl_to_native_post, argument_count)
subtest 'custom type' => sub {
my $basis = FFI::Platypus::TypeParser->create_type_basic(
FFI_PL_TYPE_SINT8,
);
my $type = FFI::Platypus::TypeParser->_create_type_custom(
$basis,
sub {},
sub {},
sub {},
1,
);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_CUSTOM_PERL;
is $type->sizeof, 1;
is $type->is_record, 0;
is $type->is_record_value,0;
is $type->kindof, "scalar";
is $type->countof, 1;
is $type->unitof, undef;
note Dumper($type->meta);
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_type_pointersizebuffer.t 000644 000000 000000 00000001740 15251066120 023662 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib;
use FFI::Platypus;
use FFI::Platypus::Memory qw( malloc );
my $ffi = FFI::Platypus->new;
$ffi->load_custom_type('::PointerSizeBuffer' => 'buffer_t');
$ffi->load_custom_type('::PointerSizeBuffer' => 'buffer_t2');
$ffi->lib(undef);
$ffi->attach(memcpy => ['opaque', 'buffer_t'] => 'void');
my $string = "luna park\0";
my $pointer = malloc length $string;
memcpy($pointer, $string);
my $string2 = $ffi->cast('opaque' => 'string', $pointer);
is $string2, 'luna park';
SKIP: {
eval { $ffi->attach(snprintf => ['buffer_t', 'string' ] => 'int') };
skip "test require working snprintf", 2 if $@;
is snprintf($string2, "this is a very long string"), 26;
is $string2, "this is \000";
}
$ffi->lib(find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach(memcmp4 => ['buffer_t', 'buffer_t'] => 'int');
my $str1 = "test";
my $str2 = "test2";
is !!memcmp4($str1, $str2), 1;
is memcmp4($str1, $str1), 0;
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_type_stringarray.t 000644 000000 000000 00000005477 15251066120 022475 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib;
use FFI::Platypus;
my $libtest = find_lib lib => 'test', libpath => 't/ffi';
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
subtest 'fixed length input' => sub {
$ffi->load_custom_type('::StringArray' => 'string_5_hey' => 5, "hey");
$ffi->load_custom_type('::StringArray' => 'string_5_undef' => 5, undef);
my $a1 = $ffi->function(get_string_from_array => ['string_5_hey', 'int'] => 'string');
my $a2 = $ffi->function(get_string_from_array => ['string_5_undef', 'int'] => 'string');
my @list = ( 'foo', 'bar', 'baz', undef, 'five', 'six' );
subtest 'with default' => sub {
is $a1->(\@list, 0), 'foo', 'a1(0) = foo';
is $a1->(\@list, 1), 'bar', 'a1(0) = bar';
is $a1->(\@list, 2), 'baz', 'a1(0) = baz';
is $a1->(\@list, 3), 'hey', 'a1(0) = hey';
is $a1->(\@list, 4), 'five', 'a1(0) = five';
is $a1->(\@list, 5), undef, 'a1(0) = undef';
};
subtest 'with default' => sub {
is $a2->(\@list, 0), 'foo', 'a2(0) = foo';
is $a2->(\@list, 1), 'bar', 'a2(0) = bar';
is $a2->(\@list, 2), 'baz', 'a2(0) = baz';
is $a2->(\@list, 3), undef, 'a2(0) = undef';
is $a2->(\@list, 4), 'five', 'a2(0) = five';
is $a2->(\@list, 5), undef, 'a2(0) = undef';
};
};
subtest 'variable length input' => sub {
$ffi->load_custom_type('::StringArray' => 'sa');
my $get_string_from_array = $ffi->function(get_string_from_array => ['sa','int'] => 'string');
my @list = qw( foo bar baz );
for(0..2)
{
is $get_string_from_array->(\@list, $_), $list[$_], "get_string_from_array(\@list, $_) = $list[$_]";
}
is $get_string_from_array->(\@list, 3), undef, "get_string_from_array(\@list, 3) = undef";
};
subtest 'fixed length return' => sub {
$ffi->load_custom_type('::StringArray' => 'sa3' => 3);
$ffi->load_custom_type('::StringArray' => 'sa3x' => 3, 'x');
is(
$ffi->function(pointer_null => [] => 'sa3')->call,
undef,
'returns null',
);
is(
$ffi->function(onetwothree3 => [] => 'sa3')->call,
[ qw( one two three ) ],
'returns with just strings',
);
is(
$ffi->function(onenullthree3 => [] => 'sa3')->call,
[ 'one', undef, 'three' ],
'returns with NULL/undef in the middle',
);
is(
$ffi->function(onenullthree3 => [] => 'sa3x')->call,
[ 'one', 'x', 'three' ],
'returns with NULL/undef in the middle with default',
);
};
subtest 'null terminated return' => sub {
#$ffi->load_custom_type('::StringArray' => 'sa');
is(
$ffi->function(pointer_null => [] => 'sa')->call,
undef,
'returns null',
);
is(
$ffi->function('onetwothree4', => [] => 'sa')->call,
[ qw( one two three ) ],
);
is(
$ffi->function('onenullthree3' => [] => 'sa')->call,
[ qw( one ) ],
);
is(
$ffi->function('ptrnull' => [] => 'sa')->call,
[],
);
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_type_stringpointer.t 000644 000000 000000 00000002634 15251066120 023027 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my $ffi = FFI::Platypus->new;
$ffi->load_custom_type('::StringPointer' => 'string_p');
$ffi->lib(find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach( string_pointer_pointer_get => ['string_p'] => 'string');
$ffi->attach( string_pointer_pointer_set => ['string_p', 'string'] => 'void');
$ffi->attach( pointer_pointer_is_null => ['string_p'] => 'int');
$ffi->attach( pointer_is_null => ['string_p'] => 'int');
$ffi->attach( string_pointer_pointer_return => ['string'] => 'string_p');
$ffi->attach( pointer_null => [] => 'string_p');
subtest 'arg pass in' => sub {
is string_pointer_pointer_get(\"hello there"), "hello there", "not null";
is pointer_pointer_is_null(\undef), 1, "\\undef is null";
is pointer_is_null(undef), 1, "undef is null";
};
subtest 'arg pass out' => sub {
my $string = '';
string_pointer_pointer_set(\$string, "hi there");
is $string, "hi there", "not null string = $string";
my $string2;
string_pointer_pointer_set(\$string2, "and another");
is $string2, "and another", "not null string = $string2";
};
subtest 'return value' => sub {
my $string = "once more onto";
is string_pointer_pointer_return($string), \"once more onto", "not null string = $string";
is string_pointer_pointer_return(undef), \undef, "\\null";
my $value = pointer_null();
is $value, undef, "null";
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_type_widestring.t 000644 000000 000000 00000010175 15251066120 022276 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use open ':std', ':encoding(utf8)';
use FFI::CheckLib;
use FFI::Platypus;
use FFI::Platypus::Memory qw( free strdup );
use FFI::Platypus::Type::WideString;
my($encoding,$width) = eval { FFI::Platypus::Type::WideString->_compute_wide_string_encoding() };
if(my $error = $@)
{
$error =~ s/ at .*$//;
skip_all "Unable to detect wide string details: $error\n";
}
# This test assumes a wchar_t of at least 2 bytes, which is probably true
# everywhere Platypus is actually suppored, but wchar_t could technically
# be the same size as char.
note "encoding = $encoding";
note "width = $width";
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi'; # need test lib for pointer_is_null
push @lib, undef; # for libc wcs* functions
my $ffi = FFI::Platypus->new( api => 1, lib => \@lib );
$ffi->ignore_not_found(1);
$ffi->load_custom_type('::WideString' => 'wstring');
$ffi->load_custom_type('::WideString' => 'wstring_w', access => 'write');
my $wcsdup = do {
our $ptr;
my $wrapper = sub {
my $xsub = shift;
free $ptr if defined $ptr;
$ptr = undef;
$ptr = $xsub->(@_);
};
my $wcsdup = $ffi->function( wcsdup => ['wstring'] => 'opaque' => $wrapper);
$wcsdup = $ffi->function( _wcsdup => ['wstring'] => 'opaque' => $wrapper)
if $^O eq 'MSWin32' && ! defined $wcsdup;
END { free $ptr if defined $ptr; undef $ptr };
$wcsdup;
};
subtest 'wcschr' => sub {
my $wcschr = $ffi->function( wcschr => ['opaque','wchar_t'] => 'wstring' );
skip_all 'Test requires wcschr' unless defined $wcschr;
skip_all 'Test requires wcsdup' unless defined $wcsdup;
is( $ffi->cast( opaque => 'wstring', $wcsdup->call("I \x{2764} Platypus")), "I \x{2764} Platypus" );
# make sure libc is using the same wchar_t as we are.
# also tests "in as argument" mode.
is( $wcschr->call($wcsdup->call('foobar'), ord('b')), 'bar');
is( $wcschr->call($wcsdup->call("I \x{2764} Platypus"), ord("\x{2764}")), "\x{2764} Platypus");
};
my @strings = (
[ "trivial" => "" ],
[ "simple" => "abcde" ],
[ "fancy" => "abcd\x{E9}" ],
[ "complex" => "I \x{2764} Platypus" ],
);
subtest 'wide string as argument (in)' => sub {
my $wcslen = $ffi->function( wcslen => ['wstring'] => 'size_t' );
skip_all 'Test requires wcslen' unless defined $wcslen;
foreach my $test (@strings)
{
my($name, $string) = @$test;
# note: this works because on Windows with UTF_16
# because all of our test strings are in the BMP
is($wcslen->call($string), length($string), $name);
}
is($ffi->cast( 'wstring', 'opaque', undef), undef, 'NULL');
};
subtest 'wide string as argument (out)' => sub {
my $wcscpy = $ffi->function( wcscpy => ['wstring_w','wstring'] );
skip_all 'Test requires wcscpy' unless defined $wcscpy;
foreach my $test (@strings)
{
my($name, $string) = @$test;
my $out1;
$wcscpy->call(\$out1, $string);
is($out1, $string, "$name default buffer size");
my $out2 = "\0" x ($width * (length($string)+1));
$wcscpy->call(\$out2, $string);
is($out2, $string, "$name with just enough buffer");
}
my $is_null = $ffi->function( pointer_is_null => ['wstring_w'] => 'int' );
ok($is_null->call(undef), "NULL");
};
subtest 'wide string as a return value' => sub {
skip_all 'Test requires wcsdup' unless defined $wcsdup;
foreach my $test (@strings)
{
my($name, $string) = @$test;
my $ptr = $wcsdup->($string);
is($ffi->cast('opaque','wstring', $ptr), $string, $name);
}
is($ffi->cast('opaque','wstring', undef), undef, 'NULL');
};
subtest 'wide string as in-out argument' => sub {
my $wcscat = $ffi->function( wcscat => ['wstring_w','wstring'] );
skip_all 'Test requires wcscat' unless defined $wcscat;
foreach my $test (@strings)
{
my($name, $string) = @$test;
my $out1;
$wcscat->call([\$out1, $string], $string);
is($out1, "$string$string", "$name default buffer size");
my $out2 = "\0" x ($width * (length($string)*2+1));
$wcscat->call([\$out2, $string], $string);
is($out2, "$string$string", "$name with just enough buffer");
}
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_typeparser.t 000644 000000 000000 00000001040 15251066120 021243 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
subtest 'basic' => sub {
my $tp = FFI::Platypus::TypeParser->new;
isa_ok $tp, 'FFI::Platypus::TypeParser';
};
subtest 'pick the right one' => sub {
isa_ok(
FFI::Platypus->new( api => 0 )->{tp},
'FFI::Platypus::TypeParser::Version0',
);
# ignore api=1 warning
local $SIG{__WARN__} = sub { note "[warnings]\n", $_[0] };
isa_ok(
FFI::Platypus->new( api => 1 )->{tp},
'FFI::Platypus::TypeParser::Version1',
);
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_typeparser_version0.t 000644 000000 000000 00000022774 15251066120 023111 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
use FFI::Platypus::Internal;
use FFI::Platypus::TypeParser::Version0;
my $ffi = FFI::Platypus->new;
my $type;
my $pointer_size = $ffi->sizeof('opaque');
subtest basic => sub {
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('uint64')->meta,
{
element_size => 8,
element_type => 'int',
ffi_type => 'uint64',
sign => 0,
size => 8,
type => 'scalar',
type_code => FFI_PL_TYPE_UINT64,
},
'basic basic',
) or diag explain $type;
subtest 'longdouble' => sub {
skip_all 'test requires support for long double'
unless FFI::Platypus::TypeParser->have_type('longdouble');
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('longdouble')->meta,
{
element_size => 16,
element_type => 'float',
ffi_type => 'longdouble',
size => 16,
type => 'scalar',
type_code => FFI_PL_TYPE_LONG_DOUBLE,
},
'longdouble',
) or diag explain $type;
};
subtest 'complex' => sub {
skip_all 'test requires support for complex'
unless FFI::Platypus::TypeParser->have_type('complex_float');
skip_all 'test requires support for complex'
unless FFI::Platypus::TypeParser->have_type('complex_double');
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('complex_float')->meta,
{
element_size => 8,
element_type => 'float',
ffi_type => 'complex_float',
size => 8,
type => 'scalar',
type_code => FFI_PL_TYPE_COMPLEX_FLOAT,
},
'complex float',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('complex_double')->meta,
{
element_size => 16,
element_type => 'float',
ffi_type => 'complex_double',
size => 16,
type => 'scalar',
type_code => FFI_PL_TYPE_COMPLEX_DOUBLE,
},
'complex double',
) or diag explain $type;
};
};
subtest record => sub {
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('string(42)')->meta,
{
ffi_type => 'pointer',
ref => 0,
size => 42,
type => 'record',
type_code => FFI_PL_TYPE_RECORD,
},
'fixed string',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('record(42)')->meta,
{
ffi_type => 'pointer',
ref => 0,
size => 42,
type => 'record',
type_code => FFI_PL_TYPE_RECORD,
},
'unclassed record',
) or diag explain $type;
{ package
Foo::Bar::Baz;
use FFI::Platypus::Record;
record_layout (qw(
sint64 foo
));
}
is(
$type =FFI::Platypus::TypeParser::Version0->new->parse('record(Foo::Bar::Baz)')->meta,
{
ffi_type => 'pointer',
ref => 1,
size => 8,
type => 'record',
type_code => FFI_PL_TYPE_RECORD,
class => 'Foo::Bar::Baz',
},
'classed record',
) or diag explain $type;
};
subtest string => sub {
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('string')->meta,
{
access => 'ro',
element_size => $pointer_size,
ffi_type => 'pointer',
size => $pointer_size,
type => 'string',
type_code => FFI_PL_TYPE_STRING,
},
'default string',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('string ro')->meta,
{
access => 'ro',
element_size => $pointer_size,
ffi_type => 'pointer',
size => $pointer_size,
type => 'string',
type_code => FFI_PL_TYPE_STRING,
},
'explicit ro string',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('string_ro')->meta,
{
access => 'ro',
element_size => $pointer_size,
ffi_type => 'pointer',
size => $pointer_size,
type => 'string',
type_code => FFI_PL_TYPE_STRING,
},
'explicit ro string with underscore',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('string rw')->meta,
{
access => 'rw',
element_size => $pointer_size,
ffi_type => 'pointer',
size => $pointer_size,
type => 'string',
type_code => FFI_PL_TYPE_STRING,
},
'explicit rw string',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('string_rw')->meta,
{
access => 'rw',
element_size => $pointer_size,
ffi_type => 'pointer',
size => $pointer_size,
type => 'string',
type_code => FFI_PL_TYPE_STRING,
},
'explicit rw string with underscore',
) or diag explain $type;
};
subtest array => sub {
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('uint64 [4]')->meta,
{
element_count => 4,
element_size => 8,
element_type => 'int',
ffi_type => 'uint64',
sign => 0,
size => 32,
type => 'array',
type_code => FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_ARRAY,
},
'fixed array',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('uint64 []')->meta,
{
element_count => 0,
element_size => 8,
element_type => 'int',
ffi_type => 'uint64',
sign => 0,
size => 0,
type => 'array',
type_code => FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_ARRAY,
},
'variable array',
) or diag explain $type;
subtest 'longdouble' => sub {
skip_all 'test requires support for long double'
unless FFI::Platypus::TypeParser->have_type('longdouble');
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('longdouble []')->meta,
{
element_count => 0,
element_size => 16,
element_type => 'float',
ffi_type => 'longdouble',
size => 0,
type => 'array',
type_code => FFI_PL_TYPE_LONG_DOUBLE | FFI_PL_SHAPE_ARRAY,
},
'variable array',
) or diag explain $type;
};
subtest 'complex' => sub {
skip_all 'test requires support for complex'
unless FFI::Platypus::TypeParser->have_type('complex_float');
skip_all 'test requires support for complex'
unless FFI::Platypus::TypeParser->have_type('complex_double');
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('complex_float []')->meta,
{
element_count => 0,
element_size => 8,
element_type => 'float',
ffi_type => 'complex_float',
size => 0,
type => 'array',
type_code => FFI_PL_TYPE_COMPLEX_FLOAT | FFI_PL_SHAPE_ARRAY,
},
'variable array',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('complex_double []')->meta,
{
element_count => 0,
element_size => 16,
element_type => 'float',
ffi_type => 'complex_double',
size => 0,
type => 'array',
type_code => FFI_PL_TYPE_COMPLEX_DOUBLE | FFI_PL_SHAPE_ARRAY,
},
'variable array',
) or diag explain $type;
};
};
subtest pointer => sub {
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('uint64 *')->meta,
{
element_size => 8,
element_type => 'int',
ffi_type => 'uint64',
sign => 0,
size => $pointer_size,
type => 'pointer',
type_code => FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_POINTER,
},
'pointer',
) or diag explain $type;
subtest 'longdouble' => sub {
skip_all 'test requires support for long double'
unless FFI::Platypus::TypeParser->have_type('longdouble');
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('longdouble *')->meta,
{
element_size => 16,
element_type => 'float',
ffi_type => 'longdouble',
size => $pointer_size,
type => 'pointer',
type_code => FFI_PL_TYPE_LONG_DOUBLE | FFI_PL_SHAPE_POINTER,
},
'longdouble pointer',
) or diag explain $type;
};
subtest 'complex' => sub {
skip_all 'test requires support for complex'
unless FFI::Platypus::TypeParser->have_type('complex_float');
skip_all 'test requires support for complex'
unless FFI::Platypus::TypeParser->have_type('complex_double');
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('complex_float *')->meta,
{
element_size => 8,
element_type => 'float',
ffi_type => 'complex_float',
size => $pointer_size,
type => 'pointer',
type_code => FFI_PL_TYPE_COMPLEX_FLOAT | FFI_PL_SHAPE_POINTER,
},
'complex float pointer',
) or diag explain $type;
is(
$type = FFI::Platypus::TypeParser::Version0->new->parse('complex_double *')->meta,
{
element_size => 16,
element_type => 'float',
ffi_type => 'complex_double',
size => $pointer_size,
type => 'pointer',
type_code => FFI_PL_TYPE_COMPLEX_DOUBLE | FFI_PL_SHAPE_POINTER,
},
'complex double pointer',
) or diag explain $type;
};
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_typeparser_version1.t 000644 000000 000000 00000022516 15251066120 023104 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::Internal;
use FFI::Platypus::TypeParser::Version1;
use Data::Dumper qw( Dumper );
my $tp = FFI::Platypus::TypeParser::Version1->new;
my $pointer_size = FFI::Platypus->new->sizeof('opaque');
subtest 'bad types' => sub {
eval { $tp->parse("bogus") };
like "$@", qr/^unknown type: bogus/;
eval { $tp->parse("*(^^%*%I(*&&^") };
like "$@", qr/^bad type name:/;
};
subtest 'basic types' => sub {
subtest 'void' => sub {
my $void = $tp->parse('void');
isa_ok $void, 'FFI::Platypus::Type';
is $void->type_code, FFI_PL_TYPE_VOID;
eval { $tp->parse('void*') };
like "$@", qr/^void pointer not allowed/;
eval { $tp->parse('void[]') };
like "$@", qr/^void array not allowed/;
};
subtest 'non-void' => sub {
is(
$tp->parse('sint8')->type_code,
FFI_PL_TYPE_SINT8,
);
is(
$tp->parse('sint8*')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('sint8[]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('sint8[]')->meta->{size},
0,
);
is(
$tp->parse('sint8[10]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('sint8[10]')->meta->{size},
10,
);
};
subtest 'string' => sub {
is(
$tp->parse('string')->type_code,
FFI_PL_TYPE_STRING,
);
is($tp->parse('string')->is_ro, 1);
is(
$tp->parse('string rw')->type_code,
FFI_PL_TYPE_STRING,
);
is(
$tp->parse('string ro')->type_code,
FFI_PL_TYPE_STRING,
);
is($tp->parse('string ro')->is_ro, 1);
is($tp->parse('string rw')->is_ro, 0);
is(
$tp->parse('string*')->type_code,
FFI_PL_TYPE_STRING | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('string[]')->type_code,
FFI_PL_TYPE_STRING | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('string[]')->meta->{size},
0,
);
is(
$tp->parse('string[10]')->type_code,
FFI_PL_TYPE_STRING | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('string[10]')->meta->{size},
10 * $pointer_size,
);
};
subtest 'bogus' => sub {
eval { $tp->parse('sint8[0]') };
like "$@", qr/^array size must be larger than 0/;
};
};
subtest 'type map' => sub {
my $tp = FFI::Platypus::TypeParser::Version1->new;
$tp->type_map({
'char' => 'sint8',
'int' => 'sint32',
'unsigned int' => 'uint32',
'intptr' => 'sint32*',
});
is(
$tp->parse('char')->type_code,
FFI_PL_TYPE_SINT8,
);
is(
$tp->parse('int')->type_code,
FFI_PL_TYPE_SINT32,
);
is(
$tp->parse('unsigned int')->type_code,
FFI_PL_TYPE_UINT32,
);
is(
$tp->parse('char*')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('int*')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('unsigned int *')->type_code,
FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('char[]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('int[]')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('unsigned int []')->type_code,
FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('char[]')->meta->{size},
0,
);
is(
$tp->parse('int[]')->meta->{size},
0,
);
is(
$tp->parse('unsigned int []')->meta->{size},
0,
);
is(
$tp->parse('char[22]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('int[22]')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('unsigned int [22]')->type_code,
FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('char[22]')->meta->{size},
22,
);
is(
$tp->parse('int[22]')->meta->{size},
88,
);
is(
$tp->parse('unsigned int [22]')->meta->{size},
88,
);
eval { $tp->parse('int[0]') };
like "$@", qr/^array size must be larger than 0/;
is(
$tp->parse('intptr')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_POINTER,
);
eval { $tp->parse('intptr*') };
like "$@", qr/^bad type name: sint32\* \*/;
eval { $tp->parse('intptr[]') };
like "$@", qr/^bad type name: sint32\* \[\]/;
eval { $tp->parse('intptr[10]') };
like "$@", qr/^bad type name: sint32\* \[10\]/;
};
subtest 'fixed record / fixed string' => sub {
subtest 'zero bad' => sub {
my @bad = (
'string(0)',
'record(0)',
' string(0)',
'string(0) ',
'string (0)',
' string (0) ',
);
foreach my $bad (@bad)
{
eval { $tp->parse( $bad ) };
like "$@", qr{^fixed record / fixed string size must be larger than 0};
}
};
subtest 'ten good' => sub {
my @good = (
'string(10)*',
'record(10)*',
' string(10)*',
'string(10) *',
'string (10)*',
' string (10)* ',
);
foreach my $good (@good)
{
my $type = $tp->parse($good);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_RECORD;
is $type->meta->{size}, 10;
is $type->meta->{ref}, 0;
}
};
subtest 'ten pass-by-value' => sub {
my @good = (
'string(10)',
'record(10)',
' string(10)',
'string(10) ',
'string (10)',
' string (10) ',
);
foreach my $good (@good)
{
eval { $tp->parse($good) };
like "$@", qr{^fixed string / classless record not allowed as value type};
}
};
};
subtest 'record class' => sub {
{
package Foo::Bar1;
sub ffi_record_size { 220 };
}
{
package Foo::Bar2;
sub _ffi_record_size { 220 };
}
{
package Foo::Bar3;
}
subtest 'good with size' => sub {
my @good = qw(
record(Foo::Bar1)*
record(Foo::Bar2)*
);
foreach my $good (@good)
{
my $type = $tp->parse($good);
isa_ok $type, 'FFI::Platypus::Type';
}
};
subtest 'bad without size' => sub {
my @bad = qw(
record(Foo::Bar3)*
record(Foo::Bar4)*
);
foreach my $bad (@bad)
{
eval { $tp->parse($bad) };
like "$@", qr/^Foo::Bar[34] has no ffi_record_size or _ffi_record_size method/;
}
};
{
package Foo::Bar5;
use FFI::Platypus::Record;
record_layout(qw(
string(67) foo
));
}
subtest 'pass-by-value' => sub {
my @bad = qw(
record(Foo::Bar5)
);
foreach my $bad (@bad)
{
my $type = $tp->parse($bad);
isa_ok $type, 'FFI::Platypus::Type';
}
};
subtest 'alias' => sub {
local $@ = '';
my $check = eval { $tp->check_alias('foo_bar5_t') };
is "$@", "";
is $check, 1;
eval { $tp->set_alias('foo_bar5_t', $tp->parse('record(Foo::Bar5)') ) };
is "$@", "";
is $tp->parse('foo_bar5_t')->type_code, FFI_PL_TYPE_RECORD_VALUE;
is $tp->parse('foo_bar5_t*')->type_code, FFI_PL_TYPE_RECORD;
is $tp->parse('foo_bar5_t*')->sizeof, 67;
};
};
subtest 'check alias' => sub {
is(
$tp->check_alias('foo_bar_baz_1239_XOR'),
1,
);
eval { $tp->check_alias('foo bar') };
like "$@", qr/^spaces not allowed in alias/;
eval { $tp->check_alias('!$#!$#') };
like "$@", qr/^allowed characters for alias: \[A-Za-z0-9_\]/;
eval { $tp->check_alias('void') };
like "$@", qr/^alias "void" conflicts with existing type/;
eval { $tp->check_alias('struct') };
like "$@", qr/^reserved world "struct" cannot be used as an alias/;
eval { $tp->check_alias('enum') };
like "$@", qr/^reserved world "enum" cannot be used as an alias/;
my $tp = FFI::Platypus::TypeParser::Version1->new;
$tp->type_map({
'foo_t' => 'sint16',
});
eval { $tp->check_alias('foo_t') };
like "$@", qr/^alias "foo_t" conflicts with existing type/;
$tp->set_alias('bar_t' => $tp->parse('sint32'));
eval { $tp->check_alias('bar_t') };
like "$@", qr/^alias "bar_t" conflicts with existing type/;
};
subtest 'use alias' => sub {
my $tp = FFI::Platypus::TypeParser::Version1->new;
$tp->set_alias('foo_t' => $tp->parse('sint8'));
$tp->set_alias('bar_t' => $tp->parse('sint8*'));
is(
$tp->parse('foo_t')->type_code,
FFI_PL_TYPE_SINT8,
);
is(
$tp->parse('foo_t*')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('foo_t[]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('foo_t[]')->meta->{size},
0,
);
is(
$tp->parse('foo_t[99]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('foo_t[99]')->meta->{size},
99,
);
is(
$tp->parse('bar_t')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
eval { $tp->parse('bar_t*') };
like "$@", qr/^cannot make a pointer to bar_t/;
eval { $tp->parse('bar_t[]') };
like "$@", qr/^cannot make an array of bar_t/;
eval { $tp->parse('bar_t[200]') };
like "$@", qr/^cannot make an array of bar_t/;
};
subtest 'object' => sub {
{ package Roger; }
is(
$tp->parse('object(Roger)')->type_code,
FFI_PL_SHAPE_OBJECT | FFI_PL_TYPE_OPAQUE,
);
is(
$tp->parse('object(Roger,sint32)')->type_code,
FFI_PL_SHAPE_OBJECT | FFI_PL_TYPE_SINT32,
);
local $@ = '';
eval { $tp->parse('object(Roger,float)') };
like "$@", qr/^cannot make an object of float/;
};
done_testing;
FFI-Platypus-2.12/t/ffi_platypus_typeparser_version2.t 000644 000000 000000 00000023062 15251066120 023102 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::Internal;
use FFI::Platypus::TypeParser::Version2;
use Data::Dumper qw( Dumper );
my $tp = FFI::Platypus::TypeParser::Version2->new;
my $pointer_size = FFI::Platypus->new->sizeof('opaque');
subtest 'bad types' => sub {
eval { $tp->parse("bogus") };
like "$@", qr/^unknown type: bogus/;
eval { $tp->parse("*(^^%*%I(*&&^") };
like "$@", qr/^bad type name:/;
};
subtest 'basic types' => sub {
subtest 'void' => sub {
my $void = $tp->parse('void');
isa_ok $void, 'FFI::Platypus::Type';
is $void->type_code, FFI_PL_TYPE_VOID;
eval { $tp->parse('void*') };
like "$@", qr/^void pointer not allowed/;
eval { $tp->parse('void[]') };
like "$@", qr/^void array not allowed/;
};
subtest 'non-void' => sub {
is(
$tp->parse('sint8')->type_code,
FFI_PL_TYPE_SINT8,
);
is(
$tp->parse('sint8*')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('sint8[]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('sint8[]')->meta->{size},
0,
);
is(
$tp->parse('sint8[10]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('sint8[10]')->meta->{size},
10,
);
};
subtest 'string' => sub {
is(
$tp->parse('string')->type_code,
FFI_PL_TYPE_STRING,
);
is($tp->parse('string')->is_ro, 1);
is(
$tp->parse('string rw')->type_code,
FFI_PL_TYPE_STRING,
);
is(
$tp->parse('string ro')->type_code,
FFI_PL_TYPE_STRING,
);
is($tp->parse('string ro')->is_ro, 1);
is($tp->parse('string rw')->is_ro, 0);
is(
$tp->parse('string*')->type_code,
FFI_PL_TYPE_STRING | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('string[]')->type_code,
FFI_PL_TYPE_STRING | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('string[]')->meta->{size},
0,
);
is(
$tp->parse('string[10]')->type_code,
FFI_PL_TYPE_STRING | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('string[10]')->meta->{size},
10 * $pointer_size,
);
};
subtest 'bogus' => sub {
eval { $tp->parse('sint8[0]') };
like "$@", qr/^array size must be larger than 0/;
};
};
subtest 'type map' => sub {
my $tp = FFI::Platypus::TypeParser::Version2->new;
$tp->type_map({
'char' => 'sint8',
'int' => 'sint32',
'unsigned int' => 'uint32',
'intptr' => 'sint32*',
});
is(
$tp->parse('char')->type_code,
FFI_PL_TYPE_SINT8,
);
is(
$tp->parse('int')->type_code,
FFI_PL_TYPE_SINT32,
);
is(
$tp->parse('unsigned int')->type_code,
FFI_PL_TYPE_UINT32,
);
is(
$tp->parse('char*')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('int*')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('unsigned int *')->type_code,
FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('char[]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('int[]')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('unsigned int []')->type_code,
FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('char[]')->meta->{size},
0,
);
is(
$tp->parse('int[]')->meta->{size},
0,
);
is(
$tp->parse('unsigned int []')->meta->{size},
0,
);
is(
$tp->parse('char[22]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('int[22]')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('unsigned int [22]')->type_code,
FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('char[22]')->meta->{size},
22,
);
is(
$tp->parse('int[22]')->meta->{size},
88,
);
is(
$tp->parse('unsigned int [22]')->meta->{size},
88,
);
eval { $tp->parse('int[0]') };
like "$@", qr/^array size must be larger than 0/;
is(
$tp->parse('intptr')->type_code,
FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_POINTER,
);
eval { $tp->parse('intptr*') };
like "$@", qr/^bad type name: sint32\* \*/;
eval { $tp->parse('intptr[]') };
like "$@", qr/^bad type name: sint32\* \[\]/;
eval { $tp->parse('intptr[10]') };
like "$@", qr/^bad type name: sint32\* \[10\]/;
};
subtest 'fixed record / fixed string' => sub {
subtest 'zero bad' => sub {
my @bad = (
'string(0)',
'record(0)',
' string(0)',
'string(0) ',
'string (0)',
' string (0) ',
);
foreach my $bad (@bad)
{
eval { $tp->parse( $bad ) };
like "$@", qr{^fixed record / fixed string size must be larger than 0};
}
};
subtest 'ten good' => sub {
my @good = (
'string(10)*',
'record(10)*',
' string(10)*',
'string(10) *',
'string (10)*',
' string (10)* ',
);
foreach my $good (@good)
{
my $type = $tp->parse($good);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_RECORD;
is $type->meta->{size}, 10;
is $type->meta->{ref}, 0;
}
};
subtest 'ten pass-by-value' => sub {
my @good = (
'string(10)',
' string(10)',
'string(10) ',
'string (10)',
' string (10) ',
);
foreach my $good (@good)
{
my $type = $tp->parse($good);
isa_ok $type, 'FFI::Platypus::Type';
is $type->type_code, FFI_PL_TYPE_RECORD;
is $type->meta->{size}, 10;
is $type->meta->{ref}, 0;
}
};
subtest 'ten record pass-by-value' => sub {
local $@;
eval { $tp->parse("record(10)") };
like "$@", qr/^classless record not allowed as value type/;
};
};
subtest 'record class' => sub {
{
package Foo::Bar1;
sub ffi_record_size { 220 };
}
{
package Foo::Bar2;
sub _ffi_record_size { 220 };
}
{
package Foo::Bar3;
}
subtest 'good with size' => sub {
my @good = qw(
record(Foo::Bar1)*
record(Foo::Bar2)*
);
foreach my $good (@good)
{
my $type = $tp->parse($good);
isa_ok $type, 'FFI::Platypus::Type';
}
};
subtest 'bad without size' => sub {
my @bad = qw(
record(Foo::Bar3)*
record(Foo::Bar4)*
);
foreach my $bad (@bad)
{
eval { $tp->parse($bad) };
like "$@", qr/^Foo::Bar[34] has no ffi_record_size or _ffi_record_size method/;
}
};
{
package Foo::Bar5;
use FFI::Platypus::Record;
record_layout(qw(
string(67) foo
));
}
subtest 'pass-by-value' => sub {
my @bad = qw(
record(Foo::Bar5)
);
foreach my $bad (@bad)
{
my $type = $tp->parse($bad);
isa_ok $type, 'FFI::Platypus::Type';
}
};
subtest 'alias' => sub {
local $@ = '';
my $check = eval { $tp->check_alias('foo_bar5_t') };
is "$@", "";
is $check, 1;
eval { $tp->set_alias('foo_bar5_t', $tp->parse('record(Foo::Bar5)') ) };
is "$@", "";
is $tp->parse('foo_bar5_t')->type_code, FFI_PL_TYPE_RECORD_VALUE;
is $tp->parse('foo_bar5_t*')->type_code, FFI_PL_TYPE_RECORD;
is $tp->parse('foo_bar5_t*')->sizeof, 67;
};
};
subtest 'check alias' => sub {
is(
$tp->check_alias('foo_bar_baz_1239_XOR'),
1,
);
eval { $tp->check_alias('foo bar') };
like "$@", qr/^spaces not allowed in alias/;
eval { $tp->check_alias('!$#!$#') };
like "$@", qr/^allowed characters for alias: \[A-Za-z0-9_\]/;
eval { $tp->check_alias('void') };
like "$@", qr/^alias "void" conflicts with existing type/;
eval { $tp->check_alias('struct') };
like "$@", qr/^reserved world "struct" cannot be used as an alias/;
eval { $tp->check_alias('enum') };
like "$@", qr/^reserved world "enum" cannot be used as an alias/;
my $tp = FFI::Platypus::TypeParser::Version2->new;
$tp->type_map({
'foo_t' => 'sint16',
});
eval { $tp->check_alias('foo_t') };
like "$@", qr/^alias "foo_t" conflicts with existing type/;
$tp->set_alias('bar_t' => $tp->parse('sint32'));
eval { $tp->check_alias('bar_t') };
like "$@", qr/^alias "bar_t" conflicts with existing type/;
};
subtest 'use alias' => sub {
my $tp = FFI::Platypus::TypeParser::Version2->new;
$tp->set_alias('foo_t' => $tp->parse('sint8'));
$tp->set_alias('bar_t' => $tp->parse('sint8*'));
is(
$tp->parse('foo_t')->type_code,
FFI_PL_TYPE_SINT8,
);
is(
$tp->parse('foo_t*')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
is(
$tp->parse('foo_t[]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('foo_t[]')->meta->{size},
0,
);
is(
$tp->parse('foo_t[99]')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY,
);
is(
$tp->parse('foo_t[99]')->meta->{size},
99,
);
is(
$tp->parse('bar_t')->type_code,
FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER,
);
eval { $tp->parse('bar_t*') };
like "$@", qr/^cannot make a pointer to bar_t/;
eval { $tp->parse('bar_t[]') };
like "$@", qr/^cannot make an array of bar_t/;
eval { $tp->parse('bar_t[200]') };
like "$@", qr/^cannot make an array of bar_t/;
};
subtest 'object' => sub {
{ package Roger; }
is(
$tp->parse('object(Roger)')->type_code,
FFI_PL_SHAPE_OBJECT | FFI_PL_TYPE_OPAQUE,
);
is(
$tp->parse('object(Roger,sint32)')->type_code,
FFI_PL_SHAPE_OBJECT | FFI_PL_TYPE_SINT32,
);
local $@ = '';
eval { $tp->parse('object(Roger,float)') };
like "$@", qr/^cannot make an object of float/;
};
done_testing;
FFI-Platypus-2.12/t/ffi_probe.t 000644 000000 000000 00000007123 15251066120 016223 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use 5.008004;
use FFI::Probe;
use FFI::Probe::Runner;
use Capture::Tiny qw( capture_merged );
use FFI::Temp;
use File::Basename qw( basename );
use Config;
sub n (&)
{
my($code) = @_;
my($out, @ret) = capture_merged {
$code->();
};
note $out;
@ret;
}
sub f (@)
{
foreach my $filename (@_)
{
note "==@{[ basename $filename ]}==";
my $fh;
open $fh, '<', $filename;
note do { local $/; <$fh> };
close $fh;
}
}
my $runner = do {
my $exe = "blib/lib/auto/share/dist/FFI-Platypus/probe/bin/dlrun$Config{exe_ext}";
unless(-f $exe)
{
require FFI::Probe::Runner::Builder;
my $out;
my $exception;
($out, $exe, $exception) = capture_merged {
my $exe = eval {
FFI::Probe::Runner::Builder->new( dir => FFI::Temp->newdir( CLEANUP => 1, TEMPLATE => 'test-probe-XXXXXX' ) )->build;
};
($exe, $exception);
};
note $out;
die $exception if $exception;
}
FFI::Probe::Runner->new(
exe => $exe,
);
};
subtest 'check_header' => sub {
my $dir = FFI::Temp->newdir;
my $probe = FFI::Probe->new(
log => "$dir/probe.log",
data_filename => "$dir/probe.pl",
runner => $runner,
);
isa_ok $probe, 'FFI::Probe';
n {
$probe->check_header('stdio.h');
$probe->check_header('bogus/does/not/exist.h');
};
is($probe->data->{header}->{"stdio.h"}, 1);
is($probe->data->{header}->{"bogus/does/not/exist.h"}, 0);
undef $probe;
f "$dir/probe.log",
"$dir/probe.pl";
# make sure that we cache that data correctly.
my $probe2 = FFI::Probe->new(
log => "$dir/probe2.log",
data_filename => "$dir/probe.pl",
runner => $runner,
);
is($probe2->data->{header}->{"stdio.h"}, 1);
is($probe2->data->{header}->{"bogus/does/not/exist.h"}, 0);
n {
$probe2->check_header('stdio.h');
$probe2->check_header('bogus/does/not/exist.h');
};
is($probe2->data->{header}->{"stdio.h"}, 1);
is($probe2->data->{header}->{"bogus/does/not/exist.h"}, 0);
f "$dir/probe2.log",
"$dir/probe.pl";
};
subtest check_eval => sub {
my $dir = FFI::Temp->newdir;
# make sure that we cache that data correctly.
my $probe = FFI::Probe->new(
log => "$dir/probe.log",
data_filename => "$dir/probe.pl",
runner => $runner,
);
my $ret;
n {
$ret = $probe->check_eval(
eval => {
'foo.bar.baz' => [ '%d' => '1+2' ],
},
);
};
ok $ret, 'foo.bar.baz';
is $probe->data, { foo => { bar => { baz => 3 } } };
n {
$ret = $probe->check_eval(
decl => ['char buffer[256];'],
stmt => ['sprintf(buffer, "hello world %d", 3+4);'],
eval => {
'foo.bar.string' => [ '%s' => 'buffer' ],
},
);
};
ok $ret, 'foo.bar.string';
is $probe->data, { foo => { bar => { baz => 3, string => 'hello world 7' } } };
n {
$ret = $probe->check_type_int('unsigned char');
};
is $ret, 'uint8';
is $probe->data->{type}->{'unsigned char'}->{size}, 1;
is $probe->data->{type}->{'unsigned char'}->{sign}, 'unsigned';
like $probe->data->{type}->{'unsigned char'}->{align}, qr/^[0-9]+$/;
n {
$ret = $probe->check_type_float('float');
};
is $ret, 'float';
is $probe->data->{type}->{'float'}->{size}, 4;
like $probe->data->{type}->{'float'}->{align}, qr/^[0-9]+$/;
n {
$ret = $probe->check_type_pointer;
};
is $ret, 'pointer';
like $probe->data->{type}->{pointer}->{size}, qr/^[0-9]+$/;
like $probe->data->{type}->{pointer}->{align}, qr/^[0-9]+$/;
$probe->save;
undef $probe;
f "$dir/probe.log",
"$dir/probe.pl";
};
done_testing;
FFI-Platypus-2.12/t/ffi_probe_runner.t 000644 000000 000000 00000005246 15251066120 017620 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use Config;
use FFI::Probe::Runner;
use Capture::Tiny qw( capture_merged );
use FFI::Build;
use FFI::Build::File::C;
use FFI::Temp;
use lib 't/lib';
use Test::Cleanup;
my $runner;
my $tempdir = FFI::Temp->newdir( TEMPLATE => 'test-probe-XXXXXX' );
subtest basic => sub {
my $exe = "blib/lib/auto/share/dist/FFI-Platypus/probe/bin/dlrun$Config{exe_ext}";
unless(-f $exe)
{
require FFI::Probe::Runner::Builder;
my $out;
my $exception;
($out, $exe, $exception) = capture_merged {
my $exe = eval {
FFI::Probe::Runner::Builder->new( dir => $tempdir )->build;
};
($exe, $exception);
};
note $out;
die $exception if $exception;
}
note "exe=$exe";
$runner = FFI::Probe::Runner->new(
exe => $exe,
);
isa_ok $runner, 'FFI::Probe::Runner';
is($runner->flags, '-');
is($runner->verify, 1);
};
subtest 'run not pass' => sub {
my $dir = FFI::Temp->newdir( TEMPLATE => 'test-probe-XXXXXX' );
my $lib = do {
my $build = FFI::Build->new(
'frooble1',
dir => $dir,
buildname => "test-probe-$$-@{[ time ]}",
verbose => 1,
source => 'corpus/ffi_probe_runner/foo.c',
export => ['dlmain'],
);
note capture_merged {
$build->build;
();
};
cleanup("corpus/ffi_probe_runner/@{[ $build->buildname ]}");
$build->file->path;
};
note "lib=$lib";
my $res = $runner->run($lib, 'one','two','three');
is($res->rv, 12);
is($res->signal, 0);
like($res->stdout, qr!argc=4!ms);
like($res->stdout, qr!argv\[0\]=.*/bin/dlrun!ms);
like($res->stdout, qr!argv\[1\]=one!ms);
like($res->stdout, qr!argv\[2\]=two!ms);
like($res->stdout, qr!argv\[3\]=three!ms);
like($res->stderr, qr/something to std error/);
ok(!$res->pass);
};
subtest 'run pass' => sub {
my $dir = FFI::Temp->newdir( TEMPLATE => 'test-probe-XXXXXX' );
my $lib = do {
my $build = FFI::Build->new(
'frooble2',
verbose => 1,
dir => $dir,
buildname => "test-probe-$$-@{[ time ]}",
source => 'corpus/ffi_probe_runner/bar.c',
export => ['dlmain'],
);
note capture_merged {
$build->build;
();
};
cleanup("corpus/ffi_probe_runner/@{[ $build->buildname ]}");
$build->file->path;
};
note "lib=$lib";
my $res = $runner->run($lib, 'one','two','three');
is($res->rv, 0);
is($res->signal, 0);
like($res->stdout, qr!argc=4!ms);
like($res->stdout, qr!argv\[0\]=.*/bin/dlrun!ms);
like($res->stdout, qr!argv\[1\]=one!ms);
like($res->stdout, qr!argv\[2\]=two!ms);
like($res->stdout, qr!argv\[3\]=three!ms);
like($res->stderr, qr/something to std error/);
ok(!!$res->pass);
};
done_testing;
FFI-Platypus-2.12/t/ffi_probe_runner_builder.t 000644 000000 000000 00000001670 15251066120 021323 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Temp;
use Capture::Tiny qw( capture_merged );
use FFI::Probe::Runner::Builder;
use IPC::Cmd qw( can_run );
$FFI::Probe::Runner::Builder::VERBOSE = 1;
my $dir = FFI::Temp->newdir( TEMPLATE => 'test-probe-XXXXXX' );
note "dir = $dir";
my $builder = FFI::Probe::Runner::Builder->new(
dir => $dir,
);
foreach my $lib (@{ $builder->libs })
{
note "libs=" . join(' ', @$lib)
}
isa_ok $builder, 'FFI::Probe::Runner::Builder';
my($out1, $exe, $error) = capture_merged {
my $exe = eval { $builder->build };
($exe, $@);
};
note $out1;
is $error, '', 'no error';
ok -f $exe, "executable exists";
note "exe = $exe";
my($out2, $ret) = capture_merged {
print "+ $exe verify self\n";
system $exe, 'verify', 'self';
$?;
};
note $out2;
is $ret, 0, 'verify ok';
if($^O eq 'linux' && can_run('ldd'))
{
note capture_merged {
print "+ ldd $exe\n";
system "ldd", $exe;
();
};
}
done_testing;
FFI-Platypus-2.12/t/ffi_probe_runner_result.t 000644 000000 000000 00000001136 15251066120 021210 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Probe::Runner::Result;
my %std = ( stdout => "foo\n", stderr => "bar\n", rv => 0, signal => 0 );
my $result1 = FFI::Probe::Runner::Result->new(
%std
);
isa_ok $result1, 'FFI::Probe::Runner::Result';
ok($result1->pass);
my $result2 = FFI::Probe::Runner::Result->new(
%std,
rv => 2,
);
isa_ok $result2, 'FFI::Probe::Runner::Result';
is($result2->rv, 2);
ok(!$result2->pass);
my $result3 = FFI::Probe::Runner::Result->new(
%std,
signal => 9,
);
isa_ok $result3, 'FFI::Probe::Runner::Result';
is($result3->signal, 9);
ok(!$result3->pass);
done_testing;
FFI-Platypus-2.12/t/ffi_temp.t 000644 000000 000000 00000000302 15251066120 016051 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Temp;
my $dir = FFI::Temp->newdir;
ok -d $dir;
note "dir = $dir";
my $fh = FFI::Temp->new;
close $fh;
note "file = @{[ $fh->filename ]}";
done_testing;
FFI-Platypus-2.12/t/forks.t 000644 000000 000000 00000001220 15251066120 015404 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib;
use FFI::Platypus;
use File::Spec;
BEGIN
{
my $path;
foreach my $inc (@INC)
{
$path = File::Spec->catfile($inc, 'forks.pm');
last if -f $path;
}
skip_all 'Test requires forks' unless defined $path && -f $path;
}
use forks;
my $ffi = FFI::Platypus->new(lib => find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi' ));
sub f0
{
$ffi->function(f0 => ['uint8'] => 'uint8')->call(@_);
}
sub otherthread
{
my $val = f0(22);
undef $ffi;
$val;
}
ok 1;
is(threads->create(\&otherthread)->join(), 22, 'works in a thread');
is f0(24), 24, 'works in main thread';
done_testing;
FFI-Platypus-2.12/t/gh117.t 000644 000000 000000 00000000533 15251066120 015115 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib qw( find_lib );
use FFI::Platypus;
my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
my $ffi = FFI::Platypus->new;
$ffi->lib($libtest);
my $value64 = $ffi->function('gh117' => [] => 'uint64')->call;
note "value64 = $value64";
is($value64, "1099511627775");
done_testing;
FFI-Platypus-2.12/t/gh129.t 000644 000000 000000 00000003637 15251066120 015130 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib qw( find_lib );
use FFI::Platypus;
use Carp ();
my $ffi = FFI::Platypus->new;
$ffi->lib(find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi');
subtest 'attached function' => sub {
$ffi->attach( f0 => ['uint8'] => 'uint8' => sub {
package Foo::Bar;
my($xsub, $arg) = @_;
Carp::croak "here";
$xsub->($arg);
});
local $@ = '';
eval { f0(1) }; my $line = __LINE__;
like "$@", qr/^here .*gh129\.t line \Q$line\E/;
};
subtest 'dynamic function' => sub {
my $f0 = $ffi->function( f0 => ['uint8'] => 'uint8' => sub {
package Foo::Bar;
my($xsub, $arg) = @_;
Carp::croak "here";
$xsub->($arg);
});
local $@ = '';
eval { $f0->call(1) }; my $line = __LINE__;
like "$@", qr/^here .*gh129\.t line \Q$line\E/;
};
subtest 'type wrapper argument' => sub {
$ffi->custom_type( foo_t => {
native_type => 'uint8',
perl_to_native => sub {
package Foo::Bar;
Carp::croak "here";
},
});
my $f0 = $ffi->function( f0 => ['foo_t'] => 'uint8');
local $@ = '';
eval { $f0->call(22) }; my $line = __LINE__;
like "$@", qr/^here .*gh129\.t line \Q$line\E/;
};
subtest 'type wrapper argument post' => sub {
$ffi->custom_type( baz_t => {
native_type => 'uint8',
perl_to_native_post => sub {
package Foo::Bar;
Carp::croak "here";
},
});
my $f0 = $ffi->function( f0 => ['baz_t'] => 'uint8');
local $@ = '';
eval { $f0->call(22) }; my $line = __LINE__;
like "$@", qr/^here .*gh129\.t line \Q$line\E/;
};
subtest 'type wrapper return type' => sub {
$ffi->custom_type( bar_t => {
native_type => 'uint8',
native_to_perl => sub {
package Foo::Bar;
Carp::croak "here";
},
});
my $f0 = $ffi->function( f0 => ['uint8'] => 'bar_t');
local $@ = '';
eval { $f0->call(22) }; my $line = __LINE__;
like "$@", qr/^here .*gh129\.t line \Q$line\E/;
};
done_testing;
FFI-Platypus-2.12/t/gh260.t 000644 000000 000000 00000004525 15251066120 015121 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib qw( find_lib );
use Config qw( %Config );
# https://github.com/PerlFFI/FFI-Platypus/issues/260
#
# Confirm that the minimum and maximum value for each of the standard
# integer types survives a round trip unmolested as a scalar argument
# and return value, as a pointer, as a fixed size array, and as a
# variable size (pointer based) array. See also gh#258, where a bug
# in a related project was masked for a long time because existing
# tests only ever used small values that happen to fit into any
# integer representation.
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
my %minmax = (
sint8 => [ -128, 127 ],
uint8 => [ 0, 255 ],
sint16 => [ -32768, 32767 ],
uint16 => [ 0, 65535 ],
sint32 => [ -2147483648, 2147483647 ],
uint32 => [ 0, 4294967295 ],
);
if($Config{uvsize} >= 8)
{
$minmax{sint64} = [ -9223372036854775808, 9223372036854775807 ];
$minmax{uint64} = [ 0, 18446744073709551615 ];
}
else
{
note 'skipping sint64/uint64 since this Perl does not have 64 bit integer support';
}
foreach my $type (sort keys %minmax)
{
subtest $type => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => 2, lib => [@lib] );
$ffi->attach( [ "${type}_add" => 'add' ] => [ "$type", "$type" ] => "$type" );
$ffi->attach( [ "${type}_inc" => 'inc' ] => [ "${type}*", "$type" ] => "${type}*" );
$ffi->attach( [ "${type}_sum" => 'sum' ] => [ "${type}[10]" ] => "$type" );
$ffi->attach( [ "${type}_sum2" => 'sum2' ] => [ "${type}[]", 'size_t' ] => "$type" );
foreach my $value (@{ $minmax{$type} })
{
subtest "value = $value" => sub {
is add($value, 0), $value, 'scalar argument and return value';
my $copy = $value;
is ${ inc(\$copy, 0) }, $value, 'pointer argument and return value';
is $copy, $value, 'value pointed to is unmodified by increment of 0';
my @array10 = ($value, (0) x 9);
is sum(\@array10), $value, 'fixed size array argument';
my @array_n = ($value);
is sum2(\@array_n, scalar @array_n), $value, 'variable size (pointer) array argument';
};
}
};
}
done_testing;
FFI-Platypus-2.12/t/gh323.t 000644 000000 000000 00000001756 15251066120 015124 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::Memory qw( malloc free );
skip_all 'test requires variadic function support'
unless eval { FFI::Platypus->new( lib => [undef] )->function(
sprintf => ['opaque', 'string'] => ['float'] ) };
foreach my $api (0,1,2)
{
subtest "api => $api" => sub {
our $ffi = FFI::Platypus->new( api => $api, lib => [undef], experimental => ($api > 2 ? $api : undef));
$ffi->type('float' => 'my_float');
sub callit
{
my($type) = @_;
my $ptr = malloc 1024;
$ffi->function( sprintf => ['opaque','string'] => [$type] )->call($ptr, "%f", 3.14);
my $string = $ffi->cast('opaque' => 'string', $ptr);
free $ptr;
return $string;
}
my $double = callit('double');
my $float = callit('float');
note "double = $double";
note "float = $float";
is $float, $double;
$float = callit('my_float');
note "my_float = $float";
is $float, $double;
};
}
done_testing;
FFI-Platypus-2.12/t/lib/ 000755 000000 000000 00000000000 15251066120 014646 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/t/lib/Test/ 000755 000000 000000 00000000000 15251066120 015565 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/t/lib/Test/Cleanup.pm 000644 000000 000000 00000000546 15251066120 017517 0 ustar 00root root 000000 000000 package Test::Cleanup;
use strict;
use warnings;
use Exporter qw( import );
use File::Path qw( rmtree );
our @EXPORT = qw( cleanup );
my @cleanup;
sub cleanup
{
push @cleanup, @_;
}
END
{
foreach my $item (@cleanup)
{
if(ref $item eq 'CODE')
{
$item->();
}
else
{
rmtree("$item", { verbose => 0 });
}
}
}
1;
FFI-Platypus-2.12/t/lib/Test/FauxAttach.pm 000644 000000 000000 00000002210 15251066120 020146 0 ustar 00root root 000000 000000 package Test::FauxAttach;
use strict;
use warnings;
use Test2::V0 ();
my @funcs;
# This plugin implements an alternative to attach/sub_ref
# without the process level-leak which makes it easier to
# find real leaks. It relies on no attached sub being called
# in END, etc. blocks, which we cannot normally rely on.
# it's also probably a lot slower than a real xsub.
sub import
{
die "load Test::FauxAttach before FFI::Platypus::Function"
if $INC{'FFI/Platypus/Function.pm'};
require FFI::Platypus::Function;
no warnings 'redefine';
*FFI::Platypus::Function::Function::_sub_ref = sub {
my($self, $location) = @_;
push @funcs, $self;
my $i = $#funcs;
sub { $funcs[$i]->call(@_) };
};
*FFI::Platypus::Function::Function::_attach = sub {
my($self, $perl_name, $location, $proto) = @_;
Test2::V0::note(" attaching: $perl_name");
my $xsub = $self->_sub_ref($location);
FFI::Platypus::Function::Wrapper::_set_prototype($proto, $xsub) if defined $proto;
no strict 'refs';
*{"$perl_name"} = $xsub;
};
}
END {
Test2::V0::note("deleting @{[ scalar @funcs ]} attached functions");
@funcs = ();
}
1;
FFI-Platypus-2.12/t/lib/Test/Platypus.pm 000644 000000 000000 00000000654 15251066120 017751 0 ustar 00root root 000000 000000 package Test::Platypus;
use strict;
use warnings;
use Test2::API qw( context );
use Exporter qw( import );
our @EXPORT = qw( platypus );
sub platypus {
my($count, $code) = @_;
my $ffi = eval {
require FFI::Platypus;
FFI::Platypus->new;
};
if($ffi)
{
$code->($ffi);
}
else
{
my $ctx = context();
$ctx->skip('', "Test requires FFI::Platypus") for 1..$count;
$ctx->release;
}
}
1;
FFI-Platypus-2.12/t/memory.t 000644 000000 000000 00000003116 15251066120 015576 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use Config;
use Capture::Tiny qw( capture_merged );
use FFI::Temp;
# libexpat1-dev
skip_all 'tested only in CI' if ($ENV{CIPSOMETHING}||'') ne 'true';
skip_all 'tested only in CI -debug' if $Config{ccflags} !~ /-DDEBUG_LEAKING_SCALARS/;
my %exfail = map { $_ => 1 } qw( attach.pl );
# you can run this on just one (or more) test file in corpus/memory by
# perl -Mblib t/memory.t foo.pl
my @list = @ARGV ? @ARGV : do {
my $dh;
opendir $dh, 'corpus/memory';
grep /\.pl$/, sort readdir $dh;
};
my @supp = do {
my $dh;
opendir $dh, 'corpus/memory/supp';
map { "--suppressions=corpus/memory/supp/$_" } grep /\.supp/, sort readdir $dh;
};
foreach my $name (@list)
{
subtest $name => sub {
local $ENV{PERL_DESTRUCT_LEVEL} = 2;
my $log = FFI::Temp->new;
my @command = (
'valgrind',
'--leak-check=yes',
"--log-file=$log",
'--error-exitcode=2',
#'--gen-suppressions=all',
#'-v',
@supp,
$^X,
'-Mblib',
"corpus/memory/$name",
);
my($out, $exit) = capture_merged {
print "+ @command\n";
system @command;
$?;
};
if($exfail{$name})
{
note "expected fail";
{
my $todo = todo 'expected fail';
is($exit, 0, 'valgrind') or do {
note "[output]\n$out";
note "[log]\n", do { local $/; <$log> };
};
};
}
else
{
note "expected pass";
is($exit, 0, 'valgrind') or do {
diag "[output]\n$out";
diag "[log]\n", do { local $/; <$log> };
};
}
};
}
done_testing;
FFI-Platypus-2.12/t/threads.t 000644 000000 000000 00000001017 15251066120 015716 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
BEGIN { skip_all 'Test requires a threading Perl' unless eval q{ use threads; 1 } }
use FFI::CheckLib;
use FFI::Platypus;
use Config;
my $ffi = FFI::Platypus->new(lib => find_lib(lib => 'test', symbol => 'f0', libpath => 't/ffi' ));
sub f0
{
$ffi->function(f0 => ['uint8'] => 'uint8')->call(@_);
}
sub otherthread
{
my $val = f0(22);
undef $ffi;
$val;
}
ok 1;
is(threads->create(\&otherthread)->join(), 22, 'works in a thread');
is f0(24), 24, 'works in main thread';
done_testing;
FFI-Platypus-2.12/t/type_complex_double.t 000644 000000 000000 00000014113 15251066120 020327 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_complex_float.t
# all instances of "float" have been changed to "double"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
use FFI::CheckLib;
use Data::Dumper qw( Dumper );
BEGIN {
skip_all 'Test requires support for double complex'
unless FFI::Platypus::TypeParser->have_type('complex_double');
}
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, experimental => ($api > 2 ? $api : undef) );
$ffi->lib(find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach(['complex_double_get_real' => 'creal'] => ['complex_double'] => 'double');
$ffi->attach(['complex_double_get_imag' => 'cimag'] => ['complex_double'] => 'double');
$ffi->attach(['complex_double_to_string' => 'to_string'] => ['complex_double'] => 'string');
subtest 'standard argument' => sub {
subtest 'with a real number' => sub {
note "to_string(10.5) = ", to_string(10.5);
is creal(10.5), 10.5, "creal(10.5) = 10.5";
is cimag(10.5), 0.0, "cimag(10.5) = 0.0";
};
subtest 'with an array ref' => sub {
note "to_string([10.5,20.5]) = ", to_string([10.5,20.5]);
is creal([10.5,20.5]), 10.5, "creal([10.5,20.5]) = 10.5";
is cimag([10.5,20.5]), 20.5, "cimag([10.5,20.5]) = 20.5";
};
subtest 'with Math::Complex' => sub {
skip_all 'test requires Math::Complex'
unless eval q{ use Math::Complex (); 1 };
my $c = Math::Complex->make(10.5, 20.5);
note "to_string(\$c) = ", to_string($c);
is creal($c), 10.5, "creal(\$c) = 10.5";
is cimag($c), 20.5, "cimag(\$c) = 20.5";
};
};
$ffi->attach(['complex_double_ptr_get_real' => 'creal_ptr'] => ['complex_double *'] => 'double');
$ffi->attach(['complex_double_ptr_get_imag' => 'cimag_ptr'] => ['complex_double *'] => 'double');
$ffi->attach(['complex_double_ptr_set' => 'complex_set'] => ['complex_double *','double','double'] => 'void');
subtest 'pointer argument' => sub {
subtest 'with a real number' => sub {
note "to_string(10.5) = ", to_string(10.5);
is creal_ptr(\10.5), 10.5, "creal_ptr(\\10.5) = 10.5";
is cimag_ptr(\10.5), 0.0, "cimag_ptr(\\10.5) = 0.0";
};
subtest 'with an array ref' => sub {
note "to_string([10.5,20.5]) = ", to_string([10.5,20.5]);
is creal_ptr(\[10.5,20.5]), 10.5, "creal_ptr(\\[10.5,20.5]) = 10.5";
is cimag_ptr(\[10.5,20.5]), 20.5, "cimag_ptr(\\[10.5,20.5]) = 20.5";
};
subtest 'with Math::Complex' => sub {
skip_all 'test requires Math::Complex'
unless eval q{ use Math::Complex (); 1 };
my $c = Math::Complex->make(10.5, 20.5);
note "to_string(\$c) = ", to_string($c);
is creal_ptr(\$c), 10.5, "creal_ptr(\\$c) = 10.5";
is cimag_ptr(\$c), 20.5, "cimag_ptr(\\$c) = 20.5";
};
subtest 'values set on out (array)' => sub {
my @c;
complex_set(\\@c, 1.0, 2.0);
is \@c, [ 1.0, 2.0 ];
};
subtest 'values set on out (object)' => sub {
skip_all 'test requires Math::Complex'
unless eval q{ use Math::Complex (); 1 };
my $c = Math::Complex->make(0.0, 0.0);
complex_set(\$c, 1.0, 2.0);
is( [ $c->Re, $c->Im ], [1.0,2.0] );
};
subtest 'values set on out (other)' => sub {
my $c;
complex_set(\$c, 1.0, 2.0);
is( $c, [1.0, 2.0]);
};
};
$ffi->attach(['pointer_null' => 'complex_null'] => [] => 'complex_double*');
$ffi->attach(['complex_double_ret' => 'complex_ret'] => ['double','double'] => 'complex_double');
$ffi->attach(['complex_double_ptr_ret' => 'complex_ptr_ret'] => ['double','double'] => 'complex_double*');
subtest 'return value' => sub {
is(complex_ret(1.0,2.0), [1.0,2.0], 'standard');
is(complex_ptr_ret(1.0,2.0), \[1.0,2.0], 'pointer');
is([complex_null()], $api >= 2 ? [undef] : [], 'null');
};
subtest 'complex array arg' => sub {
my $f = $ffi->function(complex_double_array_get => ['complex_double[]','int'] => 'complex_double' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
my $ret;
is( $ret = $f->call(\@a, 0), [0.0,0.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 1), [1.0,2.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 2), [3.0,4.0] )
or diag Dumper($ret);
};
subtest 'complex array arg' => sub {
skip_all 'for api >= 2 only' unless $api >= 2;
my $f = $ffi->function(complex_double_array_get => ['complex_double*','int'] => 'complex_double' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
my $ret;
is( $ret = $f->call(\@a, 0), [0.0,0.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 1), [1.0,2.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 2), [3.0,4.0] )
or diag Dumper($ret);
};
subtest 'complex array arg set' => sub {
my $f = $ffi->function(complex_double_array_set => ['complex_double[]','int','double','double'] => 'void' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
$f->call(\@a, 1, 5.0, 6.0);
is(\@a, [[0.0,0.0], [5.0,6.0], [3.0,4.0]]);
};
subtest 'complex array arg set' => sub {
skip_all 'for api >= 2 only' unless $api >= 2;
my $f = $ffi->function(complex_double_array_set => ['complex_double*','int','double','double'] => 'void' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
$f->call(\@a, 1, 5.0, 6.0);
is(\@a, [[0.0,0.0], [5.0,6.0], [3.0,4.0]]);
};
subtest 'complex array ret' => sub {
my $f = $ffi->function(complex_double_array_ret => [] => 'complex_double[3]' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
my $ret;
is(
$ret = $f->call( \@a ),
\@a,
) or diag Dumper($ret);
};
};
}
done_testing;
FFI-Platypus-2.12/t/type_complex_float.t 000644 000000 000000 00000013607 15251066120 020171 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
use FFI::CheckLib;
use Data::Dumper qw( Dumper );
BEGIN {
skip_all 'Test requires support for float complex'
unless FFI::Platypus::TypeParser->have_type('complex_float');
}
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, experimental => ($api > 2 ? $api : undef) );
$ffi->lib(find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi');
$ffi->attach(['complex_float_get_real' => 'creal'] => ['complex_float'] => 'float');
$ffi->attach(['complex_float_get_imag' => 'cimag'] => ['complex_float'] => 'float');
$ffi->attach(['complex_float_to_string' => 'to_string'] => ['complex_float'] => 'string');
subtest 'standard argument' => sub {
subtest 'with a real number' => sub {
note "to_string(10.5) = ", to_string(10.5);
is creal(10.5), 10.5, "creal(10.5) = 10.5";
is cimag(10.5), 0.0, "cimag(10.5) = 0.0";
};
subtest 'with an array ref' => sub {
note "to_string([10.5,20.5]) = ", to_string([10.5,20.5]);
is creal([10.5,20.5]), 10.5, "creal([10.5,20.5]) = 10.5";
is cimag([10.5,20.5]), 20.5, "cimag([10.5,20.5]) = 20.5";
};
subtest 'with Math::Complex' => sub {
skip_all 'test requires Math::Complex'
unless eval q{ use Math::Complex (); 1 };
my $c = Math::Complex->make(10.5, 20.5);
note "to_string(\$c) = ", to_string($c);
is creal($c), 10.5, "creal(\$c) = 10.5";
is cimag($c), 20.5, "cimag(\$c) = 20.5";
};
};
$ffi->attach(['complex_float_ptr_get_real' => 'creal_ptr'] => ['complex_float *'] => 'float');
$ffi->attach(['complex_float_ptr_get_imag' => 'cimag_ptr'] => ['complex_float *'] => 'float');
$ffi->attach(['complex_float_ptr_set' => 'complex_set'] => ['complex_float *','float','float'] => 'void');
subtest 'pointer argument' => sub {
subtest 'with a real number' => sub {
note "to_string(10.5) = ", to_string(10.5);
is creal_ptr(\10.5), 10.5, "creal_ptr(\\10.5) = 10.5";
is cimag_ptr(\10.5), 0.0, "cimag_ptr(\\10.5) = 0.0";
};
subtest 'with an array ref' => sub {
note "to_string([10.5,20.5]) = ", to_string([10.5,20.5]);
is creal_ptr(\[10.5,20.5]), 10.5, "creal_ptr(\\[10.5,20.5]) = 10.5";
is cimag_ptr(\[10.5,20.5]), 20.5, "cimag_ptr(\\[10.5,20.5]) = 20.5";
};
subtest 'with Math::Complex' => sub {
skip_all 'test requires Math::Complex'
unless eval q{ use Math::Complex (); 1 };
my $c = Math::Complex->make(10.5, 20.5);
note "to_string(\$c) = ", to_string($c);
is creal_ptr(\$c), 10.5, "creal_ptr(\\$c) = 10.5";
is cimag_ptr(\$c), 20.5, "cimag_ptr(\\$c) = 20.5";
};
subtest 'values set on out (array)' => sub {
my @c;
complex_set(\\@c, 1.0, 2.0);
is \@c, [ 1.0, 2.0 ];
};
subtest 'values set on out (object)' => sub {
skip_all 'test requires Math::Complex'
unless eval q{ use Math::Complex (); 1 };
my $c = Math::Complex->make(0.0, 0.0);
complex_set(\$c, 1.0, 2.0);
is( [ $c->Re, $c->Im ], [1.0,2.0] );
};
subtest 'values set on out (other)' => sub {
my $c;
complex_set(\$c, 1.0, 2.0);
is( $c, [1.0, 2.0]);
};
};
$ffi->attach(['pointer_null' => 'complex_null'] => [] => 'complex_float*');
$ffi->attach(['complex_float_ret' => 'complex_ret'] => ['float','float'] => 'complex_float');
$ffi->attach(['complex_float_ptr_ret' => 'complex_ptr_ret'] => ['float','float'] => 'complex_float*');
subtest 'return value' => sub {
is(complex_ret(1.0,2.0), [1.0,2.0], 'standard');
is(complex_ptr_ret(1.0,2.0), \[1.0,2.0], 'pointer');
is([complex_null()], $api >= 2 ? [undef] : [], 'null');
};
subtest 'complex array arg' => sub {
my $f = $ffi->function(complex_float_array_get => ['complex_float[]','int'] => 'complex_float' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
my $ret;
is( $ret = $f->call(\@a, 0), [0.0,0.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 1), [1.0,2.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 2), [3.0,4.0] )
or diag Dumper($ret);
};
subtest 'complex array arg' => sub {
skip_all 'for api >= 2 only' unless $api >= 2;
my $f = $ffi->function(complex_float_array_get => ['complex_float*','int'] => 'complex_float' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
my $ret;
is( $ret = $f->call(\@a, 0), [0.0,0.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 1), [1.0,2.0] )
or diag Dumper($ret);
is( $ret = $f->call(\@a, 2), [3.0,4.0] )
or diag Dumper($ret);
};
subtest 'complex array arg set' => sub {
my $f = $ffi->function(complex_float_array_set => ['complex_float[]','int','float','float'] => 'void' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
$f->call(\@a, 1, 5.0, 6.0);
is(\@a, [[0.0,0.0], [5.0,6.0], [3.0,4.0]]);
};
subtest 'complex array arg set' => sub {
skip_all 'for api >= 2 only' unless $api >= 2;
my $f = $ffi->function(complex_float_array_set => ['complex_float*','int','float','float'] => 'void' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
$f->call(\@a, 1, 5.0, 6.0);
is(\@a, [[0.0,0.0], [5.0,6.0], [3.0,4.0]]);
};
subtest 'complex array ret' => sub {
my $f = $ffi->function(complex_float_array_ret => [] => 'complex_float[3]' );
my @a = ([0.0,0.0], [1.0,2.0], [3.0,4.0]);
my $ret;
is(
$ret = $f->call( \@a ),
\@a,
) or diag Dumper($ret);
};
};
}
done_testing;
FFI-Platypus-2.12/t/type_custom.t 000644 000000 000000 00000006717 15251066120 016653 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
use FFI::Platypus::ShareConfig;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
my @legal = qw( float double opaque );
push @legal, map { ("sint$_","uint$_") } qw( 8 16 32 64 );
my $return_ok = FFI::Platypus::ShareConfig->get('probe')->{recordvalue};
subtest 'legal custom types' => sub {
my $ffi = FFI::Platypus->new( api => 1 );
foreach my $type (@legal)
{
local $@ = "";
eval {
$ffi->custom_type( "foo_$type" => {
native_type => $type,
native_to_perl => sub {},
});
};
is "$@", "";
}
};
subtest 'illegal types' => sub {
my $ffi = FFI::Platypus->new( api => 1 );
foreach my $type (qw( sint8[32] sint8* ))
{
local $@ = "";
my $alias = "foo_$type";
$alias =~ s/[\*\[\]]/_/g;
note "alias = $alias";
eval {
$ffi->custom_type( $alias => {
native_type => $type,
native_to_perl => sub {},
});
};
like "$@", qr/\Q$type\E is not a legal basis for a custom type/;
}
};
subtest 'records' => sub {
{
package Foo;
use FFI::Platypus::Record;
record_layout qw(
string(16) name
sint32 value
);
}
subtest 'pointer' => sub {
my $ffi = FFI::Platypus->new( api => 2, lib => [@lib] );
local $@ = '';
eval {
$ffi->custom_type(
'foo_t' => {
native_type => 'record(Foo)*',
perl_to_native => sub {
my $var = shift;
return Foo->new(name => $var->[0], value => $var->[1]);
},
native_to_perl => sub {
my $rec = shift;
return defined $rec ? [$rec->name, $rec->value] : [];
},
},
);
};
is "$@", '' or return;
{
is(
$ffi->function( foo_get_name => [ 'foo_t' ] => 'string' )
->call( ["Graham", 47] ),
"Graham",
);
is(
$ffi->function( foo_get_value => [ 'foo_t' ] => 'sint32' )
->call( ["Graham", 47] ),
47,
);
is(
$ffi->function( foo_create => ['string','sint32'] => 'foo_t' )
->call("Adams", 42),
["Adams\0\0\0\0\0\0\0\0\0\0\0", 42],
);
is(
$ffi->function( pointer_null => [] => 'foo_t' )
->call,
[],
);
}
};
subtest 'by-value' => sub {
my $ffi = FFI::Platypus->new( api => 1, lib => [@lib] );
local $@ = '';
eval {
$ffi->custom_type(
'foo_t' => {
native_type => 'record(Foo)',
perl_to_native => sub {
my $var = shift;
return Foo->new(name => $var->[0], value => $var->[1]);
},
native_to_perl => sub {
my $rec = shift;
return [$rec->name, $rec->value];
},
},
);
};
is "$@", '' or return;
{
is(
$ffi->function( foo_value_get_name => [ 'foo_t' ] => 'string' )
->call( ["Graham", 47] ),
"Graham",
);
is(
$ffi->function( foo_value_get_value => [ 'foo_t' ] => 'sint32' )
->call( ["Graham", 47] ),
47,
);
subtest 'return-value' => sub {
skip_all 'test requires working return records-by-value'
unless $return_ok;
is(
$ffi->function( foo_value_create => ['string','sint32'] => 'foo_t' )
->call("Adams", 42),
["Adams\0\0\0\0\0\0\0\0\0\0\0", 42],
);
};
}
};
};
done_testing;
FFI-Platypus-2.12/t/type_double.t 000644 000000 000000 00000007757 15251066120 016620 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_float.t
# all instances of "float" have been changed to "double"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('double *' => 'double_p');
$ffi->type('double [10]' => 'double_a');
$ffi->type('double []' => 'double_a2');
$ffi->type('(double)->double' => 'double_c');
$ffi->attach( [double_add => 'add'] => ['double', 'double'] => 'double');
$ffi->attach( [double_inc => 'inc'] => ['double_p', 'double'] => 'double_p');
$ffi->attach( [double_sum => 'sum'] => ['double_a'] => 'double');
$ffi->attach( [double_sum2 => 'sum2'] => ['double_a2','size_t'] => 'double');
$ffi->attach( [double_array_inc => 'array_inc'] => ['double_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'double_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['double_p'] => 'int');
$ffi->attach( [double_static_array => 'static_array'] => [] => 'double_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'double_a');
if($api >= 2)
{
$ffi->attach( [double_sum => 'sum3'] => ['double*'] => 'double');
$ffi->attach( [double_array_inc => 'array_inc2'] => ['double*'] => 'void');
}
is add(1.5,2.5), 4, 'add(1.5,2.5) = 4';
is eval { no warnings; add() }, 0.0, 'add() = 0.0';
my $i = 3.5;
is ${inc(\$i, 4.25)}, 7.75, 'inc(\$i,4.25) = \7.75';
is $i, 3.5+4.25, "i=3.5+4.25";
is ${inc(\3,4)}, 7, 'inc(\3,4) = \7';
my @list = (1,2,3,4,5,6,7,8,9,10);
is sum(\@list), 55, 'sum([1..10]) = 55';
is sum2(\@list,scalar @list), 55, 'sum2([1..10],10) = 55';
if($api >= 2)
{
is sum3(\@list), 55, 'sum([1..10]) = 55';
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc(); };
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
if($api >= 2)
{
array_inc2(\@list);
is \@list, [3,4,5,6,7,8,9,10,11,12], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [-5.5, 5.5, -10, 10, -15.5, 15.5, 20, -20, 25.5, -25.5], 'static_array = [-5.5, 5.5, -10, 10, -15.5, 15.5, 20, -20, 25.5, -25.5]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]+2.25 });
$ffi->attach( [double_set_closure => 'set_closure'] => ['double_c'] => 'void');
$ffi->attach( [double_call_closure => 'call_closure'] => ['double'] => 'double');
set_closure($closure);
is call_closure(2.5), 4.75, 'call_closure(2.5) = 4.75';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2.5) }, 0, 'call_closure(2.5) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'double', perl_to_native => sub { is $_[0], 1.25; $_[0]+0.25 } });
$ffi->attach( [double_add => 'custom_add'] => ['type1','double'] => 'double');
is custom_add(1.25,2.5), 4, 'custom_add(1.25,2.5) = 4';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'double', native_to_perl => sub { is $_[0], 2.0; $_[0]+0.25 } });
$ffi->attach( [double_add => 'custom_add2'] => ['double','double'] => 'type2');
is custom_add2(1,1), 2.25, 'custom_add2(1,1) = 2.25';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
done_testing;
FFI-Platypus-2.12/t/type_float.t 000644 000000 000000 00000007460 15251066120 016442 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('float *' => 'float_p');
$ffi->type('float [10]' => 'float_a');
$ffi->type('float []' => 'float_a2');
$ffi->type('(float)->float' => 'float_c');
$ffi->attach( [float_add => 'add'] => ['float', 'float'] => 'float');
$ffi->attach( [float_inc => 'inc'] => ['float_p', 'float'] => 'float_p');
$ffi->attach( [float_sum => 'sum'] => ['float_a'] => 'float');
$ffi->attach( [float_sum2 => 'sum2'] => ['float_a2','size_t'] => 'float');
$ffi->attach( [float_array_inc => 'array_inc'] => ['float_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'float_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['float_p'] => 'int');
$ffi->attach( [float_static_array => 'static_array'] => [] => 'float_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'float_a');
if($api >= 2)
{
$ffi->attach( [float_sum => 'sum3'] => ['float*'] => 'float');
$ffi->attach( [float_array_inc => 'array_inc2'] => ['float*'] => 'void');
}
is add(1.5,2.5), 4, 'add(1.5,2.5) = 4';
is eval { no warnings; add() }, 0.0, 'add() = 0.0';
my $i = 3.5;
is ${inc(\$i, 4.25)}, 7.75, 'inc(\$i,4.25) = \7.75';
is $i, 3.5+4.25, "i=3.5+4.25";
is ${inc(\3,4)}, 7, 'inc(\3,4) = \7';
my @list = (1,2,3,4,5,6,7,8,9,10);
is sum(\@list), 55, 'sum([1..10]) = 55';
is sum2(\@list,scalar @list), 55, 'sum2([1..10],10) = 55';
if($api >= 2)
{
is sum3(\@list), 55, 'sum([1..10]) = 55';
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc(); };
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
if($api >= 2)
{
array_inc2(\@list);
is \@list, [3,4,5,6,7,8,9,10,11,12], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [-5.5, 5.5, -10, 10, -15.5, 15.5, 20, -20, 25.5, -25.5], 'static_array = [-5.5, 5.5, -10, 10, -15.5, 15.5, 20, -20, 25.5, -25.5]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]+2.25 });
$ffi->attach( [float_set_closure => 'set_closure'] => ['float_c'] => 'void');
$ffi->attach( [float_call_closure => 'call_closure'] => ['float'] => 'float');
set_closure($closure);
is call_closure(2.5), 4.75, 'call_closure(2.5) = 4.75';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2.5) }, 0, 'call_closure(2.5) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'float', perl_to_native => sub { is $_[0], 1.25; $_[0]+0.25 } });
$ffi->attach( [float_add => 'custom_add'] => ['type1','float'] => 'float');
is custom_add(1.25,2.5), 4, 'custom_add(1.25,2.5) = 4';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'float', native_to_perl => sub { is $_[0], 2.0; $_[0]+0.25 } });
$ffi->attach( [float_add => 'custom_add2'] => ['float','float'] => 'type2');
is custom_add2(1,1), 2.25, 'custom_add2(1,1) = 2.25';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
done_testing;
FFI-Platypus-2.12/t/type_longdouble.t 000644 000000 000000 00000013247 15251066120 017467 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
use FFI::CheckLib;
use Config;
BEGIN {
skip_all 'test requires support for long double'
unless FFI::Platypus::TypeParser->have_type('longdouble');
}
subtest 'Math::LongDouble is loaded when needed for return type' => sub {
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->lib(find_lib lib => 'test', libpath => 't/ffi');
is($INC{'Math/LongDouble.pm'}, undef, 'not pre-loaded');
$ffi->function( longdouble_add => ['longdouble','longdouble'] => 'longdouble' );
my $pm = $INC{'Math/LongDouble.pm'};
if(eval q{ use Math::LongDouble; 1 })
{
is($pm, $INC{'Math/LongDouble.pm'});
isnt $pm, undef;
}
else
{
is($pm, undef);
is($INC{'Math/LongDouble.pm'}, undef);
}
};
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, experimental => ($api > 2 ? $api : undef) );
$ffi->lib(find_lib lib => 'test', libpath => 't/ffi');
$ffi->type('longdouble*' => 'longdouble_p');
$ffi->type('longdouble[3]' => 'longdouble_a3');
$ffi->type('longdouble[]' => 'longdouble_a');
$ffi->attach( [longdouble_add => 'add'] => ['longdouble','longdouble'] => 'longdouble');
$ffi->attach( longdouble_pointer_test => ['longdouble_p', 'longdouble_p'] => 'int');
$ffi->attach( longdouble_array_test => ['longdouble_a', 'int'] => 'int');
$ffi->attach( [longdouble_array_test => 'longdouble_array_test3'] => ['longdouble_a3', 'int'] => 'int');
$ffi->attach( [longdouble_array_test => 'longdouble_array_test_ptr'] => ['longdouble*', 'int'] => 'int') if $api >= 2;
$ffi->attach( longdouble_array_return_test => [] => 'longdouble_a3');
$ffi->attach( pointer_is_null => ['longdouble_p'] => 'int');
$ffi->attach( longdouble_pointer_return_test => ['longdouble'] => 'longdouble_p');
$ffi->attach( pointer_null => [] => 'longdouble_p');
subtest 'with Math::LongDouble' => sub {
skip_all 'test requires Math::LongDouble'
if $Config{uselongdouble} || !eval q{ use Math::LongDouble; 1 };
my $ld15 = Math::LongDouble->new(1.5);
my $ld25 = Math::LongDouble->new(2.5);
my $ld40 = Math::LongDouble->new(4.0);
my $ld80 = Math::LongDouble->new(8.0);
subtest 'scalar' => sub {
my $result = add($ld15, $ld25);
isa_ok $result, 'Math::LongDouble';
ok $result == $ld40, "add(1.5,2.5) = 4.0";
};
subtest 'pointer' => sub {
my $x = Math::LongDouble->new(1.5);
my $y = Math::LongDouble->new(2.5);
ok longdouble_pointer_test(\$x, \$y);
ok $x == $ld40;
ok $y == $ld80;
ok pointer_is_null(undef);
my $c = longdouble_pointer_return_test($ld15);
isa_ok $$c, 'Math::LongDouble';
ok $$c == $ld15;
};
my $ld10 = Math::LongDouble->new(1.0);
my $ld20 = Math::LongDouble->new(2.0);
my $ld30 = Math::LongDouble->new(3.0);
subtest 'array fixed' => sub {
my $list = [ map { Math::LongDouble->new($_) } qw( 25.0 25.0 50.0 )];
ok longdouble_array_test3($list, 3);
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == $ld10;
ok $list->[1] == $ld20;
ok $list->[2] == $ld30;
};
subtest 'array var' => sub {
my $list = [ map { Math::LongDouble->new($_) } qw( 25.0 25.0 50.0 )];
ok longdouble_array_test($list, 3);
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == $ld10;
ok $list->[1] == $ld20;
ok $list->[2] == $ld30;
};
subtest 'array var ptr' => sub {
skip_all 'for api = 2 and better only' unless $api >= 2;
my $list = [ map { Math::LongDouble->new($_) } qw( 25.0 25.0 50.0 )];
ok longdouble_array_test_ptr($list, 3);
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == $ld10;
ok $list->[1] == $ld20;
ok $list->[2] == $ld30;
};
subtest 'array return' => sub {
my $list = longdouble_array_return_test();
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == $ld10;
ok $list->[1] == $ld20;
ok $list->[2] == $ld30;
};
};
subtest 'without Math::LongDouble' => sub {
skip_all 'test requires Math::LongDouble'
if ! $Config{uselongdouble} || ! eval q{ use Math::LongDouble; 1 };
subtest 'scalar' => sub {
is add(1.5, 2.5), 4.0, "add(1.5,2.5) = 4";
};
subtest 'pointer' => sub {
my $x = 1.5;
my $y = 2.5;
ok longdouble_pointer_test(\$x, \$y);
ok $x == 4.0;
ok $y == 8.0;
ok pointer_is_null(undef);
my $c = longdouble_pointer_return_test(1.5);
ok $$c == 1.5;
};
subtest 'array fixed' => sub {
my $list = [ qw( 25.0 25.0 50.0 )];
ok longdouble_array_test3($list, 3);
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == 1.0;
ok $list->[1] == 2.0;
ok $list->[2] == 3.0;
};
subtest 'array var' => sub {
my $list = [ qw( 25.0 25.0 50.0 )];
ok longdouble_array_test($list, 3);
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == 1.0;
ok $list->[1] == 2.0;
ok $list->[2] == 3.0;
};
subtest 'array return' => sub {
my $list = longdouble_array_return_test();
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == 1.0;
ok $list->[1] == 2.0;
ok $list->[2] == 3.0;
};
};
};
}
done_testing;
FFI-Platypus-2.12/t/type_longdouble__array.t 000644 000000 000000 00000001517 15251066120 021021 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
use FFI::CheckLib;
use Config;
BEGIN {
skip_all 'test requires support for long double'
unless FFI::Platypus::TypeParser->have_type('longdouble');
}
my $ffi = FFI::Platypus->new;
$ffi->lib(find_lib lib => 'test', libpath => 't/ffi');
subtest 'Math::LongDouble is loaded when needed for return type' => sub {
$ffi->function( 0 => ['longdouble'] => 'int');
$ffi->function( 0 => ['int'] => 'int');
is($INC{'Math/LongDouble.pm'}, undef, 'not pre-loaded');
$ffi->function( 0 => ['longdouble[]'] => 'int' );
my $pm = $INC{'Math/LongDouble.pm'};
if(eval q{ use Math::LongDouble; 1 })
{
is($pm, $INC{'Math/LongDouble.pm'});
isnt $pm, undef;
}
else
{
is($pm, undef);
is($INC{'Math/LongDouble.pm'}, undef);
}
};
done_testing;
FFI-Platypus-2.12/t/type_longdouble__hide.t 000644 000000 000000 00000005372 15251066120 020617 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
use FFI::CheckLib;
BEGIN {
local $SIG{__WARN__} = sub {
my $message = shift;
return note $message if $message =~ /hides Math\/LongDouble\.pm/;
warn $message;
};
skip_all 'test requires support for long double'
unless FFI::Platypus::TypeParser->have_type('longdouble');
skip_all 'test requires Devel::Hide 0.0010'
unless eval q{ use Devel::Hide 0.0010 qw( Math::LongDouble ); 1; };
}
my $ffi = FFI::Platypus->new;
$ffi->lib(find_lib lib => 'test', libpath => 't/ffi');
subtest 'Math::LongDouble is loaded when needed for return type' => sub {
is($INC{'Math/LongDouble.pm'}, undef, 'not pre-loaded');
$ffi->function( longdouble_add => ['longdouble','longdouble'] => 'longdouble' );
my $loaded = Math::LongDouble->can("new");
ok !$loaded;
};
$ffi->type('longdouble*' => 'longdouble_p');
$ffi->type('longdouble[3]' => 'longdouble_a3');
$ffi->type('longdouble[]' => 'longdouble_a');
$ffi->attach( [longdouble_add => 'add'] => ['longdouble','longdouble'] => 'longdouble');
$ffi->attach( longdouble_pointer_test => ['longdouble_p', 'longdouble_p'] => 'int');
$ffi->attach( longdouble_array_test => ['longdouble_a', 'int'] => 'int');
$ffi->attach( [longdouble_array_test => 'longdouble_array_test3'] => ['longdouble_a3', 'int'] => 'int');
$ffi->attach( longdouble_array_return_test => [] => 'longdouble_a3');
$ffi->attach( pointer_is_null => ['longdouble_p'] => 'int');
$ffi->attach( longdouble_pointer_return_test => ['longdouble'] => 'longdouble_p');
$ffi->attach( pointer_null => [] => 'longdouble_p');
subtest 'without Math::LongDouble' => sub {
skip_all 'test requires Math::LongDouble'
if eval q{ use Math::LongDouble; 1 };
subtest 'scalar' => sub {
is add(1.5, 2.5), 4.0, "add(1.5,2.5) = 4";
};
subtest 'pointer' => sub {
my $x = 1.5;
my $y = 2.5;
ok longdouble_pointer_test(\$x, \$y);
ok $x == 4.0;
ok $y == 8.0;
ok pointer_is_null(undef);
my $c = longdouble_pointer_return_test(1.5);
ok $$c == 1.5;
};
subtest 'array fixed' => sub {
my $list = [ qw( 25.0 25.0 50.0 )];
ok longdouble_array_test3($list, 3);
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == 1.0;
ok $list->[1] == 2.0;
ok $list->[2] == 3.0;
};
subtest 'array var' => sub {
my $list = [ qw( 25.0 25.0 50.0 )];
ok longdouble_array_test($list, 3);
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == 1.0;
ok $list->[1] == 2.0;
ok $list->[2] == 3.0;
};
subtest 'array return' => sub {
my $list = longdouble_array_return_test();
note "[", join(',', map { "$_" } @$list), "]";
ok $list->[0] == 1.0;
ok $list->[1] == 2.0;
ok $list->[2] == 3.0;
};
};
done_testing;
FFI-Platypus-2.12/t/type_longdouble__ptr.t 000644 000000 000000 00000001516 15251066120 020507 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::Platypus::TypeParser;
use FFI::CheckLib;
use Config;
BEGIN {
skip_all 'test requires support for long double'
unless FFI::Platypus::TypeParser->have_type('longdouble');
}
my $ffi = FFI::Platypus->new;
$ffi->lib(find_lib lib => 'test', libpath => 't/ffi');
subtest 'Math::LongDouble is loaded when needed for return type' => sub {
$ffi->function( 0 => ['longdouble'] => 'int');
$ffi->function( 0 => ['int'] => 'int');
is($INC{'Math/LongDouble.pm'}, undef, 'not pre-loaded');
$ffi->function( 0 => ['longdouble*'] => 'int' );
my $pm = $INC{'Math/LongDouble.pm'};
if(eval q{ use Math::LongDouble; 1 })
{
is($pm, $INC{'Math/LongDouble.pm'});
isnt $pm, undef;
}
else
{
is($pm, undef);
is($INC{'Math/LongDouble.pm'}, undef);
}
};
done_testing;
FFI-Platypus-2.12/t/type_opaque.t 000644 000000 000000 00000015210 15251066120 016617 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::CheckLib;
use FFI::Platypus;
use FFI::Platypus::Memory qw( malloc free );
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, experimental => ($api > 2 ? $api : undef), lib => [@lib] );
$ffi->attach( [pointer_null => 'null'] => [] => 'opaque');
$ffi->attach( [pointer_is_null => 'is_null'] => ['opaque'] => 'int');
$ffi->attach( [pointer_set_my_pointer => 'setp'] => ['opaque'] => 'void');
$ffi->attach( [pointer_get_my_pointer => 'getp'] => [] => 'opaque');
$ffi->attach( [pointer_get_my_pointer_arg => 'geta'] => ['opaque*'] => 'void');
is [null()], [$api >= 2 ? (undef) : ()], 'null = ()/undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
my $ptr = malloc 32;
is is_null($ptr), 0, 'is_null($ptr) = 0';
setp($ptr);
is getp(), $ptr, "setp($ptr); getp() = $ptr";
do {
my $tmp;
geta(\$tmp);
is $tmp, $ptr, "get(\$tmp); tmp = $ptr";
};
do {
my $tmp = malloc 32;
my $tmp2 = $tmp;
setp(undef);
geta(\$tmp);
is $tmp, undef, "get(\\\$tmp); \\\$tmp = undef";
free $tmp2;
};
free $ptr;
$ffi->attach( [pointer_arg_array_in => 'aa_in'] => ['opaque[3]'] => 'int');
$ffi->attach( [pointer_arg_array_in => 'aa_in_ptr'] => ['opaque*'] => 'int') if $api >= 2;
$ffi->attach( [pointer_arg_array_null_in => 'aa_null_in'] => ['opaque[3]'] => 'int');
$ffi->attach( [pointer_arg_array_out => 'aa_out'] => ['opaque[3]'] => 'void');
$ffi->attach( [pointer_arg_array_out => 'aa_out_ptr'] => ['opaque*'] => 'void') if $api >= 2;
$ffi->attach( [pointer_arg_array_null_out => 'aa_null_out'] => ['opaque[3]'] => 'void');
do {
my @stuff = map { perl_to_c_string_copy($_) } qw( one two three );
is aa_in([@stuff]), 1, "aa_in([one two three])";
free $_ for @stuff;
};
if($api >= 2)
{
my @stuff = map { perl_to_c_string_copy($_) } qw( one two three );
is aa_in_ptr([@stuff]), 1, "aa_in([one two three])";
free $_ for @stuff;
};
is aa_null_in([undef,undef,undef]), 1, "aa_null_in([undef,undef,undef])";
do {
my @list = (undef,undef,undef);
aa_out(\@list);
is [map { $ffi->cast('opaque' => 'string', $_) } @list], [qw( four five six )], 'aa_out()';
};
if($api >= 2)
{
my @list = (undef,undef,undef);
aa_out(\@list);
is [map { $ffi->cast('opaque' => 'string', $_) } @list], [qw( four five six )], 'aa_out()';
};
do {
my @list1 = (malloc 32, malloc 32, malloc 32);
my @list2 = @list1;
aa_null_out(\@list2);
is [@list2], [undef,undef,undef], 'aa_null_out()';
free $_ for @list1;
};
$ffi->attach( [pointer_ret_array_out => 'ra_out'] => [] => 'opaque[3]');
$ffi->attach( [pointer_ret_array_out_null_terminated => 'ra_out_nt'] => [] => 'opaque[]');
$ffi->attach( [pointer_ret_array_null_out => 'ra_null_out'] => [] => 'opaque[3]');
is [map { $ffi->cast('opaque' => 'string', $_) } @{ ra_out() } ], [qw( seven eight nine )], "ra_out()";
is [map { $ffi->cast('opaque' => 'string', $_) } @{ ra_out_nt() } ], [qw( seven eight nine )], "ra_out_nt()";
is ra_null_out(), [undef,undef,undef], 'ra_null_out';
$ffi->attach( [pointer_pointer_pointer_to_pointer => 'pp2p'] => ['opaque*'] => 'opaque');
$ffi->attach( [pointer_pointer_to_pointer_pointer => 'p2pp'] => ['opaque'] => 'opaque*');
is pp2p(\undef), undef, 'pp2p(\undef) = undef';
do {
my $ptr = malloc 32;
is pp2p(\$ptr), $ptr, "pp2p(\\$ptr) = $ptr";
free $ptr;
};
is p2pp(undef), \undef, 'p2pp(undef) = \undef';
do {
my $ptr = malloc 32;
is ${p2pp($ptr)}, $ptr, "pp2p($ptr) = \\$ptr";
free $ptr;
};
$ffi->attach( [pointer_set_closure => 'set_closure'] => ['(opaque)->opaque'] => 'void');
$ffi->attach( [pointer_call_closure => 'call_closure'] => ['opaque'] => 'opaque');
my $save = 1;
my $closure = $ffi->closure(sub { $save = $_[0] });
set_closure($closure);
is call_closure(undef), undef, "call_closure(undef) = undef";
is $save, undef, "save = undef";
do {
my $ptr = malloc 32;
is call_closure($ptr), $ptr, "call_closure(\\$ptr) = $ptr";
is $save, $ptr, "save = $ptr";
free $ptr;
};
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { perl_to_native => sub {
is $ffi->cast('opaque'=>'string',$_[0]), "abc";
free $_[0];
perl_to_c_string_copy("def");
} });
$ffi->attach(['pointer_set_my_pointer' => 'custom1_setp'] => ['type1'] => 'void');
custom1_setp(perl_to_c_string_copy("abc"));
my $ptr = getp();
is $ffi->cast('opaque'=>'string',$ptr), "def";
free $ptr;
};
subtest 'custom type output' => sub {
setp(perl_to_c_string_copy("ABC"));
$ffi->custom_type(type2 => { native_to_perl => sub {
is $ffi->cast('opaque'=>'string',$_[0]), "ABC";
free $_[0];
"DEF";
} });
$ffi->attach([pointer_get_my_pointer => 'custom2_getp'] => [] => 'type2');
is custom2_getp(), "DEF";
setp(undef);
};
};
}
foreach my $api (1,2) {
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, experimental => ($api > 2 ? $api : undef), lib => [@lib] );
$ffi->type('object(Roger)', 'roger_t');
$ffi->type('object(Roger,opaque)', 'roger2_t');
my $ptr = malloc 200;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'opaque', bless(\$ptr, 'Roger')), $ptr;
is $ffi->cast('roger2_t' => 'opaque', bless(\$ptr, 'Roger')), $ptr;
};
subtest 'return value' => sub {
is $ffi->cast('opaque' => 'roger_t', undef), undef;
my $obj1 = $ffi->cast('opaque' => 'roger_t', $ptr);
isa_ok $obj1, 'Roger';
is $$obj1, $ptr;
my $obj2 = $ffi->cast('opaque' => 'roger2_t', $ptr);
isa_ok $obj2, 'Roger';
is $$obj2, $ptr;
};
is
[$ffi->function( pointer_null => [] => 'roger_t' )->call],
[$api >= 2 ? (undef) : ()],
;
free $ptr;
};
};
done_testing;
package
MyPerlStrDup;
use FFI::Platypus::Memory qw( malloc memcpy );
sub main::perl_to_c_string_copy
{
my($string) = @_;
my $ptr = malloc(length($string)+1);
memcpy($ptr, FFI::Platypus->new->cast('string' => 'opaque', $string), length($string)+1);
$ptr;
};
FFI-Platypus-2.12/t/type_record.t 000644 000000 000000 00000014570 15251066120 016613 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib qw( find_lib );
use FFI::Platypus::Memory qw( malloc free );
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
my $record_size = My::FooRecord->ffi_record_size;
note "record size = $record_size";
subtest 'not a reference' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->type("record($record_size)" => 'foo_record_t');
my $get_name = $ffi->function( foo_get_name => [ 'foo_record_t' ] => 'string' );
my $get_value = $ffi->function( foo_get_value => [ 'foo_record_t' ] => 'sint32' );
my $is_null = $ffi->function( pointer_is_null => [ 'foo_record_t' ] => 'int' );
my $create = $ffi->function( foo_create => [ 'string', 'sint32' ] => 'foo_record_t' );
my $null = $ffi->function( pointer_null => [] => 'foo_record_t' );
subtest in => sub {
my $packed = pack('A16l', "hi there\0", 42);
note "packed size = ", length $packed;
is $get_value->($packed), 42, "get_value(\$packed) = 42";
is $get_name->($packed), "hi there", "get_name(\$packed) = hi there";
is $is_null->(undef), 1, "is_null(undef)";
};
subtest out => sub {
my $packed = $create->("platypus", 47);
note "packed size = ", length $packed;
is $get_value->($packed), 47, "get_value(\$packed) = 47";
is $get_name->($packed), 'platypus', "get_value(\$packed) = platypus";
is $null->(), undef, 'null() = undef';
};
};
subtest 'return null' => sub {
is(
[FFI::Platypus->new( api => 1, lib => [@lib] )->function( pointer_null => [] => 'record(10)*' )->call],
[],
);
is(
[FFI::Platypus->new( api => 2, lib => [@lib] )->function( pointer_null => [] => 'record(10)*' )->call],
[undef],
);
};
subtest 'is a reference' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->type("record(My::FooRecord)" => 'foo_record_t');
my $get_name = $ffi->function( foo_get_name => [ 'foo_record_t' ] => 'string' );
my $get_value = $ffi->function( foo_get_value => [ 'foo_record_t' ] => 'sint32' );
my $is_null = $ffi->function( pointer_is_null => [ 'foo_record_t' ] => 'int' );
my $create = $ffi->function( foo_create => [ 'string', 'sint32' ] => 'foo_record_t' );
my $null = $ffi->function( pointer_null => [] => 'foo_record_t' );
subtest in => sub {
my $packed = pack('A16l', "hi there\0", 42);
note "packed size = ", length $packed;
is $get_value->(\$packed), 42, "get_value(\\\$packed) = 42";
is $get_name->(\$packed), "hi there", "get_name(\\\$packed) = hi there";
is $is_null->(\undef), 1, "is_null(\\undef)";
};
subtest out => sub {
my $packed = $create->("platypus", 47);
note "packed size = ", length $packed;
isa_ok $packed, 'My::FooRecord';
is $packed->my_method, "starscream", "packed.my_method = starscream";
is $get_value->($packed), 47, "get_value(\$packed) = 47";
is $get_name->($packed), 'platypus', "get_value(\$packed) = platypus";
is $null->(), undef, 'null() = \undef';
};
};
subtest 'closure' => sub {
{ package Closure::Record::RW;
use FFI::Platypus::Record;
record_layout(
'string_rw' => 'one',
'string_rw' => 'two',
'int' => 'three',
'string_rw' => 'four',
'int[2]' => 'myarray1',
'opaque' => 'opaque1',
'opaque[2]' => 'myarray2',
'string(5)' => 'fixedfive',
);
}
my $ffi = FFI::Platypus->new( lib => [@lib] );
$ffi->type('record(Closure::Record::RW)' => 'cx_struct_rw_t');
eval { $ffi->type('(cx_struct_rw_t,int)->void' => 'cx_closure_t') };
is $@, '', 'allow record type as arg';
my $cx_closure_set = $ffi->function(cx_closure_set => [ 'cx_closure_t' ] => 'void' );
my $cx_closure_call = $ffi->function(cx_closure_call => [ 'cx_struct_rw_t', 'int' ] => 'void' );
my $r = Closure::Record::RW->new;
$r->one("one");
$r->two("two");
$r->three(3);
$r->four("four");
$r->myarray1([1,2]);
$r->opaque1(malloc(22));
$r->myarray2([malloc(33),malloc(44)]);
$r->fixedfive("five\0");
is($r->_ffi_record_ro, 0);
my $here = 0;
my $f = $ffi->closure(sub {
my($r2,$num) = @_;
is($r2->_ffi_record_ro, 1);
is($r2->one, "one");
is($r2->two, "two");
is($r2->three, 3);
{
local $@ = '';
eval { $r2->three(64) };
isnt $@, '';
note "error = $@";
}
is($r2->three, 3);
is($r2->four, "four");
is($r2->myarray1, [1,2]);
{
local $@ = '';
eval { $r2->myarray1([3,4]) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray1, [1,2]);
{
local $@ = '';
eval { $r2->myarray1(3,4) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray1, [1,2]);
is($r2->opaque1, $r->opaque1);
{
local $@ = '';
eval { $r2->opaque1(undef) };
isnt $@, '';
note "error = $@";
}
is($r2->opaque1, $r->opaque1);
is($r2->myarray2, $r->myarray2);
{
local $@ = '';
eval { $r2->myarray2([undef,undef]) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray2, $r->myarray2);
{
local $@ = '';
eval { $r2->myarray2(undef,undef) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray2, $r->myarray2);
{
local $@ = '';
eval { $r2->one("new string!") };
isnt $@, '';
note "error = $@";
}
is($r2->one, "one");
is($r2->fixedfive, "five\0");
{
local $@ = '';
eval { $r2->fixedfive("xxxxx") };
isnt $@, '';
note "error = $@";
}
is($r2->fixedfive, "five\0");
is($num, 42);
$here = 1;
});
$cx_closure_set->($f);
$cx_closure_call->($r, 42);
is($here, 1);
$here = 0;
my $f2 = $ffi->closure(sub {
my($r2, $num) = @_;
is($r2, undef);
is($num, 0);
$here = 1;
});
$cx_closure_set->($f2);
$cx_closure_call->(undef, undef);
is($here, 1);
};
subtest 'api = 1 fixed string' => sub {
my $ffi = FFI::Platypus->new( api => 1, lib => [@lib] );
{
package My::FooRecord2;
use FFI::Platypus::Record;
eval { record_layout( $ffi, qw( string(5)* foo string(5) bar )) };
}
is "$@", "";
my $r = My::FooRecord2->new( foo => '12345', bar => '67890' );
is $r->foo, '12345';
is $r->bar, '67890';
};
done_testing;
package
My::FooRecord;
use constant ffi_record_size => do {
my $ffi = FFI::Platypus->new;
$ffi->sizeof('char[16]') + $ffi->sizeof('sint32');
};
sub my_method { "starscream" }
FFI-Platypus-2.12/t/type_record_value.t 000644 000000 000000 00000015560 15251066120 020007 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib qw( find_lib );
use FFI::Platypus::Memory qw( malloc free );
use FFI::Platypus::ShareConfig;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
my $return_ok = FFI::Platypus::ShareConfig->get('probe')->{recordvalue};
{
package
FooRecord;
use FFI::Platypus::Record;
record_layout(qw(
string(16) name
sint32 value
));
}
subtest 'is a reference' => sub {
my $ffi = FFI::Platypus->new( lib => [@lib], api => 1 );
$ffi->type("record(FooRecord)" => 'foo_record_t');
my $get_name = $ffi->function( foo_value_get_name => [ 'foo_record_t' ] => 'string' );
my $get_value = $ffi->function( foo_value_get_value => [ 'foo_record_t' ] => 'sint32' );
subtest 'argument' => sub {
subtest 'bad' => sub {
my $data = "\0" x 100;
my $bad1 = bless \$data, 'FooRecordBad';
eval { $get_name->call($bad1) };
like "$@", qr/^argument 0 is not an instance of FooRecord/;
eval { $get_name->call(\42) };
like "$@", qr/^argument 0 is not an instance of FooRecord/;
eval { $get_name->call(42) };
like "$@", qr/^argument 0 is not an instance of FooRecord/;
};
subtest 'good' => sub {
my $rv = FooRecord->new(
name => "hello",
value => 42,
);
is $get_name->call($rv), "hello";
is $get_value->call($rv), 42;
};
};
subtest 'return value' => sub {
skip_all 'test requires working return records-by-value'
unless $return_ok;
subtest 'function object' => sub {
my $create = $ffi->function( foo_value_create => [ 'string', 'sint32' ] => 'foo_record_t' );
my $rv = $create->call("laters", 47);
is $rv->name, "laters\0\0\0\0\0\0\0\0\0\0";
is $rv->value, 47;
};
subtest 'xsub_ref' => sub {
my $create = $ffi->function( foo_value_create => [ 'string', 'sint32' ] => 'foo_record_t' )->sub_ref;
my $rv = $create->("laters", 47);
is $rv->name, "laters\0\0\0\0\0\0\0\0\0\0";
is $rv->value, 47;
};
subtest 'attach' => sub {
$ffi->attach( foo_value_create => [ 'string', 'sint32' ] => 'foo_record_t' );
my $rv = foo_value_create("laters", 47);
is $rv->name, "laters\0\0\0\0\0\0\0\0\0\0";
is $rv->value, 47;
};
};
};
subtest 'closure' => sub {
{ package Closure::Record::RW;
use FFI::Platypus::Record;
record_layout_1(
'string rw' => 'one',
'string rw' => 'two',
'int' => 'three',
'string rw' => 'four',
'int[2]' => 'myarray1',
'opaque' => 'opaque1',
'opaque[2]' => 'myarray2',
'string(5)' => 'fixedfive',
);
}
my $ffi = FFI::Platypus->new( lib => [@lib], api => 1 );
$ffi->type('record(Closure::Record::RW)' => 'cx_struct_rw_t');
{
local $@ = '';
eval { $ffi->type('(cx_struct_rw_t,int)->void' => 'cxv_closure_t') };
is $@, '', 'do allow record type as arg';
}
{
local $@ = '';
eval { $ffi->type('()->cx_struct_rw_t' ) };
like "$@", qr/Record return type contains types that cannot be returned from a closure/, 'do not allow record type with pointer strings as ret type';
}
my $cxv_closure_set = $ffi->function(cxv_closure_set => [ 'cxv_closure_t' ] => 'void' );
my $cxv_closure_call = $ffi->function(cxv_closure_call => [ 'cx_struct_rw_t', 'int' ] => 'void' );
my $r = Closure::Record::RW->new;
$r->one("one");
$r->two("two");
$r->three(3);
$r->four("four");
$r->myarray1([1,2]);
$r->opaque1(malloc(22));
$r->myarray2([malloc(33),malloc(44)]);
$r->fixedfive("five\0");
is($r->_ffi_record_ro, 0);
my $here = 0;
my $f = $ffi->closure(sub {
my($r2,$num) = @_;
note "first closure";
isa_ok $r2, 'Closure::Record::RW';
is($r2->_ffi_record_ro, 1);
is($r2->one, "one");
is($r2->two, "two");
is($r2->three, 3);
{
local $@ = '';
eval { $r2->three(64) };
isnt $@, '';
note "error = $@";
}
is($r2->three, 3);
is($r2->four, "four");
is($r2->myarray1, [1,2]);
{
local $@ = '';
eval { $r2->myarray1([3,4]) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray1, [1,2]);
{
local $@ = '';
eval { $r2->myarray1(3,4) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray1, [1,2]);
is($r2->opaque1, $r->opaque1);
{
local $@ = '';
eval { $r2->opaque1(undef) };
isnt $@, '';
note "error = $@";
}
is($r2->opaque1, $r->opaque1);
is($r2->myarray2, $r->myarray2);
{
local $@ = '';
eval { $r2->myarray2([undef,undef]) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray2, $r->myarray2);
{
local $@ = '';
eval { $r2->myarray2(undef,undef) };
isnt $@, '';
note "error = $@";
}
is($r2->myarray2, $r->myarray2);
{
local $@ = '';
eval { $r2->one("new string!") };
isnt $@, '';
note "error = $@";
}
is($r2->one, "one");
is($r2->fixedfive, "five\0");
{
local $@ = '';
eval { $r2->fixedfive("xxxxx") };
isnt $@, '';
note "error = $@";
}
is($r2->fixedfive, "five\0");
is($num, 42);
$here = 1;
});
$cxv_closure_set->($f);
$cxv_closure_call->($r, 42);
is($here, 1);
};
subtest 'closure ret' => sub {
{ package Closure::Record::Simple;
use FFI::Platypus::Record;
record_layout_1(
char => 'foo',
short => 'bar',
int => 'baz',
);
}
my $ffi = FFI::Platypus->new( lib => [@lib], api => 1 );
$ffi->type('record(Closure::Record::Simple)' => 'cx_struct_simple_t');
{
local $@ = '';
eval { $ffi->type('()->cx_struct_simple_t' => 'cxv_closure_simple_t' ) };
is "$@", '';
}
my $cxv_closure_simple_call = do {
local $@ = '';
my $f = eval { $ffi->function( cxv_closure_simple_call => ['cxv_closure_simple_t'] => 'cx_struct_simple_t*') };
is "$@", '';
$f;
};
subtest 'good' => sub {
my $f = $ffi->closure(sub {
return Closure::Record::Simple->new( foo => 1, bar => 2, baz => 3 );
});
my $r = $cxv_closure_simple_call->call($f);
isa_ok $r, 'Closure::Record::Simple';
is $r->foo, 1;
is $r->bar, 2;
is $r->baz, 3;
};
subtest 'bad' => sub {
my $f = $ffi->closure(sub {
return undef;
});
local $SIG{__WARN__} = sub {
note @_;
};
my $r = $cxv_closure_simple_call->call($f);
isa_ok $r, 'Closure::Record::Simple';
is $r->foo, 0;
is $r->bar, 0;
is $r->baz, 0;
};
subtest 'short' => sub {
my $f = $ffi->closure(sub {
my $r = Closure::Record::Simple->new;
$$r = "";
return $r;
});
local $SIG{__WARN__} = sub {
note @_;
};
my $r = $cxv_closure_simple_call->call($f);
isa_ok $r, 'Closure::Record::Simple';
is $r->foo, 0;
is $r->bar, 0;
is $r->baz, 0;
};
};
done_testing;
FFI-Platypus-2.12/t/type_sint16.t 000644 000000 000000 00000010722 15251066120 016454 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_sint8.t
# all instances of "int8" have been changed to "int16"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('sint16 *' => 'sint16_p');
$ffi->type('sint16 [10]' => 'sint16_a');
$ffi->type('sint16 []' => 'sint16_a2');
$ffi->type('(sint16)->sint16' => 'sint16_c');
$ffi->attach( [sint16_add => 'add'] => ['sint16', 'sint16'] => 'sint16');
$ffi->attach( [sint16_inc => 'inc'] => ['sint16_p', 'sint16'] => 'sint16_p');
$ffi->attach( [sint16_sum => 'sum'] => ['sint16_a'] => 'sint16');
$ffi->attach( [sint16_sum2 => 'sum2'] => ['sint16_a2','size_t'] => 'sint16');
$ffi->attach( [sint16_array_inc => 'array_inc'] => ['sint16_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'sint16_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['sint16_p'] => 'int');
$ffi->attach( [sint16_static_array => 'static_array'] => [] => 'sint16_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'sint16_a');
if($api >= 2)
{
$ffi->attach( [sint16_sum => 'sum3'] => ['sint16*'] => 'sint16' );
$ffi->attach( [sint16_array_inc => 'array_inc2'] => ['sint16*'] => 'void');
}
is add(-1,2), 1, 'add(-1,2) = 1';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = -3;
is ${inc(\$i, 4)}, 1, 'inc(\$i,4) = \1';
is $i, 1, "i=1";
is ${inc(\-3,4)}, 1, 'inc(\-3,4) = \1';
my @list = (-5,-4,-3,-2,-1,0,1,2,3,4);
is sum(\@list), -5, 'sum([-5..4]) = -5';
is sum2(\@list,scalar @list), -5, 'sum([-5..4],10) = -5';
if($api >= 2)
{
is(sum3(\@list), -5, 'sum([-5..4]) = -5 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
if($api >= 2)
{
@list = (-5,-4,-3,-2,-1,0,1,2,3,4);
array_inc2(\@list);
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [-1,2,-3,4,-5,6,-7,8,-9,10], 'static_array = [-1,2,-3,4,-5,6,-7,8,-9,10]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]-2 });
$ffi->attach( [sint16_set_closure => 'set_closure'] => ['sint16_c'] => 'void');
$ffi->attach( [sint16_call_closure => 'call_closure'] => ['sint16'] => 'sint16');
set_closure($closure);
is call_closure(-2), -4, 'call_closure(-2) = -4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint16', perl_to_native => sub { is $_[0], -2; $_[0]*2 } });
$ffi->attach( [sint16_add => 'custom_add'] => ['type1','sint16'] => 'sint16');
is custom_add(-2,-1), -5, 'custom_add(-2,-1) = -5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'sint16', native_to_perl => sub { is $_[0], -3; $_[0]*2 } });
$ffi->attach( [sint16_add => 'custom_add2'] => ['sint16','sint16'] => 'type2');
is custom_add2(-2,-1), -6, 'custom_add2(-2,-1) = -6';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('object(Roger,sint16)', 'roger_t');
my $int = -22;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'sint16', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('sint16' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
};
};
done_testing;
FFI-Platypus-2.12/t/type_sint32.t 000644 000000 000000 00000010722 15251066120 016452 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_sint8.t
# all instances of "int8" have been changed to "int32"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('sint32 *' => 'sint32_p');
$ffi->type('sint32 [10]' => 'sint32_a');
$ffi->type('sint32 []' => 'sint32_a2');
$ffi->type('(sint32)->sint32' => 'sint32_c');
$ffi->attach( [sint32_add => 'add'] => ['sint32', 'sint32'] => 'sint32');
$ffi->attach( [sint32_inc => 'inc'] => ['sint32_p', 'sint32'] => 'sint32_p');
$ffi->attach( [sint32_sum => 'sum'] => ['sint32_a'] => 'sint32');
$ffi->attach( [sint32_sum2 => 'sum2'] => ['sint32_a2','size_t'] => 'sint32');
$ffi->attach( [sint32_array_inc => 'array_inc'] => ['sint32_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'sint32_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['sint32_p'] => 'int');
$ffi->attach( [sint32_static_array => 'static_array'] => [] => 'sint32_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'sint32_a');
if($api >= 2)
{
$ffi->attach( [sint32_sum => 'sum3'] => ['sint32*'] => 'sint32' );
$ffi->attach( [sint32_array_inc => 'array_inc2'] => ['sint32*'] => 'void');
}
is add(-1,2), 1, 'add(-1,2) = 1';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = -3;
is ${inc(\$i, 4)}, 1, 'inc(\$i,4) = \1';
is $i, 1, "i=1";
is ${inc(\-3,4)}, 1, 'inc(\-3,4) = \1';
my @list = (-5,-4,-3,-2,-1,0,1,2,3,4);
is sum(\@list), -5, 'sum([-5..4]) = -5';
is sum2(\@list,scalar @list), -5, 'sum([-5..4],10) = -5';
if($api >= 2)
{
is(sum3(\@list), -5, 'sum([-5..4]) = -5 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
if($api >= 2)
{
@list = (-5,-4,-3,-2,-1,0,1,2,3,4);
array_inc2(\@list);
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [-1,2,-3,4,-5,6,-7,8,-9,10], 'static_array = [-1,2,-3,4,-5,6,-7,8,-9,10]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]-2 });
$ffi->attach( [sint32_set_closure => 'set_closure'] => ['sint32_c'] => 'void');
$ffi->attach( [sint32_call_closure => 'call_closure'] => ['sint32'] => 'sint32');
set_closure($closure);
is call_closure(-2), -4, 'call_closure(-2) = -4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint32', perl_to_native => sub { is $_[0], -2; $_[0]*2 } });
$ffi->attach( [sint32_add => 'custom_add'] => ['type1','sint32'] => 'sint32');
is custom_add(-2,-1), -5, 'custom_add(-2,-1) = -5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'sint32', native_to_perl => sub { is $_[0], -3; $_[0]*2 } });
$ffi->attach( [sint32_add => 'custom_add2'] => ['sint32','sint32'] => 'type2');
is custom_add2(-2,-1), -6, 'custom_add2(-2,-1) = -6';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('object(Roger,sint32)', 'roger_t');
my $int = -22;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'sint32', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('sint32' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
};
};
done_testing;
FFI-Platypus-2.12/t/type_sint64.t 000644 000000 000000 00000010722 15251066120 016457 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_sint8.t
# all instances of "int8" have been changed to "int64"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('sint64 *' => 'sint64_p');
$ffi->type('sint64 [10]' => 'sint64_a');
$ffi->type('sint64 []' => 'sint64_a2');
$ffi->type('(sint64)->sint64' => 'sint64_c');
$ffi->attach( [sint64_add => 'add'] => ['sint64', 'sint64'] => 'sint64');
$ffi->attach( [sint64_inc => 'inc'] => ['sint64_p', 'sint64'] => 'sint64_p');
$ffi->attach( [sint64_sum => 'sum'] => ['sint64_a'] => 'sint64');
$ffi->attach( [sint64_sum2 => 'sum2'] => ['sint64_a2','size_t'] => 'sint64');
$ffi->attach( [sint64_array_inc => 'array_inc'] => ['sint64_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'sint64_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['sint64_p'] => 'int');
$ffi->attach( [sint64_static_array => 'static_array'] => [] => 'sint64_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'sint64_a');
if($api >= 2)
{
$ffi->attach( [sint64_sum => 'sum3'] => ['sint64*'] => 'sint64' );
$ffi->attach( [sint64_array_inc => 'array_inc2'] => ['sint64*'] => 'void');
}
is add(-1,2), 1, 'add(-1,2) = 1';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = -3;
is ${inc(\$i, 4)}, 1, 'inc(\$i,4) = \1';
is $i, 1, "i=1";
is ${inc(\-3,4)}, 1, 'inc(\-3,4) = \1';
my @list = (-5,-4,-3,-2,-1,0,1,2,3,4);
is sum(\@list), -5, 'sum([-5..4]) = -5';
is sum2(\@list,scalar @list), -5, 'sum([-5..4],10) = -5';
if($api >= 2)
{
is(sum3(\@list), -5, 'sum([-5..4]) = -5 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
if($api >= 2)
{
@list = (-5,-4,-3,-2,-1,0,1,2,3,4);
array_inc2(\@list);
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [-1,2,-3,4,-5,6,-7,8,-9,10], 'static_array = [-1,2,-3,4,-5,6,-7,8,-9,10]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]-2 });
$ffi->attach( [sint64_set_closure => 'set_closure'] => ['sint64_c'] => 'void');
$ffi->attach( [sint64_call_closure => 'call_closure'] => ['sint64'] => 'sint64');
set_closure($closure);
is call_closure(-2), -4, 'call_closure(-2) = -4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint64', perl_to_native => sub { is $_[0], -2; $_[0]*2 } });
$ffi->attach( [sint64_add => 'custom_add'] => ['type1','sint64'] => 'sint64');
is custom_add(-2,-1), -5, 'custom_add(-2,-1) = -5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'sint64', native_to_perl => sub { is $_[0], -3; $_[0]*2 } });
$ffi->attach( [sint64_add => 'custom_add2'] => ['sint64','sint64'] => 'type2');
is custom_add2(-2,-1), -6, 'custom_add2(-2,-1) = -6';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('object(Roger,sint64)', 'roger_t');
my $int = -22;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'sint64', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('sint64' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
};
};
done_testing;
FFI-Platypus-2.12/t/type_sint8.t 000644 000000 000000 00000010422 15251066120 016372 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('sint8 *' => 'sint8_p');
$ffi->type('sint8 [10]' => 'sint8_a');
$ffi->type('sint8 []' => 'sint8_a2');
$ffi->type('(sint8)->sint8' => 'sint8_c');
$ffi->attach( [sint8_add => 'add'] => ['sint8', 'sint8'] => 'sint8');
$ffi->attach( [sint8_inc => 'inc'] => ['sint8_p', 'sint8'] => 'sint8_p');
$ffi->attach( [sint8_sum => 'sum'] => ['sint8_a'] => 'sint8');
$ffi->attach( [sint8_sum2 => 'sum2'] => ['sint8_a2','size_t'] => 'sint8');
$ffi->attach( [sint8_array_inc => 'array_inc'] => ['sint8_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'sint8_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['sint8_p'] => 'int');
$ffi->attach( [sint8_static_array => 'static_array'] => [] => 'sint8_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'sint8_a');
if($api >= 2)
{
$ffi->attach( [sint8_sum => 'sum3'] => ['sint8*'] => 'sint8' );
$ffi->attach( [sint8_array_inc => 'array_inc2'] => ['sint8*'] => 'void');
}
is add(-1,2), 1, 'add(-1,2) = 1';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = -3;
is ${inc(\$i, 4)}, 1, 'inc(\$i,4) = \1';
is $i, 1, "i=1";
is ${inc(\-3,4)}, 1, 'inc(\-3,4) = \1';
my @list = (-5,-4,-3,-2,-1,0,1,2,3,4);
is sum(\@list), -5, 'sum([-5..4]) = -5';
is sum2(\@list,scalar @list), -5, 'sum([-5..4],10) = -5';
if($api >= 2)
{
is(sum3(\@list), -5, 'sum([-5..4]) = -5 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
if($api >= 2)
{
@list = (-5,-4,-3,-2,-1,0,1,2,3,4);
array_inc2(\@list);
is \@list, [-4,-3,-2,-1,0,1,2,3,4,5], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [-1,2,-3,4,-5,6,-7,8,-9,10], 'static_array = [-1,2,-3,4,-5,6,-7,8,-9,10]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]-2 });
$ffi->attach( [sint8_set_closure => 'set_closure'] => ['sint8_c'] => 'void');
$ffi->attach( [sint8_call_closure => 'call_closure'] => ['sint8'] => 'sint8');
set_closure($closure);
is call_closure(-2), -4, 'call_closure(-2) = -4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint8', perl_to_native => sub { is $_[0], -2; $_[0]*2 } });
$ffi->attach( [sint8_add => 'custom_add'] => ['type1','sint8'] => 'sint8');
is custom_add(-2,-1), -5, 'custom_add(-2,-1) = -5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'sint8', native_to_perl => sub { is $_[0], -3; $_[0]*2 } });
$ffi->attach( [sint8_add => 'custom_add2'] => ['sint8','sint8'] => 'type2');
is custom_add2(-2,-1), -6, 'custom_add2(-2,-1) = -6';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef) );
$ffi->type('object(Roger,sint8)', 'roger_t');
my $int = -22;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'sint8', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('sint8' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
};
};
done_testing;
FFI-Platypus-2.12/t/type_string.t 000644 000000 000000 00000015205 15251066120 016637 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $p = $api == 0 ? '' : '*';
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type("string(10)$p" => 'string_10');
$ffi->type("string(5)$p" => 'string_5');
$ffi->attach( 'string_matches_foobarbaz' => ['string'] => 'int');
$ffi->attach( 'string_return_foobarbaz' => [] => 'string');
$ffi->attach( [pointer_null => 'null'] => [] => 'string');
$ffi->attach( [pointer_is_null => 'is_null'] => ['string'] => 'int');
$ffi->attach( 'string_write_to_string' => ['string','string'] => 'void');
ok string_matches_foobarbaz("foobarbaz"), "string_matches_foobarbaz(foobarbaz) = true";
ok !string_matches_foobarbaz("x"), "string_matches_foobarbaz(foobarbaz) = false";
is string_return_foobarbaz(), "foobarbaz", "string_return_foobarbaz() = foobarbaz";
is null(), undef, 'null() = undef';
is is_null(undef), 1, 'is_null(undef) = 1';
is is_null(), 1, 'is_null() = 1';
is is_null("foo"), 0, 'is_null("foo") = 0';
$ffi->attach( [string_set_closure => 'set_closure'] => ['(string)->void'] => 'void');
$ffi->attach( [string_call_closure => 'call_closure'] => ['string']=>'void');
my $save = 1;
my $closure = $ffi->closure(sub { $save = $_[0] });
set_closure($closure);
call_closure("hey there");
is $save, "hey there", "\$save = hey there";
call_closure(undef);
is $save, undef, "\$save = undef";
$ffi->attach( ['string_matches_foobarbaz' => 'fixed_input_test'] => ['string_10'] => 'int');
$ffi->attach( ['pointer_is_null' => 'fixed_input_is_null'] => ['string_10'] => 'int');
is fixed_input_test("foobarbaz\0"), 1, "fixed_input_test(foobarbaz\\0)";
is fixed_input_is_null(undef), 1, "fixed_input_is_null(undef)";
$ffi->attach( string_fixed_test => ['int'] => 'string_5');
is string_fixed_test(0), "zero ", "string_fixed_text(0) = zero";
is string_fixed_test(1), "one ", "string_fixed_text(1) = one";
is string_fixed_test(2), "two ", "string_fixed_text(2) = two";
is string_fixed_test(3), "three", "string_fixed_text(3) = three";
$ffi->attach( [pointer_null => 'fixed_output_null'] => [] => 'string_5');
is fixed_output_null(), undef, 'fixed_output_null()';
$ffi->attach( [string_set_closure => 'set_closure_fixed'] => ['(string_5)->void'] => 'void');
my $closure_fixed = $ffi->closure(sub { $save = $_[0] });
set_closure_fixed($closure_fixed);
call_closure("zero one two three");
is $save, "zero ", "save=zero ";
$ffi->attach( string_test_pointer_arg => [ 'string*' ] => 'string' );
{
my $arg = "foo";
is( string_test_pointer_arg(\$arg), "*arg==foo");
is( $arg, "out" );
}
{
my $arg;
is( string_test_pointer_arg(\$arg), "*arg==NULL");
is( $arg, "out" );
}
is( string_test_pointer_arg(undef), "arg==NULL");
$ffi->attach( string_test_pointer_ret => [ 'string' ] => 'string*' );
$ffi->attach( [ pointer_null => 'string_test_pointer_ret_null' ] => [] => 'string*' );
is( string_test_pointer_ret("foo"), \"foo" );
is( string_test_pointer_ret(undef), \undef );
is( [string_test_pointer_ret_null()], [$api >= 2 ? (undef) : ()] );
subtest 'fixed length input' => sub {
$ffi->type('string[5]' => 'string_5_undef');
my $a2 = $ffi->function(get_string_from_array => ['string_5_undef', 'int'] => 'string');
my @list = ( 'foo', 'bar', 'baz', undef, 'five', 'six' );
subtest 'with default' => sub {
is $a2->(\@list, 0), 'foo', 'a2(0) = foo';
is $a2->(\@list, 1), 'bar', 'a2(0) = bar';
is $a2->(\@list, 2), 'baz', 'a2(0) = baz';
is $a2->(\@list, 3), undef, 'a2(0) = undef';
is $a2->(\@list, 4), 'five', 'a2(0) = five';
};
};
subtest 'variable length input' => sub {
$ffi->type('string[]' => 'sa');
my $get_string_from_array = $ffi->function(get_string_from_array => ['sa','int'] => 'string');
my @list = ('foo', 'bar', 'baz', undef );
for(0..2)
{
is $get_string_from_array->(\@list, $_), $list[$_], "get_string_from_array(\@list, $_) = $list[$_]";
}
is $get_string_from_array->(\@list, 3), undef, "get_string_from_array(\@list, 3) = undef";
};
subtest 'variable length input' => sub {
skip_all 'test requires api >=2'
unless $api >= 2;
my $get_string_from_array = $ffi->function(get_string_from_array => ['string*','int'] => 'string');
my @list = ('foo', 'bar', 'baz', undef );
for(0..2)
{
is $get_string_from_array->(\@list, $_), $list[$_], "get_string_from_array(\@list, $_) = $list[$_]";
}
is $get_string_from_array->(\@list, 3), undef, "get_string_from_array(\@list, 3) = undef";
};
subtest 'fixed length return' => sub {
$ffi->type('string[3]' => 'sa3');
is(
$ffi->function(pointer_null => [] => 'sa3')->call,
undef,
'returns null',
);
is(
$ffi->function(onetwothree3 => [] => 'sa3')->call,
[ qw( one two three ) ],
'returns with just strings',
);
is(
$ffi->function(onenullthree3 => [] => 'sa3')->call,
[ 'one', undef, 'three' ],
'returns with NULL/undef in the middle',
);
};
subtest 'null terminated return' => sub {
is(
$ffi->function(pointer_null => [] => 'sa')->call,
undef,
'returns null',
);
is(
$ffi->function('onetwothree4', => [] => 'sa')->call,
[ qw( one two three ) ],
);
is(
$ffi->function('onenullthree3' => [] => 'sa')->call,
[ qw( one ) ],
);
is(
$ffi->function('ptrnull' => [] => 'sa')->call,
[],
);
};
subtest 'argument update' => sub {
my @args = ( undef, 'six', 'xx' );
$ffi->function( string_array_arg_update => [ 'string[3]' ] => 'void' )->call(\@args);
is(
\@args,
[ "one", "two", "xx" ],
);
};
subtest 'write to string' => sub {
my $src = 'hello world';
my $dst = ' ' x (length($src)+1);
string_write_to_string($dst, $src);
is($dst, "hello world\0");
};
is(
[$ffi->function( pointer_null => [] => 'string' )->call],
[$api >= 2 ? (undef) : ()],
);
};
}
done_testing;
FFI-Platypus-2.12/t/type_uint16.t 000644 000000 000000 00000011334 15251066120 016456 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_uint8.t
# all instances of "int8" have been changed to "int16"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('uint16 *' => 'uint16_p');
$ffi->type('uint16 [10]' => 'uint16_a');
$ffi->type('uint16 []' => 'uint16_a2');
$ffi->type('(uint16)->uint16' => 'uint16_c');
$ffi->attach( [uint16_add => 'add'] => ['uint16', 'uint16'] => 'uint16');
$ffi->attach( [uint16_inc => 'inc'] => ['uint16_p', 'uint16'] => 'uint16_p');
$ffi->attach( [uint16_sum => 'sum'] => ['uint16_a'] => 'uint16');
$ffi->attach( [uint16_sum2 => 'sum2'] => ['uint16_a2','size_t'] => 'uint16');
$ffi->attach( [uint16_array_inc => 'array_inc'] => ['uint16_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'uint16_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['uint16_p'] => 'int');
$ffi->attach( [uint16_static_array => 'static_array'] => [] => 'uint16_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'uint16_a');
if($api >= 2)
{
$ffi->attach( [uint16_sum => 'sum3'] => ['uint16*'] => 'uint16' );
$ffi->attach( [uint16_array_inc => 'array_inc2'] => ['uint16*'] => 'void');
}
is add(1,2), 3, 'add(1,2) = 3';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = 3;
is ${inc(\$i, 4)}, 7, 'inc(\$i,4) = \7';
is $i, 3+4, "i=3+4";
is ${inc(\3,4)}, 7, 'inc(\3,4) = \7';
my @list = (1,2,3,4,5,6,7,8,9,10);
is sum(\@list), 55, 'sum([1..10]) = 55';
is sum2(\@list, scalar @list), 55, 'sum2([1..10],10) = 55';
if($api >= 2)
{
is(sum3(\@list), 55, 'sum([1..10]) = 55 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
if($api >= 2)
{
@list = (1,2,3,4,5,6,7,8,9,10);
array_inc2(\@list);
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [1,4,6,8,10,12,14,16,18,20], 'static_array = [1,4,6,8,10,12,14,16,18,20]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]+2 });
$ffi->attach( [uint16_set_closure => 'set_closure'] => ['uint16_c'] => 'void');
$ffi->attach( [uint16_call_closure => 'call_closure'] => ['uint16'] => 'uint16');
set_closure($closure);
is call_closure(2), 4, 'call_closure(2) = 4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint16', perl_to_native => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint16_add => 'custom_add'] => ['type1','uint16'] => 'uint16');
is custom_add(2,1), 5, 'custom_add(2,1) = 5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'uint16', native_to_perl => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint16_add => 'custom_add2'] => ['uint16','uint16'] => 'type2');
is custom_add2(1,1), 4, 'custom_add2(1,1) = 4';
};
subtest 'custom type post' => sub {
$ffi->custom_type(type3 => { native_type => 'uint16', perl_to_native_post => sub { is $_[0], 1 } });
$ffi->attach( [uint16_add => 'custom_add3'] => ['type3','uint16'] => 'uint16');
is custom_add3(1,2), 3, 'custom_add3(1,2) = 3';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('object(Roger,uint16)', 'roger_t');
my $int = 211;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'uint16', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('uint16' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
}
};
done_testing;
FFI-Platypus-2.12/t/type_uint32.t 000644 000000 000000 00000011334 15251066120 016454 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_uint8.t
# all instances of "int8" have been changed to "int32"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('uint32 *' => 'uint32_p');
$ffi->type('uint32 [10]' => 'uint32_a');
$ffi->type('uint32 []' => 'uint32_a2');
$ffi->type('(uint32)->uint32' => 'uint32_c');
$ffi->attach( [uint32_add => 'add'] => ['uint32', 'uint32'] => 'uint32');
$ffi->attach( [uint32_inc => 'inc'] => ['uint32_p', 'uint32'] => 'uint32_p');
$ffi->attach( [uint32_sum => 'sum'] => ['uint32_a'] => 'uint32');
$ffi->attach( [uint32_sum2 => 'sum2'] => ['uint32_a2','size_t'] => 'uint32');
$ffi->attach( [uint32_array_inc => 'array_inc'] => ['uint32_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'uint32_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['uint32_p'] => 'int');
$ffi->attach( [uint32_static_array => 'static_array'] => [] => 'uint32_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'uint32_a');
if($api >= 2)
{
$ffi->attach( [uint32_sum => 'sum3'] => ['uint32*'] => 'uint32' );
$ffi->attach( [uint32_array_inc => 'array_inc2'] => ['uint32*'] => 'void');
}
is add(1,2), 3, 'add(1,2) = 3';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = 3;
is ${inc(\$i, 4)}, 7, 'inc(\$i,4) = \7';
is $i, 3+4, "i=3+4";
is ${inc(\3,4)}, 7, 'inc(\3,4) = \7';
my @list = (1,2,3,4,5,6,7,8,9,10);
is sum(\@list), 55, 'sum([1..10]) = 55';
is sum2(\@list, scalar @list), 55, 'sum2([1..10],10) = 55';
if($api >= 2)
{
is(sum3(\@list), 55, 'sum([1..10]) = 55 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
if($api >= 2)
{
@list = (1,2,3,4,5,6,7,8,9,10);
array_inc2(\@list);
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [1,4,6,8,10,12,14,16,18,20], 'static_array = [1,4,6,8,10,12,14,16,18,20]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]+2 });
$ffi->attach( [uint32_set_closure => 'set_closure'] => ['uint32_c'] => 'void');
$ffi->attach( [uint32_call_closure => 'call_closure'] => ['uint32'] => 'uint32');
set_closure($closure);
is call_closure(2), 4, 'call_closure(2) = 4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint32', perl_to_native => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint32_add => 'custom_add'] => ['type1','uint32'] => 'uint32');
is custom_add(2,1), 5, 'custom_add(2,1) = 5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'uint32', native_to_perl => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint32_add => 'custom_add2'] => ['uint32','uint32'] => 'type2');
is custom_add2(1,1), 4, 'custom_add2(1,1) = 4';
};
subtest 'custom type post' => sub {
$ffi->custom_type(type3 => { native_type => 'uint32', perl_to_native_post => sub { is $_[0], 1 } });
$ffi->attach( [uint32_add => 'custom_add3'] => ['type3','uint32'] => 'uint32');
is custom_add3(1,2), 3, 'custom_add3(1,2) = 3';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('object(Roger,uint32)', 'roger_t');
my $int = 211;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'uint32', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('uint32' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
}
};
done_testing;
FFI-Platypus-2.12/t/type_uint64.t 000644 000000 000000 00000011334 15251066120 016461 0 ustar 00root root 000000 000000 #
# DO NOT MODIFY THIS FILE.
# This file generated from similar file t/type_uint8.t
# all instances of "int8" have been changed to "int64"
#
use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('uint64 *' => 'uint64_p');
$ffi->type('uint64 [10]' => 'uint64_a');
$ffi->type('uint64 []' => 'uint64_a2');
$ffi->type('(uint64)->uint64' => 'uint64_c');
$ffi->attach( [uint64_add => 'add'] => ['uint64', 'uint64'] => 'uint64');
$ffi->attach( [uint64_inc => 'inc'] => ['uint64_p', 'uint64'] => 'uint64_p');
$ffi->attach( [uint64_sum => 'sum'] => ['uint64_a'] => 'uint64');
$ffi->attach( [uint64_sum2 => 'sum2'] => ['uint64_a2','size_t'] => 'uint64');
$ffi->attach( [uint64_array_inc => 'array_inc'] => ['uint64_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'uint64_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['uint64_p'] => 'int');
$ffi->attach( [uint64_static_array => 'static_array'] => [] => 'uint64_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'uint64_a');
if($api >= 2)
{
$ffi->attach( [uint64_sum => 'sum3'] => ['uint64*'] => 'uint64' );
$ffi->attach( [uint64_array_inc => 'array_inc2'] => ['uint64*'] => 'void');
}
is add(1,2), 3, 'add(1,2) = 3';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = 3;
is ${inc(\$i, 4)}, 7, 'inc(\$i,4) = \7';
is $i, 3+4, "i=3+4";
is ${inc(\3,4)}, 7, 'inc(\3,4) = \7';
my @list = (1,2,3,4,5,6,7,8,9,10);
is sum(\@list), 55, 'sum([1..10]) = 55';
is sum2(\@list, scalar @list), 55, 'sum2([1..10],10) = 55';
if($api >= 2)
{
is(sum3(\@list), 55, 'sum([1..10]) = 55 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
if($api >= 2)
{
@list = (1,2,3,4,5,6,7,8,9,10);
array_inc2(\@list);
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [1,4,6,8,10,12,14,16,18,20], 'static_array = [1,4,6,8,10,12,14,16,18,20]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]+2 });
$ffi->attach( [uint64_set_closure => 'set_closure'] => ['uint64_c'] => 'void');
$ffi->attach( [uint64_call_closure => 'call_closure'] => ['uint64'] => 'uint64');
set_closure($closure);
is call_closure(2), 4, 'call_closure(2) = 4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint64', perl_to_native => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint64_add => 'custom_add'] => ['type1','uint64'] => 'uint64');
is custom_add(2,1), 5, 'custom_add(2,1) = 5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'uint64', native_to_perl => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint64_add => 'custom_add2'] => ['uint64','uint64'] => 'type2');
is custom_add2(1,1), 4, 'custom_add2(1,1) = 4';
};
subtest 'custom type post' => sub {
$ffi->custom_type(type3 => { native_type => 'uint64', perl_to_native_post => sub { is $_[0], 1 } });
$ffi->attach( [uint64_add => 'custom_add3'] => ['type3','uint64'] => 'uint64');
is custom_add3(1,2), 3, 'custom_add3(1,2) = 3';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('object(Roger,uint64)', 'roger_t');
my $int = 211;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'uint64', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('uint64' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
}
};
done_testing;
FFI-Platypus-2.12/t/type_uint8.t 000644 000000 000000 00000011030 15251066120 016370 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use FFI::Platypus;
use FFI::CheckLib;
my @lib = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
foreach my $api (0, 1, 2)
{
subtest "api = $api" => sub {
local $SIG{__WARN__} = sub {
my $message = shift;
return if $message =~ /^Subroutine main::.* redefined/;
warn $message;
};
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('uint8 *' => 'uint8_p');
$ffi->type('uint8 [10]' => 'uint8_a');
$ffi->type('uint8 []' => 'uint8_a2');
$ffi->type('(uint8)->uint8' => 'uint8_c');
$ffi->attach( [uint8_add => 'add'] => ['uint8', 'uint8'] => 'uint8');
$ffi->attach( [uint8_inc => 'inc'] => ['uint8_p', 'uint8'] => 'uint8_p');
$ffi->attach( [uint8_sum => 'sum'] => ['uint8_a'] => 'uint8');
$ffi->attach( [uint8_sum2 => 'sum2'] => ['uint8_a2','size_t'] => 'uint8');
$ffi->attach( [uint8_array_inc => 'array_inc'] => ['uint8_a'] => 'void');
$ffi->attach( [pointer_null => 'null'] => [] => 'uint8_p');
$ffi->attach( [pointer_is_null => 'is_null'] => ['uint8_p'] => 'int');
$ffi->attach( [uint8_static_array => 'static_array'] => [] => 'uint8_a');
$ffi->attach( [pointer_null => 'null2'] => [] => 'uint8_a');
if($api >= 2)
{
$ffi->attach( [uint8_sum => 'sum3'] => ['uint8*'] => 'uint8' );
$ffi->attach( [uint8_array_inc => 'array_inc2'] => ['uint8*'] => 'void');
}
is add(1,2), 3, 'add(1,2) = 3';
is do { no warnings; add() }, 0, 'add() = 0';
my $i = 3;
is ${inc(\$i, 4)}, 7, 'inc(\$i,4) = \7';
is $i, 3+4, "i=3+4";
is ${inc(\3,4)}, 7, 'inc(\3,4) = \7';
my @list = (1,2,3,4,5,6,7,8,9,10);
is sum(\@list), 55, 'sum([1..10]) = 55';
is sum2(\@list, scalar @list), 55, 'sum2([1..10],10) = 55';
if($api >= 2)
{
is(sum3(\@list), 55, 'sum([1..10]) = 55 (passed as pointer)');
}
array_inc(\@list);
do { local $SIG{__WARN__} = sub {}; array_inc() };
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
if($api >= 2)
{
@list = (1,2,3,4,5,6,7,8,9,10);
array_inc2(\@list);
is \@list, [2,3,4,5,6,7,8,9,10,11], 'array increment';
}
is [null()], [$api >= 2 ? (undef) : ()], 'null() == undef';
is is_null(undef), 1, 'is_null(undef) == 1';
is is_null(), 1, 'is_null() == 1';
is is_null(\22), 0, 'is_null(22) == 0';
is static_array(), [1,4,6,8,10,12,14,16,18,20], 'static_array = [1,4,6,8,10,12,14,16,18,20]';
is [null2()], [$api >= 2 ? (undef) : ()], 'null2() == undef';
my $closure = $ffi->closure(sub { $_[0]+2 });
$ffi->attach( [uint8_set_closure => 'set_closure'] => ['uint8_c'] => 'void');
$ffi->attach( [uint8_call_closure => 'call_closure'] => ['uint8'] => 'uint8');
set_closure($closure);
is call_closure(2), 4, 'call_closure(2) = 4';
$closure = $ffi->closure(sub { undef });
set_closure($closure);
is do { no warnings; call_closure(2) }, 0, 'call_closure(2) = 0';
subtest 'custom type input' => sub {
$ffi->custom_type(type1 => { native_type => 'uint8', perl_to_native => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint8_add => 'custom_add'] => ['type1','uint8'] => 'uint8');
is custom_add(2,1), 5, 'custom_add(2,1) = 5';
};
subtest 'custom type output' => sub {
$ffi->custom_type(type2 => { native_type => 'uint8', native_to_perl => sub { is $_[0], 2; $_[0]*2 } });
$ffi->attach( [uint8_add => 'custom_add2'] => ['uint8','uint8'] => 'type2');
is custom_add2(1,1), 4, 'custom_add2(1,1) = 4';
};
subtest 'custom type post' => sub {
$ffi->custom_type(type3 => { native_type => 'uint8', perl_to_native_post => sub { is $_[0], 1 } });
$ffi->attach( [uint8_add => 'custom_add3'] => ['type3','uint8'] => 'uint8');
is custom_add3(1,2), 3, 'custom_add3(1,2) = 3';
};
$ffi->attach( [pointer_is_null => 'closure_pointer_is_null'] => ['()->void'] => 'int');
is closure_pointer_is_null(), 1, 'closure_pointer_is_null() = 1';
};
}
foreach my $api (1,2)
{
subtest 'object' => sub {
{ package Roger }
my $ffi = FFI::Platypus->new( api => $api, lib => [@lib], experimental => ($api > 2 ? $api : undef ) );
$ffi->type('object(Roger,uint8)', 'roger_t');
my $int = 211;
subtest 'argument' => sub {
is $ffi->cast('roger_t' => 'uint8', bless(\$int, 'Roger')), $int;
};
subtest 'return value' => sub {
my $obj1 = $ffi->cast('uint8' => 'roger_t', $int);
isa_ok $obj1, 'Roger';
is $$obj1, $int;
};
}
};
done_testing;
FFI-Platypus-2.12/xs/ 000755 000000 000000 00000000000 15251066120 014267 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/xs/ABI.xs 000644 000000 000000 00000001174 15251066120 015241 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::ABI
int
verify(abi)
int abi
PREINIT:
ffi_abi ffi_abi;
ffi_cif ffi_cif;
ffi_type *args[1];
CODE:
/*
* I had at least one report from (unknown version of) libffi
* where 999999 was accepted as a legal ABI, and all the other
* tests passed
*/
if(abi < FFI_FIRST_ABI || abi > FFI_LAST_ABI)
{
RETVAL = 0;
}
else
{
ffi_abi = abi;
if(ffi_prep_cif(&ffi_cif, ffi_abi, 0, &ffi_type_void, args) == FFI_OK)
{
RETVAL = 1;
}
else
{
RETVAL = 0;
}
}
OUTPUT:
RETVAL
FFI-Platypus-2.12/xs/API.xs 000644 000000 000000 00000014266 15251066120 015265 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::API
int
arguments_count()
PROTOTYPE:
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_count(MY_CXT.current_argv);
OUTPUT:
RETVAL
void *
arguments_get_pointer(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_pointer(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_pointer(i, value)
int i
void *value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_pointer(MY_CXT.current_argv, i, value);
ffi_pl_string
arguments_get_string(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_string(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_string(i, value)
int i
ffi_pl_string value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_string(MY_CXT.current_argv, i, value);
UV
arguments_get_uint8(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_uint8(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_uint8(i, value)
int i
UV value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_uint8(MY_CXT.current_argv, i, value);
IV
arguments_get_sint8(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_sint8(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_sint8(i, value)
int i
IV value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_sint8(MY_CXT.current_argv, i, value);
float
arguments_get_float(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_float(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_float(i, value)
int i
float value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_float(MY_CXT.current_argv, i, value);
double
arguments_get_double(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_double(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_double(i, value)
int i
double value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_double(MY_CXT.current_argv, i, value);
UV
arguments_get_uint16(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_uint16(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_uint16(i, value)
int i
UV value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_uint16(MY_CXT.current_argv, i, value);
IV
arguments_get_sint16(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_sint16(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_sint16(i, value)
int i
IV value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_sint16(MY_CXT.current_argv, i, value);
UV
arguments_get_uint32(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_uint32(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_uint32(i, value)
int i
UV value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_uint32(MY_CXT.current_argv, i, value);
IV
arguments_get_sint32(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
RETVAL = ffi_pl_arguments_get_sint32(MY_CXT.current_argv, i);
OUTPUT:
RETVAL
void
arguments_set_sint32(i, value)
int i
IV value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_sint32(MY_CXT.current_argv, i, value);
void
arguments_get_uint64(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
XSRETURN_U64(ffi_pl_arguments_get_uint64(MY_CXT.current_argv, i));
void
arguments_set_uint64(i, value)
int i
SV* value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_uint64(MY_CXT.current_argv, i, SvU64(value));
void
arguments_get_sint64(i)
int i
PROTOTYPE: $
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
XSRETURN_I64(ffi_pl_arguments_get_sint64(MY_CXT.current_argv, i));
void
arguments_set_sint64(i, value)
int i
SV* value
PROTOTYPE: $$
PREINIT:
dMY_CXT;
CODE:
if(MY_CXT.current_argv == NULL)
croak("Not in custom type handler");
ffi_pl_arguments_set_sint64(MY_CXT.current_argv, i, SvI64(value));
FFI-Platypus-2.12/xs/Buffer.xs 000644 000000 000000 00000004737 15251066120 016067 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::Buffer
void
window(sv, addr, len = 0, utf8 = 0)
SV* sv
void *addr
size_t len
IV utf8
PROTOTYPE: $$;$$
CODE:
if(len == 0)
len = strlen((char*)addr);
SvUPGRADE(sv, SVt_PV);
SvPVX(sv) = addr;
SvCUR_set(sv, len);
SvLEN_set(sv, 0);
SvPOK_only(sv);
SvREADONLY_on(sv);
if(utf8)
SvUTF8_on(sv);
void
grow (sv, size, ... )
SV *sv
STRLEN size
PROTOTYPE: $$;$
PREINIT:
int clear = 1;
int set_length = 1;
PPCODE:
if (SvROK (sv))
croak("buffer argument must be a scalar");
if ( items > 2 ) {
HV* hash = NULL;
SV* options = ST(2);
char *key;
I32 len;
SV* value;
if ( SvROK(options) )
hash = (HV*) SvRV(options);
if ( !hash || SvTYPE(hash) != SVt_PVHV )
croak("options argument must be a hash");
hv_iterinit(hash);
while( (value = hv_iternextsv(hash, &key, &len)) != NULL ) {
if ( 0 == strncmp( key, "clear", len ) ) {
clear = SvTRUE( value );
}
else if ( 0 == strncmp( key, "set_length", len ) ) {
set_length = SvTRUE( value );
}
else {
croak("unknown option: %s", key );
}
}
}
/* if not a string turn it into an empty one, or if clearing is
requested, reset string length */
if (!SvPOK (sv) || clear ) {
#if PERL_API_VERSION >= 26
SvPVCLEAR(sv);
#else
sv_setpvn (sv, "", 0);
#endif
}
SvGROW (sv, size);
if ( set_length )
SvCUR_set( sv, size );
EXTEND (SP, 1);
mPUSHi (SvLEN (sv));
void
raw_scalar(size)
STRLEN size
PROTOTYPE: $
PREINIT:
SV *sv;
PPCODE:
/* newSV(0) doesn't allocate a buffer at all, so ask for at least one
byte so that the scalar always has a valid PV to point at */
sv = newSV(size ? size : 1);
SvPOK_only(sv);
SvCUR_set(sv, size);
SvPVX(sv)[size] = '\0';
EXTEND(SP, 1);
PUSHs(sv_2mortal(sv));
STRLEN
set_used_length( sv, size )
SV *sv
STRLEN size
PROTOTYPE: $$
PREINIT:
STRLEN len;
CODE:
if (SvROK (sv))
croak("buffer argument must be a scalar");
/* add some stringiness if necessary; svCUR_set only works on PV's */
if (!SvPOK (sv))
sv_setpvn (sv, "", 0);
len = SvLEN( sv );
RETVAL = size > len ? len : size;
SvCUR_set( sv, RETVAL );
OUTPUT:
RETVAL
FFI-Platypus-2.12/xs/Closure.xs 000644 000000 000000 00000001510 15251066120 016254 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::Closure
void
_sticky(self)
SV *self
CODE:
if(sv_isobject(self) && sv_derived_from(self, "FFI::Platypus::Closure"))
{
SvREFCNT_inc_simple_void_NN(SvRV(self));
SvREFCNT_inc_simple_void_NN(SvRV(self));
}
else
croak("object is not a closure");
void
_unstick(self)
SV *self
CODE:
if(sv_isobject(self) && sv_derived_from(self, "FFI::Platypus::Closure"))
{
SvREFCNT_dec(SvRV(self));
SvREFCNT_dec(SvRV(self));
}
else
croak("object is not a closure");
U32
_svrefcnt(self)
SV *self
CODE:
/* used in test only */
if(sv_isobject(self) && sv_derived_from(self, "FFI::Platypus::Closure"))
{
RETVAL = SvREFCNT(SvRV(self));
}
else
croak("object is not a closure");
OUTPUT:
RETVAL
FFI-Platypus-2.12/xs/ClosureData.xs 000644 000000 000000 00000000317 15251066120 017052 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::ClosureData
void
DESTROY(self)
ffi_pl_closure *self
CODE:
SvREFCNT_dec(self->coderef);
ffi_closure_free(self->ffi_closure);
Safefree(self);
FFI-Platypus-2.12/xs/DL.xs 000644 000000 000000 00000002762 15251066120 015151 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::DL
BOOT:
{
HV *stash;
stash = gv_stashpv("FFI::Platypus::DL", TRUE);
#ifdef RTLD_LAZY
newCONSTSUB(stash, "RTLD_PLATYPUS_DEFAULT", newSViv(RTLD_LAZY));
newCONSTSUB(stash, "RTLD_LAZY", newSViv(RTLD_LAZY));
#else
newCONSTSUB(stash, "RTLD_PLATYPUS_DEFAULT", newSViv(0));
#endif
#ifdef RTLD_NOW
newCONSTSUB(stash, "RTLD_NOW", newSViv(RTLD_NOW));
#endif
#ifdef RTLD_GLOBAL
newCONSTSUB(stash, "RTLD_GLOBAL", newSViv(RTLD_GLOBAL));
#endif
#ifdef RTLD_LOCAL
newCONSTSUB(stash, "RTLD_LOCAL", newSViv(RTLD_LOCAL));
#endif
#ifdef RTLD_NODELETE
newCONSTSUB(stash, "RTLD_NODELETE", newSViv(RTLD_NODELETE));
#endif
#ifdef RTLD_NOLOAD
newCONSTSUB(stash, "RTLD_NOLOAD", newSViv(RTLD_NOLOAD));
#endif
#ifdef RTLD_DEEPBIND
newCONSTSUB(stash, "RTLD_DEEPBIND", newSViv(RTLD_DEEPBIND));
#endif
}
void *
dlopen(filename, flags);
ffi_pl_string filename
int flags
INIT:
void *ptr;
CODE:
ptr = dlopen(filename, flags);
if(ptr == NULL)
{
XSRETURN_EMPTY;
}
else
{
RETVAL = ptr;
}
OUTPUT:
RETVAL
const char *
dlerror();
void *
dlsym(handle, symbol);
void *handle
const char *symbol
INIT:
void *ptr;
CODE:
ptr = dlsym(handle, symbol);
if(ptr == NULL)
{
XSRETURN_EMPTY;
}
else
{
RETVAL = ptr;
}
OUTPUT:
RETVAL
int
dlclose(handle);
void *handle
CODE:
if(!PL_dirty)
RETVAL = dlclose(handle);
else
RETVAL = 0;
OUTPUT:
RETVAL
FFI-Platypus-2.12/xs/Function.xs 000644 000000 000000 00000021037 15251066120 016433 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::Function::Function
ffi_pl_function *
new(class, platypus, address, abi, var_fixed_args, return_type, ...)
const char *class
SV *platypus
void *address
int abi
int var_fixed_args
ffi_pl_type *return_type
PREINIT:
ffi_pl_function *self;
int i,n,j;
SV* arg;
void *buffer;
ffi_type *ffi_return_type;
ffi_type **ffi_argument_types;
ffi_status ffi_status;
ffi_abi ffi_abi;
int extra_arguments;
dMY_CXT;
CODE:
(void)class;
#ifndef FFI_PL_PROBE_VARIADIC
if(var_fixed_args != -1)
{
croak("variadic functions are not supported by some combination of your libffi/compiler/platypus");
}
#endif
#ifndef FFI_PL_PROBE_RECORDVALUE
if(return_type->type_code == FFI_PL_TYPE_RECORD_VALUE
|| return_type->type_code == (FFI_PL_TYPE_RECORD_VALUE|FFI_PL_SHAPE_CUSTOM_PERL))
{
croak("returning record values is not supported by some combination of your libffi/compiler/platypus");
}
#endif
ffi_abi = abi == -1 ? FFI_DEFAULT_ABI : abi;
for(i=0,extra_arguments=0; i<(items-6); i++)
{
ffi_pl_type *arg_type;
arg = ST(i+6);
if(!(sv_isobject(arg) && sv_derived_from(arg, "FFI::Platypus::Type")))
{
croak("non-type parameter passed in as type");
}
arg_type = INT2PTR(ffi_pl_type*, SvIV((SV*) SvRV(arg)));
if(arg_type->type_code == FFI_PL_TYPE_VOID)
croak("void not allowed as argument type");
if((arg_type->type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
extra_arguments += arg_type->extra[0].custom_perl.argument_count;
}
Newx(buffer, (sizeof(ffi_pl_function) + sizeof(ffi_pl_type*)*(items-6+extra_arguments)), char);
self = (ffi_pl_function*)buffer;
Newx(ffi_argument_types, items-6+extra_arguments, ffi_type*);
{
HV *hv;
SV **sv;
hv = (HV*) SvRV(platypus);
sv = hv_fetch(hv, "api", 3, 0);
self->platypus_api = SvIV(*sv);
}
self->address = address;
self->return_type = return_type;
ffi_return_type = ffi_pl_type_to_libffi_type(return_type);
for(i=0,n=0; i<(items-6); i++,n++)
{
arg = ST(i+6);
self->argument_types[n] = INT2PTR(ffi_pl_type*, SvIV((SV*) SvRV(arg)));
ffi_argument_types[n] = ffi_pl_type_to_libffi_type(self->argument_types[n]);
if((self->argument_types[n]->type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL
&& self->argument_types[n]->extra[0].custom_perl.argument_count > 0)
{
for(j=1; j-1 < self->argument_types[n]->extra[0].custom_perl.argument_count; j++)
{
self->argument_types[n+j] = self->argument_types[n];
ffi_argument_types[n+j] = ffi_pl_type_to_libffi_type(self->argument_types[n]);
}
n += self->argument_types[n]->extra[0].custom_perl.argument_count;
}
if(
(self->argument_types[n]->type_code & (FFI_PL_BASE_MASK|FFI_PL_SIZE_MASK)) == FFI_PL_TYPE_LONG_DOUBLE &&
((self->argument_types[n]->type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_POINTER ||
(self->argument_types[n]->type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_ARRAY)
)
{
/*
* For historical reasons, we return longdouble pointer and array as Math::LongDouble
* if it is installed, but we need to load it when the function is created, not on
* the first call
*/
if(!MY_CXT.loaded_math_longdouble)
{
require_pv("Math/LongDouble.pm");
if(SvTRUE(ERRSV))
{
MY_CXT.loaded_math_longdouble = 2;
}
else
{
MY_CXT.loaded_math_longdouble = 1;
}
}
}
}
if(
(return_type->type_code & (FFI_PL_BASE_MASK|FFI_PL_SIZE_MASK)) == FFI_PL_TYPE_LONG_DOUBLE
)
{
/*
* For historical reasons, we return longdouble as Math::LongDouble if it is
* installed, but we need to load it when the function is created, not on
* the first call
*/
if(!MY_CXT.loaded_math_longdouble)
{
require_pv("Math/LongDouble.pm");
if(SvTRUE(ERRSV))
{
MY_CXT.loaded_math_longdouble = 2;
}
else
{
MY_CXT.loaded_math_longdouble = 1;
}
}
}
if(var_fixed_args == -1)
{
ffi_status = ffi_prep_cif(
&self->ffi_cif, /* ffi_cif | */
ffi_abi, /* ffi_abi | */
items-6+extra_arguments, /* int | argument count */
ffi_return_type, /* ffi_type * | return type */
ffi_argument_types /* ffi_type ** | argument types */
);
}
else
{
#ifdef FFI_PL_PROBE_VARIADIC
ffi_status = ffi_prep_cif_var(
&self->ffi_cif, /* ffi_cif | */
ffi_abi, /* ffi_abi | */
var_fixed_args, /* int | fixed argument count */
items-6+extra_arguments, /* int | total argument count */
ffi_return_type, /* ffi_type * | return type */
ffi_argument_types /* ffi_type ** | argument types */
);
#endif
}
if(ffi_status != FFI_OK)
{
Safefree(self);
Safefree(ffi_argument_types);
if(ffi_status == FFI_BAD_TYPEDEF)
croak("bad typedef");
else if(ffi_status == FFI_BAD_ABI)
croak("bad abi");
else
croak("unknown error with ffi_prep_cif");
}
self->platypus_sv = SvREFCNT_inc_simple_NN(platypus);
RETVAL = self;
OUTPUT:
RETVAL
void
call(self, ...)
ffi_pl_function *self
PREINIT:
int i, n, perl_arg_index;
SV *arg;
ffi_pl_arguments *arguments;
void **argument_pointers;
dMY_CXT;
CODE:
#define EXTRA_ARGS 1
{
#include "ffi_platypus_call.h"
}
void
_attach(self, perl_name, path_name, proto)
SV *self
const char *perl_name
ffi_pl_string path_name
ffi_pl_string proto
PREINIT:
CV* cv;
int is_ret_rv;
ffi_pl_function *f;
CODE:
if(!(sv_isobject(self) && sv_derived_from(self, "FFI::Platypus::Function")))
croak("self is not of type FFI::Platypus::Function");
f = INT2PTR(ffi_pl_function*, SvIV((SV*) SvRV(self)));
is_ret_rv = (f->return_type->type_code == FFI_PL_TYPE_RECORD_VALUE) ||
(f->return_type->type_code == (FFI_PL_TYPE_RECORD_VALUE | FFI_PL_SHAPE_CUSTOM_PERL));
if(path_name == NULL)
path_name = "unknown";
if(proto == NULL)
cv = newXS(perl_name, is_ret_rv ? ffi_pl_sub_call_rv : ffi_pl_sub_call, path_name);
else
{
/*
* this ifdef is needed for Perl 5.8.8 support.
* once we don't need to support 5.8.8 we can
* remove this workaround (the ndef'd branch)
*/
#ifdef newXS_flags
cv = newXSproto(perl_name, is_ret_rv ? ffi_pl_sub_call_rv : ffi_pl_sub_call, path_name, proto);
#else
newXSproto(perl_name, is_ret_rv ? ffi_pl_sub_call_rv : ffi_pl_sub_call, path_name, proto);
cv = get_cv(perl_name,0);
#endif
}
CvXSUBANY(cv).any_ptr = (void *) f;
/*
* No coresponding decrement !!
* once attached, you can never free the function object, or the FFI::Platypus
* it was created from.
*/
SvREFCNT_inc_simple_void_NN(self);
SV*
_sub_ref(self, path_name)
SV *self
ffi_pl_string path_name
PREINIT:
CV* cv;
SV *ref;
int is_ret_rv;
ffi_pl_function *f;
CODE:
f = INT2PTR(ffi_pl_function*, SvIV((SV*) SvRV(self)));
is_ret_rv = (f->return_type->type_code == FFI_PL_TYPE_RECORD_VALUE) ||
(f->return_type->type_code == (FFI_PL_TYPE_RECORD_VALUE | FFI_PL_SHAPE_CUSTOM_PERL));
cv = newXS(NULL, is_ret_rv ? ffi_pl_sub_call_rv : ffi_pl_sub_call, path_name);
CvXSUBANY(cv).any_ptr = (void *) INT2PTR(ffi_pl_function*, SvIV((SV*) SvRV(self)));
/*
* No coresponding decrement !!
* once attached, you can never free the function object, or the FFI::Platypus
* it was created from.
*/
SvREFCNT_inc_simple_void_NN(self);
RETVAL = newRV_inc((SV*)cv);
OUTPUT:
RETVAL
void
DESTROY(self)
ffi_pl_function *self
CODE:
SvREFCNT_dec(self->platypus_sv);
if(!PL_dirty)
{
Safefree(self->ffi_cif.arg_types);
Safefree(self);
}
MODULE = FFI::Platypus PACKAGE = FFI::Platypus::Function::Wrapper
void
_set_prototype(proto, code)
SV *proto;
SV *code;
PROTOTYPE: $$
PREINIT:
SV *cv; /* not CV */
CODE:
SvGETMAGIC(code);
cv = SvRV(code);
sv_copypv(cv, proto);
FFI-Platypus-2.12/xs/Internal.xs 000644 000000 000000 00000007276 15251066120 016433 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::Internal
void
_init()
INIT:
HV *stash;
CODE:
stash = gv_stashpv("FFI::Platypus::Internal", TRUE);
newCONSTSUB(stash, "FFI_PL_SIZE_0", newSViv(FFI_PL_SIZE_0));
newCONSTSUB(stash, "FFI_PL_SIZE_8", newSViv(FFI_PL_SIZE_8));
newCONSTSUB(stash, "FFI_PL_SIZE_16", newSViv(FFI_PL_SIZE_16));
newCONSTSUB(stash, "FFI_PL_SIZE_32", newSViv(FFI_PL_SIZE_32));
newCONSTSUB(stash, "FFI_PL_SIZE_64", newSViv(FFI_PL_SIZE_64));
newCONSTSUB(stash, "FFI_PL_SIZE_128", newSViv(FFI_PL_SIZE_128));
newCONSTSUB(stash, "FFI_PL_SIZE_256", newSViv(FFI_PL_SIZE_256));
newCONSTSUB(stash, "FFI_PL_SIZE_512", newSViv(FFI_PL_SIZE_512));
newCONSTSUB(stash, "FFI_PL_SIZE_PTR", newSViv(FFI_PL_SIZE_PTR));
newCONSTSUB(stash, "FFI_PL_SIZE_MASK", newSViv(FFI_PL_SIZE_MASK));
newCONSTSUB(stash, "FFI_PL_BASE_VOID", newSViv(FFI_PL_BASE_VOID));
newCONSTSUB(stash, "FFI_PL_BASE_SINT", newSViv(FFI_PL_BASE_SINT));
newCONSTSUB(stash, "FFI_PL_BASE_UINT", newSViv(FFI_PL_BASE_UINT));
newCONSTSUB(stash, "FFI_PL_BASE_FLOAT", newSViv(FFI_PL_BASE_FLOAT));
newCONSTSUB(stash, "FFI_PL_BASE_COMPLEX", newSViv(FFI_PL_BASE_COMPLEX));
newCONSTSUB(stash, "FFI_PL_BASE_OPAQUE", newSViv(FFI_PL_BASE_OPAQUE));
newCONSTSUB(stash, "FFI_PL_BASE_STRING", newSViv(FFI_PL_BASE_STRING));
newCONSTSUB(stash, "FFI_PL_BASE_CLOSURE", newSViv(FFI_PL_BASE_CLOSURE));
newCONSTSUB(stash, "FFI_PL_BASE_RECORD", newSViv(FFI_PL_BASE_RECORD));
newCONSTSUB(stash, "FFI_PL_BASE_MASK", newSViv(FFI_PL_BASE_MASK));
newCONSTSUB(stash, "FFI_PL_SHAPE_SCALAR", newSViv(FFI_PL_SHAPE_SCALAR));
newCONSTSUB(stash, "FFI_PL_SHAPE_POINTER", newSViv(FFI_PL_SHAPE_POINTER));
newCONSTSUB(stash, "FFI_PL_SHAPE_ARRAY", newSViv(FFI_PL_SHAPE_ARRAY));
newCONSTSUB(stash, "FFI_PL_SHAPE_CUSTOM_PERL", newSViv(FFI_PL_SHAPE_CUSTOM_PERL));
newCONSTSUB(stash, "FFI_PL_SHAPE_OBJECT", newSViv(FFI_PL_SHAPE_OBJECT));
newCONSTSUB(stash, "FFI_PL_SHAPE_CUSTOM_MASK", newSViv(FFI_PL_SHAPE_MASK));
newCONSTSUB(stash, "FFI_PL_TYPE_VOID", newSViv(FFI_PL_TYPE_VOID));
newCONSTSUB(stash, "FFI_PL_TYPE_SINT8", newSViv(FFI_PL_TYPE_SINT8));
newCONSTSUB(stash, "FFI_PL_TYPE_SINT16", newSViv(FFI_PL_TYPE_SINT16));
newCONSTSUB(stash, "FFI_PL_TYPE_SINT32", newSViv(FFI_PL_TYPE_SINT32));
newCONSTSUB(stash, "FFI_PL_TYPE_SINT64", newSViv(FFI_PL_TYPE_SINT64));
newCONSTSUB(stash, "FFI_PL_TYPE_UINT8", newSViv(FFI_PL_TYPE_UINT8));
newCONSTSUB(stash, "FFI_PL_TYPE_UINT16", newSViv(FFI_PL_TYPE_UINT16));
newCONSTSUB(stash, "FFI_PL_TYPE_UINT32", newSViv(FFI_PL_TYPE_UINT32));
newCONSTSUB(stash, "FFI_PL_TYPE_UINT64", newSViv(FFI_PL_TYPE_UINT64));
newCONSTSUB(stash, "FFI_PL_TYPE_FLOAT", newSViv(FFI_PL_TYPE_FLOAT));
newCONSTSUB(stash, "FFI_PL_TYPE_DOUBLE", newSViv(FFI_PL_TYPE_DOUBLE));
newCONSTSUB(stash, "FFI_PL_TYPE_LONG_DOUBLE", newSViv(FFI_PL_TYPE_LONG_DOUBLE));
newCONSTSUB(stash, "FFI_PL_TYPE_COMPLEX_FLOAT", newSViv(FFI_PL_TYPE_COMPLEX_FLOAT));
newCONSTSUB(stash, "FFI_PL_TYPE_COMPLEX_DOUBLE", newSViv(FFI_PL_TYPE_COMPLEX_DOUBLE));
newCONSTSUB(stash, "FFI_PL_TYPE_OPAQUE", newSViv(FFI_PL_TYPE_OPAQUE));
newCONSTSUB(stash, "FFI_PL_TYPE_STRING", newSViv(FFI_PL_TYPE_STRING));
newCONSTSUB(stash, "FFI_PL_TYPE_CLOSURE", newSViv(FFI_PL_TYPE_CLOSURE));
newCONSTSUB(stash, "FFI_PL_TYPE_RECORD", newSViv(FFI_PL_TYPE_RECORD));
newCONSTSUB(stash, "FFI_PL_TYPE_RECORD_VALUE", newSViv(FFI_PL_TYPE_RECORD_VALUE));
FFI-Platypus-2.12/xs/Record.xs 000644 000000 000000 00000013067 15251066120 016070 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::Record
int
_ffi_record_ro(self)
SV* self
CODE:
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
RETVAL = SvREADONLY(self) ? 1 : 0;
OUTPUT:
RETVAL
void
_accessor(perl_name, path_name, type, offset)
const char *perl_name
ffi_pl_string path_name;
ffi_pl_type *type
int offset
PROTOTYPE: $$$$
PREINIT:
ffi_pl_record_member *member;
CV *cv;
void *function=NULL;
/* not the correct prototype */
extern void ffi_pl_record_accessor_uint8();
extern void ffi_pl_record_accessor_uint16();
extern void ffi_pl_record_accessor_uint32();
extern void ffi_pl_record_accessor_uint64();
extern void ffi_pl_record_accessor_sint8();
extern void ffi_pl_record_accessor_sint16();
extern void ffi_pl_record_accessor_sint32();
extern void ffi_pl_record_accessor_sint64();
extern void ffi_pl_record_accessor_float();
extern void ffi_pl_record_accessor_double();
extern void ffi_pl_record_accessor_opaque();
extern void ffi_pl_record_accessor_uint8_array();
extern void ffi_pl_record_accessor_uint16_array();
extern void ffi_pl_record_accessor_uint32_array();
extern void ffi_pl_record_accessor_uint64_array();
extern void ffi_pl_record_accessor_sint8_array();
extern void ffi_pl_record_accessor_sint16_array();
extern void ffi_pl_record_accessor_sint32_array();
extern void ffi_pl_record_accessor_sint64_array();
extern void ffi_pl_record_accessor_float_array();
extern void ffi_pl_record_accessor_double_array();
extern void ffi_pl_record_accessor_opaque_array();
extern void ffi_pl_record_accessor_string_ro();
extern void ffi_pl_record_accessor_string_rw();
extern void ffi_pl_record_accessor_string_fixed();
CODE:
Newx(member, 1, ffi_pl_record_member);
member->offset = offset;
switch(type->type_code & FFI_PL_SHAPE_MASK)
{
case FFI_PL_SHAPE_ARRAY:
member->count = type->extra[0].array.element_count;
break;
default:
member->count = 1;
break;
}
switch(type->type_code)
{
case FFI_PL_TYPE_UINT8:
function = ffi_pl_record_accessor_uint8;
break;
case FFI_PL_TYPE_SINT8:
function = ffi_pl_record_accessor_sint8;
break;
case FFI_PL_TYPE_UINT16:
function = ffi_pl_record_accessor_uint16;
break;
case FFI_PL_TYPE_SINT16:
function = ffi_pl_record_accessor_sint16;
break;
case FFI_PL_TYPE_UINT32:
function = ffi_pl_record_accessor_uint32;
break;
case FFI_PL_TYPE_SINT32:
function = ffi_pl_record_accessor_sint32;
break;
case FFI_PL_TYPE_UINT64:
function = ffi_pl_record_accessor_uint64;
break;
case FFI_PL_TYPE_SINT64:
function = ffi_pl_record_accessor_sint64;
break;
case FFI_PL_TYPE_FLOAT:
function = ffi_pl_record_accessor_float;
break;
case FFI_PL_TYPE_DOUBLE:
function = ffi_pl_record_accessor_double;
break;
case FFI_PL_TYPE_OPAQUE:
function = ffi_pl_record_accessor_opaque;
break;
case FFI_PL_TYPE_STRING:
switch(type->sub_type)
{
case FFI_PL_TYPE_STRING_RO:
member->count = 1;
function = ffi_pl_record_accessor_string_ro;
break;
case FFI_PL_TYPE_STRING_RW:
member->count = 1;
function = ffi_pl_record_accessor_string_rw;
break;
}
break;
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_uint8_array;
break;
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_sint8_array;
break;
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_uint16_array;
break;
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_sint16_array;
break;
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_uint32_array;
break;
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_sint32_array;
break;
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_uint64_array;
break;
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_sint64_array;
break;
case FFI_PL_TYPE_FLOAT | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_float_array;
break;
case FFI_PL_TYPE_DOUBLE | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_double_array;
break;
case FFI_PL_TYPE_OPAQUE | FFI_PL_SHAPE_ARRAY:
function = ffi_pl_record_accessor_opaque_array;
break;
case FFI_PL_TYPE_RECORD:
member->count = type->extra[0].record.size;
function = ffi_pl_record_accessor_string_fixed;
break;
default:
Safefree(member);
XSRETURN_PV("type not supported");
break;
}
if(path_name == NULL)
path_name = "unknown";
/*
* this ifdef is needed for Perl 5.8.8 support.
* once we don't need to support 5.8.8 we can
* remove this workaround (the ndef'd branch)
*/
#ifdef newXS_flags
cv = newXSproto(perl_name, function, path_name, "$;$");
#else
newXSproto(perl_name, function, path_name, "$;$");
cv = get_cv(perl_name,0);
#endif
CvXSUBANY(cv).any_ptr = (void*) member;
XSRETURN_EMPTY;
FFI-Platypus-2.12/xs/Type.xs 000644 000000 000000 00000022047 15251066120 015571 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::Type
BOOT:
{
HV *ft = get_hv("FFI::Platypus::TypeParser::ffi_type", GV_ADD);
hv_stores(ft, "void", newSViv(PTR2IV( &ffi_type_void )));
hv_stores(ft, "sint8", newSViv(PTR2IV( &ffi_type_sint8 )));
hv_stores(ft, "sint16", newSViv(PTR2IV( &ffi_type_sint16 )));
hv_stores(ft, "sint32", newSViv(PTR2IV( &ffi_type_sint32 )));
hv_stores(ft, "sint64", newSViv(PTR2IV( &ffi_type_sint64 )));
hv_stores(ft, "uint8", newSViv(PTR2IV( &ffi_type_uint8 )));
hv_stores(ft, "uint16", newSViv(PTR2IV( &ffi_type_uint16 )));
hv_stores(ft, "uint32", newSViv(PTR2IV( &ffi_type_uint32 )));
hv_stores(ft, "uint64", newSViv(PTR2IV( &ffi_type_uint64 )));
hv_stores(ft, "pointer", newSViv(PTR2IV( &ffi_type_pointer )));
hv_stores(ft, "float", newSViv(PTR2IV( &ffi_type_float )));
hv_stores(ft, "double", newSViv(PTR2IV( &ffi_type_double )));
#ifdef FFI_PL_PROBE_LONGDOUBLE
hv_stores(ft, "longdouble", newSViv(PTR2IV( &ffi_type_longdouble )));
#endif
#ifdef FFI_PL_PROBE_COMPLEX
hv_stores(ft, "complex_float", newSViv(PTR2IV( &ffi_type_complex_float )));
hv_stores(ft, "complex_double", newSViv(PTR2IV( &ffi_type_complex_double )));
#endif
}
SV*
meta(self)
ffi_pl_type *self
PREINIT:
HV *meta;
CODE:
meta = ffi_pl_get_type_meta(self);
RETVAL = newRV_noinc((SV*)meta);
OUTPUT:
RETVAL
int
sizeof(self)
ffi_pl_type *self
CODE:
RETVAL = ffi_pl_sizeof(self);
OUTPUT:
RETVAL
SV*
unitof(self)
ffi_pl_type *self
PREINIT:
int type_code;
CODE:
type_code = self->type_code;
/* ignore custom asoect */
if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
{
type_code ^= FFI_PL_SHAPE_CUSTOM_PERL;
}
switch(type_code)
{
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_SINT8 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("sint8");
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_UINT8 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("uint8");
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_SINT16 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("sint16");
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_UINT16 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("uint16");
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_SINT32 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("sint32");
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_UINT32 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("uint32");
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_SINT64 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("sint64");
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_UINT64 | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("uint64");
case FFI_PL_TYPE_FLOAT | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_FLOAT | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("float");
case FFI_PL_TYPE_DOUBLE | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_DOUBLE | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("double");
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_LONG_DOUBLE | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("longdouble");
#endif
#ifdef FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_COMPLEX_FLOAT | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("complex_float");
case FFI_PL_TYPE_COMPLEX_DOUBLE | FFI_PL_SHAPE_POINTER:
case FFI_PL_TYPE_COMPLEX_DOUBLE | FFI_PL_SHAPE_ARRAY:
XSRETURN_PV("complex_double");
#endif
default:
XSRETURN_UNDEF;
}
const char *
kindof(self)
ffi_pl_type *self
PREINIT:
int type_code;
CODE:
type_code = self->type_code;
/* ignore custom asoect */
if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
{
type_code ^= FFI_PL_SHAPE_CUSTOM_PERL;
}
switch(type_code)
{
case FFI_PL_TYPE_VOID :
RETVAL = "void";
break;
case FFI_PL_TYPE_SINT8:
case FFI_PL_TYPE_UINT8:
case FFI_PL_TYPE_SINT16:
case FFI_PL_TYPE_UINT16:
case FFI_PL_TYPE_SINT32:
case FFI_PL_TYPE_UINT32:
case FFI_PL_TYPE_SINT64:
case FFI_PL_TYPE_UINT64:
case FFI_PL_TYPE_FLOAT:
case FFI_PL_TYPE_DOUBLE:
case FFI_PL_TYPE_LONG_DOUBLE:
case FFI_PL_TYPE_COMPLEX_FLOAT:
case FFI_PL_TYPE_COMPLEX_DOUBLE:
case FFI_PL_TYPE_OPAQUE:
RETVAL = "scalar";
break;
case FFI_PL_TYPE_STRING:
RETVAL = "string";
break;
case FFI_PL_TYPE_CLOSURE:
RETVAL = "closure";
break;
case FFI_PL_TYPE_RECORD:
RETVAL = "record";
break;
case FFI_PL_TYPE_RECORD_VALUE:
RETVAL = "record-value";
break;
default:
switch(type_code & FFI_PL_SHAPE_MASK)
{
case FFI_PL_SHAPE_POINTER:
RETVAL = "pointer";
break;
case FFI_PL_SHAPE_ARRAY:
RETVAL = "array";
break;
case FFI_PL_SHAPE_OBJECT:
RETVAL = "object";
break;
default:
croak("internal error computing type kind (%x)", type_code);
}
}
OUTPUT:
RETVAL
int
countof(self)
ffi_pl_type *self
CODE:
switch(self->type_code & FFI_PL_SHAPE_MASK)
{
case FFI_PL_SHAPE_SCALAR:
case FFI_PL_SHAPE_POINTER:
case FFI_PL_SHAPE_CUSTOM_PERL:
case FFI_PL_SHAPE_OBJECT:
switch(self->type_code)
{
case FFI_PL_TYPE_VOID:
RETVAL = 0;
break;
default:
RETVAL = 1;
break;
}
break;
case FFI_PL_SHAPE_ARRAY:
RETVAL = self->extra[0].array.element_count;
break;
default:
croak("internal error computing type kind (%x)", self->type_code);
}
OUTPUT:
RETVAL
int
type_code(self)
ffi_pl_type *self
CODE:
RETVAL = self->type_code;
OUTPUT:
RETVAL
int
is_record(self)
ffi_pl_type *self
CODE:
/* may not need this method anymore */
RETVAL = self->type_code == FFI_PL_TYPE_RECORD
|| self->type_code == (FFI_PL_TYPE_RECORD | FFI_PL_SHAPE_CUSTOM_PERL);
OUTPUT:
RETVAL
int
is_record_value(self)
ffi_pl_type *self
CODE:
RETVAL = self->type_code == FFI_PL_TYPE_RECORD_VALUE
|| self->type_code == (FFI_PL_TYPE_RECORD_VALUE | FFI_PL_SHAPE_CUSTOM_PERL);
OUTPUT:
RETVAL
int
is_customizable(self)
ffi_pl_type *self
PREINIT:
int shape;
int base;
CODE:
shape = self->type_code & FFI_PL_SHAPE_MASK;
base = self->type_code & FFI_PL_BASE_MASK;
RETVAL = shape == FFI_PL_SHAPE_SCALAR
&& ( base == FFI_PL_BASE_SINT
|| base == FFI_PL_BASE_UINT
|| base == FFI_PL_BASE_FLOAT
|| base == FFI_PL_BASE_OPAQUE
|| base == FFI_PL_BASE_RECORD
|| base == (FFI_PL_BASE_RECORD | FFI_PL_BASE_OPAQUE)
);
OUTPUT:
RETVAL
int
is_object_ok(self)
ffi_pl_type *self
PREINIT:
int shape;
int base;
CODE:
shape = self->type_code & FFI_PL_SHAPE_MASK;
base = self->type_code & FFI_PL_BASE_MASK;
RETVAL = shape == FFI_PL_SHAPE_SCALAR
&& ( base == FFI_PL_BASE_SINT
|| base == FFI_PL_BASE_UINT
|| base == FFI_PL_BASE_OPAQUE
);
OUTPUT:
RETVAL
int
is_ro(self)
ffi_pl_type *self
CODE:
RETVAL = self->type_code == FFI_PL_TYPE_STRING &&
self->sub_type == FFI_PL_TYPE_STRING_RO;
OUTPUT:
RETVAL
void
DESTROY(self)
ffi_pl_type *self
CODE:
if(self->type_code == FFI_PL_TYPE_CLOSURE)
{
if(!PL_dirty)
Safefree(self->extra[0].closure.ffi_cif.arg_types);
}
else if(self->type_code == FFI_PL_TYPE_RECORD
|| self->type_code == FFI_PL_TYPE_RECORD_VALUE)
{
if(self->extra[0].record.class != NULL)
free(self->extra[0].record.class);
}
else
{
switch(self->type_code & FFI_PL_SHAPE_MASK)
{
case FFI_PL_SHAPE_CUSTOM_PERL:
{
ffi_pl_type_extra_custom_perl *custom;
custom = &self->extra[0].custom_perl;
if(custom->perl_to_native != NULL)
SvREFCNT_dec(custom->perl_to_native);
if(custom->perl_to_native_post != NULL)
SvREFCNT_dec(custom->perl_to_native_post);
if(custom->native_to_perl != NULL)
SvREFCNT_dec(custom->native_to_perl);
if(self->extra[0].record.class != NULL)
free(self->extra[0].record.class);
}
break;
case FFI_PL_SHAPE_OBJECT:
{
if(self->extra[0].object.class != NULL)
free(self->extra[0].object.class);
}
break;
default:
break;
}
}
if(!PL_dirty)
Safefree(self);
FFI-Platypus-2.12/xs/TypeParser.xs 000644 000000 000000 00000024546 15251066120 016754 0 ustar 00root root 000000 000000 MODULE = FFI::Platypus PACKAGE = FFI::Platypus::TypeParser
BOOT:
{
HV *bt = get_hv("FFI::Platypus::TypeParser::basic_type", GV_ADD);
hv_stores(bt, "void", newSViv(FFI_PL_TYPE_VOID));
hv_stores(bt, "sint8", newSViv(FFI_PL_TYPE_SINT8));
hv_stores(bt, "sint16", newSViv(FFI_PL_TYPE_SINT16));
hv_stores(bt, "sint32", newSViv(FFI_PL_TYPE_SINT32));
hv_stores(bt, "sint64", newSViv(FFI_PL_TYPE_SINT64));
hv_stores(bt, "uint8", newSViv(FFI_PL_TYPE_UINT8));
hv_stores(bt, "uint16", newSViv(FFI_PL_TYPE_UINT16));
hv_stores(bt, "uint32", newSViv(FFI_PL_TYPE_UINT32));
hv_stores(bt, "uint64", newSViv(FFI_PL_TYPE_UINT64));
hv_stores(bt, "float", newSViv(FFI_PL_TYPE_FLOAT));
hv_stores(bt, "double", newSViv(FFI_PL_TYPE_DOUBLE));
hv_stores(bt, "string", newSViv(FFI_PL_TYPE_STRING));
hv_stores(bt, "opaque", newSViv(FFI_PL_TYPE_OPAQUE));
#ifdef FFI_PL_PROBE_LONGDOUBLE
hv_stores(bt, "longdouble", newSViv(FFI_PL_TYPE_LONG_DOUBLE));
#endif
#ifdef FFI_PL_PROBE_COMPLEX
hv_stores(bt, "complex_float", newSViv(FFI_PL_TYPE_COMPLEX_FLOAT));
hv_stores(bt, "complex_double", newSViv(FFI_PL_TYPE_COMPLEX_DOUBLE));
#endif
}
ffi_pl_type *
create_type_basic(self, type_code)
SV *self
int type_code
PREINIT:
ffi_pl_type *type;
CODE:
(void)self;
type = ffi_pl_type_new(0);
type->type_code |= type_code;
RETVAL = type;
OUTPUT:
RETVAL
ffi_pl_type *
create_type_record(self, is_by_value, size, record_class=NULL, meta=NULL)
SV *self
int is_by_value
size_t size
ffi_pl_string record_class
void *meta
PREINIT:
ffi_pl_type *type;
CODE:
(void)self;
type = ffi_pl_type_new(sizeof(ffi_pl_type_extra_record));
type->type_code |= is_by_value ? FFI_PL_TYPE_RECORD_VALUE : FFI_PL_TYPE_RECORD;
type->extra[0].record.size = size;
if(record_class != NULL)
{
size = strlen(record_class)+1;
type->extra[0].record.class = malloc(size);
memcpy(type->extra[0].record.class, record_class, size);
}
else
{
type->extra[0].record.class = NULL;
}
type->extra[0].record.meta = meta;
RETVAL = type;
OUTPUT:
RETVAL
ffi_pl_type*
create_type_object(self, type_code, class)
SV *self
int type_code
ffi_pl_string class
PREINIT:
ffi_pl_type *type;
size_t size;
CODE:
(void)self;
type = ffi_pl_type_new(sizeof(ffi_pl_type_extra_object));
size = strlen(class)+1;
type->extra[0].object.class = malloc(size);
memcpy(type->extra[0].object.class, class, size);
type->type_code |= type_code;
type->type_code |= FFI_PL_SHAPE_OBJECT;
RETVAL = type;
OUTPUT:
RETVAL
ffi_pl_type *
create_type_string(self, rw)
SV *self
int rw
PREINIT:
ffi_pl_type *type;
CODE:
(void)self;
type = ffi_pl_type_new(0);
type->type_code = FFI_PL_TYPE_STRING;
if(rw)
type->sub_type = FFI_PL_TYPE_STRING_RW;
else
type->sub_type = FFI_PL_TYPE_STRING_RO;
RETVAL = type;
OUTPUT:
RETVAL
ffi_pl_type *
create_type_array(self, type_code, size)
SV *self
int type_code
size_t size
PREINIT:
ffi_pl_type *type;
CODE:
(void)self;
type = ffi_pl_type_new(sizeof(ffi_pl_type_extra_array));
type->type_code |= FFI_PL_SHAPE_ARRAY | type_code;
type->extra[0].array.element_count = size;
RETVAL = type;
OUTPUT:
RETVAL
ffi_pl_type*
create_type_pointer(self, type_code)
SV *self
int type_code
PREINIT:
ffi_pl_type *type;
CODE:
(void)self;
type = ffi_pl_type_new(0);
type->type_code |= FFI_PL_SHAPE_POINTER | type_code;
RETVAL = type;
OUTPUT:
RETVAL
ffi_pl_type *
_create_type_custom(self, basis, perl_to_native, native_to_perl, perl_to_native_post, argument_count)
SV *self
ffi_pl_type* basis
SV *perl_to_native
SV *native_to_perl
SV *perl_to_native_post
int argument_count
PREINIT:
ffi_pl_type *type;
int type_code;
ffi_pl_type_extra_custom_perl *custom;
ffi_pl_type_extra_record *record;
size_t size;
CODE:
(void)self;
type = ffi_pl_type_new(sizeof(ffi_pl_type_extra_custom_perl));
type->type_code = FFI_PL_SHAPE_CUSTOM_PERL | basis->type_code;
type->extra[0].record.class = NULL;
if( (basis->type_code & FFI_PL_BASE_MASK) == (FFI_PL_TYPE_RECORD & FFI_PL_BASE_MASK)
|| (basis->type_code & FFI_PL_BASE_MASK) == (FFI_PL_TYPE_RECORD_VALUE & FFI_PL_BASE_MASK))
{
type->extra[0].record.size = basis->extra[0].record.size;
type->extra[0].record.meta = basis->extra[0].record.meta;
if(basis->extra[0].record.class)
{
size = strlen(basis->extra[0].record.class) + 1;
type->extra[0].record.class = malloc(size);
memcpy(type->extra[0].record.class, basis->extra[0].record.class, size);
}
}
custom = &type->extra[0].custom_perl;
custom->perl_to_native = SvOK(perl_to_native) ? SvREFCNT_inc_simple_NN(perl_to_native) : NULL;
custom->perl_to_native_post = SvOK(perl_to_native_post) ? SvREFCNT_inc_simple_NN(perl_to_native_post) : NULL;
custom->native_to_perl = SvOK(native_to_perl) ? SvREFCNT_inc_simple_NN(native_to_perl) : NULL;
custom->argument_count = argument_count-1;
RETVAL = type;
OUTPUT:
RETVAL
ffi_pl_type *
create_type_closure(self, abi, return_type, ...)
SV *self
int abi
ffi_pl_type *return_type
PREINIT:
ffi_pl_type *type;
int i;
SV *arg;
ffi_type *ffi_return_type;
ffi_type **ffi_argument_types;
ffi_status ffi_status;
CODE:
(void)self;
switch(return_type->type_code)
{
case FFI_PL_TYPE_VOID:
ffi_return_type = &ffi_type_void;
break;
case FFI_PL_TYPE_SINT8:
ffi_return_type = &ffi_type_sint8;
break;
case FFI_PL_TYPE_SINT16:
ffi_return_type = &ffi_type_sint16;
break;
case FFI_PL_TYPE_SINT32:
ffi_return_type = &ffi_type_sint32;
break;
case FFI_PL_TYPE_SINT64:
ffi_return_type = &ffi_type_sint64;
break;
case FFI_PL_TYPE_UINT8:
ffi_return_type = &ffi_type_uint8;
break;
case FFI_PL_TYPE_UINT16:
ffi_return_type = &ffi_type_uint16;
break;
case FFI_PL_TYPE_UINT32:
ffi_return_type = &ffi_type_uint32;
break;
case FFI_PL_TYPE_UINT64:
ffi_return_type = &ffi_type_uint64;
break;
case FFI_PL_TYPE_FLOAT:
ffi_return_type = &ffi_type_float;
break;
case FFI_PL_TYPE_DOUBLE:
ffi_return_type = &ffi_type_double;
break;
case FFI_PL_TYPE_OPAQUE:
ffi_return_type = &ffi_type_pointer;
break;
case FFI_PL_TYPE_RECORD_VALUE:
if(return_type->extra[0].record.meta == NULL)
croak("Only native types are supported as closure return types (%d)", return_type->type_code);
if(!return_type->extra[0].record.meta->can_return_from_closure)
croak("Record return type contains types that cannot be returned from a closure");
ffi_return_type = &return_type->extra[0].record.meta->ffi_type;
break;
default:
croak("Only native types are supported as closure return types (%d)", return_type->type_code);
break;
}
Newx(ffi_argument_types, items-3, ffi_type*);
type = ffi_pl_type_new(sizeof(ffi_pl_type_extra_closure) + sizeof(ffi_pl_type)*(items-3));
type->type_code = FFI_PL_TYPE_CLOSURE;
type->extra[0].closure.return_type = return_type;
type->extra[0].closure.flags = 0;
for(i=0; i<(items-3); i++)
{
arg = ST(3+i);
type->extra[0].closure.argument_types[i] = INT2PTR(ffi_pl_type*, SvIV((SV*)SvRV(arg)));
switch(type->extra[0].closure.argument_types[i]->type_code)
{
case FFI_PL_TYPE_VOID:
ffi_argument_types[i] = &ffi_type_void;
break;
case FFI_PL_TYPE_SINT8:
ffi_argument_types[i] = &ffi_type_sint8;
break;
case FFI_PL_TYPE_SINT16:
ffi_argument_types[i] = &ffi_type_sint16;
break;
case FFI_PL_TYPE_SINT32:
ffi_argument_types[i] = &ffi_type_sint32;
break;
case FFI_PL_TYPE_SINT64:
ffi_argument_types[i] = &ffi_type_sint64;
break;
case FFI_PL_TYPE_UINT8:
ffi_argument_types[i] = &ffi_type_uint8;
break;
case FFI_PL_TYPE_UINT16:
ffi_argument_types[i] = &ffi_type_uint16;
break;
case FFI_PL_TYPE_UINT32:
ffi_argument_types[i] = &ffi_type_uint32;
break;
case FFI_PL_TYPE_UINT64:
ffi_argument_types[i] = &ffi_type_uint64;
break;
case FFI_PL_TYPE_FLOAT:
ffi_argument_types[i] = &ffi_type_float;
break;
case FFI_PL_TYPE_DOUBLE:
ffi_argument_types[i] = &ffi_type_double;
break;
case FFI_PL_TYPE_OPAQUE:
case FFI_PL_TYPE_STRING:
case FFI_PL_TYPE_RECORD:
ffi_argument_types[i] = &ffi_type_pointer;
break;
case FFI_PL_TYPE_RECORD_VALUE:
if(type->extra[0].closure.argument_types[i]->extra[0].record.meta == NULL)
{
Safefree(ffi_argument_types);
croak("Only native types and strings are supported as closure argument types (%d)", type->extra[0].closure.argument_types[i]->type_code);
}
ffi_argument_types[i] = &type->extra[0].closure.argument_types[i]->extra[0].record.meta->ffi_type;
break;
default:
Safefree(ffi_argument_types);
croak("Only native types and strings are supported as closure argument types (%d)", type->extra[0].closure.argument_types[i]->type_code);
break;
}
}
ffi_status = ffi_prep_cif(
&type->extra[0].closure.ffi_cif,
abi == -1 ? FFI_DEFAULT_ABI : abi,
items-3,
ffi_return_type,
ffi_argument_types
);
if(ffi_status != FFI_OK)
{
Safefree(type);
Safefree(ffi_argument_types);
if(ffi_status == FFI_BAD_TYPEDEF)
croak("bad typedef");
else if(ffi_status == FFI_BAD_ABI)
croak("bad abi");
else
croak("unknown error with ffi_prep_cif");
}
if( items-3 == 0 )
{
type->extra[0].closure.flags |= G_NOARGS;
}
if(type->extra[0].closure.return_type->type_code == FFI_PL_TYPE_VOID)
{
type->extra[0].closure.flags |= G_DISCARD | G_VOID;
}
else
{
type->extra[0].closure.flags |= G_SCALAR;
}
RETVAL = type;
OUTPUT:
RETVAL
FFI-Platypus-2.12/xs/cast.c 000644 000000 000000 00000000474 15251066120 015372 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
#if SIZEOF_VOIDP == 4 && !defined(__hppa__)
uint64_t
cast0(void)
{
return 0LL;
}
#else
void *
cast0(void)
{
return NULL;
}
#endif
#if SIZEOF_VOIDP == 4 && !defined(__hppa__)
uint64_t
cast1(uint64_t value)
{
return value;
}
#else
void *
cast1(void *value)
{
return value;
}
#endif
FFI-Platypus-2.12/xs/closure.c 000644 000000 000000 00000017003 15251066120 016110 0 ustar 00root root 000000 000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
#include "perl_math_int64.h"
void
ffi_pl_closure_add_data(SV *closure, ffi_pl_closure *closure_data)
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(closure);
XPUSHs(sv_2mortal(newSViv(PTR2IV(closure_data))));
XPUSHs(sv_2mortal(newSViv(PTR2IV(closure_data->type))));
PUTBACK;
call_pv("FFI::Platypus::Closure::add_data", G_DISCARD);
FREETMPS;
LEAVE;
}
ffi_pl_closure *
ffi_pl_closure_get_data(SV *closure, ffi_pl_type *type)
{
dSP;
int count;
ffi_pl_closure *ret;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(closure);
XPUSHs(sv_2mortal(newSViv(PTR2IV(type))));
PUTBACK;
count = call_pv("FFI::Platypus::Closure::get_data", G_SCALAR);
SPAGAIN;
if (count != 1)
ret = NULL;
else
ret = INT2PTR(void*, POPi);
PUTBACK;
FREETMPS;
LEAVE;
return ret;
}
void
ffi_pl_closure_call(ffi_cif *ffi_cif, void *result, void **arguments, void *user)
{
dSP;
ffi_pl_closure *closure = (ffi_pl_closure*) user;
ffi_pl_type_extra_closure *extra = &closure->type->extra[0].closure;
int flags = extra->flags;
int i;
int count;
SV *sv,*ref;
if(!(flags & G_NOARGS))
{
ENTER;
SAVETMPS;
}
PUSHMARK(SP);
if(!(flags & G_NOARGS))
{
for(i=0; i< ffi_cif->nargs; i++)
{
switch(extra->argument_types[i]->type_code)
{
case FFI_PL_TYPE_VOID:
break;
case FFI_PL_TYPE_SINT8:
sv = sv_newmortal();
sv_setiv(sv, *((int8_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_SINT16:
sv = sv_newmortal();
sv_setiv(sv, *((int16_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_SINT32:
sv = sv_newmortal();
sv_setiv(sv, *((int32_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_SINT64:
sv = sv_newmortal();
sv_seti64(sv, *((int64_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_UINT8:
sv = sv_newmortal();
sv_setuv(sv, *((uint8_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_UINT16:
sv = sv_newmortal();
sv_setuv(sv, *((uint16_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_UINT32:
sv = sv_newmortal();
sv_setuv(sv, *((uint32_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_UINT64:
sv = sv_newmortal();
sv_setu64(sv, *((uint64_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_FLOAT:
sv = sv_newmortal();
sv_setnv(sv, *((float*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_DOUBLE:
sv = sv_newmortal();
sv_setnv(sv, *((double*)arguments[i]));
XPUSHs(sv);
break;
case FFI_PL_TYPE_OPAQUE:
sv = sv_newmortal();
if( *((void**)arguments[i]) != NULL)
sv_setiv(sv, PTR2IV( *((void**)arguments[i]) ));
XPUSHs(sv);
break;
case FFI_PL_TYPE_STRING:
sv = sv_newmortal();
if( *((char**)arguments[i]) != NULL)
{
sv_setpv(sv, *((char**)arguments[i]));
}
XPUSHs(sv);
break;
case FFI_PL_TYPE_RECORD:
sv = sv_newmortal();
if( *((char**)arguments[i]) != NULL)
{
sv_setpvn(sv, *((char**)arguments[i]), extra->argument_types[i]->extra[0].record.size);
if(extra->argument_types[i]->extra[0].record.class != NULL)
{
ref = newRV_inc(sv);
sv_bless(ref, gv_stashpv(extra->argument_types[i]->extra[0].record.class, GV_ADD));
SvREADONLY_on(sv);
sv = ref;
}
else
{
SvREADONLY_on(sv);
}
}
XPUSHs(sv);
break;
case FFI_PL_TYPE_RECORD_VALUE:
sv = sv_newmortal();
sv_setpvn(sv, (char*)arguments[i], extra->argument_types[i]->extra[0].record.size);
ref = newRV_inc(sv);
sv_bless(ref, gv_stashpv(extra->argument_types[i]->extra[0].record.class, GV_ADD));
SvREADONLY_on(sv);
XPUSHs(ref);
break;
default:
warn("bad type");
break;
}
}
PUTBACK;
}
count = call_sv(closure->coderef, flags | G_EVAL);
if(SvTRUE(ERRSV))
{
#ifdef warn_sv
warn_sv(ERRSV);
#else
warn("%s", SvPV_nolen(ERRSV));
#endif
}
if(!(flags & G_DISCARD))
{
SPAGAIN;
if(count != 1)
sv = &PL_sv_undef;
else
sv = POPs;
switch(extra->return_type->type_code)
{
case FFI_PL_TYPE_VOID:
break;
case FFI_PL_TYPE_UINT8:
#if defined FFI_PL_PROBE_BIGENDIAN
((uint8_t*)result)[3] = SvUV(sv);
#elif defined FFI_PL_PROBE_BIGENDIAN64
((uint8_t*)result)[7] = SvUV(sv);
#else
*((uint8_t*)result) = SvUV(sv);
#endif
break;
case FFI_PL_TYPE_SINT8:
#if defined FFI_PL_PROBE_BIGENDIAN
((int8_t*)result)[3] = SvIV(sv);
#elif defined FFI_PL_PROBE_BIGENDIAN64
((int8_t*)result)[7] = SvIV(sv);
#else
*((int8_t*)result) = SvIV(sv);
#endif
break;
case FFI_PL_TYPE_UINT16:
#if defined FFI_PL_PROBE_BIGENDIAN
((uint16_t*)result)[1] = SvUV(sv);
#elif defined FFI_PL_PROBE_BIGENDIAN64
((uint16_t*)result)[3] = SvUV(sv);
#else
*((uint16_t*)result) = SvUV(sv);
#endif
break;
case FFI_PL_TYPE_SINT16:
#if defined FFI_PL_PROBE_BIGENDIAN
((int16_t*)result)[1] = SvIV(sv);
#elif defined FFI_PL_PROBE_BIGENDIAN64
((int16_t*)result)[3] = SvIV(sv);
#else
*((int16_t*)result) = SvIV(sv);
#endif
break;
case FFI_PL_TYPE_UINT32:
#if defined FFI_PL_PROBE_BIGENDIAN64
((uint32_t*)result)[1] = SvUV(sv);
#else
*((uint32_t*)result) = SvUV(sv);
#endif
break;
case FFI_PL_TYPE_SINT32:
#if defined FFI_PL_PROBE_BIGENDIAN64
((int32_t*)result)[1] = SvIV(sv);
#else
*((int32_t*)result) = SvIV(sv);
#endif
break;
case FFI_PL_TYPE_UINT64:
*((uint64_t*)result) = SvU64(sv);
break;
case FFI_PL_TYPE_SINT64:
*((int64_t*)result) = SvI64(sv);
break;
case FFI_PL_TYPE_FLOAT:
*((float*)result) = SvNV(sv);
break;
case FFI_PL_TYPE_DOUBLE:
*((double*)result) = SvNV(sv);
break;
case FFI_PL_TYPE_OPAQUE:
*((void**)result) = SvOK(sv) ? INT2PTR(void*, SvIV(sv)) : NULL;
break;
case FFI_PL_TYPE_RECORD_VALUE:
if(sv_isobject(sv) && sv_derived_from(sv, extra->return_type->extra[0].record.class))
{
char *ptr;
STRLEN len;
ptr = SvPV(SvRV(sv), len);
if(len > extra->return_type->extra[0].record.size)
len = extra->return_type->extra[0].record.size;
else if(len < extra->return_type->extra[0].record.size)
{
warn("Return record from closure is wrong size!");
memset(result, 0, extra->return_type->extra[0].record.size);
}
memcpy(result, ptr, len);
break;
}
warn("Return record from closure is wrong type!");
memset(result, 0, extra->return_type->extra[0].record.size);
break;
default:
warn("bad type");
break;
}
PUTBACK;
}
if(!(flags & G_NOARGS))
{
FREETMPS;
LEAVE;
}
}
FFI-Platypus-2.12/xs/complex.c 000644 000000 000000 00000006611 15251066120 016106 0 ustar 00root root 000000 000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
static double
decompose(SV *sv, int imag)
{
/* Re(z) */
dSP;
int count;
double result = 0.0;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv);
PUTBACK;
count = call_pv(imag ? "Math::Complex::Im" : "Math::Complex::Re", G_ARRAY);
SPAGAIN;
if(count >= 1)
result = POPn;
PUTBACK;
FREETMPS;
LEAVE;
return result;
}
static void
set(SV *sv, SV *new_value, int imag)
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv);
XPUSHs(new_value);
PUTBACK;
call_pv(imag ? "Math::Complex::Im" : "Math::Complex::Re", G_DISCARD);
FREETMPS;
LEAVE;
}
void
ffi_pl_perl_to_complex_float(SV *sv, float *ptr)
{
if(sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
{
ptr[0] = decompose(sv, 0);
ptr[1] = decompose(sv, 1);
}
else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
{
AV *av = (AV*) SvRV(sv);
SV **real_sv, **imag_sv;
real_sv = av_fetch(av, 0, 0);
imag_sv = av_fetch(av, 1, 0);
ptr[0] = real_sv != NULL ? SvNV(*real_sv) : 0.0;
ptr[1]= imag_sv != NULL ? SvNV(*imag_sv) : 0.0;
}
else if(SvOK(sv))
{
ptr[0] = SvNV(sv);
ptr[1] = 0.0;
}
else
{
ptr[0] = 0.0;
ptr[1] = 0.0;
}
}
void
ffi_pl_complex_float_to_perl(SV *sv, float *ptr)
{
if(SvOK(sv) && sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
{
/* the complex variable is a Math::Complex object */
set(sv, sv_2mortal(newSVnv(ptr[0])), 0);
set(sv, sv_2mortal(newSVnv(ptr[1])), 1);
}
else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
{
/* the compex variable is already an array */
AV *av = (AV*) SvRV(sv);
av_store(av, 0, newSVnv(ptr[0]));
av_store(av, 1, newSVnv(ptr[1]));
}
else
{
/* the complex variable is something else and an array needs to be created */
SV *values[2];
AV *av;
values[0] = newSVnv(ptr[0]);
values[1] = newSVnv(ptr[1]);
av = av_make(2, values);
sv_setsv(sv, newRV_noinc((SV*)av));
}
}
void
ffi_pl_perl_to_complex_double(SV *sv, double *ptr)
{
if(sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
{
ptr[0] = decompose(sv, 0);
ptr[1] = decompose(sv, 1);
}
else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
{
AV *av = (AV*) SvRV(sv);
SV **real_sv, **imag_sv;
real_sv = av_fetch(av, 0, 0);
imag_sv = av_fetch(av, 1, 0);
ptr[0] = real_sv != NULL ? SvNV(*real_sv) : 0.0;
ptr[1]= imag_sv != NULL ? SvNV(*imag_sv) : 0.0;
}
else if(SvOK(sv))
{
ptr[0] = SvNV(sv);
ptr[1] = 0.0;
}
else
{
ptr[0] = 0.0;
ptr[1] = 0.0;
}
}
void
ffi_pl_complex_double_to_perl(SV *sv, double *ptr)
{
if(SvOK(sv) && sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
{
/* the complex variable is a Math::Complex object */
set(sv, sv_2mortal(newSVnv(ptr[0])), 0);
set(sv, sv_2mortal(newSVnv(ptr[1])), 1);
}
else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
{
/* the compex variable is already an array */
AV *av = (AV*) SvRV(sv);
av_store(av, 0, newSVnv(ptr[0]));
av_store(av, 1, newSVnv(ptr[1]));
}
else
{
/* the complex variable is something else and an array needs to be created */
SV *values[2];
AV *av;
values[0] = newSVnv(ptr[0]);
values[1] = newSVnv(ptr[1]);
av = av_make(2, values);
sv_setsv(sv, newRV_noinc((SV*)av));
}
}
FFI-Platypus-2.12/xs/custom.c 000644 000000 000000 00000001517 15251066120 015751 0 ustar 00root root 000000 000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
SV*
ffi_pl_custom_perl(SV *subref, SV *in_arg, int i)
{
if(subref == NULL)
{
return newSVsv(in_arg);
}
else
{
dSP;
int count;
SV *out_arg;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(in_arg);
XPUSHs(sv_2mortal(newSViv(i)));
PUTBACK;
count = call_sv(subref, G_ARRAY);
SPAGAIN;
if(count >= 1)
out_arg = SvREFCNT_inc(POPs);
else
out_arg = NULL;
PUTBACK;
FREETMPS;
LEAVE;
return out_arg;
}
}
void
ffi_pl_custom_perl_cb(SV *subref, SV *in_arg, int i)
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(in_arg);
XPUSHs(sv_2mortal(newSViv(i)));
PUTBACK;
call_sv(subref, G_VOID|G_DISCARD);
FREETMPS;
LEAVE;
}
FFI-Platypus-2.12/xs/meta.c 000644 000000 000000 00000022010 15251066120 015354 0 ustar 00root root 000000 000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
/*
* - negative shift is undefined, so while it may work somewheree we make an explicit check for the
* 0 size.
* - We will eventually migrate fixed strings to be internally of record type, for now we have to
* check the platypus type when we have a type_code == FFI_PL_BASE_RECORD
*/
#define unit_size(self) \
((self->type_code & FFI_PL_BASE_MASK) == FFI_PL_BASE_RECORD \
? (self->extra[0].record.size) \
: ((self->type_code & FFI_PL_SIZE_MASK) == FFI_PL_SIZE_0 \
? 0 \
: 1 << ((self->type_code & FFI_PL_SIZE_MASK)-1) \
) \
)
size_t
ffi_pl_sizeof_new(ffi_pl_type *self)
{
switch( self->type_code & FFI_PL_SHAPE_MASK )
{
case FFI_PL_SHAPE_SCALAR:
case FFI_PL_SHAPE_CUSTOM_PERL:
return unit_size(self);
case FFI_PL_SHAPE_POINTER:
return sizeof(void*);
case FFI_PL_SHAPE_ARRAY:
return unit_size(self) * self->extra[0].array.element_count;
default:
return 0;
}
}
size_t
ffi_pl_sizeof(ffi_pl_type *self)
{
if(self->type_code == FFI_PL_TYPE_RECORD
|| self->type_code == FFI_PL_TYPE_RECORD_VALUE
|| self->type_code == (FFI_PL_TYPE_RECORD | FFI_PL_SHAPE_CUSTOM_PERL)
|| self->type_code == (FFI_PL_TYPE_RECORD_VALUE | FFI_PL_SHAPE_CUSTOM_PERL))
{
return self->extra[0].record.size;
}
else
{
return ffi_pl_sizeof_new(self);
}
}
HV *
ffi_pl_get_type_meta(ffi_pl_type *self)
{
HV *meta;
const char *string;
meta = newHV();
hv_store(meta, "size", 4, newSViv(ffi_pl_sizeof(self)), 0);
hv_store(meta, "type_code", 9, newSViv(self->type_code), 0);
switch(self->type_code & FFI_PL_SHAPE_MASK)
{
case FFI_PL_SHAPE_SCALAR:
{
switch(self->type_code)
{
case FFI_PL_TYPE_STRING:
hv_store(meta, "element_size", 12, newSViv(sizeof(void*)), 0);
hv_store(meta, "type", 4, newSVpv("string",0),0);
switch(self->sub_type)
{
case FFI_PL_TYPE_STRING_RO:
hv_store(meta, "access", 6, newSVpv("ro",0), 0);
break;
case FFI_PL_TYPE_STRING_RW:
hv_store(meta, "access", 6, newSVpv("rw",0), 0);
break;
}
break;
case FFI_PL_TYPE_CLOSURE:
{
AV *signature;
AV *argument_types;
HV *subtype;
int i;
int number_of_arguments;
number_of_arguments = self->extra[0].closure.ffi_cif.nargs;
signature = newAV();
argument_types = newAV();
for(i=0; i < number_of_arguments; i++)
{
subtype = ffi_pl_get_type_meta(self->extra[0].closure.argument_types[i]);
av_store(argument_types, i, newRV_noinc((SV*)subtype));
}
av_store(signature, 0, newRV_noinc((SV*)argument_types));
subtype = ffi_pl_get_type_meta(self->extra[0].closure.return_type);
av_store(signature, 1, newRV_noinc((SV*)subtype));
hv_store(meta, "signature", 9, newRV_noinc((SV*)signature), 0);
hv_store(meta, "element_size", 12, newSViv(sizeof(void*)), 0);
hv_store(meta, "type", 4, newSVpv("closure",0),0);
}
break;
case FFI_PL_TYPE_RECORD:
hv_store(meta, "type", 4, newSVpv("record",0),0);
hv_store(meta, "ref", 3, newSViv(self->extra[0].record.class != NULL ? 1 : 0),0);
if(self->extra[0].record.class != NULL)
hv_store(meta, "class", 5, newSVpv(self->extra[0].record.class,0), 0);
break;
case FFI_PL_TYPE_RECORD_VALUE:
hv_store(meta, "type", 4, newSVpv("record_value",0),0);
hv_store(meta, "ref", 3, newSViv(self->extra[0].record.class != NULL ? 1 : 0),0);
hv_store(meta, "class", 5, newSVpv(self->extra[0].record.class,0), 0);
break;
default:
hv_store(meta, "element_size", 12, newSViv(unit_size(self)), 0);
hv_store(meta, "type", 4, newSVpv("scalar",0),0);
break;
}
}
break;
case FFI_PL_SHAPE_POINTER:
hv_store(meta, "element_size", 12, newSViv(unit_size(self)), 0);
hv_store(meta, "type", 4, newSVpv("pointer",0),0);
break;
case FFI_PL_SHAPE_ARRAY:
hv_store(meta, "element_size", 12, newSViv(unit_size(self)), 0);
hv_store(meta, "type", 4, newSVpv("array",0),0);
hv_store(meta, "element_count", 13, newSViv(self->extra[0].array.element_count), 0);
break;
case FFI_PL_SHAPE_CUSTOM_PERL:
hv_store(meta, "type", 4, newSVpv("custom_perl",0),0);
if(self->extra[0].custom_perl.perl_to_native != NULL)
hv_store(meta, "custom_perl_to_native", 18, newRV_inc((SV*)self->extra[0].custom_perl.perl_to_native), 0);
if(self->extra[0].custom_perl.perl_to_native_post != NULL)
hv_store(meta, "custom_perl_to_native_post", 23, newRV_inc((SV*)self->extra[0].custom_perl.perl_to_native_post), 0);
if(self->extra[0].custom_perl.native_to_perl != NULL)
hv_store(meta, "custom_native_to_perl", 18, newRV_inc((SV*)self->extra[0].custom_perl.native_to_perl), 0);
if(self->type_code == (FFI_PL_TYPE_RECORD | FFI_PL_SHAPE_CUSTOM_PERL))
{
hv_store(meta, "sub_type", 8, newSVpv("record",0),0);
hv_store(meta, "ref", 3, newSViv(self->extra[0].record.class != NULL ? 1 : 0),0);
if(self->extra[0].record.class != NULL)
hv_store(meta, "class", 5, newSVpv(self->extra[0].record.class,0), 0);
}
break;
}
switch(self->type_code & (FFI_PL_SIZE_MASK | FFI_PL_BASE_MASK))
{
case FFI_PL_TYPE_VOID:
hv_store(meta, "element_type", 12, newSVpv("void",0),0);
break;
case FFI_PL_TYPE_FLOAT:
case FFI_PL_TYPE_DOUBLE:
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
#endif
#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
case FFI_PL_TYPE_COMPLEX_FLOAT:
case FFI_PL_TYPE_COMPLEX_DOUBLE:
#endif
hv_store(meta, "element_type", 12, newSVpv("float",0),0);
break;
case FFI_PL_TYPE_UINT8:
case FFI_PL_TYPE_UINT16:
case FFI_PL_TYPE_UINT32:
case FFI_PL_TYPE_UINT64:
hv_store(meta, "element_type", 12, newSVpv("int",0),0);
hv_store(meta, "sign", 4, newSViv(0),0);
break;
case FFI_PL_TYPE_SINT8:
case FFI_PL_TYPE_SINT16:
case FFI_PL_TYPE_SINT32:
case FFI_PL_TYPE_SINT64:
hv_store(meta, "element_type", 12, newSVpv("int",0),0);
hv_store(meta, "sign", 4, newSViv(1),0);
break;
case FFI_PL_TYPE_OPAQUE:
hv_store(meta, "element_type", 12, newSVpv("opaque",0),0);
break;
}
switch(self->type_code & (FFI_PL_SIZE_MASK | FFI_PL_BASE_MASK))
{
case FFI_PL_TYPE_VOID:
string = "void";
break;
case FFI_PL_TYPE_FLOAT:
string = "float";
break;
case FFI_PL_TYPE_DOUBLE:
string = "double";
break;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
string = "longdouble";
break;
#endif
case FFI_PL_TYPE_UINT8:
string = "uint8";
break;
case FFI_PL_TYPE_SINT8:
string = "sint8";
break;
case FFI_PL_TYPE_UINT16:
string = "uint16";
break;
case FFI_PL_TYPE_SINT16:
string = "sint16";
break;
case FFI_PL_TYPE_UINT32:
string = "uint32";
break;
case FFI_PL_TYPE_SINT32:
string = "sint32";
break;
case FFI_PL_TYPE_UINT64:
string = "uint64";
break;
case FFI_PL_TYPE_SINT64:
string = "sint64";
break;
case FFI_PL_TYPE_OPAQUE:
case FFI_PL_TYPE_STRING:
case FFI_PL_TYPE_CLOSURE:
case FFI_PL_TYPE_RECORD:
string = "pointer";
break;
case FFI_PL_TYPE_RECORD_VALUE:
string = "struct";
break;
#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
case FFI_PL_TYPE_COMPLEX_FLOAT:
string = "complex_float";
break;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
string = "complex_double";
break;
#endif
default:
warn("bad type: %04x\n", self->type_code & (FFI_PL_SIZE_MASK | FFI_PL_BASE_MASK));
string = NULL;
break;
}
hv_store(meta, "ffi_type", 8, newSVpv(string,0),0);
return meta;
}
ffi_pl_type *ffi_pl_type_new(size_t size)
{
char *buffer;
ffi_pl_type *self;
Newx(buffer, sizeof(ffi_pl_type) + size, char);
self = (ffi_pl_type*) buffer;
self->type_code = 0;
self->sub_type = 0;
return self;
}
FFI-Platypus-2.12/xs/names.c 000644 000000 000000 00000003546 15251066120 015546 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
#include <stdio.h>
ffi_type *
ffi_pl_type_to_libffi_type(ffi_pl_type *type)
{
int type_code = type->type_code;
if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
type_code = type_code & ~(FFI_PL_SHAPE_MASK);
if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_OBJECT)
type_code = type_code & ~(FFI_PL_SHAPE_MASK);
switch(type_code)
{
case FFI_PL_TYPE_VOID:
return &ffi_type_void;
case FFI_PL_TYPE_SINT8:
return &ffi_type_sint8;
case FFI_PL_TYPE_SINT16:
return &ffi_type_sint16;
case FFI_PL_TYPE_SINT32:
return &ffi_type_sint32;
case FFI_PL_TYPE_SINT64:
return &ffi_type_sint64;
case FFI_PL_TYPE_UINT8:
return &ffi_type_uint8;
case FFI_PL_TYPE_UINT16:
return &ffi_type_uint16;
case FFI_PL_TYPE_UINT32:
return &ffi_type_uint32;
case FFI_PL_TYPE_UINT64:
return &ffi_type_uint64;
case FFI_PL_TYPE_FLOAT:
return &ffi_type_float;
case FFI_PL_TYPE_DOUBLE:
return &ffi_type_double;
#ifdef FFI_PL_PROBE_LONGDOUBLE
case FFI_PL_TYPE_LONG_DOUBLE:
return &ffi_type_longdouble;
#endif
#if FFI_PL_PROBE_COMPLEX
case FFI_PL_TYPE_COMPLEX_FLOAT:
return &ffi_type_complex_float;
case FFI_PL_TYPE_COMPLEX_DOUBLE:
return &ffi_type_complex_double;
#endif
case FFI_PL_TYPE_OPAQUE:
case FFI_PL_TYPE_STRING:
case FFI_PL_TYPE_CLOSURE:
case FFI_PL_TYPE_RECORD:
return &ffi_type_pointer;
case FFI_PL_TYPE_RECORD_VALUE:
return type->extra[0].record.meta != NULL ? &type->extra[0].record.meta->ffi_type : NULL;
}
switch(type_code & (FFI_PL_SHAPE_MASK))
{
case FFI_PL_SHAPE_POINTER:
case FFI_PL_SHAPE_ARRAY:
return &ffi_type_pointer;
default:
fprintf(stderr, "FFI::Platypus: internal error: type = %04x\n", type_code);
fflush(stderr);
return NULL;
}
}
FFI-Platypus-2.12/xs/perl_math_int64.c 000644 000000 000000 00000011032 15251066120 017427 0 ustar 00root root 000000 000000 #include "ffi_platypus_config.h"
#ifndef HAVE_IV_IS_64
/* imported from Math::Int64 0.34 6 December 2014 by PLICEASE */
/*
* perl_math_int64.c - This file is in the public domain
* Author: Salvador Fandino <sfandino@yahoo.com>
*
* Generated on: 2014-10-30 11:43:56
* Math::Int64 version: 0.33
* Module::CAPIMaker version: 0.02
*/
#include "EXTERN.h"
#include "perl.h"
#include "ppport.h"
#ifdef __MINGW32__
#include <stdint.h>
#endif
#ifdef _MSC_VER
#include <stdlib.h>
typedef __int64 int64_t;
typedef unsigned __int64 uint64_t;
#endif
/* you may need to add a typemap for int64_t here if it is not defined
by default in your C header files */
HV *math_int64_c_api_hash;
int math_int64_c_api_min_version;
int math_int64_c_api_max_version;
int64_t (*math_int64_c_api_SvI64)(pTHX_ SV*);
int (*math_int64_c_api_SvI64OK)(pTHX_ SV*);
uint64_t (*math_int64_c_api_SvU64)(pTHX_ SV*);
int (*math_int64_c_api_SvU64OK)(pTHX_ SV*);
SV * (*math_int64_c_api_newSVi64)(pTHX_ int64_t);
SV * (*math_int64_c_api_newSVu64)(pTHX_ uint64_t);
uint64_t (*math_int64_c_api_randU64)(pTHX);
int
perl_math_int64_load(int required_version) {
dTHX;
SV **svp;
eval_pv("require Math::Int64", TRUE);
if (SvTRUE(ERRSV)) return 0;
math_int64_c_api_hash = get_hv("Math::Int64::C_API", 0);
if (!math_int64_c_api_hash) {
sv_setpv(ERRSV, "Unable to load Math::Int64 C API");
SvSETMAGIC(ERRSV);
return 0;
}
svp = hv_fetch(math_int64_c_api_hash, "min_version", 11, 0);
if (!svp) svp = hv_fetch(math_int64_c_api_hash, "version", 7, 1);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to retrieve C API version for Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_min_version = SvIV(*svp);
svp = hv_fetch(math_int64_c_api_hash, "max_version", 11, 0);
if (!svp) svp = hv_fetch(math_int64_c_api_hash, "version", 7, 1);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to retrieve C API version for Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_max_version = SvIV(*svp);
if ((required_version < math_int64_c_api_min_version) ||
(required_version > math_int64_c_api_max_version)) {
sv_setpvf(ERRSV,
"Math::Int64 C API version mismatch. "
"The installed module supports versions %d to %d but %d is required",
math_int64_c_api_min_version,
math_int64_c_api_max_version,
required_version);
SvSETMAGIC(ERRSV);
return 0;
}
svp = hv_fetch(math_int64_c_api_hash, "SvI64", 5, 0);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to fetch pointer 'SvI64' C function from Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_SvI64 = INT2PTR(void *, SvIV(*svp));
svp = hv_fetch(math_int64_c_api_hash, "SvI64OK", 7, 0);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to fetch pointer 'SvI64OK' C function from Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_SvI64OK = INT2PTR(void *, SvIV(*svp));
svp = hv_fetch(math_int64_c_api_hash, "SvU64", 5, 0);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to fetch pointer 'SvU64' C function from Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_SvU64 = INT2PTR(void *, SvIV(*svp));
svp = hv_fetch(math_int64_c_api_hash, "SvU64OK", 7, 0);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to fetch pointer 'SvU64OK' C function from Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_SvU64OK = INT2PTR(void *, SvIV(*svp));
svp = hv_fetch(math_int64_c_api_hash, "newSVi64", 8, 0);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to fetch pointer 'newSVi64' C function from Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_newSVi64 = INT2PTR(void *, SvIV(*svp));
svp = hv_fetch(math_int64_c_api_hash, "newSVu64", 8, 0);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to fetch pointer 'newSVu64' C function from Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_newSVu64 = INT2PTR(void *, SvIV(*svp));
svp = hv_fetch(math_int64_c_api_hash, "randU64", 7, 0);
if (!svp || !*svp) {
sv_setpv(ERRSV, "Unable to fetch pointer 'randU64' C function from Math::Int64");
SvSETMAGIC(ERRSV);
return 0;
}
math_int64_c_api_randU64 = INT2PTR(void *, SvIV(*svp));
return 1;
}
#endif
FFI-Platypus-2.12/xs/record_opaque.c 000644 000000 000000 00000005346 15251066120 017273 0 ustar 00root root 000000 000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
XS(ffi_pl_record_accessor_opaque)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
char *ptr1;
void **ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (void**) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
arg = ST(1);
*ptr2 = SvOK(arg) ? INT2PTR(void*, SvIV(arg)) : NULL;
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
if(*ptr2 != NULL)
XSRETURN_IV( PTR2IV( *ptr2 ));
else
XSRETURN_EMPTY;
}
XS(ffi_pl_record_accessor_opaque_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
void **ptr2;
int i;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (void**) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvOK(arg) ? INT2PTR(void*, SvIV(arg)) : NULL;
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = INT2PTR(void*, SvIV(*item));
}
else
{
ptr2[i] = NULL;
}
}
}
else
{
i = SvIV(ST(1));
if(i < 0 && i >= member->count)
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
else if(ptr2[i] == NULL)
{
XSRETURN_EMPTY;
}
else
{
XSRETURN_IV(PTR2IV(ptr2[i]));
}
warn("passing non array reference into ffi/platypus array argument type");
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
if(ptr2[i] != NULL)
sv_setiv(*av_fetch(av, i, 1), PTR2IV(ptr2[i]));
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
FFI-Platypus-2.12/xs/record_simple.c 000644 000000 000000 00000054534 15251066120 017275 0 ustar 00root root 000000 000000 /* DO NOT MODIFY THIS FILE it is generated from these files:
* inc/template/accessor.tt
* inc/template/accessor_wrapper.tt
* inc/run/generate_record_accessor.pl
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
XS(ffi_pl_record_accessor_uint8)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
uint8_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint8_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (uint8_t) SvUV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_UV(*ptr2);
}
XS(ffi_pl_record_accessor_uint8_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
uint8_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint8_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvUV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvUV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_UV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setuv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_sint8)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
int8_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int8_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (int8_t) SvIV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_IV(*ptr2);
}
XS(ffi_pl_record_accessor_sint8_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
int8_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int8_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvIV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvIV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_IV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setiv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_uint16)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
uint16_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint16_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (uint16_t) SvUV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_UV(*ptr2);
}
XS(ffi_pl_record_accessor_uint16_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
uint16_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint16_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvUV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvUV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_UV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setuv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_sint16)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
int16_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int16_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (int16_t) SvIV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_IV(*ptr2);
}
XS(ffi_pl_record_accessor_sint16_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
int16_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int16_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvIV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvIV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_IV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setiv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_uint32)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
uint32_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint32_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (uint32_t) SvUV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_UV(*ptr2);
}
XS(ffi_pl_record_accessor_uint32_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
uint32_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint32_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvUV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvUV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_UV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setuv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_sint32)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
int32_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int32_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (int32_t) SvIV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_IV(*ptr2);
}
XS(ffi_pl_record_accessor_sint32_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
int32_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int32_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvIV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvIV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_IV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setiv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_uint64)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
uint64_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint64_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (uint64_t) SvUV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_UV(*ptr2);
}
XS(ffi_pl_record_accessor_uint64_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
uint64_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (uint64_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvUV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvUV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_UV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setuv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_sint64)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
int64_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int64_t*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (int64_t) SvIV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_IV(*ptr2);
}
XS(ffi_pl_record_accessor_sint64_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
int64_t *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (int64_t*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvIV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvIV(*item);
}
else
{
ptr2[i] = 0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_IV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setiv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_float)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
float *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (float*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (float) SvNV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_NV(*ptr2);
}
XS(ffi_pl_record_accessor_float_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
float *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (float*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvNV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvNV(*item);
}
else
{
ptr2[i] = 0.0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_NV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setnv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
XS(ffi_pl_record_accessor_double)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
double *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (double*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
*ptr2 = (double) SvNV(ST(1));
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
XSRETURN_NV(*ptr2);
}
XS(ffi_pl_record_accessor_double_array)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV **item;
AV *av;
char *ptr1;
int i;
double *ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (double*) &ptr1[member->offset];
if(items > 1 && SvREADONLY(self))
{
croak("record is read-only");
}
if(items > 2)
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
arg = ST(2);
ptr2[i] = SvNV(arg);
}
else
{
warn("illegal index %d", i);
}
}
else if(items > 1)
{
arg = ST(1);
if(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
{
av = (AV*) SvRV(arg);
for(i=0; i < member->count; i++)
{
item = av_fetch(av, i, 0);
if(item != NULL && SvOK(*item))
{
ptr2[i] = SvNV(*item);
}
else
{
ptr2[i] = 0.0;
}
}
}
else
{
i = SvIV(ST(1));
if(i >= 0 && i < member->count)
{
XSRETURN_NV(ptr2[i]);
}
else
{
warn("illegal index %d", i);
XSRETURN_EMPTY;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
av = newAV();
av_fill(av, member->count-1);
for(i=0; i < member->count; i++)
{
sv_setnv(*av_fetch(av, i, 1), ptr2[i]);
}
ST(0) = newRV_inc((SV*)av);
XSRETURN(1);
}
FFI-Platypus-2.12/xs/record_string.c 000644 000000 000000 00000005454 15251066120 017307 0 ustar 00root root 000000 000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "ffi_platypus.h"
#include "ffi_platypus_guts.h"
XS(ffi_pl_record_accessor_string_ro)
{
ffi_pl_record_member *member;
SV *self;
char *ptr1;
char **ptr2;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (char**) &ptr1[member->offset];
if(items > 1)
{
croak("member is read only");
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
if(*ptr2 != NULL)
XSRETURN_PV(*ptr2);
else
XSRETURN_EMPTY;
}
XS(ffi_pl_record_accessor_string_rw)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
char *ptr1;
char **ptr2;
char *arg_ptr;
STRLEN len;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (char**) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
arg = ST(1);
if(SvOK(arg))
{
arg_ptr = SvPV(arg, len);
*ptr2 = realloc(*ptr2, len+1);
(*ptr2)[len] = 0;
memcpy(*ptr2, arg_ptr, len);
}
else if(*ptr2 != NULL)
{
free(*ptr2);
*ptr2 = NULL;
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
if(*ptr2 != NULL)
XSRETURN_PV(*ptr2);
else
XSRETURN_EMPTY;
}
XS(ffi_pl_record_accessor_string_fixed)
{
ffi_pl_record_member *member;
SV *self;
SV *arg;
SV *value;
char *ptr1;
char *ptr2;
char *arg_ptr;
STRLEN len;
dVAR; dXSARGS;
if(items == 0)
croak("This is a method, you must provide at least the object");
member = (ffi_pl_record_member*) CvXSUBANY(cv).any_ptr;
self = ST(0);
if(SvROK(self))
self = SvRV(self);
if(!SvOK(self))
croak("Null record error");
ptr1 = (char*) SvPV_nolen(self);
ptr2 = (char*) &ptr1[member->offset];
if(items > 1)
{
if(SvREADONLY(self))
{
croak("record is read-only");
}
else
{
arg = ST(1);
if(SvOK(arg))
{
arg_ptr = SvPV(ST(1), len);
if(len > member->count)
len = member->count;
memcpy(ptr2, arg_ptr, len);
}
else
{
croak("Cannot assign undef to a fixed string field");
}
}
}
if(GIMME_V == G_VOID)
XSRETURN_EMPTY;
value = sv_newmortal();
sv_setpvn(value, ptr2, member->count);
ST(0) = value;
XSRETURN(1);
}
FFI-Platypus-2.12/xs/windl.c 000644 000000 000000 00000007064 15251066120 015557 0 ustar 00root root 000000 000000 #include "ffi_platypus.h"
#ifdef PERL_OS_WINDOWS
#ifdef HAVE_WINDOWS_H
#include <windows.h>
#endif
#ifdef HAVE_SYS_CYGWIN_H
#include <sys/cygwin.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
/*
* TODO: c::ac is not detecting psapi.h for some reason ...
* but it should always be there in any platform that
* we support
*/
#include <psapi.h>
typedef struct _library_handle {
int is_null;
int flags;
HMODULE os_handle;
} library_handle;
static const char *error = NULL;
/*
* dlopen()
*/
void *
windlopen(const char *filename, int flags)
{
char *win_path_filename;
library_handle *handle;
win_path_filename = NULL;
#ifdef PERL_OS_CYGWIN
if(filename != NULL)
{
ssize_t size;
size = cygwin_conv_path(CCP_POSIX_TO_WIN_A | CCP_RELATIVE, filename, NULL, 0);
if(size < 0)
{
error = "unable to determine length of string for cygwin_conv_path";
return NULL;
}
win_path_filename = malloc(size);
if(win_path_filename == NULL)
{
error = "unable to allocate enough memory for cygwin_conv_path";
return NULL;
}
if(cygwin_conv_path(CCP_POSIX_TO_WIN_A | CCP_RELATIVE, filename, win_path_filename, size))
{
error = "error in conversion for cygwin_conv_path";
free(win_path_filename);
return NULL;
}
filename = win_path_filename;
}
#endif
handle = malloc(sizeof(library_handle));
if(handle == NULL)
{
if(win_path_filename != NULL)
free(win_path_filename);
error = "unable to allocate memory for handle";
return NULL;
}
if(filename == NULL)
{
handle->is_null = 1;
}
else
{
handle->is_null = 0;
handle->os_handle = LoadLibrary(filename);
if(handle->os_handle == NULL)
{
free(handle);
error = "Error loading file";
return NULL;
}
}
handle->flags = flags;
if(win_path_filename != NULL)
free(win_path_filename);
error = NULL;
return (void*) handle;
}
/*
* dlsym()
*/
void *
windlsym(void *void_handle, const char *symbol_name)
{
library_handle *handle = (library_handle*) void_handle;
static const char *not_found = "symbol not found";
void *symbol;
if(!handle->is_null)
{
symbol = GetProcAddress(handle->os_handle, symbol_name);
if(symbol == NULL)
error = not_found;
else
error = NULL;
return symbol;
}
else
{
int n;
DWORD needed;
HANDLE process;
HMODULE mods[1024];
TCHAR mod_name[MAX_PATH];
process = OpenProcess(
PROCESS_QUERY_INFORMATION | PROCESS_VM_READ,
FALSE, GetCurrentProcessId()
);
if(process == NULL)
{
error = "Process for self not found";
return NULL;
}
if(EnumProcessModules(process, mods, sizeof(mods), &needed))
{
for(n=0; n < (needed/sizeof(HMODULE)); n++)
{
if(GetModuleFileNameEx(process, mods[n], mod_name, sizeof(mod_name) / sizeof(TCHAR)))
{
HMODULE handle = LoadLibrary(mod_name);
if(handle == NULL)
continue;
symbol = GetProcAddress(handle, symbol_name);
if(symbol != NULL)
{
error = NULL;
FreeLibrary(handle);
return symbol;
}
FreeLibrary(handle);
}
}
}
error = not_found;
return NULL;
}
}
/*
* dlerror()
*/
const char *
windlerror(void)
{
return error;
}
/*
* dlclose()
*/
int
windlclose(void *void_handle)
{
library_handle *handle = (library_handle*) void_handle;
if(!handle->is_null)
{
FreeLibrary(handle->os_handle);
}
free(handle);
error = NULL;
return 0;
}
#endif
FFI-Platypus-2.12/xt/ 000755 000000 000000 00000000000 15251066120 014270 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/xt/author/ 000755 000000 000000 00000000000 15251066120 015572 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/xt/author/critic.t 000644 000000 000000 00000000516 15251066120 017236 0 ustar 00root root 000000 000000 use Test2::Require::Module 'Test2::Tools::PerlCritic';
use Test2::Require::Module 'Perl::Critic';
use Test2::Require::Module 'Perl::Critic::Community';
use Test2::V0;
use Perl::Critic;
use Test2::Tools::PerlCritic;
my $critic = Perl::Critic->new(
-profile => 'perlcriticrc',
);
perl_critic_ok ['lib','t'], $critic;
done_testing;
FFI-Platypus-2.12/xt/author/eol.t 000644 000000 000000 00000000510 15251066120 016532 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'test requires Test::EOL'
unless eval q{ use Test::EOL; 1 };
};
use Test::EOL;
use FindBin;
use File::Spec;
chdir(File::Spec->catdir($FindBin::Bin, File::Spec->updir, File::Spec->updir));
all_perl_files_ok(grep { -e $_ } qw( bin lib t Makefile.PL ));
FFI-Platypus-2.12/xt/author/example.t 000644 000000 000000 00000006565 15251066120 017426 0 ustar 00root root 000000 000000 use Test2::V0 -no_srand => 1;
use Test2::Require::EnvVar 'FFI_PLATYPUS_TEST_EXAMPLES';
BEGIN {
eval {
require FFI::Platypus;
FFI::Platypus->VERSION('2.00');
require Convert::Binary::C;
require YAML;
require Capture::Tiny;
Capture::Tiny->import('capture_merged');
require Path::Tiny;
Path::Tiny->import('path');
require File::chdir;
File::chdir->import();
require Test::Script;
Test::Script->import('script_compiles');
require FFI::C;
};
if($@)
{
note "error = $@";
skip_all 'Test requires FFI::Platypus 2.00, Capture::Tiny, Test::Script, Path::Tiny, Convert::Binary::C, File::chdir, FFI:C and YAML';
}
}
my @skipped;
foreach my $dir (qw( examples ))
{
subtest "$dir" => sub {
local $CWD = $dir;
my @c_source = grep { $_->basename =~ /\.c$/ } path('.')->children;
if(@c_source)
{
subtest 'Compile C' => sub {
foreach my $c_source (@c_source)
{
my $so_file = $c_source->parent->child(do {
my $basename = $c_source->basename;
$basename =~ s/\.c$/.so/;
$basename;
});
my @cmd = ('cc', '-fPIC', '-shared', -o => "$so_file", "$c_source");
my($out, $ret) = capture_merged {
system @cmd;
};
ok $ret == 0, "@cmd";
if($ret == 0)
{
note $out if $out ne '';
}
else
{
diag $out if $out ne '';
}
}
};
}
my @pl_source = grep { $_->basename =~ /\.pl$/ } path('.')->children;
if(@pl_source)
{
subtest 'Run Perl' => sub {
foreach my $pl_source (@pl_source)
{
subtest "$pl_source" => sub {
script_compiles "$pl_source";
my $key = join '/', $dir, $pl_source->basename;
if($^O ne 'MSWin32' && $pl_source->basename =~ /^win32_/)
{
push @skipped, [$key, 'Microsoft Windows Only'];
return;
}
my @cmd = ($^X, $pl_source);
my($out, $ret) = capture_merged {
system @cmd;
};
ok $ret == 0, "@cmd";
if($ret == 0)
{
note $out if $out ne '';
}
else
{
diag $out if $out ne '';
}
};
}
};
}
unlink $_ for grep { $_->basename =~ /\.so$/ || $_->basename =~ /^zmq-ffi-/ } path('.')->children;
}
}
foreach my $bundle (grep { -d $_ && $_->basename =~ /^bundle-/ } path('examples')->children)
{
if($bundle->basename eq 'bundle-bzip2' && !eval { require Alien::Libbz2; 1 })
{
push @skipped, [$bundle->basename, 'Alien::Libbz2 is not installed'];
next;
}
subtest $bundle->basename => sub {
local $CWD = $bundle;
my @cmd = ('prove', '-lvm');
my($out, $ret) = capture_merged {
system @cmd;
};
ok $ret == 0, "@cmd";
if($ret == 0)
{
note $out if $out ne '';
}
else
{
diag $out if $out ne '';
}
};
}
if(@skipped)
{
diag '';
diag '';
diag '';
my $max = 5;
foreach my $skip (@skipped)
{
$max = length($skip->[0])
if $max < length($skip->[0]);
}
diag 'Skipped these examples:';
foreach my $skip (@skipped)
{
diag sprintf "%-${max}s %s", $skip->[0], $skip->[1];
}
diag '';
diag '';
}
done_testing;
FFI-Platypus-2.12/xt/author/no_tabs.t 000644 000000 000000 00000000522 15251066120 017403 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'test requires Test::NoTabs'
unless eval q{ use Test::NoTabs; 1 };
};
use Test::NoTabs;
use FindBin;
use File::Spec;
chdir(File::Spec->catdir($FindBin::Bin, File::Spec->updir, File::Spec->updir));
all_perl_files_ok( grep { -e $_ } qw( bin lib t Makefile.PL ));
FFI-Platypus-2.12/xt/author/pod.t 000644 000000 000000 00000000472 15251066120 016544 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'test requires Test::Pod'
unless eval q{ use Test::Pod; 1 };
};
use Test::Pod;
use FindBin;
use File::Spec;
chdir(File::Spec->catdir($FindBin::Bin, File::Spec->updir, File::Spec->updir));
all_pod_files_ok( grep { -e $_ } qw( bin lib ));
FFI-Platypus-2.12/xt/author/pod_coverage.t 000644 000000 000000 00000004001 15251066120 020407 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'test requires 5.010 or better'
unless $] >= 5.010;
plan skip_all => 'test requires Test::Pod::Coverage'
unless eval q{ use Test::Pod::Coverage; 1 };
plan skip_all => 'test requires YAML'
unless eval q{ use YAML; 1; };
plan skip_all => 'test does not always work in cip check'
if defined $ENV{CIPSTATIC} && $ENV{CIPSTATIC} eq 'true';
};
use Test::Pod::Coverage;
use YAML qw( LoadFile );
use FindBin;
use File::Spec;
my $config_filename = File::Spec->catfile(
$FindBin::Bin, File::Spec->updir, File::Spec->updir, 'author.yml'
);
my $config;
$config = LoadFile($config_filename)
if -r $config_filename;
plan skip_all => 'disabled' if $config->{pod_coverage}->{skip};
chdir(File::Spec->catdir($FindBin::Bin, File::Spec->updir, File::Spec->updir));
my @private_classes;
my %private_methods;
push $config->{pod_coverage}->{private}->@*,
'Alien::.*::Install::Files#Inline';
foreach my $private ($config->{pod_coverage}->{private}->@*)
{
my($class,$method) = split /#/, $private;
if(defined $class && $class ne '')
{
my $regex = eval 'qr{^' . $class . '$}';
if(defined $method && $method ne '')
{
push @private_classes, { regex => $regex, method => $method };
}
else
{
push @private_classes, { regex => $regex, all => 1 };
}
}
elsif(defined $method && $method ne '')
{
$private_methods{$_} = 1 for split /,/, $method;
}
}
my @classes = all_modules;
plan tests => scalar @classes;
foreach my $class (@classes)
{
SKIP: {
my($is_private_class) = map { 1 } grep { $class =~ $_->{regex} && $_->{all} } @private_classes;
skip "private class: $class", 1 if $is_private_class;
my %methods = map {; $_ => 1 } map { split /,/, $_->{method} } grep { $class =~ $_->{regex} } @private_classes;
$methods{$_} = 1 for keys %private_methods;
my $also_private = eval 'qr{^' . join('|', keys %methods ) . '$}';
pod_coverage_ok $class, { also_private => [$also_private] };
};
}
FFI-Platypus-2.12/xt/author/pod_link.t 000644 000000 000000 00000002256 15251066120 017563 0 ustar 00root root 000000 000000 use Test2::Require::Module 'Test::Pod::LinkCheck::Lite';
use Test2::Require::EnvVar 'POD_CHECK';
use Test2::V0;
use Test::Pod::LinkCheck::Lite;
use Path::Tiny qw( path );
use HTTP::Tiny::Mech;
use WWW::Mechanize::Cached;
use CHI;
my @checks;
if(-d 'blib/script')
{
push @checks, 'blib/script';
}
elsif(-d 'bin')
{
push @checks, 'bin';
}
if(-d 'blib')
{
push @checks, 'blib';
}
else
{
push @checks, 'lib';
diag "checking lib instead of blib";
}
my $dir = path('~/.xor/cache');
$dir->mkpath;
$dir->chmod(0700);
my $ua = HTTP::Tiny::Mech->new(
mechua => WWW::Mechanize::Cached->new(
cache => CHI->new(
# keep cache around for 24hrs
expires_in => 60*60*24,
driver => 'File',
root_dir => $dir->stringify,
),
),
);
my $mock1 = mock 'Test::Pod::LinkCheck::Lite' => (
override => [
_user_agent => sub { $ua },
],
);
# WWW::Mechanize::Cached gets confused by HEAD
# requests and thinks they are invalid because
# content-length is non-zero (as it should be)
my $mock2 = mock 'HTTP::Tiny::Mech' => (
override => [
head => sub { shift->get(@_) },
],
);
Test::Pod::LinkCheck::Lite
->new
->all_pod_files_ok(@checks);
done_testing;
FFI-Platypus-2.12/xt/author/pod_spelling_system.t 000644 000000 000000 00000002367 15251066120 022052 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'test requires Test::Spelling'
unless eval q{ use Test::Spelling; 1 };
plan skip_all => 'test requires YAML'
unless eval q{ use YAML; 1; };
};
use Test::Spelling;
use YAML qw( LoadFile );
use FindBin;
use File::Spec;
my $config_filename = File::Spec->catfile(
$FindBin::Bin, File::Spec->updir, File::Spec->updir, 'author.yml'
);
my $config;
$config = LoadFile($config_filename)
if -r $config_filename;
plan skip_all => 'disabled' if $config->{pod_spelling_system}->{skip};
chdir(File::Spec->catdir($FindBin::Bin, File::Spec->updir, File::Spec->updir));
add_stopwords($config->{pod_spelling_system}->{stopwords}->@*);
add_stopwords(qw(
Plicease
stdout
stderr
stdin
subref
loopback
username
os
Ollis
Mojolicious
plicease
CPAN
reinstall
TODO
filename
filenames
login
callback
callbacks
standalone
VMS
hostname
hostnames
TCP
UDP
IP
API
MSWin32
OpenBSD
FreeBSD
NetBSD
unencrypted
WebSocket
WebSockets
timestamp
timestamps
poney
BackPAN
portably
RedHat
AIX
BSD
XS
FFI
perlish
optimizations
subdirectory
RESTful
SQLite
JavaScript
dir
plugins
munge
jQuery
namespace
PDF
PDFs
usernames
DBI
pluggable
APIs
SSL
JSON
YAML
uncommented
Solaris
OpenVMS
URI
URL
CGI
));
all_pod_files_spelling_ok;
FFI-Platypus-2.12/xt/author/version.t 000644 000000 000000 00000001473 15251066120 017451 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
use FindBin ();
BEGIN {
plan skip_all => "test requires Test::Version 2.00"
unless eval q{
use Test::Version 2.00 qw( version_all_ok ), {
has_version => 1,
filename_match => sub { $_[0] !~ m{/(ConfigData|Install/Files)\.pm$} },
};
1
};
plan skip_all => 'test requires YAML'
unless eval q{ use YAML; 1; };
}
use YAML qw( LoadFile );
use FindBin;
use File::Spec;
my $config_filename = File::Spec->catfile(
$FindBin::Bin, File::Spec->updir, File::Spec->updir, 'author.yml'
);
my $config;
$config = LoadFile($config_filename)
if -r $config_filename;
if($config->{version}->{dir})
{
note "using dir " . $config->{version}->{dir}
}
version_all_ok($config->{version}->{dir} ? ($config->{version}->{dir}) : ());
done_testing;
FFI-Platypus-2.12/xt/release/ 000755 000000 000000 00000000000 15251066120 015710 5 ustar 00root root 000000 000000 FFI-Platypus-2.12/xt/release/changes.t 000644 000000 000000 00000001113 15251066120 017501 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'test requires Test::CPAN::Changes'
unless eval q{ use Test::CPAN::Changes; 1 };
};
use Test::CPAN::Changes;
use FindBin;
use File::Spec;
chdir(File::Spec->catdir($FindBin::Bin, File::Spec->updir, File::Spec->updir));
do {
my $old = \&Test::Builder::carp;
my $new = sub {
my($self, @messages) = @_;
return if $messages[0] =~ /^Date ".*" is not in the recommend format/;
$old->($self, @messages);
};
no warnings 'redefine';
*Test::Builder::carp = $new;
};
changes_file_ok;
done_testing;
FFI-Platypus-2.12/xt/release/fixme.t 000644 000000 000000 00000000616 15251066120 017210 0 ustar 00root root 000000 000000 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'test requires Test::Fixme'
unless eval q{ use Test::Fixme 0.14; 1 };
};
use Test::Fixme 0.07;
use FindBin;
use File::Spec;
chdir(File::Spec->catdir($FindBin::Bin, File::Spec->updir, File::Spec->updir));
run_tests(
match => qr/FIXME/,
where => [ grep { -e $_ } qw( bin lib t Makefile.PL Build.PL )],
warn => 1,
);