FFI-Platypus-2.10/000755 000000 000000 00000000000 14730610136 013636 5ustar00rootroot000000 000000 FFI-Platypus-2.10/CONTRIBUTING000644 000000 000000 00000012472 14730610136 015476 0ustar00rootroot000000 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.10/Changes000644 000000 000000 00000110456 14730610136 015140 0ustar00rootroot000000 000000 Revision history for FFI-Platypus 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.10/Changes.FFI-Build000644 000000 000000 00000002244 14730610136 016573 0ustar00rootroot000000 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.10/Changes.FFI-Platypus-Type-StringArray000644 000000 000000 00000000372 14730610136 022537 0ustar00rootroot000000 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.10/INSTALL000644 000000 000000 00000004553 14730610136 014676 0ustar00rootroot000000 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.10/LICENSE000644 000000 000000 00000046446 14730610136 014661 0ustar00rootroot000000 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. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 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, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA 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 Ty Coon, 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.10/MANIFEST000644 000000 000000 00000020600 14730610136 014765 0ustar00rootroot000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.032. CONTRIBUTING Changes Changes.FFI-Build Changes.FFI-Platypus-Type-StringArray INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README 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/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.10/META.json000644 000000 000000 00000021144 14730610136 015261 0ustar00rootroot000000 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.032, 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" : { "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", "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.10", "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.40.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.38", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later", "x_use_unsafe_inc" : 0 } FFI-Platypus-2.10/META.yml000644 000000 000000 00000003710 14730610136 015110 0ustar00rootroot000000 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.032, 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.10' 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.40.0 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' x_use_unsafe_inc: 0 FFI-Platypus-2.10/Makefile.PL000644 000000 000000 00000012764 14730610136 015622 0ustar00rootroot000000 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.77. 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.10", "test" => { "TESTS" => "t/*.t" } ); mymm::myWriteMakefile(%WriteMakefileArgs);FFI-Platypus-2.10/README000644 000000 000000 00000246414 14730610136 014531 0ustar00rootroot000000 000000 NAME FFI::Platypus - Write Perl bindings to non-Perl libraries with FFI. No XS required. VERSION version 2.10 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 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 Dyn A wrapper around dyncall <https://dyncall.org>, which is itself an alternative to libffi <https://sourceware.org/libffi/>. 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.10/SUPPORT���������������������������������������������������������������������������000644 �000000 �000000 �00000001020 14730610136 014726� 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.10/author.yml������������������������������������������������������������������������000644 �000000 �000000 �00000006670 14730610136 015674� 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 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.10/corpus/���������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015151� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build/�����������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017074� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build/project-cxx/�����������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021342� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build/project-cxx/foo1.cxx���������������������������������������������000644 �000000 �000000 �00000000167 14730610136 022736� 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.10/corpus/ffi_build/project-cxx/foo2.cpp���������������������������������������������000644 �000000 �000000 �00000000523 14730610136 022713� 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.10/corpus/ffi_build/project1/��������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020623� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build/project1/foo1.c��������������������������������������������������000644 �000000 �000000 �00000000165 14730610136 021635� 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.10/corpus/ffi_build/project1/foo2.c��������������������������������������������������000644 �000000 �000000 �00000000200 14730610136 021624� 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.10/corpus/ffi_build/project2/��������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020624� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build/project2/bar.c���������������������������������������������������000644 �000000 �000000 �00000000101 14730610136 021524� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <libdontpanic.h> int myanswer() { return answer(); } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build/source/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020374� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build/source/foo.c�����������������������������������������������������000644 �000000 �000000 �00000000000 14730610136 021311� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_base/�������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021065� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_base/basic.foo����������������������������������������������000644 �000000 �000000 �00000000025 14730610136 022650� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������This is a basic foo. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_c/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020375� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_c/basic.c���������������������������������������������������000644 �000000 �000000 �00000000105 14730610136 021616� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> int main(int argc, char *argv[]) { return 0; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_c/foo1.c����������������������������������������������������000644 �000000 �000000 �00000000034 14730610136 021402� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������int foo1() { return 42; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_c/foo2.c����������������������������������������������������000644 �000000 �000000 �00000000057 14730610136 021410� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <myfoo.h> int foo1() { return 42; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_c/include/��������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 022020� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_c/include/myfoo.h�������������������������������������������000644 �000000 �000000 �00000000123 14730610136 023316� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#ifndef MYFOO_H #define MYFOO_H /* this doesn't do anything apparently */ #endif ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_cxx/��������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020755� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_cxx/basic.cxx�����������������������������������������������000644 �000000 �000000 �00000000151 14730610136 022557� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <iostream.h> int main(int argc, char *argv[]) { cout << "hello world" << endl; return 0; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_cxx/foo1.cxx������������������������������������������������000644 �000000 �000000 �00000000171 14730610136 022344� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������class Foo { public: int answer() { return 42; }; }; int foo1() { // comment Foo foo; return foo.answer(); } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_cxx/foo2.cpp������������������������������������������������000644 �000000 �000000 �00000000170 14730610136 022324� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <myfoo.h> class Foo { public: int answer() { return 42; }; }; int foo1() { // comment return 42; } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_cxx/include/������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 022400� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_file_cxx/include/myfoo.h�����������������������������������������000644 �000000 �000000 �00000000123 14730610136 023676� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#ifndef MYFOO_H #define MYFOO_H /* this doesn't do anything apparently */ #endif ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/��������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017565� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb1/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020243� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb1/hello.fbx�������������������������������������������������000644 �000000 �000000 �00000000206 14730610136 022045� 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.10/corpus/ffi_build_mm/lb1/hello1.c��������������������������������������������������000644 �000000 �000000 �00000000000 14730610136 021561� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb1/hello2.c��������������������������������������������������000644 �000000 �000000 �00000000000 14730610136 021562� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb1bad/�������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020712� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb1bad/hello.fbx����������������������������������������������000644 �000000 �000000 �00000000226 14730610136 022516� 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.10/corpus/ffi_build_mm/lb1bad/hello1.c�����������������������������������������������000644 �000000 �000000 �00000000000 14730610136 022230� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb1bad/hello2.c�����������������������������������������������000644 �000000 �000000 �00000000000 14730610136 022231� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb2/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020244� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb2/hello1.c��������������������������������������������������000644 �000000 �000000 �00000000000 14730610136 021562� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/lb2/hello2.c��������������������������������������������������000644 �000000 �000000 �00000000000 14730610136 021563� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/�����������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021314� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/ffi/�������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 022060� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/ffi/x.c����������������������������������������������000644 �000000 �000000 �00000000200 14730610136 022463� 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.10/corpus/ffi_build_mm/project1/ffi/y.c����������������������������������������������000644 �000000 �000000 �00000000000 14730610136 022462� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/ffi/z.c����������������������������������������������000644 �000000 �000000 �00000000000 14730610136 022463� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/t/���������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021557� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/t/ffi/�����������������������������������������������000755 �000000 �000000 �00000000000 14730610136 022323� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/t/ffi/a.c��������������������������������������������000644 �000000 �000000 �00000000175 14730610136 022712� 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.10/corpus/ffi_build_mm/project1/t/ffi/b.c��������������������������������������������000644 �000000 �000000 �00000000000 14730610136 022676� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_mm/project1/t/ffi/c.c��������������������������������������������000644 �000000 �000000 �00000000000 14730610136 022677� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020452� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib1/�����������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021301� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib1/FFI/�������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021705� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib1/FFI/Build/�������������������������������������������000755 �000000 �000000 �00000000000 14730610136 022744� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib1/FFI/Build/Plugin/������������������������������������000755 �000000 �000000 �00000000000 14730610136 024202� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib1/FFI/Build/Plugin/blank.txt���������������������������000644 �000000 �000000 �00000000001 14730610136 026021� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib2/�����������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021302� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib2/FFI/�������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021706� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib2/FFI/Build/�������������������������������������������000755 �000000 �000000 �00000000000 14730610136 022745� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/������������������������������������000755 �000000 �000000 �00000000000 14730610136 024203� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/Foo1.pm�����������������������������000644 �000000 �000000 �00000000323 14730610136 025343� 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.10/corpus/ffi_build_plugin/lib2/FFI/Build/Plugin/Foo2.pm�����������������������������000644 �000000 �000000 �00000000224 14730610136 025344� 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.10/corpus/ffi_probe_runner/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020475� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/ffi_probe_runner/bar.c�����������������������������������������������������000644 �000000 �000000 �00000000333 14730610136 021404� 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.10/corpus/ffi_probe_runner/foo.c�����������������������������������������������������000644 �000000 �000000 �00000000334 14730610136 021424� 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.10/corpus/memory/��������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 016461� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/memory/arg_array.pl��������������������������������������������������������000644 �000000 �000000 �00000002761 14730610136 020773� 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.10/corpus/memory/arg_custom.pl�������������������������������������������������������000644 �000000 �000000 �00000002336 14730610136 021165� 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.10/corpus/memory/arg_object.pl�������������������������������������������������������000644 �000000 �000000 �00000001761 14730610136 021122� 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.10/corpus/memory/arg_pointer.pl������������������������������������������������������000644 �000000 �000000 �00000003135 14730610136 021331� 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.10/corpus/memory/arg_scalar.pl�������������������������������������������������������000644 �000000 �000000 �00000005125 14730610136 021117� 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.10/corpus/memory/attach.pl�����������������������������������������������������������000644 �000000 �000000 �00000000626 14730610136 020266� 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.10/corpus/memory/empty.pl������������������������������������������������������������000644 �000000 �000000 �00000000053 14730610136 020152� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; print "nada\n"; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/memory/function.pl���������������������������������������������������������000644 �000000 �000000 �00000000706 14730610136 020646� 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.10/corpus/memory/return_array.pl�����������������������������������������������������000644 �000000 �000000 �00000005334 14730610136 021540� 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.10/corpus/memory/return_custom.pl����������������������������������������������������000644 �000000 �000000 �00000002340 14730610136 021726� 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.10/corpus/memory/return_object.pl����������������������������������������������������000644 �000000 �000000 �00000001715 14730610136 021667� 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.10/corpus/memory/return_pointer.pl���������������������������������������������������000644 �000000 �000000 �00000002626 14730610136 022103� 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.10/corpus/memory/return_scalar.pl����������������������������������������������������000644 �000000 �000000 �00000004237 14730610136 021670� 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.10/corpus/memory/supp/���������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017450� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/corpus/memory/supp/basic_type_cache.supp������������������������������������������000644 �000000 �000000 �00000000331 14730610136 023623� 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.10/dist.ini��������������������������������������������������������������������������000644 �000000 �000000 �00000020207 14730610136 015303� 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.10 ; 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.10/examples/�������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015454� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/add.c��������������������������������������������������������������������000644 �000000 �000000 �00000000050 14730610136 016343� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������int add(int a, int b) { return a+b; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/add.pl�������������������������������������������������������������������000644 �000000 �000000 �00000000443 14730610136 016542� 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.10/examples/archive.pl���������������������������������������������������������������000644 �000000 �000000 �00000006267 14730610136 017445� 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.10/examples/archive.tar��������������������������������������������������������������000644 �000000 �000000 �00000024000 14730610136 017601� 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.10/examples/archive_object.pl��������������������������������������������������������000644 �000000 �000000 �00000005744 14730610136 020772� 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.10/examples/array_reverse.c����������������������������������������������������������000644 �000000 �000000 �00000000323 14730610136 020467� 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.10/examples/array_reverse.pl���������������������������������������������������������000644 �000000 �000000 �00000000567 14730610136 020672� 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.10/examples/array_sum.c��������������������������������������������������������������000644 �000000 �000000 �00000000243 14730610136 017621� 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.10/examples/array_sum.pl�������������������������������������������������������������000644 �000000 �000000 �00000000440 14730610136 020011� 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.10/examples/bundle-answer/�����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020222� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/ffi/�������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020766� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/ffi/answer.c�����������������������������������������������000644 �000000 �000000 �00000000131 14730610136 022424� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������int answer(void) { /* the answer to life the universe and everything */ return 42; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/ffi/answer.fbx���������������������������������������������000644 �000000 �000000 �00000000143 14730610136 022764� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; our $DIR; return { cflags => "-I/include", source => "$DIR/*.c", } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/include/���������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 021645� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/include/answer.h�������������������������������������������000644 �000000 �000000 �00000000075 14730610136 023317� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#ifndef ANSWER_H #define ANSWER_H int answer(void); #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/lib/�������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020770� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/lib/Answer.pm����������������������������������������������000644 �000000 �000000 �00000000337 14730610136 022570� 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.10/examples/bundle-answer/t/���������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020465� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-answer/t/answer.t�������������������������������������������������000644 �000000 �000000 �00000000075 14730610136 022153� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Answer; is(answer(), 42); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-bzip2/������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017751� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-bzip2/ffi/��������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020515� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-bzip2/ffi/bz2.fbx�������������������������������������������������000644 �000000 �000000 �00000000127 14730610136 021713� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; { alien => ['Alien::Libbz2'], source => ['ffi/*.c'], }; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-bzip2/ffi/compress.c����������������������������������������������000644 �000000 �000000 �00000000516 14730610136 022516� 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 = malloc(sizeof(bz_stream)); (*stream)->bzalloc = NULL; (*stream)->bzfree = NULL; (*stream)->opaque = NULL; return BZ2_bzCompressInit(*stream, blockSize100k, verbosity, workFactor ); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-bzip2/lib/��������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020517� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-bzip2/lib/Bzip2.pm������������������������������������������������000644 �000000 �000000 �00000001313 14730610136 022041� 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.10/examples/bundle-bzip2/t/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020214� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-bzip2/t/bzip2.t���������������������������������������������������000644 �000000 �000000 �00000000175 14730610136 021432� 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.10/examples/bundle-const/������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020051� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-const/ffi/��������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020615� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-const/ffi/const.c�������������������������������������������������000644 �000000 �000000 �00000000661 14730610136 022112� 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.10/examples/bundle-const/ffi/myheader.h����������������������������������������������000644 �000000 �000000 �00000000326 14730610136 022565� 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.10/examples/bundle-const/lib/��������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020617� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-const/lib/Const.pm������������������������������������������������000644 �000000 �000000 �00000000207 14730610136 022242� 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.10/examples/bundle-const/t/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020314� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-const/t/const.t���������������������������������������������������000644 �000000 �000000 �00000000235 14730610136 021627� 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.10/examples/bundle-foo/��������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017506� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-foo/Makefile.PL���������������������������������������������������000644 �000000 �000000 �00000000415 14730610136 021460� 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.10/examples/bundle-foo/ffi/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020252� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-foo/ffi/foo.c�����������������������������������������������������000644 �000000 �000000 �00000000762 14730610136 021206� 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.10/examples/bundle-foo/lib/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020254� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-foo/lib/Foo.pm����������������������������������������������������000644 �000000 �000000 �00000001012 14730610136 021327� 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.10/examples/bundle-foo/t/������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017751� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-foo/t/foo.t�������������������������������������������������������000644 �000000 �000000 �00000000217 14730610136 020721� 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.10/examples/bundle-init/�������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017666� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-init/ffi/���������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020432� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-init/ffi/init.c���������������������������������������������������000644 �000000 �000000 �00000000706 14730610136 021544� 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.10/examples/bundle-init/lib/���������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020434� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-init/lib/Init.pm��������������������������������������������������000644 �000000 �000000 �00000000601 14730610136 021672� 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.10/examples/bundle-init/t/�����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020131� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/bundle-init/t/init.t�����������������������������������������������������000644 �000000 �000000 �00000000075 14730610136 021263� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Init; ok 'did not crash'; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/char.pl������������������������������������������������������������������000644 �000000 �000000 �00000000646 14730610136 016734� 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.10/examples/closure-opaque.pl��������������������������������������������������������000644 �000000 �000000 �00000000664 14730610136 020763� 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.10/examples/closure.c����������������������������������������������������������������000644 �000000 �000000 �00000000556 14730610136 017302� 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.10/examples/closure.pl���������������������������������������������������������������000644 �000000 �000000 �00000000761 14730610136 017471� 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.10/examples/color.c������������������������������������������������������������������000644 �000000 �000000 �00000000433 14730610136 016736� 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.10/examples/color.pl�����������������������������������������������������������������000644 �000000 �000000 �00000001504 14730610136 017127� 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.10/examples/curl.pl������������������������������������������������������������������000644 �000000 �000000 �00000001161 14730610136 016755� 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.10/examples/curl_callback.pl���������������������������������������������������������000644 �000000 �000000 �00000002134 14730610136 020572� 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.10/examples/file_handle.pl�����������������������������������������������������������000644 �000000 �000000 �00000001765 14730610136 020254� 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.10/examples/file_handle.txt����������������������������������������������������������000644 �000000 �000000 �00000000014 14730610136 020442� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Hello World ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/list_integer_types.pl����������������������������������������������������000644 �000000 �000000 �00000000471 14730610136 021727� 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.10/examples/malloc.pl����������������������������������������������������������������000644 �000000 �000000 �00000000521 14730610136 017256� 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.10/examples/math.pl������������������������������������������������������������������000644 �000000 �000000 �00000000611 14730610136 016740� 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.10/examples/notify.pl����������������������������������������������������������������000644 �000000 �000000 �00000001420 14730610136 017316� 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.10/examples/notify.png���������������������������������������������������������������000644 �000000 �000000 �00000022603 14730610136 017475� 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´V­Vˤr“Ùh0èÛÚÛ.Tž‹ŒˆŠŽŒéú[JÝ ÖÀôÀ}5uÕR9|è¨ÖÖ–¶öÖööv›Ís=™LSu©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½ZR}©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µª4­zçU­T×-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#­¨IIXwÍ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‹%:&J­Q•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�#ð[# 㾺ESȯ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ã©_¯ébF 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ëœu­m’Üñ°ßÐ*ÿì³×_~àaiLR‹ž|æ/Ͼ60]‘œÉéŽKMäê5¯¾ñÀ}a‡ì?Õôò‡OüãÙ¿˜C;³«ÎŸ1eIù©û¦ŒŠÌKM«M™o¿eÆ}ÕMÒgV.ä7´ÚÔZyõÊg–<¯ý¯ÏŸ|͋˗½hz÷ï÷º¡M€_ÎW·6VI*œë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Ø{å+}Mc¢ï)Ã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‰Rfz•þô¦~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¸ci‡_ì~tùÁnB òz¿³»U ½ OMQ«(Z]AïÓÌÇ¡ÑQî2ìtKHž¶ º!1äq¡›dC—)j@ó~DqVŠ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.10/examples/person.c�����������������������������������������������������������������000644 �000000 �000000 �00000000732 14730610136 017130� 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.10/examples/person.pl����������������������������������������������������������������000644 �000000 �000000 �00000001174 14730610136 017322� 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.10/examples/pipe.pl������������������������������������������������������������������000644 �000000 �000000 �00000000360 14730610136 016745� 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.10/examples/puts.pl������������������������������������������������������������������000644 �000000 �000000 �00000000256 14730610136 017007� 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.10/examples/string_reverse.c���������������������������������������������������������000644 �000000 �000000 �00000000553 14730610136 020664� 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.10/examples/string_reverse.pl��������������������������������������������������������000644 �000000 �000000 �00000000373 14730610136 021055� 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.10/examples/swap.c�������������������������������������������������������������������000644 �000000 �000000 �00000000105 14730610136 016566� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������void swap(int *a, int *b) { int tmp = *b; *b = *a; *a = tmp; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/examples/swap.pl������������������������������������������������������������������000644 �000000 �000000 �00000000402 14730610136 016757� 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.10/examples/tcod.pl������������������������������������������������������������������000644 �000000 �000000 �00000002011 14730610136 016734� 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.10/examples/time.pl������������������������������������������������������������������000644 �000000 �000000 �00000003425 14730610136 016753� 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.10/examples/time_record.pl�����������������������������������������������������������000644 �000000 �000000 �00000001633 14730610136 020310� 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.10/examples/time_struct.pl�����������������������������������������������������������000644 �000000 �000000 �00000002072 14730610136 020354� 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.10/examples/var_array.c��������������������������������������������������������������000644 �000000 �000000 �00000000211 14730610136 017600� 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.10/examples/var_array.pl�������������������������������������������������������������000644 �000000 �000000 �00000000355 14730610136 020002� 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.10/examples/win32_beep.pl������������������������������������������������������������000644 �000000 �000000 �00000000403 14730610136 017743� 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.10/examples/win32_getSystemTime.pl���������������������������������������������������000644 �000000 �000000 �00000003012 14730610136 021632� 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.10/examples/win32_messagebox.pl������������������������������������������������������000644 �000000 �000000 �00000001030 14730610136 021162� 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.10/examples/win32_messagebox.png�����������������������������������������������������000644 �000000 �000000 �00000010461 14730610136 021343� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������‰PNG  ��� IHDR���Á���ô���"õB‚���sRGB�®Îé���gAMA��± üa��� pHYs��%��%IR$ð��ÆIDATx^íOLG‡ß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‹wKð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%š+}TH�Ô €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.10/examples/xor_cipher.c�������������������������������������������������������������000644 �000000 �000000 �00000000663 14730610136 017767� 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.10/examples/xor_cipher.pl������������������������������������������������������������000644 �000000 �000000 �00000001325 14730610136 020154� 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.10/examples/zmq3.pl������������������������������������������������������������������000644 �000000 �000000 �00000004260 14730610136 016705� 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.10/ffi/������������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014402� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/ffi/constant.c��������������������������������������������������������������������000644 �000000 �000000 �00000001172 14730610136 016400� 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.10/ffi/memory.c����������������������������������������������������������������������000644 �000000 �000000 �00000001665 14730610136 016066� 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.10/ffi/record_meta.c�����������������������������������������������������������������000644 �000000 �000000 �00000004420 14730610136 017032� 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.10/inc/������������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014407� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/inc/Alien/������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015437� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/inc/Alien/Base/�������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 016311� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/inc/Alien/Base/Wrapper.pm���������������������������������������������������������000644 �000000 �000000 �00000032325 14730610136 020274� 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.83'; # 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.83 =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.10/inc/Alien/FFI/��������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 016043� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/inc/Alien/FFI/PkgConfigPP.pm������������������������������������������������������000644 �000000 �000000 �00000001202 14730610136 020503� 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.10/inc/Alien/FFI/Vcpkg.pm������������������������������������������������������������000644 �000000 �000000 �00000000777 14730610136 017466� 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.10/inc/Alien/FFI/pkgconfig.pm��������������������������������������������������������000644 �000000 �000000 �00000003473 14730610136 020357� 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.10/inc/Alien/psapi.pm����������������������������������������������������������������000644 �000000 �000000 �00000000562 14730610136 017114� 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.10/inc/My/���������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014774� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/inc/My/BuildConfig.pm�������������������������������������������������������������000644 �000000 �000000 �00000000351 14730610136 017516� 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.10/inc/My/Config.pm������������������������������������������������������������������000644 �000000 �000000 �00000025646 14730610136 016554� 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.10/inc/My/ConfigH.pm�����������������������������������������������������������������000644 �000000 �000000 �00000001445 14730610136 016653� 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.10/inc/My/ConfigPl.pm����������������������������������������������������������������000644 �000000 �000000 �00000001637 14730610136 017042� 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.10/inc/My/ShareConfig.pm�������������������������������������������������������������000644 �000000 �000000 �00000000407 14730610136 017523� 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.10/inc/abi/��������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015142� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/inc/abi/abis-all.json�������������������������������������������������������������000644 �000000 �000000 �00000001377 14730610136 017531� 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.10/inc/abi/compute-all.pl������������������������������������������������������������000644 �000000 �000000 �00000003110 14730610136 017714� 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.10/inc/bad-5100t.pl������������������������������������������������������������������000644 �000000 �000000 �00000001241 14730610136 016237� 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.10/inc/bad-forks.pl������������������������������������������������������������������000644 �000000 �000000 �00000001451 14730610136 016615� 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.10/inc/bad-oldperl.pl����������������������������������������������������������������000644 �000000 �000000 �00000001223 14730610136 017127� 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.10/inc/mm-build.pl�������������������������������������������������������������������000644 �000000 �000000 �00000002634 14730610136 016457� 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.10/inc/mm-clean.pl�������������������������������������������������������������������000644 �000000 �000000 �00000001163 14730610136 016436� 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.10/inc/mm-config-pb.pl���������������������������������������������������������������000644 �000000 �000000 �00000000165 14730610136 017221� 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.10/inc/mm-config-set.pl��������������������������������������������������������������000644 �000000 �000000 �00000000327 14730610136 017413� 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.10/inc/mm-config.pl������������������������������������������������������������������000644 �000000 �000000 �00000000305 14730610136 016616� 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.10/inc/mm-test.pl��������������������������������������������������������������������000644 �000000 �000000 �00000000564 14730610136 016337� 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.10/inc/mymm.pl�����������������������������������������������������������������������000644 �000000 �000000 �00000021625 14730610136 015731� 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.10/inc/pdb���������������������������������������������������������������������������000755 �000000 �000000 �00000001776 14730610136 015115� 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.10/inc/probe/������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015516� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/inc/probe/abi.c�������������������������������������������������������������������000644 �000000 �000000 �00000000364 14730610136 016420� 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.10/inc/probe/alloca.c����������������������������������������������������������������000644 �000000 �000000 �00000000213 14730610136 017111� 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.10/inc/probe/bigendian.c�������������������������������������������������������������000644 �000000 �000000 �00000000654 14730610136 017607� 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.10/inc/probe/bigendian64.c�����������������������������������������������������������000644 �000000 �000000 �00000000704 14730610136 017755� 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.10/inc/probe/complex.c���������������������������������������������������������������000644 �000000 �000000 �00000004506 14730610136 017336� 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.10/inc/probe/longdouble.c������������������������������������������������������������000644 �000000 �000000 �00000001263 14730610136 020016� 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.10/inc/probe/recordvalue.c�����������������������������������������������������������000644 �000000 �000000 �00000002056 14730610136 020200� 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.10/inc/probe/strnlen.c���������������������������������������������������������������000644 �000000 �000000 �00000000272 14730610136 017350� 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.10/inc/probe/variadic.c��������������������������������������������������������������000644 �000000 �000000 �00000002407 14730610136 017447� 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.10/include/��������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015261� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/include/ffi_platypus.h������������������������������������������������������������000644 �000000 �000000 �00000027552 14730610136 020152� 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 uint64_t cast0(void); #else void *cast0(void); #endif #if SIZEOF_VOIDP == 4 uint64_t cast1(uint64_t value); #else void *cast1(void *value); #endif #ifdef __cplusplus } #endif #endif ������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/include/ffi_platypus_bundle.h�����������������������������������������������������000644 �000000 �000000 �00000001436 14730610136 021474� 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.10/include/ffi_platypus_call.h�������������������������������������������������������000644 �000000 �000000 �00000172353 14730610136 021145� 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.10/include/ffi_platypus_guts.h�������������������������������������������������������000644 �000000 �000000 �00000005761 14730610136 021212� 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.10/include/libtest.h�����������������������������������������������������������������000644 �000000 �000000 �00000000326 14730610136 017101� 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.10/include/perl_math_int64.h���������������������������������������������������������000644 �000000 �000000 �00000005343 14730610136 020436� 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.10/include/ppport.h������������������������������������������������������������������000644 �000000 �000000 �00002110777 14730610136 016775� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#if 0 my $void = <<'SKIP'; #endif /* ---------------------------------------------------------------------- include/ppport.h -- Perl/Pollution/Portability Version 3.72 Automatically created by Devel::PPPort running under perl 5.040000. 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.72 =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 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.72; 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_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| 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| sv_vsetpvf|5.006000|5.004000|p sv_vsetpvf_mg|5.006000|5.004000|p sv_vsetpvfn|5.004000|5.004000| SvVSTRING_mg|5.009004|5.003007|p 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 #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 #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 #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.10/lib/������������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014404� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/��������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015010� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Build.pm������������������������������������������������������������������000644 �000000 �000000 �00000035605 14730610136 016416� 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.10'; # 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.10 =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.10/lib/FFI/Build/��������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 016047� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Build/File/���������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 016726� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Build/File/Base.pm��������������������������������������������������������000644 �000000 �000000 �00000015753 14730610136 020151� 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.10'; # 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.10 =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.10/lib/FFI/Build/File/C.pm�����������������������������������������������������������000644 �000000 �000000 �00000011000 14730610136 017436� 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.10'; # 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.10 =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.10/lib/FFI/Build/File/CXX.pm���������������������������������������������������������000644 �000000 �000000 �00000002776 14730610136 017742� 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.10'; # 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.10 =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.10/lib/FFI/Build/File/Library.pm�����������������������������������������������������000644 �000000 �000000 �00000003464 14730610136 020677� 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.10'; # 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.10 =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.10/lib/FFI/Build/File/Object.pm������������������������������������������������������000644 �000000 �000000 �00000003067 14730610136 020500� 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.10'; # 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.10 =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.10/lib/FFI/Build/MM.pm���������������������������������������������������������������000644 �000000 �000000 �00000021223 14730610136 016716� 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.10'; # 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.10 =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.10/lib/FFI/Build/Platform.pm���������������������������������������������������������000644 �000000 �000000 �00000031317 14730610136 020176� 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.10'; # 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.10 =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.10/lib/FFI/Build/Plugin.pm�����������������������������������������������������������000644 �000000 �000000 �00000004617 14730610136 017653� 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.10'; # 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.10 =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.10/lib/FFI/Build/PluginData.pm�������������������������������������������������������000644 �000000 �000000 �00000003140 14730610136 020433� 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.10'; # 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.10 =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.10/lib/FFI/Platypus.pm���������������������������������������������������������������000644 �000000 �000000 �00000267676 14730610136 017217� 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.10'; # 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.10 =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 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<Dyn> A wrapper around L<dyncall|https://dyncall.org>, which is itself an alternative to L<libffi|https://sourceware.org/libffi/>. =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.10/lib/FFI/Platypus.xs���������������������������������������������������������������000644 �000000 �000000 �00000003627 14730610136 017215� 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.10/lib/FFI/Platypus/�����������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 016631� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Platypus/API.pm�����������������������������������������������������������000644 �000000 �000000 �00000013466 14730610136 017612� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Buffer.pm��������������������������������������������������������000644 �000000 �000000 �00000023354 14730610136 020407� 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 ); # ABSTRACT: Convert scalars to C buffers our $VERSION = '2.10'; # 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.10 =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. =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.10/lib/FFI/Platypus/Bundle.pm��������������������������������������������������������000644 �000000 �000000 �00000050504 14730610136 020404� 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.10'; # 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.10 =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 = malloc(sizeof(bz_stream)); (*stream)->bzalloc = NULL; (*stream)->bzfree = NULL; (*stream)->opaque = NULL; 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.10/lib/FFI/Platypus/Closure.pm�������������������������������������������������������000644 �000000 �000000 �00000007013 14730610136 020604� 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.10'; # 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) = @_; return if $self->{sticky}; $self->{sticky} = 1; $self->_sticky; } sub unstick { my($self) = @_; return unless $self->{sticky}; $self->{sticky} = 0; $self->_unstick; } package FFI::Platypus::ClosureData; our $VERSION = '2.10'; # VERSION 1; __END__ =pod =encoding UTF-8 =head1 NAME FFI::Platypus::Closure - Platypus closure object =head1 VERSION version 2.10 =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. =head2 unstick $closure->unstick; Unmark the closure as sticky. =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.10/lib/FFI/Platypus/Constant.pm������������������������������������������������������000644 �000000 �000000 �00000011324 14730610136 020761� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/DL.pm������������������������������������������������������������000644 �000000 �000000 �00000013113 14730610136 017465� 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.10'; # VERSION 1; __END__ =pod =encoding UTF-8 =head1 NAME FFI::Platypus::DL - Slightly non-portable interface to libdl =head1 VERSION version 2.10 =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.10/lib/FFI/Platypus/Function.pm������������������������������������������������������000644 �000000 �000000 �00000007611 14730610136 020761� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Internal.pm������������������������������������������������������000644 �000000 �000000 �00000002617 14730610136 020751� 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.10'; # VERSION 1; __END__ =pod =encoding UTF-8 =head1 NAME FFI::Platypus::Internal - For internal use only =head1 VERSION version 2.10 =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.10/lib/FFI/Platypus/Lang.pm����������������������������������������������������������000644 �000000 �000000 �00000004671 14730610136 020060� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package FFI::Platypus::Lang; use strict; use warnings; use 5.008004; # ABSTRACT: Language specific customizations our $VERSION = '2.10'; # VERSION 1; __END__ =pod =encoding UTF-8 =head1 NAME FFI::Platypus::Lang - Language specific customizations =head1 VERSION version 2.10 =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.10/lib/FFI/Platypus/Lang/������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017512� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Platypus/Lang/ASM.pm������������������������������������������������������000644 �000000 �000000 �00000004232 14730610136 020471� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Lang/C.pm��������������������������������������������������������000644 �000000 �000000 �00000004055 14730610136 020236� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Lang/Win32.pm����������������������������������������������������000644 �000000 �000000 �00000034167 14730610136 020765� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Legacy.pm��������������������������������������������������������000644 �000000 �000000 �00000004435 14730610136 020401� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package FFI::Platypus::Legacy; use strict; use warnings; use 5.008004; # ABSTRACT: Legacy Platypus interfaces our $VERSION = '2.10'; # 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.10 =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.10/lib/FFI/Platypus/Memory.pm��������������������������������������������������������000644 �000000 �000000 �00000014545 14730610136 020450� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Record.pm��������������������������������������������������������000644 �000000 �000000 �00000027350 14730610136 020414� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Record/����������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020047� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Platypus/Record/Meta.pm���������������������������������������������������000644 �000000 �000000 �00000005304 14730610136 021275� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Record/TieArray.pm�����������������������������������������������000644 �000000 �000000 �00000005347 14730610136 022136� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/ShareConfig.pm���������������������������������������������������000644 �000000 �000000 �00000003641 14730610136 021363� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package FFI::Platypus::ShareConfig; use strict; use warnings; use 5.008004; use File::Spec; our $VERSION = '2.10'; # 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.10 =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.10/lib/FFI/Platypus/Type.pm����������������������������������������������������������000644 �000000 �000000 �00000125423 14730610136 020117� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Type/������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017552� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Platypus/Type/PointerSizeBuffer.pm����������������������������������������000644 �000000 �000000 �00000005623 14730610136 023523� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Type/StringArray.pm����������������������������������������������000644 �000000 �000000 �00000014415 14730610136 022362� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Type/StringPointer.pm��������������������������������������������000644 �000000 �000000 �00000006513 14730610136 022724� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/Type/WideString.pm�����������������������������������������������000644 �000000 �000000 �00000037174 14730610136 022203� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/TypeParser.pm����������������������������������������������������000644 �000000 �000000 �00000006457 14730610136 021301� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/TypeParser/������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 020727� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Platypus/TypeParser/Version0.pm�������������������������������������������000644 �000000 �000000 �00000015203 14730610136 022773� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/TypeParser/Version1.pm�������������������������������������������000644 �000000 �000000 �00000030313 14730610136 022773� 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.10'; # 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.10 =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.10/lib/FFI/Platypus/TypeParser/Version2.pm�������������������������������������������000644 �000000 �000000 �00000003677 14730610136 023011� 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.10'; # VERSION 1; __END__ =pod =encoding UTF-8 =head1 NAME FFI::Platypus::TypeParser::Version2 - FFI Type Parser Version Two =head1 VERSION version 2.10 =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.10/lib/FFI/Probe.pm������������������������������������������������������������������000644 �000000 �000000 �00000031014 14730610136 016414� 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.10'; # 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.10 =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.10/lib/FFI/Probe/��������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 016057� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Probe/Runner.pm�����������������������������������������������������������000644 �000000 �000000 �00000006366 14730610136 017701� 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.10'; # 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.10 =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.10/lib/FFI/Probe/Runner/�������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 017330� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/lib/FFI/Probe/Runner/Builder.pm���������������������������������������������������000644 �000000 �000000 �00000022457 14730610136 021266� 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.10'; # 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.10 =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.10/lib/FFI/Probe/Runner/Result.pm����������������������������������������������������000644 �000000 �000000 �00000003351 14730610136 021146� 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.10'; # 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.10 =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.10/lib/FFI/Temp.pm�������������������������������������������������������������������000644 �000000 �000000 �00000005212 14730610136 016253� 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.10'; # 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.10 =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.10/lib/FFI/typemap�������������������������������������������������������������������000644 �000000 �000000 �00000003021 14730610136 016406� 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.10/maint/����������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014746� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/maint/cip-before-install����������������������������������������������������������000755 �000000 �000000 �00000000410 14730610136 020346� 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.10/maint/cip-test-examples�����������������������������������������������������������000755 �000000 �000000 �00000000564 14730610136 020245� 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.10/maint/generate-abw����������������������������������������������������������������000755 �000000 �000000 �00000000477 14730610136 017245� 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.10/maint/generate-readme�������������������������������������������������������������000755 �000000 �000000 �00000000757 14730610136 017732� 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 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.10/maint/generate-record-accessor����������������������������������������������������000755 �000000 �000000 �00000001271 14730610136 021543� 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.10/maint/run-after_build.pl����������������������������������������������������������000644 �000000 �000000 �00000000477 14730610136 020375� 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.10/maint/run-before_build.pl���������������������������������������������������������000644 �000000 �000000 �00000005444 14730610136 020535� 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.10/maint/tt/�������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015375� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/maint/tt/accessor.tt��������������������������������������������������������������000644 �000000 �000000 �00000004532 14730610136 017554� 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.10/maint/tt/accessor_wrapper.tt������������������������������������������������������000644 �000000 �000000 �00000000476 14730610136 021317� 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.10/perlcriticrc����������������������������������������������������������������������000644 �000000 �000000 �00000003670 14730610136 016254� 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.10/t/��������������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014101� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/t/00_diag.t�����������������������������������������������������������������������000644 �000000 �000000 �00000010414 14730610136 015471� 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.10/t/ffi/����������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014645� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/t/ffi/align.c���������������������������������������������������������������������000644 �000000 �000000 �00000002565 14730610136 016113� 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.10/t/ffi/align_array.c���������������������������������������������������������������000644 �000000 �000000 �00000002755 14730610136 017312� 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.10/t/ffi/align_fixed.c���������������������������������������������������������������000644 �000000 �000000 �00000000262 14730610136 017262� 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.10/t/ffi/align_string.c��������������������������������������������������������������000644 �000000 �000000 �00000000610 14730610136 017466� 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.10/t/ffi/basic.c���������������������������������������������������������������������000644 �000000 �000000 �00000000410 14730610136 016065� 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.10/t/ffi/closure.c�������������������������������������������������������������������000644 �000000 �000000 �00000002777 14730610136 016502� 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.10/t/ffi/color.c���������������������������������������������������������������������000644 �000000 �000000 �00000001471 14730610136 016132� 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.10/t/ffi/complex_double.c������������������������������������������������������������000644 �000000 �000000 �00000002603 14730610136 020013� 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.10/t/ffi/complex_float.c�������������������������������������������������������������000644 �000000 �000000 �00000002307 14730610136 017647� 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.10/t/ffi/double.c��������������������������������������������������������������������000644 �000000 �000000 �00000002156 14730610136 016267� 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.10/t/ffi/float.c���������������������������������������������������������������������000644 �000000 �000000 �00000001676 14730610136 016130� 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.10/t/ffi/gh117.c���������������������������������������������������������������������000644 �000000 �000000 �00000000111 14730610136 015631� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include "libtest.h" EXTERN uint64_t gh117() { return 0xffffffffff; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/t/ffi/gh174.c���������������������������������������������������������������������000644 �000000 �000000 �00000000166 14730610136 015646� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include "libtest.h" EXTERN void gh174_func1 (void (*callback)()) { printf( "Inside func..\n"); (*callback)(); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/t/ffi/longdouble.c����������������������������������������������������������������000644 �000000 �000000 �00000001571 14730610136 017147� 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.10/t/ffi/memcmp4.c�������������������������������������������������������������������000644 �000000 �000000 �00000000233 14730610136 016351� 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.10/t/ffi/meta.c����������������������������������������������������������������������000644 �000000 �000000 �00000001247 14730610136 015743� 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.10/t/ffi/pointer.c�������������������������������������������������������������������000644 �000000 �000000 �00000003451 14730610136 016474� 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.10/t/ffi/record.c��������������������������������������������������������������������000644 �000000 �000000 �00000002472 14730610136 016274� 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.10/t/ffi/sint16.c��������������������������������������������������������������������000644 �000000 �000000 �00000002144 14730610136 016136� 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.10/t/ffi/sint32.c��������������������������������������������������������������������000644 �000000 �000000 �00000002144 14730610136 016134� 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.10/t/ffi/sint64.c��������������������������������������������������������������������000644 �000000 �000000 �00000002144 14730610136 016141� 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.10/t/ffi/sint8.c���������������������������������������������������������������������000644 �000000 �000000 �00000001666 14730610136 016067� 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.10/t/ffi/string.c��������������������������������������������������������������������000644 �000000 �000000 �00000003123 14730610136 016316� 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.10/t/ffi/string_array.c��������������������������������������������������������������000644 �000000 �000000 �00000001554 14730610136 017522� 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.10/t/ffi/uint16.c��������������������������������������������������������������������000644 �000000 �000000 �00000002170 14730610136 016137� 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.10/t/ffi/uint32.c��������������������������������������������������������������������000644 �000000 �000000 �00000002170 14730610136 016135� 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.10/t/ffi/uint64.c��������������������������������������������������������������������000644 �000000 �000000 �00000002170 14730610136 016142� 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.10/t/ffi/uint8.c���������������������������������������������������������������������000644 �000000 �000000 �00000001712 14730610136 016061� 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.10/t/ffi/variadic.c������������������������������������������������������������������000644 �000000 �000000 �00000002125 14730610136 016573� 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.10/t/ffi_build.t���������������������������������������������������������������������000644 �000000 �000000 �00000012015 14730610136 016210� 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.10/t/ffi_build_file_base.t�����������������������������������������������������������000644 �000000 �000000 �00000004703 14730610136 020206� 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.10/t/ffi_build_file_c.t��������������������������������������������������������������000644 �000000 �000000 �00000002156 14730610136 017516� 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.10/t/ffi_build_file_cxx.t������������������������������������������������������������000644 �000000 �000000 �00000002471 14730610136 020076� 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.10/t/ffi_build_file_library.t��������������������������������������������������������000644 �000000 �000000 �00000000537 14730610136 020741� 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.10/t/ffi_build_file_object.t���������������������������������������������������������000644 �000000 �000000 �00000000507 14730610136 020540� 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.10/t/ffi_build_mm.t������������������������������������������������������������������000644 �000000 �000000 �00000006762 14730610136 016715� 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.10/t/ffi_build_platform.t������������������������������������������������������������000644 �000000 �000000 �00000000757 14730610136 020126� 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.10/t/ffi_build_plugin.t��������������������������������������������������������������000644 �000000 �000000 �00000002051 14730610136 017565� 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.10/t/ffi_build_plugindata.t����������������������������������������������������������000644 �000000 �000000 �00000001350 14730610136 020420� 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.10/t/ffi_platypus.t������������������������������������������������������������������000644 �000000 �000000 �00000066633 14730610136 017011� 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.10/t/ffi_platypus_api.t��������������������������������������������������������������000644 �000000 �000000 �00000000666 14730610136 017634� 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.10/t/ffi_platypus_buffer.t�����������������������������������������������������������000644 �000000 �000000 �00000013310 14730610136 020322� 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 ); 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]); }; }; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/t/ffi_platypus_bundle.t�����������������������������������������������������������000644 �000000 �000000 �00000013467 14730610136 020337� 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.10/t/ffi_platypus_closure.t����������������������������������������������������������000644 �000000 �000000 �00000006512 14730610136 020533� 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 '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.10/t/ffi_platypus_constant.t���������������������������������������������������������000644 �000000 �000000 �00000003040 14730610136 020701� 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.10/t/ffi_platypus_dl.t���������������������������������������������������������������000644 �000000 �000000 �00000002372 14730610136 017456� 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.10/t/ffi_platypus_function.t���������������������������������������������������������000644 �000000 �000000 �00000013352 14730610136 020704� 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.10/t/ffi_platypus_function_wrapper.t�������������������������������������������������000644 �000000 �000000 �00000003630 14730610136 022442� 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.10/t/ffi_platypus_internal.t���������������������������������������������������������000644 �000000 �000000 �00000000710 14730610136 020665� 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.10/t/ffi_platypus_lang.t�������������������������������������������������������������000644 �000000 �000000 �00000004003 14730610136 017771� 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.10/t/ffi_platypus_lang_asm.t���������������������������������������������������������000644 �000000 �000000 �00000001114 14730610136 020631� 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.10/t/ffi_platypus_lang_c.t�����������������������������������������������������������000644 �000000 �000000 �00000001052 14730610136 020274� 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.10/t/ffi_platypus_lang_win32.t�������������������������������������������������������000644 �000000 �000000 �00000003200 14730610136 021011� 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.10/t/ffi_platypus_legacy.t�����������������������������������������������������������000644 �000000 �000000 �00000000367 14730610136 020325� 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.10/t/ffi_platypus_memory.t�����������������������������������������������������������000644 �000000 �000000 �00000005142 14730610136 020365� 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.10/t/ffi_platypus_record.t�����������������������������������������������������������000644 �000000 �000000 �00000025576 14730610136 020350� 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.10/t/ffi_platypus_record_meta.t������������������������������������������������������000644 �000000 �000000 �00000002207 14730610136 021340� 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.10/t/ffi_platypus_record_tiearray.t��������������������������������������������������000644 �000000 �000000 �00000001202 14730610136 022224� 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.10/t/ffi_platypus_shareconfig.t������������������������������������������������������000644 �000000 �000000 �00000000565 14730610136 021351� 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.10/t/ffi_platypus_type.t�������������������������������������������������������������000644 �000000 �000000 �00000014546 14730610136 020046� 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.10/t/ffi_platypus_type_pointersizebuffer.t�������������������������������������������000644 �000000 �000000 �00000001740 14730610136 023663� 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.10/t/ffi_platypus_type_stringarray.t�������������������������������������������������000644 �000000 �000000 �00000005477 14730610136 022476� 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.10/t/ffi_platypus_type_stringpointer.t�����������������������������������������������000644 �000000 �000000 �00000002634 14730610136 023030� 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.10/t/ffi_platypus_type_widestring.t��������������������������������������������������000644 �000000 �000000 �00000010175 14730610136 022277� 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.10/t/ffi_platypus_typeparser.t�������������������������������������������������������000644 �000000 �000000 �00000001040 14730610136 021244� 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.10/t/ffi_platypus_typeparser_version0.t����������������������������������������������000644 �000000 �000000 �00000022774 14730610136 023112� 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.10/t/ffi_platypus_typeparser_version1.t����������������������������������������������000644 �000000 �000000 �00000022516 14730610136 023105� 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.10/t/ffi_platypus_typeparser_version2.t����������������������������������������������000644 �000000 �000000 �00000023062 14730610136 023103� 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.10/t/ffi_probe.t���������������������������������������������������������������������000644 �000000 �000000 �00000007123 14730610136 016224� 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.10/t/ffi_probe_runner.t��������������������������������������������������������������000644 �000000 �000000 �00000005246 14730610136 017621� 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.10/t/ffi_probe_runner_builder.t������������������������������������������������������000644 �000000 �000000 �00000001670 14730610136 021324� 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.10/t/ffi_probe_runner_result.t�������������������������������������������������������000644 �000000 �000000 �00000001136 14730610136 021211� 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.10/t/ffi_temp.t����������������������������������������������������������������������000644 �000000 �000000 �00000000302 14730610136 016052� 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.10/t/forks.t�������������������������������������������������������������������������000644 �000000 �000000 �00000001220 14730610136 015405� 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.10/t/gh117.t�������������������������������������������������������������������������000644 �000000 �000000 �00000000533 14730610136 015116� 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.10/t/gh129.t�������������������������������������������������������������������������000644 �000000 �000000 �00000003637 14730610136 015131� 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.10/t/gh323.t�������������������������������������������������������������������������000644 �000000 �000000 �00000001756 14730610136 015125� 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.10/t/lib/����������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014647� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/t/lib/Test/�����������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015566� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/t/lib/Test/Cleanup.pm�������������������������������������������������������������000644 �000000 �000000 �00000000546 14730610136 017520� 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.10/t/lib/Test/FauxAttach.pm����������������������������������������������������������000644 �000000 �000000 �00000002210 14730610136 020147� 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.10/t/lib/Test/Platypus.pm������������������������������������������������������������000644 �000000 �000000 �00000000654 14730610136 017752� 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.10/t/memory.t������������������������������������������������������������������������000644 �000000 �000000 �00000003116 14730610136 015577� 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.10/t/threads.t�����������������������������������������������������������������������000644 �000000 �000000 �00000001017 14730610136 015717� 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.10/t/type_complex_double.t�����������������������������������������������������������000644 �000000 �000000 �00000014113 14730610136 020330� 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.10/t/type_complex_float.t������������������������������������������������������������000644 �000000 �000000 �00000013607 14730610136 020172� 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.10/t/type_custom.t�������������������������������������������������������������������000644 �000000 �000000 �00000006717 14730610136 016654� 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.10/t/type_double.t�������������������������������������������������������������������000644 �000000 �000000 �00000007757 14730610136 016621� 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.10/t/type_float.t��������������������������������������������������������������������000644 �000000 �000000 �00000007460 14730610136 016443� 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.10/t/type_longdouble.t���������������������������������������������������������������000644 �000000 �000000 �00000013247 14730610136 017470� 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.10/t/type_longdouble__array.t��������������������������������������������������������000644 �000000 �000000 �00000001517 14730610136 021022� 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.10/t/type_longdouble__hide.t���������������������������������������������������������000644 �000000 �000000 �00000005372 14730610136 020620� 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.10/t/type_longdouble__ptr.t����������������������������������������������������������000644 �000000 �000000 �00000001516 14730610136 020510� 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.10/t/type_opaque.t�������������������������������������������������������������������000644 �000000 �000000 �00000015210 14730610136 016620� 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.10/t/type_record.t�������������������������������������������������������������������000644 �000000 �000000 �00000014570 14730610136 016614� 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.10/t/type_record_value.t�������������������������������������������������������������000644 �000000 �000000 �00000015560 14730610136 020010� 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.10/t/type_sint16.t�������������������������������������������������������������������000644 �000000 �000000 �00000010722 14730610136 016455� 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.10/t/type_sint32.t�������������������������������������������������������������������000644 �000000 �000000 �00000010722 14730610136 016453� 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.10/t/type_sint64.t�������������������������������������������������������������������000644 �000000 �000000 �00000010722 14730610136 016460� 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.10/t/type_sint8.t��������������������������������������������������������������������000644 �000000 �000000 �00000010422 14730610136 016373� 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.10/t/type_string.t�������������������������������������������������������������������000644 �000000 �000000 �00000015205 14730610136 016640� 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.10/t/type_uint16.t�������������������������������������������������������������������000644 �000000 �000000 �00000011334 14730610136 016457� 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.10/t/type_uint32.t�������������������������������������������������������������������000644 �000000 �000000 �00000011334 14730610136 016455� 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.10/t/type_uint64.t�������������������������������������������������������������������000644 �000000 �000000 �00000011334 14730610136 016462� 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.10/t/type_uint8.t��������������������������������������������������������������������000644 �000000 �000000 �00000011030 14730610136 016371� 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.10/xs/�������������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014270� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/xs/ABI.xs�������������������������������������������������������������������������000644 �000000 �000000 �00000001174 14730610136 015242� 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.10/xs/API.xs�������������������������������������������������������������������������000644 �000000 �000000 �00000014266 14730610136 015266� 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.10/xs/Buffer.xs����������������������������������������������������������������������000644 �000000 �000000 �00000004137 14730610136 016062� 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)); 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.10/xs/Closure.xs���������������������������������������������������������������������000644 �000000 �000000 �00000001510 14730610136 016255� 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.10/xs/ClosureData.xs�����������������������������������������������������������������000644 �000000 �000000 �00000000317 14730610136 017053� 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.10/xs/DL.xs��������������������������������������������������������������������������000644 �000000 �000000 �00000002762 14730610136 015152� 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.10/xs/Function.xs��������������������������������������������������������������������000644 �000000 �000000 �00000021037 14730610136 016434� 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.10/xs/Internal.xs��������������������������������������������������������������������000644 �000000 �000000 �00000007276 14730610136 016434� 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.10/xs/Record.xs����������������������������������������������������������������������000644 �000000 �000000 �00000013067 14730610136 016071� 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.10/xs/Type.xs������������������������������������������������������������������������000644 �000000 �000000 �00000022047 14730610136 015572� 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.10/xs/TypeParser.xs������������������������������������������������������������������000644 �000000 �000000 �00000024546 14730610136 016755� 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.10/xs/cast.c�������������������������������������������������������������������������000644 �000000 �000000 �00000000420 14730610136 015362� 0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include "ffi_platypus.h" #if SIZEOF_VOIDP == 4 uint64_t cast0(void) { return 0LL; } #else void * cast0(void) { return NULL; } #endif #if SIZEOF_VOIDP == 4 uint64_t cast1(uint64_t value) { return value; } #else void * cast1(void *value) { return value; } #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/xs/closure.c����������������������������������������������������������������������000644 �000000 �000000 �00000017003 14730610136 016111� 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.10/xs/complex.c����������������������������������������������������������������������000644 �000000 �000000 �00000006611 14730610136 016107� 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.10/xs/custom.c�����������������������������������������������������������������������000644 �000000 �000000 �00000001517 14730610136 015752� 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.10/xs/meta.c�������������������������������������������������������������������������000644 �000000 �000000 �00000022010 14730610136 015355� 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.10/xs/names.c������������������������������������������������������������������������000644 �000000 �000000 �00000003546 14730610136 015547� 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.10/xs/perl_math_int64.c��������������������������������������������������������������000644 �000000 �000000 �00000011032 14730610136 017430� 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.10/xs/record_opaque.c����������������������������������������������������������������000644 �000000 �000000 �00000005346 14730610136 017274� 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.10/xs/record_simple.c����������������������������������������������������������������000644 �000000 �000000 �00000054534 14730610136 017276� 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.10/xs/record_string.c����������������������������������������������������������������000644 �000000 �000000 �00000005454 14730610136 017310� 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.10/xs/windl.c������������������������������������������������������������������������000644 �000000 �000000 �00000007064 14730610136 015560� 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.10/xt/�������������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 014271� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/xt/author/������������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015573� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/xt/author/critic.t����������������������������������������������������������������000644 �000000 �000000 �00000000516 14730610136 017237� 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.10/xt/author/eol.t�������������������������������������������������������������������000644 �000000 �000000 �00000000510 14730610136 016533� 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.10/xt/author/example.t���������������������������������������������������������������000644 �000000 �000000 �00000006310 14730610136 017413� 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) { 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.10/xt/author/no_tabs.t���������������������������������������������������������������000644 �000000 �000000 �00000000522 14730610136 017404� 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.10/xt/author/pod.t�������������������������������������������������������������������000644 �000000 �000000 �00000000472 14730610136 016545� 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.10/xt/author/pod_coverage.t����������������������������������������������������������000644 �000000 �000000 �00000004001 14730610136 020410� 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.10/xt/author/pod_link.t��������������������������������������������������������������000644 �000000 �000000 �00000002256 14730610136 017564� 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.10/xt/author/pod_spelling_system.t���������������������������������������������������000644 �000000 �000000 �00000002367 14730610136 022053� 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.10/xt/author/version.t���������������������������������������������������������������000644 �000000 �000000 �00000001473 14730610136 017452� 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.10/xt/release/�����������������������������������������������������������������������000755 �000000 �000000 �00000000000 14730610136 015711� 5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������FFI-Platypus-2.10/xt/release/changes.t��������������������������������������������������������������000644 �000000 �000000 �00000001113 14730610136 017502� 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.10/xt/release/fixme.t����������������������������������������������������������������000644 �000000 �000000 �00000000616 14730610136 017211� 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, ); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������