Inline-C-0.81000755001750001750 013465524127 12122 5ustar00tinatina000000000000README100644001750001750 5107413465524127 13112 0ustar00tinatina000000000000Inline-C-0.81NAME Inline::C - C Language Support for Inline VERSION This document describes Inline::C version 0.81. DESCRIPTION Inline::C is a module that allows you to write Perl subroutines in C. Since version 0.30 the Inline module supports multiple programming languages and each language has its own support module. This document describes how to use Inline with the C programming language. It also goes a bit into Perl C internals. If you want to start working with programming examples right away, check out Inline::C::Cookbook. For more information on Inline in general, see Inline. USAGE You never actually use Inline::C directly. It is just a support module for using Inline.pm with C. So the usage is always: use Inline C => ...; or bind Inline C => ...; FUNCTION DEFINITIONS The Inline grammar for C recognizes certain function definitions (or signatures) in your C code. If a signature is recognized by Inline, then it will be available in Perl-space. That is, Inline will generate the "glue" necessary to call that function as if it were a Perl subroutine. If the signature is not recognized, Inline will simply ignore it, with no complaints. It will not be available from Perl-space, although it will be available from C-space. Inline looks for ANSI/prototype style function definitions. They must be of the form: return-type function-name ( type-name-pairs ) { ... } The most common types are: int, long, double, char*, and SV*. But you can use any type for which Inline can find a typemap. Inline uses the typemap file distributed with Perl as the default. You can specify more typemaps with the typemaps configuration option. A return type of void may also be used. The following are examples of valid function definitions. int Foo(double num, char* str) { void Foo(double num, char* str) { void Foo(SV*, ...) { long Foo(int i, int j, ...) { SV* Foo(void) { # 'void' arg invalid with the ParseRecDescent parser. # Works only with the ParseRegExp parser. # See the section on `using` (below). SV* Foo() { # Alternative to specifying 'void' arg. Is valid with # both the ParseRecDescent and ParseRegExp parsers. The following definitions would not be recognized: Foo(int i) { # no return type int Foo(float f) { # no (default) typemap for float int Foo(num, str) double num; char* str; { Notice that Inline only looks for function definitions, not function prototypes. Definitions are the syntax directly preceding a function body. Also Inline does not scan external files, like headers. Only the code passed to Inline is used to create bindings; although other libraries can linked in, and called from C-space. C CONFIGURATION OPTIONS For information on how to specify Inline configuration options, see Inline. This section describes each of the configuration options available for C. Most of the options correspond either to MakeMaker or XS options of the same name. See ExtUtils::MakeMaker and perlxs. auto_include Specifies extra statements to automatically included. They will be added onto the defaults. A newline char will be automatically added. use Inline C => config => auto_include => '#include "yourheader.h"'; autowrap If you enable => autowrap, Inline::C will parse function declarations (prototype statements) in your C code. For each declaration it can bind to, it will create a dummy wrapper that will call the real function which may be in an external library. This is a nice convenience for functions that would otherwise just require an empty wrapper function. This is similar to the base functionality you get from h2xs. It can be very useful for binding to external libraries. boot Specifies C code to be executed in the XS BOOT section. Corresponds to the XS parameter. cc Specify which compiler to use. ccflags Specify compiler flags - same as ExtUtils::MakeMaker's CCFLAGS option. Whatever gets specified here replaces the default $Config{ccflags}. Often, you'll want to add an extra flag or two without clobbering the default flags in which case you could instead use ccflagsex (see below) or, if Config.pm has already been loaded: use Inline C => Config => ccflags => $Config{ccflags} . " -DXTRA -DTOO"; ccflagsex Extend compiler flags. Sets CCFLAGS to $Config{ccflags} followed by a space, followed by the specified value: use Inline C => config => ccflagsex => "-DXTRA -DTOO"; cppflags Specify preprocessor flags. Passed to cpp C preprocessor by Preprocess() in Inline::Filters. use Inline C => <<'END', CPPFLAGS => ' -DPREPROCESSOR_DEFINE', FILTERS => 'Preprocess'; use Inline C => <<'END', CPPFLAGS => ' -DPREPROCESSOR_DEFINE=4321', FILTERS => 'Preprocess'; filters Allows you to specify a list of source code filters. If more than one is requested, be sure to group them with an array ref. The filters can either be subroutine references or names of filters provided by the supplementary Inline::Filters module. Your source code will be filtered just before it is parsed by Inline. The MD5 fingerprint is generated before filtering. Source code filters can be used to do things like stripping out POD documentation, pre-expanding #include statements or whatever else you please. For example: use Inline C => DATA => filters => [Strip_POD => \&MyFilter => Preprocess ]; Filters are invoked in the order specified. See Inline::Filters for more information. If a filter is an array reference, it is assumed to be a usage of a filter plug- in named by the first element of that array reference. The rest of the elements of the array reference are used as arguments to the filter. For example, consider a filters parameter like this: use Inline C => DATA => filters => [ [ Ragel => '-G2' ] ]; In order for Inline::C to process this filter, it will attempt to require the module Inline::Filters::Ragel and will then call the filter function in that package with the argument '-G2'. This function will return the actual filtering function. inc Specifies an include path to use. Corresponds to the MakeMaker parameter. Expects a fully qualified path. use Inline C => config => inc => '-I/inc/path'; ld Specify which linker to use. lddlflags Specify which linker flags to use. NOTE: These flags will completely override the existing flags, instead of just adding to them. So if you need to use those too, you must respecify them here. libs Specifies external libraries that should be linked into your code. Corresponds to the MakeMaker parameter. Provide a fully qualified path with the -L switch if the library is in a location where it won't be found automatically. use Inline C => config => libs => '-lyourlib'; or use Inline C => config => libs => '-L/your/path -lyourlib'; make Specify the name of the 'make' utility to use. myextlib Specifies a user compiled object that should be linked in. Corresponds to the MakeMaker parameter. Expects a fully qualified path. use Inline C => config => myextlib => '/your/path/yourmodule.so'; optimize This controls the MakeMaker OPTIMIZE setting. By setting this value to '-g', you can turn on debugging support for your Inline extensions. This will allow you to be able to set breakpoints in your C code using a debugger like gdb. prefix Specifies a prefix that will be automatically stripped from C functions when they are bound to Perl. Useful for creating wrappers for shared library API-s, and binding to the original names in Perl. Also useful when names conflict with Perl internals. Corresponds to the XS parameter. use Inline C => config => prefix => 'ZLIB_'; pre_head Specifies code that will precede the inclusion of all files specified in auto_include (ie EXTERN.h, perl.h, XSUB.h, INLINE.h and anything else that might have been added to auto_include by the user). If the specified value identifies a file, the contents of that file will be inserted, otherwise the specified value is inserted. use Inline C => config => pre_head => $code_or_filename; prototype Corresponds to the XS keyword 'PROTOTYPE'. See the perlxs documentation for both 'PROTOTYPES' and 'PROTOTYPE'. As an example, the following will set the PROTOTYPE of the 'foo' function to '$', and disable prototyping for the 'bar' function. use Inline C => config => prototype => {foo => '$', bar => 'DISABLE'} prototypes Corresponds to the XS keyword 'PROTOTYPES'. Can take only values of 'ENABLE' or 'DISABLE'. (Contrary to XS, default value is 'DISABLE'). See the perlxs documentation for both 'PROTOTYPES' and 'PROTOTYPE'. use Inline C => config => prototypes => 'ENABLE'; typemaps Specifies extra typemap files to use. These types will modify the behaviour of the C parsing. Corresponds to the MakeMaker parameter. Specify either a fully qualified path or a path relative to the cwd (ie relative to what the cwd is at the time the script is loaded). use Inline C => config => typemaps => '/your/path/typemap'; using Specifies which parser to use. The default is Inline::C::Parser::RecDescent, which uses the Parse::RecDescent module. The other options are ::Parser::Pegex and ::Parser::RegExp, which uses the Inline::C::Parser::Pegex and Inline::C::Parser::RegExp modules that ship with Inline::C. use Inline C => config => using => '::Parser::Pegex'; Note that the following old options are deprecated, but still work at this time: * ParseRecDescent * ParseRegExp * ParsePegex C-PERL BINDINGS This section describes how the Perl variables get mapped to C variables and back again. First, you need to know how Perl passes arguments back and forth to subroutines. Basically it uses a stack (also known as the Stack). When a sub is called, all of the parenthesized arguments get expanded into a list of scalars and pushed onto the Stack. The subroutine then pops all of its parameters off of the Stack. When the sub is done, it pushes all of its return values back onto the Stack. The Stack is an array of scalars known internally as SV's. The Stack is actually an array of pointers to SV or SV*; therefore every element of the Stack is natively a SV*. For FMTYEWTK about this, read perldoc perlguts. So back to variable mapping. XS uses a thing known as "typemaps" to turn each SV* into a C type and back again. This is done through various XS macro calls, casts and the Perl API. See perldoc perlapi. XS allows you to define your own typemaps as well for fancier non-standard types such as typedef- ed structs. Inline uses the default Perl typemap file for its default types. This file is called /usr/local/lib/perl5/5.6.1/ExtUtils/typemap, or something similar, depending on your Perl installation. It has definitions for over 40 types, which are automatically used by Inline. (You should probably browse this file at least once, just to get an idea of the possibilities.) Inline parses your code for these types and generates the XS code to map them. The most commonly used types are: * int * long * double * char* * void * SV* If you need to deal with a type that is not in the defaults, just use the generic SV* type in the function definition. Then inside your code, do the mapping yourself. Alternatively, you can create your own typemap files and specify them using the typemaps configuration option. A return type of void has a special meaning to Inline. It means that you plan to push the values back onto the Stack yourself. This is what you need to do to return a list of values. If you really don't want to return anything (the traditional meaning of void) then simply don't push anything back. If ellipsis or ... is used at the end of an argument list, it means that any number of SV*s may follow. Again you will need to pop the values off of the Stack yourself. See "EXAMPLES" below. THE INLINE STACK MACROS When you write Inline C, the following lines are automatically prepended to your code (by default): #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "INLINE.h" The file INLINE.h defines a set of macros that are useful for handling the Perl Stack from your C functions. Inline_Stack_Vars You'll need to use this one, if you want to use the others. It sets up a few local variables: sp, items, ax and mark, for use by the other macros. It's not important to know what they do, but I mention them to avoid possible name conflicts. NOTE: Since this macro declares variables, you'll need to put it with your other variable declarations at the top of your function. It must come before any executable statements and before any other Inline_Stack macros. Inline_Stack_Items Returns the number of arguments passed in on the Stack. Inline_Stack_Item(i) Refers to a particular SV* in the Stack, where i is an index number starting from zero. Can be used to get or set the value. Inline_Stack_Reset Use this before pushing anything back onto the Stack. It resets the internal Stack pointer to the beginning of the Stack. Inline_Stack_Push(sv) Push a return value back onto the Stack. The value must be of type SV*. Inline_Stack_Done After you have pushed all of your return values, you must call this macro. Inline_Stack_Return(n) Return n items on the Stack. Inline_Stack_Void A special macro to indicate that you really don't want to return anything. Same as: Inline_Stack_Return(0); Please note that this macro actually returns from your function. Each of these macros is available in 3 different styles to suit your coding tastes. The following macros are equivalent. Inline_Stack_Vars inline_stack_vars INLINE_STACK_VARS All of this functionality is available through XS macro calls as well. So why duplicate the functionality? There are a few reasons why I decided to offer this set of macros. First, as a convenient way to access the Stack. Second, for consistent, self documenting, non-cryptic coding. Third, for future compatibility. It occurred to me that if a lot of people started using XS macros for their C code, the interface might break under Perl6. By using this set, hopefully I will be able to insure future compatibility of argument handling. Of course, if you use the rest of the Perl API, your code will most likely break under Perl6. So this is not a 100% guarantee. But since argument handling is the most common interface you're likely to use, it seemed like a wise thing to do. WRITING C SUBROUTINES The definitions of your C functions will fall into one of the following four categories. For each category there are special considerations. int Foo(int arg1, char* arg2, SV* arg3) { This is the simplest case. You have a non void return type and a fixed length argument list. You don't need to worry about much. All the conversions will happen automatically. void Foo(int arg1, char* arg2, SV* arg3) { In this category you have a void return type. This means that either you want to return nothing, or that you want to return a list. In the latter case you'll need to push values onto the Stack yourself. There are a few Inline macros that make this easy. Code something like this: int i, max; SV* my_sv[10]; Inline_Stack_Vars; Inline_Stack_Reset; for (i = 0; i < max; i++) Inline_Stack_Push(my_sv[i]); Inline_Stack_Done; After resetting the Stack pointer, this code pushes a series of return values. At the end it uses Inline_Stack_Done to mark the end of the return stack. If you really want to return nothing, then don't use the Inline_Stack_ macros. If you must use them, then set use Inline_Stack_Void at the end of your function. char* Foo(SV* arg1, ...) { In this category you have an unfixed number of arguments. This means that you'll have to pop values off the Stack yourself. Do it like this: int i; Inline_Stack_Vars; for (i = 0; i < Inline_Stack_Items; i++) handle_sv(Inline_Stack_Item(i)); The return type of Inline_Stack_Item(i) is SV*. void* Foo(SV* arg1, ...) { In this category you have both a void return type and an unfixed number of arguments. Just combine the techniques from Categories 3 and 4. EXAMPLES Here are a few examples. Each one is a complete program that you can try running yourself. For many more examples see Inline::C::Cookbook. Example #1 - Greetings This example will take one string argument (a name) and print a greeting. The function is called with a string and with a number. In the second case the number is forced to a string. Notice that you do not need to #include . The perl.h header file which gets included by default, automatically loads the standard C header files for you. use Inline 'C'; greet('Ingy'); greet(42); __END__ __C__ void greet(char* name) { printf("Hello %s!\n", name); } Example #2 - and Salutations This is similar to the last example except that the name is passed in as a SV* (pointer to Scalar Value) rather than a string (char*). That means we need to convert the SV to a string ourselves. This is accomplished using the SvPVX function which is part of the Perl internal API. See perldoc perlapi for more info. One problem is that SvPVX doesn't automatically convert strings to numbers, so we get a little surprise when we try to greet 42. The program segfaults, a common occurrence when delving into the guts of Perl. use Inline 'C'; greet('Ingy'); greet(42); __END__ __C__ void greet(SV* sv_name) { printf("Hello %s!\n", SvPVX(sv_name)); } Example #3 - Fixing the problem We can fix the problem in Example #2 by using the SvPV function instead. This function will stringify the SV if it does not contain a string. SvPV returns the length of the string as it's second parameter. Since we don't care about the length, we can just put PL_na there, which is a special variable designed for that purpose. use Inline 'C'; greet('Ingy'); greet(42); __END__ __C__ void greet(SV* sv_name) { printf("Hello %s!\n", SvPV(sv_name, PL_na)); } SEE ALSO For general information about Inline see Inline. For sample programs using Inline with C see Inline::C::Cookbook. For information on supported languages and platforms see Inline-Support. For information on writing your own Inline Language Support Module, see Inline-API. Inline's mailing list is inline@perl.org To subscribe, send email to inline-subscribe@perl.org BUGS AND DEFICIENCIES If you use C function names that happen to be used internally by Perl, you will get a load error at run time. There is currently no functionality to prevent this or to warn you. For now, a list of Perl's internal symbols is packaged in the Inline module distribution under the filename 'symbols.perl'. Avoid using these in your code. AUTHORS Ingy döt Net Sisyphus COPYRIGHT AND LICENSE Copyright 2000-2019. Ingy döt Net. Copyright 2008, 2010-2014. Sisyphus. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://www.perl.com/perl/misc/Artistic.html Changes100644001750001750 2152213465524127 13520 0ustar00tinatina000000000000Inline-C-0.810.81 Sat 11 May 2019 12:46:41 PM CEST - test - Adjust excpected number of lines in log to Inline-0.82_001 (PR#89 @ppisar++) - Fix pod document link (PR#68 PR#90 @manwar++) - Fix docs to work with strict mode (use Inline 'C'; instead of use Inline C;) (PR#70 @akarelas-pt++) - Add test, and Cookbook example, of array-ref arg (PR#39 @mohawk2++) 0.80 Thu 18 Apr 2019 10:42:30 AM CEST - Apply PR#71 (ETJ++) Support perl 5.8.1 again - Apply PR#74 and PR#76 (WBRASWELL++) Fix Include Dir Behavior, replace -I with -iquote or -I- respectively - Apply PR#77 (WBRASWELL++) Fix Include Dir Behavior, Non-GCC Compilers - More fixes for include dir behaviour (@sisyphus++) 0.78 Tue 30 May 22:56:30 CEST 2017 - Apply PR#66 (TINITA++) Remove system calls `rm` and `diff` - Apply PR#65 (TINITA++) Use FindBin in tests (Dot gets removed from @INC in perl 5.26) 0.77 Fri 12 May 17:57:36 CEST 2017 - Apply PR#63 (@mohawk2++) 0.76 Wed Jul 1 08:09:50 PDT 2015 - Support for cppflags 0.75 Fri Mar 13 18:41:18 PDT 2015 - Doc fixes - links from Inline::C to Cookbook 0.74 Tue Feb 17 16:19:00 PST 2015 - Windows fixes. Mithaldu++ 0.73 Thu Jan 1 17:10:15 PST 2015 - Fix Swim plugins and Meta to include Sisyphus in Authors and Copyright 0.72 Thu Jan 1 15:43:37 PST 2015 - Support for Inline::Filters::* plug-ins. Fractal++ - Complete doc refactoring 0.71 Sat Dec 27 00:44:20 PST 2014 - Make tests pass on Win32 0.70 Fri Dec 26 21:43:44 PST 2014 - Windows depends on Win32::Mutex now 0.69 Fri Dec 26 23:13:52 GMT 2014 - 27inline_maker.t - remove install-dir after each module, to help Win32 0.68 Wed Dec 24 09:14:31 GMT 2014 - Fixups for Windows test 27, skip 26 on WinXP for now 0.67 Tue Nov 25 16:59:41 GMT 2014 - Skip test/pegex-parser.t unless env PERL_INLINE_DEVELOPER_TEST set 0.66 Mon Nov 17 06:09:54 GMT 2014 - Make test/pegex-parser.t less fragile on fail - No CPAN index of Inline::C::Parser classes 0.65 Tue Nov 4 04:23:45 GMT 2014 - Changes to example modules' tests - Updates for EUMM 7.00's support for PERL IN SPACE - Cookbook addition to use autowrap to replace h2xs 0.64 Fri Sep 19 23:22:49 UTC 2014 - Major release for all the work since 0.62 - Renamed the parser modules - Adjusted the `using` paramater - Updated docs 0.62_13 Thu Sep 11 17:37:28 PDT 2014 - Remove XXX debugging 0.62_12 Sun Sep 7 00:37:23 MDT 2014 - Add issue/27 TODO test - Switch back to Parse::Recdescent for now 0.62_11 Tue Aug 19 16:14:10 PDT 2014 - Replace tabs with spaces 0.62_10 Tue Aug 19 15:54:05 PDT 2014 - Doc fix from Jin++ 0.62_09 Sat Aug 16 16:38:38 PDT 2014 - Remove $testdir vars from tests 0.62_08 Sat Aug 16 15:00:53 PDT 2014 - Remove .gitignore 0.62_07 Sat Aug 16 11:13:27 PDT 2014 - Meta 0.0.2 0.62_06 Sat Aug 16 01:25:40 PDT 2014 - Clean up test code 0.62_05 Fri Aug 15 19:58:53 PDT 2014 - Add t/000-require-modules.t 0.62_04 Fri Aug 15 18:24:39 PDT 2014 - Add t/000-compile-modules.t 0.62_03 Fri Aug 1 21:10:35 PDT 2014 - Fix test/requires 0.62_02 Fri Aug 1 18:00:01 PDT 2014 - Pegex replaces Parse::RecDescent as the default parser 0.62_01 Tue Jul 29 02:22:12 BST 2014 - version-parsing improvements - Test module build in dir with space. - Perl licence on Cookbook - t/TestInlineSetup.pm fixes for Windows DLLs, tainting 0.62 Sat Jul 19 22:43:12 BST 2014 - eg/modules moved to here as they're C - tests each use own dir, and all use Test::More and test/TestInlineSetup.pm. - doc/Inline/C/Cookbook.swim mention strings can be UTF-8. 0.61 Thu Jul 17 07:50:43 PDT 2014 - Add mailing list info to Meta and Contributing 0.60 Sun Jul 13 21:41:36 PDT 2014 - Add Contributing file - Fix Metadata 0.59 Sat Jul 12 12:09:19 PDT 2014 - Finish migrating and updating docs 0.58 Fri Jul 11 07:02:53 BST 2014 - Fix prereqs 0.57 Fri Jul 11 01:51:14 BST 2014 - Inline::C separated from Inline 0.56_03 Fri Jul 11 01:20:18 BST 2014 - Test of release system. 0.56_02 Thu Jul 10 04:13:56 BST 2014 - Make depend on Inline 0.56. - Tidy up after tests. 0.56_01 Thu Jul 10 01:21:08 BST 2014 - Merge in changes to inline-pm repo since this was split off. 0.54 Thu Jun 26 10:22:29 PDT 2014 - First release of Inline::C as its own distribution. 0.53_01 Thurs 15 Aug 2013 - Add C/t/24prefix.t 0.53 Wed 1 May 2013 - Version 0.53 released to CPAN - Add C/t/23validate.t test script. 0.52_02 Wed 24 Apr 2013 - Version 0.52_02 released to CPAN - C.pm - Small tweak to setting of $o->{ILSM}{MAKEFILE}{INC} in validate() sub. Thanks, Ian Goodacre. (Ticket 0.52_01 Thurs 11 Apr 2013 - Version 0.52_01 released to CPAN 0.52 Thurs 07 Mar 2013 - Version 0.52 released to CPAN. - C-Cookbook.pod - Change the "Object Oriented Inline" example so that it doesn't emit a "print (...) interpreted as function" warning if it's run with warnings enabled. 0.51_03 Wed 28 Nov 2012 - Version-0.51_03 released to CPAN. - C-Cookbook.pod - Add additional example ("Providing a pure perl alternative"). - C.pm - Change sub compile so that it chdirs back to the original cwd before it dies (if the build fails). (Ticket 0.51_02 Tues 20 Nov 2012 - Version-0.51_02 released to CPAN. - Makefile.PL - correct typo. 0.51_01 20 Nov 2012 - Version-0.51_01 released to CPAN. - C.pm - setting $ENV{NO_INSANE_DIRNAMES} turns quote_space() into a no-op. (This is just an undocumented fallback option in case the quote_space() handling of spaces breaks something for someone who has no need of "space handling" anyway.) - additional tweaks to quote_space sub [Ticket - Makefile.PL - Set EU::MM PREREQ_PM to 6.62, but only if the current version of EU::MM is 6.57_x, and even then only if building with INSTALL_BASE. (Ticket 0.51 Sat 13 Oct 2012 - Version 0.51 released to CPAN. 0.50_03 Mon 8 Oct 2012 - Fix Reini's patch (#67053). The original version of quote_space() caused a breakage whenever the INC Config argument contained more than one -I switch. (See 0.50_02 Tues 14 Feb 2012 - C.pm - Bump version number to 0.50_02 0.50_01 Wed 8 Feb 2012 - C.pm - Bump version number to 0.50_01 0.50 Tues 7 Feb 2012 - Version 0.50 released to CPAN - C.pm - Bump version number to 0.50 0.49_02 Fri 3 Feb 2012 - Version 0.49_02 released to CPAN - C.pm - Bring version numbering into line with recommendations made in - http://perldoc.perl.org/perlmodstyle.html#Version-numbering 0.49_01 Sun 25 Dec 2011 - C.pm - Bump version to 0.49_01 - C.pod - Fix typo. (Ticket 73108) 0.49 Thurs 8 Dec 2011 - Version 0.49 released to CPAN. (No changes from 0.48_02). 0.48_02 Thurs 25 Aug 2011 - Add example for accessing fortran code to C-Cookbook. 0.48_01 Mon 11 Apr 2011 - Version 0.48_01 released to CPAN. - C/C.pm - [cpan #67053] Space in pwd. Patch from Reini Urban to work with spaces in the current dir. 0.48 Mon 21 Feb 2011 - Version 0.48 released to CPAN. (No changes from 0.47_02.) 0.47_02 Tues 1 Feb 2011 - Version 0.47_02 released to CPAN. - Change the Test::Warn dependency from 0.22 to 0.21 and specify it in top-level Makefile.PL instead of in C/Makefile.PL. 0.47_01 Sun 30 January 2011 - Version 0.47_01 released to CPAN. - Use Test::Warn (on perl-5.8 and later) to check and suppress the warnings produced by C/t/08taint.t during 'make test'. (Ticket 0.47 Fri 21 January 2011 - Version 0.47 released to CPAN. No changes from 0.46_02 0.46_02 Sat 17 Apr 2010 - C-Cookbook.pod - Fix callback example. (RT ticket 56652) 0.46_01 Sun 14 Feb 2010 - Second attempt at accommodating 'ccache cc' compiler (RT ticket 40140) 0.46 Fri 12 Feb 2010 - Same as 0.45_02. 0.45_02 Fri 5 Feb 2010 - Add C/t/08taint.t as part of RT ticket 13084 fix. See top level "Changes" file. 0.45_01 Thurs 28 Jan 2010 - Fix Rt tickets 40140, 45417 and 49419. See top level "Changes" file. 0.45 Sat Nov 22 2008 - No changes from 0.44_01 0.44_01 Tues Oct 11 2008 - In C/C.pm, allow for the calling of multiple typemaps (RT ticket 5639), and have the "No Inline C functions bound to Perl" warning specify the file for which no bindings were found (RT ticket 17774). 0.43 Sat Jul 7 12:53:33 PDT 2001 - Break up the generation of XS code into smaller stages which can be overridden in Inline::CPP. Makes the code somewhat longer, but more clear. (NEILW) 0.42 Sun Jun 10 18:34:36 PDT 2001 - Patch that prevents Inline from creating a nonexistent sitelib. Thanks Joey Hess. 0.41 Tue Jun 5 01:49:32 PDT 2001 - Added AUTOWRAP config option 0.40 Wed May 23 20:21:32 PDT 2001 - 0.40 integration - Changed object references - Account for no trailing '/' in paths 0.34 Tue May 1 00:05:58 PDT 2001 - Fixed compiler detection bugs in Makefile.PL 0.33 Sat Apr 28 20:20:29 PDT 2001 - Rearranged test harness. Moved all C tests from Inline to Inline::C 0.32 Fri Feb 23 03:16:27 PST 2001 - Special case for AIX ($Config{so}) 0.31 Sat Jan 13 12:41:38 PST 2001 - Changed over to new Inline DIRECTORY structure. 0.30 Fri Dec 8 01:55:43 PST 2000 - Created Inline::C. Separated C code from Inline 0.26 LICENSE100644001750001750 4366013465524127 13241 0ustar00tinatina000000000000Inline-C-0.81This software is copyright (c) 2019 by Ingy döt Net. 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) 2019 by Ingy döt Net. 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 Artistic License 1.0 --- This software is Copyright (c) 2019 by Ingy döt Net. This is free software, licensed under: The 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. - "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 ftp.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) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting 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. 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 whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End MANIFEST100644001750001750 360213465524127 13335 0ustar00tinatina000000000000Inline-C-0.81# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. CONTRIBUTING Changes LICENSE MANIFEST META.json META.yml Makefile.PL README example/modules/Boo-2.01/MANIFEST example/modules/Boo-2.01/Makefile.PL example/modules/Boo-2.01/lib/Boo.pm example/modules/Boo-2.01/lib/Boo/Far.pm example/modules/Boo-2.01/lib/Boo/Far/Faz.pm example/modules/Boo-2.01/lib/Boo/Far/data.txt example/modules/Boo-2.01/t/boo.t example/modules/Math-Simple-1.23/Changes example/modules/Math-Simple-1.23/MANIFEST example/modules/Math-Simple-1.23/Makefile.PL example/modules/Math-Simple-1.23/Simple.pm example/modules/Math-Simple-1.23/test.pl lib/Inline/C.pm lib/Inline/C.pod lib/Inline/C/Cookbook.pod lib/Inline/C/ParsePegex.pod lib/Inline/C/ParseRecDescent.pod lib/Inline/C/ParseRegExp.pod lib/Inline/C/Parser.pm lib/Inline/C/Parser/Pegex.pm lib/Inline/C/Parser/Pegex/AST.pm lib/Inline/C/Parser/Pegex/Grammar.pm lib/Inline/C/Parser/RecDescent.pm lib/Inline/C/Parser/RegExp.pm share/inline-c.pgx t/000-require-modules.t t/01syntax.t t/02config.t t/03typemap.t t/04perlapi.t t/05xsmode.t t/06parseregexp.t t/07typemap_multi.t t/08taint.t t/08taint_1.p t/08taint_2.p t/08taint_3.p t/09parser.t t/10callback.t t/11default_readonly.t t/14void_arg.t t/14void_arg_PRD.t t/15ccflags.t t/16ccflagsex.t t/17prehead.t t/18quote_space.t t/19INC.t t/20eval.t t/21read_DATA.t t/22read_DATA_2.t t/23validate.t t/24prefix.t t/25proto.t t/26fork.t t/27inline_maker.t t/28autowrap.t t/29refargs.t t/30cppflags.t t/31include_dirs_angle_brackets.t t/32include_dirs_double_quotes.t t/33intended_double_quotes.t t/TestInlineC.pm t/TestInlineSetup.pm t/author-pod-syntax.t t/bar/find_me_in_bar.h t/foo/find_me_in_foo.h t/iquote_test.h t/parse-pegex.t t/pegex-parser.t t/prehead.in t/proto1.p t/proto2.p t/proto3.p t/proto4.p t/proto5.p t/proto6.p t/soldier_typemap t/test_header.h t/test_header/iquote_test.h t/test_header/test_header.h t/typemap META.yml100644001750001750 211013465524127 13446 0ustar00tinatina000000000000Inline-C-0.81--- abstract: 'C Language Support for Inline' author: - 'Ingy döt Net ' build_requires: File::Copy::Recursive: '0' File::Path: '0' Test::More: '0.88' Test::Warn: '0.23' YAML::XS: '0' autodie: '0' version: '0.77' configure_requires: ExtUtils::MakeMaker: '0' File::ShareDir::Install: '0.06' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.012, 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: Inline-C no_index: directory: - example - inc - lib/Inline/C/Parser - t - xt file: - lib/Inline/C/Parser.pm requires: ExtUtils::MakeMaker: '7.00' File::Spec: '0.8' Inline: '0.83' Parse::RecDescent: '1.967009' Pegex: '0.66' perl: v5.8.1 resources: bugtracker: https://github.com/ingydotnet/inline-c-pm/issues homepage: https://github.com/ingydotnet/inline-c-pm repository: https://github.com/ingydotnet/inline-c-pm.git version: '0.81' x_generated_by_perl: v5.24.1 x_serialization_backend: 'YAML::Tiny version 1.73' t000755001750001750 013465524127 12306 5ustar00tinatina000000000000Inline-C-0.8119INC.t100644001750001750 113713465524127 13420 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; my $t; BEGIN { $t = $Bin; } use Cwd; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; BEGIN { my $incdir1 = "$t/foo/"; my $incdir2 = "$t/bar/"; $main::includes = "-I$incdir1 -I$incdir2"; }; use Inline C => Config => INC => $main::includes; use Inline C => <<'EOC'; #include #include SV * foo() { return newSViv(-42); } EOC print "1..1\n"; my $f = foo(); if($f == -42) {print "ok 1\n"} else { warn "\n\$f: $f\n"; print "not ok 1\n"; } typemap100644001750001750 15613465524127 14032 0ustar00tinatina000000000000Inline-C-0.81/tfloat T_FLOAT INPUT T_FLOAT $var = (float)SvNV($arg) OUTPUT T_FLOAT sv_setnv($arg, (double)$var); META.json100644001750001750 370613465524127 13632 0ustar00tinatina000000000000Inline-C-0.81{ "abstract" : "C Language Support for Inline", "author" : [ "Ingy d\u00f6t Net " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Inline-C", "no_index" : { "directory" : [ "example", "inc", "lib/Inline/C/Parser", "t", "xt" ], "file" : [ "lib/Inline/C/Parser.pm" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "File::ShareDir::Install" : "0.06" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "ExtUtils::MakeMaker" : "7.00", "File::Spec" : "0.8", "Inline" : "0.83", "Parse::RecDescent" : "1.967009", "Pegex" : "0.66", "perl" : "v5.8.1" } }, "test" : { "requires" : { "File::Copy::Recursive" : "0", "File::Path" : "0", "Test::More" : "0.88", "Test::Warn" : "0.23", "YAML::XS" : "0", "autodie" : "0", "version" : "0.77" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/ingydotnet/inline-c-pm/issues" }, "homepage" : "https://github.com/ingydotnet/inline-c-pm", "repository" : { "type" : "git", "url" : "https://github.com/ingydotnet/inline-c-pm.git", "web" : "https://github.com/ingydotnet/inline-c-pm" } }, "version" : "0.81", "x_generated_by_perl" : "v5.24.1", "x_serialization_backend" : "Cpanel::JSON::XS version 4.02" } proto1.p100644001750001750 43113465524127 14031 0ustar00tinatina000000000000Inline-C-0.81/tuse warnings; use strict; package PROTO1; use Inline C => Config => PROTOTYPES => 'ENABLE', #PROTOTYPE => {foo => '$'}, #BUILD_NOISY => 1, #CLEAN_AFTER_BUILD => 0, ; use Inline C => <<'EOC'; int foo(SV * x) { return 23; } EOC my $x = foo(1, 2); proto3.p100644001750001750 43213465524127 14034 0ustar00tinatina000000000000Inline-C-0.81/tuse warnings; use strict; package PROTO3; use Inline C => Config => #PROTOTYPES => 'ENABLE', #PROTOTYPE => {foo => '$'}, #BUILD_NOISY => 1, #CLEAN_AFTER_BUILD => 0, ; use Inline C => <<'EOC'; int foo(SV * x) { return 23; } EOC my $x = foo(1, 2); proto4.p100644001750001750 43613465524127 14041 0ustar00tinatina000000000000Inline-C-0.81/tuse warnings; use strict; package PROTO4; use Inline C => Config => PROTOTYPES => 'ENABLE', PROTOTYPE => {foo => 'DISABLE'}, #BUILD_NOISY => 1, #CLEAN_AFTER_BUILD => 0, ; use Inline C => <<'EOC'; int foo(SV * x) { return 23; } EOC my $x = foo(1, 2); 20eval.t100644001750001750 207513465524127 13730 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..5\n"; eval { require Inline; Inline->import (C =><<'EOC'); int foo() { return 42; } EOC }; if($@) { *foo =\&bar; } my $x = foo(); if($x == 42) {print "ok 1\n"} else { warn "\n\$x: $x\n"; print "not ok 1\n"; } $x = bar(); if($x == 43) {print "ok 2\n"} else { warn "\n\$x: $x\n"; print "not ok 2\n"; } eval { require Inline; Inline->import(C => Config => #BUILD_NOISY => 1, CC => 'missing_compiler'); Inline->import (C =><<'EOC'); int fu() { return 44; } EOC }; if($@) { *fu =\&fubar; } $x = fu(); if($x == 45) {print "ok 3\n"} else { warn "\n\$x: $x\n"; print "not ok 3\n"; } $x = fubar(); if($x == 45) {print "ok 4\n"} else { warn "\n\$x: $x\n"; print "not ok 4\n"; } if($@ =~ /missing_compiler/) {print "ok 5\n"} else { warn "\n\$\@ not as expected\n"; print "not ok 5\n"; } sub bar { return 43; } sub fubar { return 45; } proto2.p100644001750001750 43113465524127 14032 0ustar00tinatina000000000000Inline-C-0.81/tuse warnings; use strict; package PROTO2; use Inline C => Config => #PROTOTYPES => 'ENABLE', PROTOTYPE => {foo => '$'}, #BUILD_NOISY => 1, #CLEAN_AFTER_BUILD => 0, ; use Inline C => <<'EOC'; int foo(SV * x) { return 23; } EOC my $x = foo(1, 2); proto6.p100644001750001750 44013465524127 14036 0ustar00tinatina000000000000Inline-C-0.81/tuse warnings; use strict; package PROTO6; use Inline C => Config => #PROTOTYPES => 'RUBBISH', PROTOTYPE => [foo => 'DISABLE'], #BUILD_NOISY => 1, #CLEAN_AFTER_BUILD => 0, ; use Inline C => <<'EOC'; int foo(SV * x) { return 23; } EOC my $x = foo(1, 2); proto5.p100644001750001750 43713465524127 14043 0ustar00tinatina000000000000Inline-C-0.81/tuse warnings; use strict; package PROTO5; use Inline C => Config => PROTOTYPES => 'RUBBISH', PROTOTYPE => {foo => 'DISABLE'}, #BUILD_NOISY => 1, #CLEAN_AFTER_BUILD => 0, ; use Inline C => <<'EOC'; int foo(SV * x) { return 23; } EOC my $x = foo(1, 2); 26fork.t100644001750001750 112213465524127 13740 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Test::More; use Config; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; if($^O =~ /MSWin32/i && $Config{useithreads} ne 'define') { plan skip_all => 'fork() not implemented'; exit 0; } my $pid = fork; eval { Inline->bind(C => 'int add(int x, int y) { return x + y; }'); }; exit 0 unless $pid; wait; is($?, 0, 'child exited status 0'); is($@, '', 'bind was successful'); my $x = eval { add(7,3) }; is ($@, '', 'bound func no die()'); is($x, 10, 'bound func gave right result'); done_testing; 08taint.t100644001750001750 237413465524127 14130 0ustar00tinatina000000000000Inline-C-0.81/t#!perl -T BEGIN { my $fail = ''; $fail = "Skipped for perl 5.6.x" if $] < 5.007; $fail = "Skipping for Android (tests fail)" if lc($^O) eq 'android'; if ($fail) { print "1..1\nok 1\n"; warn "$fail\n"; exit(0); } } use warnings; use strict; use FindBin '$Bin'; my $bin; BEGIN { # untaint ($bin) = $Bin =~ m/(.*)/; } my $t = $bin; use lib $bin; use Test::More tests => 10; use Test::Warn; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; # deal with running as root - actually simulate running as setuid program. Avoid on Windows. eval { $< = 1 }; # ignore failure my $w1 = 'Blindly untainting tainted fields in %ENV'; my $w2 = 'Blindly untainting Inline configuration file information'; my $w3 = 'Blindly untainting tainted fields in Inline object'; warnings_like {require_taint_1()} [qr/$w1/, qr/$w2/, qr/$w1/, qr/$w3/], 'warn_test 1'; warnings_like {require_taint_2()} [qr/$w1/, qr/$w2/, qr/$w1/, qr/$w3/], 'warn_test 2'; warnings_like {require_taint_3()} [qr/$w1/, qr/$w2/, qr/$w1/, qr/$w3/, qr/$w1/, qr/$w2/, qr/$w1/, qr/$w3/], 'warn_test 3'; sub require_taint_1 { require "$t/08taint_1.p"; } sub require_taint_2 { require "$t/08taint_2.p"; } sub require_taint_3 { require "$t/08taint_3.p"; } 25proto.t100644001750001750 226013465524127 14145 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use FindBin '$Bin'; use lib $Bin; my $t = $Bin; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..6\n"; my $ret = do "$t/proto1.p"; if(!defined($ret) && $@ =~ /^Too many arguments/) {print "ok 1\n"} else { warn "\n$ret: $ret\n\$\@: $@\n"; print "not ok 1\n"; } $ret = do "$t/proto2.p"; if(!defined($ret) && $@ =~ /^Too many arguments/) {print "ok 2\n"} else { warn "\n$ret: $ret\n\$\@: $@\n"; print "not ok 2\n"; } $ret = do "$t/proto3.p"; if(!defined($ret) && $@ =~ /^Usage: PROTO3::foo/) {print "ok 3\n"} else { warn "\n$ret: $ret\n\$\@: $@\n"; print "not ok 3\n"; } $ret = do "$t/proto4.p"; if(!defined($ret) && $@ =~ /^Usage: PROTO4::foo/) {print "ok 4\n"} else { warn "\n$ret: $ret\n\$\@: $@\n"; print "not ok 4\n"; } $ret = do "$t/proto5.p"; if(!defined($ret) && $@ =~ /^PROTOTYPES can be only either 'ENABLE' or 'DISABLE'/) {print "ok 5\n"} else { warn "\n$ret: $ret\n\$\@: $@\n"; print "not ok 5\n"; } $ret = do "$t/proto6.p"; if(!defined($ret) && $@ =~ /^PROTOTYPE configure arg must specify a hash reference/) {print "ok 6\n"} else { warn "\n$ret: $ret\n\$\@: $@\n"; print "not ok 6\n"; } Makefile.PL100644001750001750 364213465524127 14162 0ustar00tinatina000000000000Inline-C-0.81# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; use File::ShareDir::Install; $File::ShareDir::Install::INCLUDE_DOTFILES = 1; $File::ShareDir::Install::INCLUDE_DOTDIRS = 1; install_share dist => "share"; my %WriteMakefileArgs = ( "ABSTRACT" => "C Language Support for Inline", "AUTHOR" => "Ingy d\x{f6}t Net ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::ShareDir::Install" => "0.06" }, "DISTNAME" => "Inline-C", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008001", "NAME" => "Inline::C", "PREREQ_PM" => { "ExtUtils::MakeMaker" => "7.00", "File::Spec" => "0.8", "Inline" => "0.83", "Parse::RecDescent" => "1.967009", "Pegex" => "0.66" }, "TEST_REQUIRES" => { "File::Copy::Recursive" => 0, "File::Path" => 0, "Test::More" => "0.88", "Test::Warn" => "0.23", "YAML::XS" => 0, "autodie" => 0, "version" => "0.77" }, "VERSION" => "0.81", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "ExtUtils::MakeMaker" => "7.00", "File::Copy::Recursive" => 0, "File::Path" => 0, "File::Spec" => "0.8", "Inline" => "0.83", "Parse::RecDescent" => "1.967009", "Pegex" => "0.66", "Test::More" => "0.88", "Test::Warn" => "0.23", "YAML::XS" => 0, "autodie" => 0, "version" => "0.77" ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; if ( $^O eq 'MSWin32' ) { $WriteMakefileArgs{PREREQ_PM}{'Win32::Mutex'} = $FallbackPrereqs{'Win32::Mutex'} = '1.09'; } WriteMakefile(%WriteMakefileArgs); { package MY; use File::ShareDir::Install qw(postamble); } CONTRIBUTING100644001750001750 253513465524127 14042 0ustar00tinatina000000000000Inline-C-0.81Contributing ============ The "Inline-C" Project needs your help! Please consider being a contributor. This file contains instructions that will help you be an effective contributor to the Project. GitHub ------ The code for this Project is hosted at GitHub. The URL is: https://github.com/ingydotnet/inline-c-pm You can get the code with this command: git clone https://github.com/ingydotnet/inline-c-pm If you've found a bug or a missing feature that you would like the author to know about, report it here: https://github.com/ingydotnet/inline-c-pm/issues or fix it and submit a pull request here: https://github.com/ingydotnet/inline-c-pm/pulls See these links for help on interacting with GitHub: * https://help.github.com/ * https://help.github.com/articles/creating-a-pull-request Zilla::Dist ----------- This Project uses Zilla::Dist to prepare it for publishing to CPAN. Read: https://metacpan.org/pod/Zilla::Dist::Contributing for up-to-date instructions on what contributors like yourself need to know to use it. IRC --- Inline-C has an IRC channel where you can find real people to help you: irc.perl.org#inline Join the channel. Join the team! Electronic Mailing List ----------------------- Inline-C has an email discussion list: inline@perl.org Thanks in advance, # This file generated by Zilla-Dist-0.0.203 01syntax.t100644001750001750 152413465524127 14324 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; is(add(3, 7), 10, 'string syntax'); is(subtract(3, 7), -4, 'string syntax again'); is(multiply(3, 7), 21, 'DATA syntax'); is(divide(7, -3), -2, 'DATA syntax again'); use Inline 'C'; use Inline C => 'DATA'; use Inline C => <<'END_OF_C_CODE'; int add(int x, int y) { return x + y; } int subtract(int x, int y) { return x - y; } END_OF_C_CODE Inline->bind(C => <<'END'); int incr(int x) { return x + 1; } END is(incr(incr(7)), 9, 'Inline->bind() syntax'); done_testing; __END__ # unused code or maybe AutoLoader stuff sub crap { return 'crap'; } __C__ int multiply(int x, int y) { return x * y; } __C__ int divide(int x, int y) { return x / y; } 05xsmode.t100644001750001750 75413465524127 14265 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Inline C => DATA => ENABLE => XSMODE => NAME => 'xsmode'; is(add(5, 10), 15); done_testing; __END__ __C__ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" MODULE = xsmode PACKAGE = main int add (x, y) int x int y CODE: RETVAL = x + y; OUTPUT: RETVAL 09parser.t100644001750001750 1353613465524127 14330 0ustar00tinatina000000000000Inline-C-0.81/tour %conf; BEGIN { warn "This test could take a couple of minutes to run\n"; %conf = ( main => { foo_ => -1, _foo_ => -3, _foo => 2, foo => 1, bar => 2, baz => 3, foobar => 4, foobarbaz => 5, }, FOO => { foo => 6, }, BAR => { bar => 7, }, BAZ => { baz => 8, baz_ => -2, } ) }; use strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; sub code { my ($p, $sym) = @_; my $code = <<"EOIC"; package $p; use Inline C => <<"EOC"; int $sym () { return $conf{$p}{$sym}; } EOC EOIC # warn "Code: $code"; eval $code; die $@ if $@; } # code ########## main:foo_ ######## use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1, USING => "Inline::C::Parser::Pegex"; # USING => "Inline::C::Parser::RegExp"; # USING => "Inline::C::Parser::RecDescent"; main::code (__PACKAGE__, "foo_"); # Use same Config options as for main::foo() main::code (__PACKAGE__, "_foo_"); ########## main:_foo ######## use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1, USING => "Inline::C::Parser::RecDescent"; main::code (__PACKAGE__, "_foo"); ########## main:foo ######## use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1, USING => "Inline::C::Parser::RegExp"; main::code (__PACKAGE__, "foo"); # No USING value specified here - will use default (Inline::C::Parser::RecDescent). use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1; main::code (__PACKAGE__, "bar"); ########## main:baz ######## use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1, USING => "Inline::C::Parser::RecDescent"; main::code (__PACKAGE__, "baz"); ########## main:foobar ######## # No USING value specified here - will use default (Inline::C::Parser::RecDescent). use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1; main::code (__PACKAGE__, "foobar"); ########## main:foobarbaz ######## # Use same config options as for main::foobar(). main::code (__PACKAGE__, "foobarbaz"); ########## FOO::foo ######## package FOO; use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1, USING => "Inline::C::Parser::RecDescent"; main::code (__PACKAGE__, "foo"); ########## BAR::bar ######## package BAR; use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1; main::code (__PACKAGE__, "bar"); ########## BAZ::baz ######## package BAZ; use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1, USING => "Inline::C::Parser::RegExp"; main::code (__PACKAGE__, "baz"); ########## BAZ::baz_ ######## # Use same Config options as for BAZ::bar() main::code (__PACKAGE__, "baz_"); ######################################## package main; use strict; use warnings; use Test::More; is ( foo_ (), $conf{main}{foo_}, " foo_ "); is ( _foo_ (), $conf{main}{_foo_}, " _foo_ "); is ( _foo (), $conf{main}{_foo}, " _foo "); is ( foo (), $conf{main}{foo}, " foo "); is ( bar (), $conf{main}{bar}, " bar "); is ( baz (), $conf{main}{baz}, " baz "); is ( foobar (), $conf{main}{foobar}, " foobar "); is ( foobarbaz (), $conf{main}{foobarbaz}, " foobarbaz"); is (main::foo_ (), $conf{main}{foo_}, "main::foo_ "); is (main::_foo_ (), $conf{main}{_foo_}, "main::_foo_ "); is (main::_foo (), $conf{main}{_foo}, "main::_foo "); is (main::foo (), $conf{main}{foo}, "main::foo "); is (main::bar (), $conf{main}{bar}, "main::bar "); is (main::baz (), $conf{main}{baz}, "main::baz "); is (main::foobar (), $conf{main}{foobar}, "main::foobar "); is (main::foobarbaz (), $conf{main}{foobarbaz}, "main::foobarbaz"); is ( FOO::foo (), $conf{FOO}{foo}, " FOO::foo "); is ( BAR::bar (), $conf{BAR}{bar}, " BAR::bar "); is ( BAZ::baz (), $conf{BAZ}{baz}, " BAZ::baz "); is ( BAZ::baz_ (), $conf{BAZ}{baz_}, " BAZ::baz_ "); my $prod = -483840; my $res = main::foo_ () * main::_foo () * main::_foo_ () * main::foo () * main::bar () * main::baz () * main::foobar () * main::foobarbaz () * FOO::foo () * BAR::bar () * BAZ::baz () * BAZ::baz_ (); is ($res, $prod, "Returned product"); chomp (my @p = do { local @ARGV = "$TestInlineSetup::DIR/parser_id"; <> }); my $expected_log_lines = 13; is (scalar @p, $expected_log_lines, "Match number of lines in log"); TODO: { local $TODO = 'Until pegex is default'; # diag "@p"; is_deeply (\@p, [ "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::Parser::RecDescent::get_parser called", "Inline::C::get_parser called", "Inline::C::Parser::Pegex::get_parser called", "Inline::C::Parser::RegExp::get_parser called", "Inline::C::Parser::RegExp::get_parser called", ], "parser log" ); } done_testing (); prehead.in100644001750001750 13013465524127 14360 0ustar00tinatina000000000000Inline-C-0.81/t#ifndef EXTRA_DEFINE #define EXTRA_DEFINE 1234 #else #define SOMETHING_ELSE 1234 #endif 24prefix.t100644001750001750 74213465524127 14261 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Config; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; use Inline C => Config => #BUILD_NOISY => 1, USING => 'Inline::C::Parser::RegExp', PREFIX => 'MY_PRE_'; use Inline C => << 'EOC'; int bar() { return 42; } int MY_PRE_foo(void) { int x = bar(); return x; } EOC if(42 == foo()) {print "ok 1\n"} else {print "not ok 1\n"} 02config.t100644001750001750 67113465524127 14226 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; eval 'use Inline C => "void foo(){}", FOO => "Bar";'; like($@, qr/not a valid config option/, 'bogus config options croak'); use Inline C => 'char* XYZ_Howdy(){return "Hello There";}', PREFIX => 'XYZ_'; is(Howdy, "Hello There", 'PREFIX config option'); done_testing; 17prehead.t100644001750001750 104713465524127 14415 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; my$t; BEGIN { $t = $Bin; } use TestInlineSetup; use Config; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; use Inline C => Config => #BUILD_NOISY => 1, #CLEAN_AFTER_BUILD => 0, FORCE_BUILD => 1, PRE_HEAD => "$t/prehead.in"; use Inline C => <<'EOC'; int foo() { return EXTRA_DEFINE; } EOC my $def = foo(); if($def == 1234) { print "ok 1\n"; } else { warn "\n Expected: 1234\n Got: $def\n"; print "not ok 1\n"; } 08taint_3.p100644001750001750 54113465524127 14320 0ustar00tinatina000000000000Inline-C-0.81/tBEGIN {is(${^TAINT}, 1, '3: taint_is_on');}; use Inline 'C'; use Inline C => 'DATA'; Inline->init() ; use Inline Config => UNTAINT => 1; is(multiply(3, 7), 21, 'multiply_test'); is(divide(7, -3), -2, 'divide_test'); 1; __DATA__ __C__ int multiply(int x, int y) { return x * y; } __C__ int divide(int x, int y) { return x / y; } 08taint_2.p100644001750001750 30513465524127 14315 0ustar00tinatina000000000000Inline-C-0.81/tBEGIN {is(${^TAINT}, 1, '2: taint_is_on');}; use Inline Config => UNTAINT => 1; Inline->bind(C => <<'END'); int incr(int x) { return x + 1; } END is(incr(incr(7)), 9, 'incr_test'); 1; 03typemap.t100644001750001750 63213465524127 14436 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; my $t; BEGIN { $t = $Bin; } use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Inline C => DATA => TYPEMAPS => File::Spec->catfile($t, 'typemap'); is(int((add_em_up(1.2, 3.4) + 0.001) * 10), 46); done_testing; __END__ __C__ float add_em_up(float x, float y) { return x + y; } 04perlapi.t100644001750001750 53713465524127 14420 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Inline 'C'; $main::myvar = $main::myvar = "myvalue"; is(lookup('main::myvar'), "myvalue"); done_testing; __END__ __C__ SV* lookup(char* var) { return perl_get_sv(var, 0); } 15ccflags.t100644001750001750 100413465524127 14376 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Config; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; use Inline C => Config => #BUILD_NOISY => 1, FORCE_BUILD => 1, CCFLAGS => $Config{ccflags} . " -DEXTRA_DEFINE=1234"; use Inline C => <<'EOC'; int foo() { return EXTRA_DEFINE; } EOC my $def = foo(); if($def == 1234) { print "ok 1\n"; } else { warn "\n Expected: 1234\n Got: $def\n"; print "not ok 1\n"; } 29refargs.t100644001750001750 144513465524127 14443 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use lib -e 't' ? 't' : 'test'; use diagnostics; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Test::More; my $c_text = <<'EOC'; SV *sum(SV *array) { int total = 0; int numelts, i; if ((!SvROK(array)) || (SvTYPE(SvRV(array)) != SVt_PVAV) || ((numelts = av_len((AV *)SvRV(array))) < 0) ) { return &PL_sv_undef; } for (i = 0; i <= numelts; i++) { total += SvIV(*av_fetch((AV *)SvRV(array), i, 0)); } return newSViv(total); } EOC Inline->bind(C => $c_text); is sum([(1..4)]), 10, 'correct sum'; is sum(undef), undef, 'return undef when given undef'; is sum('hello'), undef, 'return undef when given non-ref'; is sum([]), undef, 'return undef when given empty list'; done_testing; 08taint_1.p100644001750001750 33013465524127 14312 0ustar00tinatina000000000000Inline-C-0.81/tBEGIN {is(${^TAINT}, 1, '1: taint_is_on');}; use Inline Config => UNTAINT => 1; use Inline C => <<'END_OF_C_CODE'; int add(int x, int y) { return x + y; } END_OF_C_CODE is(add(7,3), 10, 'add_test'); 1; 14void_arg.t100644001750001750 231613465524127 14574 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use FindBin '$Bin'; use lib $Bin; use diagnostics; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Test::More; use Inline C => Config => FORCE_BUILD => 1, USING => 'Inline::C::Parser::RegExp'; my $c_text = <<'EOC'; void foo1(void) { printf("Hello from foo1\n"); } int foo2(void) { return 42; } SV * foo3(void) { return newSVnv(42.0); } void foo4() { printf("Hello from foo4\n"); } int foo5() { return 42; } SV * foo6() { return newSVnv(42.0); } void foo7( void ) { printf("Hello from foo7\n"); } int foo8( void ) { return 43; } SV * foo9( void ) { return newSVnv(43.0); } void foo10 ( void ) { printf("Hello from foo10\n"); } int foo11 ( void ) { return 44; } SV * foo12 ( void ) { return newSVnv(44.0); } EOC Inline->bind(C => $c_text); sub run_tests { for my $f (qw(foo1 foo4 foo7 foo10)) { eval "$f();"; is($@, '', $f); } for my $f (qw(foo2 foo3 foo5 foo6)) { no strict 'refs'; is(&$f, 42, $f); } for my $f (qw(foo8 foo9)) { no strict 'refs'; is(&$f, 43, $f); } for my $f (qw(foo11 foo12)) { no strict 'refs'; is(&$f, 44, $f); } } run_tests(); done_testing; 30cppflags.t100644001750001750 136613465524127 14603 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Config; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; use Inline C => Config => #BUILD_NOISY => 1, FORCE_BUILD => 1, CCFLAGS => $Config{ccflags}; # DEV NOTE: do not actually test CPPFLAGS effect on Inline::Filters here, # only test the ability to pass CPPFLAGS argument through Inline::C; # see t/Preprocess_cppflags.t in Inline::Filters for real tests use Inline C => <<'END' => CPPFLAGS => ' -DPREPROCESSOR_DEFINE'; int foo() { return 4321; } END my $foo_retval = foo(); if ( $foo_retval == 4321 ) { print "ok 1\n"; } else { warn "\n Expected: 4321\n Got: $foo_retval\n"; print "not ok 1\n"; } 10callback.t100644001750001750 1466113465524127 14560 0ustar00tinatina000000000000Inline-C-0.81/t# Check that basic callbacks are working, and that Inline::C keeps track correctly of whether functions # are truly void or not. (In response to bug #55543.) # This test script plagiarises the perlcall documentation. use strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; my $t = $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..4\n"; use Inline C => Config => FORCE_BUILD => 1, _TESTING => 1, USING => 'Inline::C::Parser::RegExp'; use Inline C => <<'END'; void list_context(int x) { Inline_Stack_Vars; int i = 0; Inline_Stack_Reset; for(i = 1; i < 11; i++) Inline_Stack_Push(sv_2mortal(newSVuv(i * x))); Inline_Stack_Done; Inline_Stack_Return(10); } void call_AddSubtract2(int a, int b) { dSP; I32 ax; int count; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK; count = call_pv("AddSubtract", G_ARRAY); SPAGAIN; SP -= count; ax = (SP - PL_stack_base) + 1; if (count != 2) croak("Big trouble\n"); printf ("%d + %d = %d\n", a, b, SvIV(ST(0))); printf ("%d - %d = %d\n", a, b, SvIV(ST(1))); PUTBACK; FREETMPS; LEAVE; } void call_PrintList() { dSP; char * words[] = {"alpha", "beta", "gamma", "delta", NULL}; call_argv("PrintList", G_DISCARD, words); } void call_Inc(int a, int b) { dSP; int count; SV * sva; SV * svb; ENTER; SAVETMPS; sva = sv_2mortal(newSViv(a)); svb = sv_2mortal(newSViv(b)); PUSHMARK(SP); XPUSHs(sva); XPUSHs(svb); PUTBACK; count = call_pv("Inc", G_DISCARD); if (count != 0) croak ("call_Inc: expected 0 values from 'Inc', got %d\n", count); printf ("%d + 1 = %d\n", a, SvIV(sva)); printf ("%d + 1 = %d\n", b, SvIV(svb)); FREETMPS; LEAVE; } void call_AddSubtract(int a, int b) { dSP; int count; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK; count = call_pv("AddSubtract", G_ARRAY); SPAGAIN; if (count != 2) croak("Big trouble\n"); printf ("%d - %d = %d\n", a, b, POPi); printf ("%d + %d = %d\n", a, b, POPi); PUTBACK; FREETMPS; LEAVE; } void call_Adder(int a, int b) { dSP; int count; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK; count = call_pv("Adder", G_SCALAR); SPAGAIN; if (count != 1) croak("Big trouble\n"); printf ("The sum of %d and %d is %d\n", a, b, POPi); PUTBACK; FREETMPS; LEAVE; } void call_PrintUID() { dSP; PUSHMARK(SP); call_pv("PrintUID", G_DISCARD|G_NOARGS); } void call_LeftString(char *a, int b) { dSP; ENTER; SAVETMPS; PUSHMARK(SP); POPMARK; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(a, 0))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK; call_pv("LeftString", G_DISCARD); FREETMPS; LEAVE; } void foo(int x) { call_AddSubtract(123, 456); call_LeftString("Hello World !!", x); call_AddSubtract(789,101112); call_AddSubtract2(23,50); call_Inc(22,223); call_PrintList(); call_PrintUID(); call_Adder(7123, 8369); call_LeftString("Hello World !!", x + 1); call_Inc(34,35); call_PrintList(); call_Adder(71231, 83692); call_PrintUID(); call_LeftString("Hello World !!", x + 2); call_AddSubtract2(23,50); } void bar(int x) { dXSARGS; int i = 0; call_LeftString("Hello World !!", x); sp = mark; call_LeftString("Hello World !!", x + 1); for(i = 1; i < 11; i++) XPUSHs(sv_2mortal(newSVuv(i * x))); /* call_LeftString("Hello World !!", x + 2); * /* CRASHES ON RETURN */ PUTBACK; call_LeftString("Hello World !!", x + 3); XSRETURN(10); } END my @list = list_context(17); if(scalar(@list) == 10 && $list[0] == 17) {print "ok 1\n"} else { warn "\nscalar \@list: ", scalar(@list), "\n\$list[0]: $list[0]\n"; print "not ok 1\n"; } call_LeftString("Just testing", 8); foo(7); @list = bar(6); if(scalar(@list) == 10 && $list[0] == 6) {print "ok 2\n"} else { warn "\nscalar \@list: ", scalar(@list), "\n\$list[0]: $list[0]\n"; print "not ok 2\n"; } call_PrintUID(); call_Adder(18, 12345); call_AddSubtract(131415, 161718); call_Inc(102,304); call_PrintList(); call_AddSubtract2(23,50); open RD, '<', "$TestInlineSetup::DIR/void_test" or warn "Unable to open $TestInlineSetup::DIR/void_test: $!"; my @checks = ; close RD or warn "Unable to close $TestInlineSetup::DIR/void_test: $!"; my $expected = 10; if(scalar(@checks == $expected)) {print "ok 3\n"} else { warn "scalar \@checks is ", scalar(@checks), ". Expected $expected\n"; print "not ok 3\n"; } my $ok; if($checks[0] eq "LIST_CONTEXT\n") {$ok .= 'a'} else {warn "4a: Got '$checks[0]', expected 'LIST_CONTEXT'\n"} if($checks[1] eq "TRULY_VOID\n") {$ok .= 'b'} else {warn "4b: Got '$checks[0]', expected 'TRULY_VOID'\n"} if($checks[2] eq "TRULY_VOID\n") {$ok .= 'c'} else {warn "4c: Got '$checks[0]', expected 'TRULY_VOID'\n"} if($checks[3] eq "LIST_CONTEXT\n") {$ok .= 'd'} else {warn "4d: Got '$checks[0]', expected 'LIST_CONTEXT'\n"} if($checks[4] eq "TRULY_VOID\n") {$ok .= 'e'} else {warn "4e: Got '$checks[4]', expected 'TRULY_VOID'\n"} if($checks[5] eq "TRULY_VOID\n") {$ok .= 'f'} else {warn "4f: Got '$checks[5]', expected 'TRULY_VOID'\n"} if($checks[6] eq "TRULY_VOID\n") {$ok .= 'g'} else {warn "4g: Got '$checks[6]', expected 'TRULY_VOID'\n"} if($checks[7] eq "TRULY_VOID\n") {$ok .= 'h'} else {warn "4h: Got '$checks[7]', expected 'TRULY_VOID'\n"} if($checks[8] eq "TRULY_VOID\n") {$ok .= 'i'} else {warn "4i: Got '$checks[8]', expected 'TRULY_VOID'\n"} if($checks[9] eq "TRULY_VOID\n") {$ok .= 'j'} else {warn "4j: Got '$checks[9]', expected 'TRULY_VOID'\n"} if($ok eq 'abcdefghij') {print "ok 4\n"} else { warn "\$ok: $ok\n"; print "not ok 4\n"; } sub PrintUID { print "UID is $<\n"; } sub LeftString { my($s, $n) = @_; print substr($s, 0, $n), "\n"; } sub Adder { my($a, $b) = @_; $a + $b; } sub AddSubtract { my($a, $b) = @_; ($a+$b, $a-$b); } sub Inc { ++ $_[0]; ++ $_[1]; } sub PrintList { my(@list) = @_; foreach (@list) { print "$_\n" } } 23validate.t100644001750001750 407513465524127 14577 0ustar00tinatina000000000000Inline-C-0.81/t# Check that a small bugfix in Inline::C::validate() (ticket #11748) # is behaving as expected. use warnings; use strict; use Config; print "1..5\n"; require Inline::C; # Next 2 lines are for the benefit of 5.8.8. my (%o1, %o2, %o3); my($o1, $o2, $o3) = (\%o1, \%o2,\ %o3); $o1->{FOOBAR}{STUFF} = 1; $o2->{FOOBAR}{STUFF} = 1; $o2->{ILSM}{MAKEFILE}{INC} = '-I/foo -I/bar'; $o3->{FOOBAR}{STUFF} = 1; bless($o1, 'Inline::C'); bless($o2, 'Inline::C'); bless($o3, 'Inline::C'); Inline::C::validate($o1); if(($Config{osname} eq 'MSWin32') and ($Config{cc} =~ /\b(cl\b|clarm|icl)/)) { ## $o1->{ILSM}{MAKEFILE}{INC} should be unset ## as it's $ENV{INCLUDE} that is instead amended if($o1->{ILSM}{MAKEFILE}{INC}) {print "not ok 1\n"} else {print "ok 1\n"} } else { ## $o1->{ILSM}{MAKEFILE}{INC} should be set ## to "-I\"$FindBin::Bin\"" if($o1->{ILSM}{MAKEFILE}{INC}) {print "ok 1\n"} else {print "not ok 1\n"} } Inline::C::validate($o2); if($o2->{ILSM}{MAKEFILE}{INC} eq '-I/foo -I/bar') {print "ok 2\n"} else { warn "INC: ", $o2->{ILSM}{MAKEFILE}{INC}, "\n"; print "not ok 2\n"; } Inline::C::validate($o2, 'INC', '-I/baz'); if($o2->{ILSM}{MAKEFILE}{INC} =~ / \-I\/baz/) {print "ok 3\n"} else { warn "INC: ", $o2->{ILSM}{MAKEFILE}{INC}, "\n"; print "not ok 3\n"; } if($o2->{ILSM}{MAKEFILE}{INC} eq '-I/foo -I/bar -I/baz') {print "ok 4\n"} else { warn "INC: ", $o2->{ILSM}{MAKEFILE}{INC}, "\n"; print "not ok 4\n"; } Inline::C::validate($o3, 'INC', '-I/baz'); if(($Config{osname} eq 'MSWin32') and ($Config{cc} =~ /\b(cl\b|clarm|icl)/)) { ## $o3->{ILSM}{MAKEFILE}{INC} should be set to " -I/baz" if($o3->{ILSM}{MAKEFILE}{INC} eq ' -I/baz' ) {print "ok 5\n"} else { warn "INC: ", $o3->{ILSM}{MAKEFILE}{INC}, "\n"; print "not ok 5\n"; } } else { ## $o3->{ILSM}{MAKEFILE}{INC} should be set ## to "-I\"$FindBin::Bin\"" followed by " -I/baz" if($o3->{ILSM}{MAKEFILE}{INC} =~ / \-I\/baz/ && $o3->{ILSM}{MAKEFILE}{INC} ne ' -I/baz' ) {print "ok 5\n"} else { warn "INC: ", $o3->{ILSM}{MAKEFILE}{INC}, "\n"; print "not ok 5\n"; } } 28autowrap.t100644001750001750 50713465524127 14631 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; my $t = $Bin; use TestInlineSetup; use Inline config => directory => $TestInlineSetup::DIR; use Test::More; use Inline C => sub { q{ double sin(double); } } => enable => "autowrap"; like &sin(1), qr/^0\.8/, "sin(1) returned 0.8-ish"; done_testing; parse-pegex.t100644001750001750 434113465524127 15055 0ustar00tinatina000000000000Inline-C-0.81/tuse Test::More; use lib -e 't' ? 't' : 'test'; use TestInlineC; test <<'...', 'Basic def'; void foo(int a, int b) { a + b; } ... TODO: { local $TODO = 'Rigorous function definition and declaration tests not yet passing.'; test <<'...', 'Basic decl'; void foo(int a, int b); ... test <<'...', 'Basic decl, no identifiers'; void foo(int,int); ... test <<'...', 'char* param'; void foo(char* ch) { } ... test <<'...', 'char* param decl'; void foo(char* ch); ... test <<'...', 'char * decl'; void foo(char *); ... test <<'...', 'char *param'; void foo(char *ch) { } ... test <<'...', 'char** param'; void foo( char** ch ) { } ... test <<'...', 'char* rv, char* param'; char* foo(char* ch) { return ch; } ... test <<'...', 'const char*'; const char* foo(const char* ch) { return ch; } ... test <<'...', 'char* const param'; char* const foo(char * const ch ) { return ch; } ... test <<'...', 'const char* const param'; const char* const foo(const char* const ch) { return ch; } ... test <<'...', 'const char* const no-id decl'; const char * const foo( const char * const); ... test <<'...', 'long int'; long int foo( long int a ) { return a + a; } ... test <<'...', 'long long'; long long foo ( long long a ) { return a + a; } ... test <<'...', 'long long int'; long long int foo ( long long int a ) { return a + a; } ... test <<'...', 'unsigned long long int'; unsigned long long int foo ( unsigned long long int abc ) { return abc + abc; } ... test <<'...', 'unsigned long long int decl no-id'; unsigned long long int foo( unsigned long long int ); ... test <<'...', 'unsigned long long decl no-id'; unsigned long long foo(unsigned long long); ... test <<'...', 'unsigned int'; unsigned int _foo ( unsigned int abcd ) { return abcd + abcd; } ... test <<'...', 'unsigned long'; unsigned long _bar1( unsigned long abcd ) { return abcd + abcd; } ... test <<'...', 'unsigned'; unsigned baz2(unsigned abcd) { return abcd+abcd; } ... test <<'...', 'unsigned decl no-id'; unsigned baz2(unsigned); ... } TODO: { local $TODO = 'Failing tests for Pegex Parser'; test <<'...', 'Issue/27'; void _dump_ptr(long d1, long d2, int use_long_output) { printf("hello, world! %d %d %d\n", d1, d2, use_long_output); } ... } done_testing; test_header.h100644001750001750 14713465524127 15070 0ustar00tinatina000000000000Inline-C-0.81/t /* used by 32include_dirs_double_quotes.t and 33intended_double_quotes.t */ #define TEST_DEFINE 2112 16ccflagsex.t100644001750001750 76213465524127 14726 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Config; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; use Inline C => Config => #BUILD_NOISY => 1, FORCE_BUILD => 1, CCFLAGSEX => "-DEXTRA_DEFINE=1234"; use Inline C => <<'EOC'; int foo() { return EXTRA_DEFINE; } EOC my $def = foo(); if($def == 1234) { print "ok 1\n"; } else { warn "\n Expected: 1234\n Got: $def\n"; print "not ok 1\n"; } 21read_DATA.t100644001750001750 114213465524127 14500 0ustar00tinatina000000000000Inline-C-0.81/t# This file checks that a bug in Inline::read_DATA() has been fixed. # The bug existed up to and including Inline-0.52. use strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Inline C => 'DATA'; print "1..1\n"; my $foo = foo1() + foo2(); if($foo == 15) {print "ok 1\n"} else { warn "\$foo: $foo\n"; print "not ok 1\n"; } __DATA__ __C__ #define __SYMBOL1__ #define __SYMBOL2__ 8 int foo1() { int ret = __SYMBOL2__ - 1; return ret; } int foo2() { return __SYMBOL2__; } iquote_test.h100644001750001750 3513465524127 15122 0ustar00tinatina000000000000Inline-C-0.81/t#define NON_DESIRED_HEADER 1 Inline000755001750001750 013465524127 14027 5ustar00tinatina000000000000Inline-C-0.81/libC.pm100644001750001750 10554513465524127 14761 0ustar00tinatina000000000000Inline-C-0.81/lib/Inlineuse strict; use warnings; package Inline::C; our $VERSION = '0.81'; use Inline 0.56; use Config; use Data::Dumper; use Carp; use Cwd qw(cwd abs_path); use File::Spec; use constant IS_WIN32 => $^O eq 'MSWin32'; use if !IS_WIN32, Fcntl => ':flock'; use if IS_WIN32, 'Win32::Mutex'; our @ISA = qw(Inline); #============================================================================== # Register this module as an Inline language support module #============================================================================== sub register { return { language => 'C', # XXX Breaking this on purpose; let's see who screams # aliases => ['c'], type => 'compiled', suffix => $Config{dlext}, }; } #============================================================================== # Validate the C config options #============================================================================== sub usage_validate { my $key = shift; return <{CONFIG}{BUILD_NOISY}; $o->{ILSM} ||= {}; $o->{ILSM}{XS} ||= {}; $o->{ILSM}{MAKEFILE} ||= {}; if (not $o->UNTAINT) { require FindBin; if (not defined $o->{ILSM}{MAKEFILE}{INC}) { # detect Microsoft Windows OS, and either Microsoft Visual Studio compiler "cl.exe", "clarm.exe", or Intel C compiler "icl.exe" if (($Config{osname} eq 'MSWin32') and ($Config{cc} =~ /\b(cl\b|clarm|icl)/)) { warn "\n Any header files specified relative to\n", " $FindBin::Bin\n", " will be included only if no file of the same relative path and\n", " name is found elsewhere in the search locations (including those\n", " specified in \$ENV{INCLUDE}).\n", " Otherwise, that header file \"found elsewhere\" will be included.\n"; warn " "; # provide filename and line number. $ENV{INCLUDE} .= qq{;"$FindBin::Bin"}; } # detect Oracle Solaris/SunOS OS, and Oracle Developer Studio compiler "cc" (and double check it is not GCC) elsif ((($Config{osname} eq 'solaris') or ($Config{osname} eq 'sunos')) and ($Config{cc} eq 'cc') and (not $Config{gccversion})) { $o->{ILSM}{MAKEFILE}{INC} = "-I\"$FindBin::Bin\" -I-"; # angle-bracket includes will NOT incorrectly search -I dirs given before -I- warn q{NOTE: Oracle compiler detected, unable to utilize '-iquote' compiler option, falling back to '-I-' which should produce correct results for files included in angle brackets}, "\n"; } else { $o->{ILSM}{MAKEFILE}{INC} = qq{-iquote"$FindBin::Bin"}; # angle-bracket includes will NOT incorrectly search -iquote dirs } } } $o->{ILSM}{AUTOWRAP} = 0 if not defined $o->{ILSM}{AUTOWRAP}; $o->{ILSM}{XSMODE} = 0 if not defined $o->{ILSM}{XSMODE}; $o->{ILSM}{AUTO_INCLUDE} ||= <{ILSM}{FILTERS} ||= []; $o->{STRUCT} ||= { '.macros' => '', '.xs' => '', '.any' => 0, '.all' => 0, }; while (@_) { my ($key, $value) = (shift, shift); if ($key eq 'PRE_HEAD') { unless( -f $value) { $o->{ILSM}{AUTO_INCLUDE} = $value . "\n" . $o->{ILSM}{AUTO_INCLUDE}; } else { my $insert; open RD, '<', $value or die "Couldn't open $value for reading: $!"; while () {$insert .= $_} close RD or die "Couldn't close $value after reading: $!"; $o->{ILSM}{AUTO_INCLUDE} = $insert . "\n" . $o->{ILSM}{AUTO_INCLUDE}; } next; } if ($key eq 'MAKE' or $key eq 'AUTOWRAP' or $key eq 'XSMODE' ) { $o->{ILSM}{$key} = $value; next; } if ($key eq 'CC' or $key eq 'LD' ) { $o->{ILSM}{MAKEFILE}{$key} = $value; next; } if ($key eq 'LIBS') { $o->add_list($o->{ILSM}{MAKEFILE}, $key, $value, []); next; } if ($key eq 'INC') { $o->add_string( $o->{ILSM}{MAKEFILE}, $key, quote_space($value), '', ); next; } if ($key eq 'MYEXTLIB' or $key eq 'OPTIMIZE' or $key eq 'CCFLAGS' or $key eq 'LDDLFLAGS' ) { $o->add_string($o->{ILSM}{MAKEFILE}, $key, $value, ''); next; } if ($key eq 'CCFLAGSEX') { $o->add_string( $o->{ILSM}{MAKEFILE}, 'CCFLAGS', $Config{ccflags} . ' ' . $value, '', ); next; } if ($key eq 'TYPEMAPS') { unless(ref($value) eq 'ARRAY') { croak "TYPEMAPS file '$value' not found" unless -f $value; $value = File::Spec->rel2abs($value); } else { for (my $i = 0; $i < scalar(@$value); $i++) { croak "TYPEMAPS file '${$value}[$i]' not found" unless -f ${$value}[$i]; ${$value}[$i] = File::Spec->rel2abs(${$value}[$i]); } } $o->add_list($o->{ILSM}{MAKEFILE}, $key, $value, []); next; } if ($key eq 'AUTO_INCLUDE') { $o->add_text($o->{ILSM}, $key, $value, ''); next; } if ($key eq 'BOOT') { $o->add_text($o->{ILSM}{XS}, $key, $value, ''); next; } if ($key eq 'PREFIX') { croak "Invalid value for 'PREFIX' option" unless ($value =~ /^\w*$/ and $value !~ /\n/); $o->{ILSM}{XS}{PREFIX} = $value; next; } if ($key eq 'FILTERS') { next if $value eq '1' or $value eq '0'; # ignore ENABLE, DISABLE $value = [$value] unless ref($value) eq 'ARRAY'; my %filters; for my $val (@$value) { if (ref($val) eq 'CODE') { $o->add_list($o->{ILSM}, $key, $val, []); } elsif (ref($val) eq 'ARRAY') { my ($filter_plugin, @args) = @$val; croak "Bad format for filter plugin name: '$filter_plugin'" unless $filter_plugin =~ m/^[\w:]+$/; eval "require Inline::Filters::${filter_plugin}"; croak "Filter plugin Inline::Filters::$filter_plugin not installed" if $@; croak "No Inline::Filters::${filter_plugin}::filter sub found" unless defined &{"Inline::Filters::${filter_plugin}::filter"}; my $filter_factory = \&{"Inline::Filters::${filter_plugin}::filter"}; $o->add_list($o->{ILSM}, $key, $filter_factory->(@args), []); } else { eval { require Inline::Filters }; croak "'FILTERS' option requires Inline::Filters to be installed." if $@; %filters = Inline::Filters::get_filters($o->{API}{language}) unless keys %filters; if (defined $filters{$val}) { my $filter = Inline::Filters->new( $val, $filters{$val}); $o->add_list($o->{ILSM}, $key, $filter, []); } else { croak "Invalid filter $val specified."; } } } next; } if ($key eq 'STRUCTS') { # A list of struct names if (ref($value) eq 'ARRAY') { for my $val (@$value) { croak "Invalid value for 'STRUCTS' option" unless ($val =~ /^[_a-z][_0-9a-z]*$/i); $o->{STRUCT}{$val}++; } } # Enable or disable elsif ($value =~ /^\d+$/) { $o->{STRUCT}{'.any'} = $value; } # A single struct name else { croak "Invalid value for 'STRUCTS' option" unless ($value =~ /^[_a-z][_0-9a-z]*$/i); $o->{STRUCT}{$value}++; } eval { require Inline::Struct }; croak "'STRUCTS' option requires Inline::Struct to be installed." if $@; $o->{STRUCT}{'.any'} = 1; next; } if ($key eq 'PROTOTYPES') { $o->{CONFIG}{PROTOTYPES} = $value; next if $value eq 'ENABLE'; next if $value eq 'DISABLE'; die "PROTOTYPES can be only either 'ENABLE' or 'DISABLE' - not $value"; } if ($key eq 'PROTOTYPE') { die "PROTOTYPE configure arg must specify a hash reference" unless ref($value) eq 'HASH'; $o->{CONFIG}{PROTOTYPE} = $value; next; } if ($key eq 'CPPFLAGS') { # C preprocessor flags, used by Inline::Filters::Preprocess() next; } my $class = ref $o; # handles subclasses correctly. croak "'$key' is not a valid config option for $class\n"; } } sub add_list { my $o = shift; my ($ref, $key, $value, $default) = @_; $value = [$value] unless ref $value eq 'ARRAY'; for (@$value) { if (defined $_) { push @{$ref->{$key}}, $_; } else { $ref->{$key} = $default; } } } sub add_string { my $o = shift; my ($ref, $key, $value, $default) = @_; $value = [$value] unless ref $value; croak usage_validate($key) unless ref($value) eq 'ARRAY'; for (@$value) { if (defined $_) { $ref->{$key} .= ' ' . $_; } else { $ref->{$key} = $default; } } } sub add_text { my $o = shift; my ($ref, $key, $value, $default) = @_; $value = [$value] unless ref $value; croak usage_validate($key) unless ref($value) eq 'ARRAY'; for (@$value) { if (defined $_) { chomp; $ref->{$key} .= $_ . "\n"; } else { $ref->{$key} = $default; } } } #============================================================================== # Return a small report about the C code.. #============================================================================== sub info { my $o = shift; return <{ILSM}{XSMODE}; No information is currently generated when using XSMODE. END my $text = ''; $o->preprocess; $o->parse; if (defined $o->{ILSM}{parser}{data}{functions}) { $text .= "The following Inline $o->{API}{language} function(s) have been successfully bound to Perl:\n"; my $parser = $o->{ILSM}{parser}; my $data = $parser->{data}; for my $function (sort @{$data->{functions}}) { my $return_type = $data->{function}{$function}{return_type}; my @arg_names = @{$data->{function}{$function}{arg_names}}; my @arg_types = @{$data->{function}{$function}{arg_types}}; my @args = map {$_ . ' ' . shift @arg_names} @arg_types; $text .= "\t$return_type $function(" . join(', ', @args) . ")\n"; } } else { $text .= "No $o->{API}{language} functions have been successfully bound to Perl.\n\n"; } $text .= Inline::Struct::info($o) if $o->{STRUCT}{'.any'}; return $text; } sub config { my $o = shift; } #============================================================================== # Parse and compile C code #============================================================================== my $total_build_time; sub build { my $o = shift; if ($o->{CONFIG}{BUILD_TIMERS}) { eval {require Time::HiRes}; croak "You need Time::HiRes for BUILD_TIMERS option:\n$@" if $@; $total_build_time = Time::HiRes::time(); } my ($file, $lockfh); if (IS_WIN32) { #this can not look like a file path, or new() fails $file = 'Inline__C_' . $o->{API}{directory} . '.lock'; $file =~ s/\\/_/g; #per CreateMutex on MSDN $lockfh = Win32::Mutex->new(0, $file) or die "lockmutex $file: $^E"; $lockfh->wait(); #acquire, can't use 1 to new(), since if new() opens #existing instead of create new Muxtex, it is not acquired } else { $file = File::Spec->catfile($o->{API}{directory}, '.lock'); open $lockfh, '>', $file or die "lockfile $file: $!"; flock($lockfh, LOCK_EX) or die "flock: $!\n" if $^O !~ /^VMS|riscos|VOS$/; } $o->mkpath($o->{API}{build_dir}); $o->call('preprocess', 'Build Preprocess'); $o->call('parse', 'Build Parse'); $o->call('write_XS', 'Build Glue 1'); $o->call('write_Inline_headers', 'Build Glue 2'); $o->call('write_Makefile_PL', 'Build Glue 3'); $o->call('compile', 'Build Compile'); if (IS_WIN32) { $lockfh->release or die "releasemutex $file: $^E"; } else { flock($lockfh, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/; } if ($o->{CONFIG}{BUILD_TIMERS}) { $total_build_time = Time::HiRes::time() - $total_build_time; printf STDERR "Total Build Time: %5.4f secs\n", $total_build_time; } } sub call { my ($o, $method, $header, $indent) = (@_, 0); my $time; my $i = ' ' x $indent; print STDERR "${i}Starting $header Stage\n" if $o->{CONFIG}{BUILD_NOISY}; $time = Time::HiRes::time() if $o->{CONFIG}{BUILD_TIMERS}; $o->$method(); $time = Time::HiRes::time() - $time if $o->{CONFIG}{BUILD_TIMERS}; print STDERR "${i}Finished $header Stage\n" if $o->{CONFIG}{BUILD_NOISY}; printf STDERR "${i}Time for $header Stage: %5.4f secs\n", $time if $o->{CONFIG}{BUILD_TIMERS}; print STDERR "\n" if $o->{CONFIG}{BUILD_NOISY}; } #============================================================================== # Apply any #============================================================================== sub preprocess { my $o = shift; return if $o->{ILSM}{parser}; $o->get_maps; $o->get_types; $o->{ILSM}{code} = $o->filter(@{$o->{ILSM}{FILTERS}}); } #============================================================================== # Parse the function definition information out of the C code #============================================================================== sub parse { my $o = shift; return if $o->{ILSM}{parser}; return if $o->{ILSM}{XSMODE}; my $parser = $o->{ILSM}{parser} = $o->get_parser; $parser->{data}{typeconv} = $o->{ILSM}{typeconv}; $parser->{data}{AUTOWRAP} = $o->{ILSM}{AUTOWRAP}; Inline::Struct::parse($o) if $o->{STRUCT}{'.any'}; $parser->code($o->{ILSM}{code}) or croak <{API}{language} code passed to Inline at @{[caller(2)]} END } # Create and initialize a parser sub get_parser { my $o = shift; Inline::C::_parser_test($o->{CONFIG}{DIRECTORY}, "Inline::C::get_parser called\n") if $o->{CONFIG}{_TESTING}; require Inline::C::Parser::RecDescent; Inline::C::Parser::RecDescent::get_parser($o); } #============================================================================== # Gather the path names of all applicable typemap files. #============================================================================== sub get_maps { my $o = shift; print STDERR "get_maps Stage\n" if $o->{CONFIG}{BUILD_NOISY}; my $typemap = ''; my $file; $file = File::Spec->catfile( $Config::Config{installprivlib}, "ExtUtils", "typemap", ); $typemap = $file if -f $file; $file = File::Spec->catfile( $Config::Config{privlibexp} ,"ExtUtils","typemap" ); $typemap = $file if (not $typemap and -f $file); warn "Can't find the default system typemap file" if (not $typemap and $^W); unshift(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $typemap) if $typemap; if (not $o->UNTAINT) { require FindBin; $file = File::Spec->catfile($FindBin::Bin,"typemap"); if ( -f $file ) { push(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $file); } } } #============================================================================== # This routine parses XS typemap files to get a list of valid types to create # bindings to. This code is mostly hacked out of Larry Wall's xsubpp program. #============================================================================== sub get_types { my (%type_kind, %proto_letter, %input_expr, %output_expr); my $o = shift; local $_; croak "No typemaps specified for Inline C code" unless @{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}; my $proto_re = "[" . quotemeta('\$%&*@;') . "]"; foreach my $typemap (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) { next unless -e $typemap; # skip directories, binary files etc. warn("Warning: ignoring non-text typemap file '$typemap'\n"), next unless -T $typemap; open(TYPEMAP, $typemap) or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; my $mode = 'Typemap'; my $junk = ""; my $current = \$junk; while () { next if /^\s*\#/; my $line_no = $. + 1; if (/^INPUT\s*$/) {$mode = 'Input'; $current = \$junk; next} if (/^OUTPUT\s*$/) {$mode = 'Output'; $current = \$junk; next} if (/^TYPEMAP\s*$/) {$mode = 'Typemap'; $current = \$junk; next} if ($mode eq 'Typemap') { chomp; my $line = $_; TrimWhitespace($_); # skip blank lines and comment lines next if /^$/ or /^\#/; my ($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next; $type = TidyType($type); $type_kind{$type} = $kind; # prototype defaults to '$' $proto = "\$" unless $proto; warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n") unless ValidProtoString($proto); $proto_letter{$type} = C_string($proto); } elsif (/^\s/) { $$current .= $_; } elsif ($mode eq 'Input') { s/\s+$//; $input_expr{$_} = ''; $current = \$input_expr{$_}; } else { s/\s+$//; $output_expr{$_} = ''; $current = \$output_expr{$_}; } } close(TYPEMAP); } my %valid_types = map {($_, 1)} grep { defined $input_expr{$type_kind{$_}} } keys %type_kind; my %valid_rtypes = map {($_, 1)} ( grep { defined $output_expr{$type_kind{$_}} } keys %type_kind ), 'void'; $o->{ILSM}{typeconv}{type_kind} = \%type_kind; $o->{ILSM}{typeconv}{input_expr} = \%input_expr; $o->{ILSM}{typeconv}{output_expr} = \%output_expr; $o->{ILSM}{typeconv}{valid_types} = \%valid_types; $o->{ILSM}{typeconv}{valid_rtypes} = \%valid_rtypes; } sub ValidProtoString ($) { my $string = shift; my $proto_re = "[" . quotemeta('\$%&*@;') . "]"; return ($string =~ /^$proto_re+$/) ? $string : 0; } sub TrimWhitespace { $_[0] =~ s/^\s+|\s+$//go; } sub TidyType { local $_ = shift; s|\s*(\*+)\s*|$1|g; s|(\*+)| $1 |g; s|\s+| |g; TrimWhitespace($_); $_; } sub C_string ($) { (my $string = shift) =~ s|\\|\\\\|g; $string; } #============================================================================== # Write the XS code #============================================================================== sub write_XS { my $o = shift; my $modfname = $o->{API}{modfname}; my $module = $o->{API}{module}; my $file = File::Spec->catfile($o->{API}{build_dir},"$modfname.xs"); open XS, ">", $file or croak "$file: $!"; if ($o->{ILSM}{XSMODE}) { warn <{ILSM}{code} !~ /MODULE\s*=\s*$module\b/; While using Inline XSMODE, your XS code does not have a line with MODULE = $module You should use the Inline NAME config option, and it should match the XS MODULE name. END print XS $o->xs_code; } else { print XS $o->xs_generate; } close XS; } #============================================================================== # Generate the XS glue code (piece together lots of snippets) #============================================================================== sub xs_generate { my $o = shift; return join '', ( $o->xs_includes, $o->xs_struct_macros, $o->xs_code, $o->xs_struct_code, $o->xs_bindings, $o->xs_boot, ); } sub xs_includes { my $o = shift; return $o->{ILSM}{AUTO_INCLUDE}; } sub xs_struct_macros { my $o = shift; return $o->{STRUCT}{'.macros'}; } sub xs_code { my $o = shift; return $o->{ILSM}{code}; } sub xs_struct_code { my $o = shift; return $o->{STRUCT}{'.xs'}; } sub xs_boot { my $o = shift; if (defined $o->{ILSM}{XS}{BOOT} and $o->{ILSM}{XS}{BOOT}) { return <{ILSM}{XS}{BOOT} END } return ''; } sub xs_bindings { my $o = shift; my $dir = $o->{API}{directory}; if ($o->{CONFIG}{_TESTING}) { my $file = "$dir/void_test"; if (! -f $file) { warn "$file: $!" if !open(TEST_FH, '>', $file); warn "$file: $!" if !close(TEST_FH); } } my ($pkg, $module) = @{$o->{API}}{qw(pkg module)}; my $prefix = ( ($o->{ILSM}{XS}{PREFIX}) ? "PREFIX = $o->{ILSM}{XS}{PREFIX}" : '' ); my $prototypes = defined($o->{CONFIG}{PROTOTYPES}) ? $o->{CONFIG}{PROTOTYPES} : 'DISABLE'; my $XS = <{ILSM}{parser}; my $data = $parser->{data}; warn( "Warning. No Inline C functions bound to Perl in ", $o->{API}{script}, "\n" . "Check your C function definition(s) for Inline compatibility\n\n" ) if ((not defined$data->{functions}) and ($^W)); for my $function (@{$data->{functions}}) { my $return_type = $data->{function}->{$function}->{return_type}; my @arg_names = @{$data->{function}->{$function}->{arg_names}}; my @arg_types = @{$data->{function}->{$function}->{arg_types}}; $XS .= join '', ( "\n$return_type\n$function (", join(', ', @arg_names), ")\n" ); for my $arg_name (@arg_names) { my $arg_type = shift @arg_types; last if $arg_type eq '...'; $XS .= "\t$arg_type\t$arg_name\n"; } my %h; if (defined($o->{CONFIG}{PROTOTYPE})) { %h = %{$o->{CONFIG}{PROTOTYPE}}; } if (defined($h{$function})) { $XS .= " PROTOTYPE: $h{$function}\n"; } my $listargs = ''; $listargs = pop @arg_names if (@arg_names and $arg_names[-1] eq '...'); my $arg_name_list = join(', ', @arg_names); if ($return_type eq 'void') { if ($o->{CONFIG}{_TESTING}) { $XS .= < ".File::Spec->catfile($o->{API}{build_dir},"INLINE.h") or croak; print HEADER <<'END'; #define Inline_Stack_Vars dXSARGS #define Inline_Stack_Items items #define Inline_Stack_Item(x) ST(x) #define Inline_Stack_Reset sp = mark #define Inline_Stack_Push(x) XPUSHs(x) #define Inline_Stack_Done PUTBACK #define Inline_Stack_Return(x) XSRETURN(x) #define Inline_Stack_Void XSRETURN(0) #define INLINE_STACK_VARS Inline_Stack_Vars #define INLINE_STACK_ITEMS Inline_Stack_Items #define INLINE_STACK_ITEM(x) Inline_Stack_Item(x) #define INLINE_STACK_RESET Inline_Stack_Reset #define INLINE_STACK_PUSH(x) Inline_Stack_Push(x) #define INLINE_STACK_DONE Inline_Stack_Done #define INLINE_STACK_RETURN(x) Inline_Stack_Return(x) #define INLINE_STACK_VOID Inline_Stack_Void #define inline_stack_vars Inline_Stack_Vars #define inline_stack_items Inline_Stack_Items #define inline_stack_item(x) Inline_Stack_Item(x) #define inline_stack_reset Inline_Stack_Reset #define inline_stack_push(x) Inline_Stack_Push(x) #define inline_stack_done Inline_Stack_Done #define inline_stack_return(x) Inline_Stack_Return(x) #define inline_stack_void Inline_Stack_Void END close HEADER; } #============================================================================== # Generate the Makefile.PL #============================================================================== sub write_Makefile_PL { my $o = shift; $o->{ILSM}{xsubppargs} = ''; my $i = 0; for (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) { $o->{ILSM}{xsubppargs} .= "-typemap \"$_\" "; } my %options = ( VERSION => $o->{API}{version} || '0.00', %{$o->{ILSM}{MAKEFILE}}, NAME => $o->{API}{module}, ); open MF, "> ".File::Spec->catfile($o->{API}{build_dir},"Makefile.PL") or croak; print MF <{API}{build_dir}; my $cwd = &cwd; ($cwd) = $cwd =~ /(.*)/ if $o->UNTAINT; chdir $build_dir; # Run these in an eval block, so that we get to chdir back to # $cwd if there's a failure. (Ticket #81375.) eval { $o->call('makefile_pl', '"perl Makefile.PL"', 2); $o->call('make', '"make"', 2); $o->call('make_install', '"make install"', 2); }; chdir $cwd; die if $@; #Die now that we've done the chdir back to $cwd. (#81375) $o->call('cleanup', 'Cleaning Up', 2); } sub makefile_pl { my ($o) = @_; my $perl; -f ($perl = $Config::Config{perlpath}) or ($perl = $^X) or croak "Can't locate your perl binary"; $perl = qq{"$perl"} if $perl =~ m/\s/; $o->system_call("$perl Makefile.PL", 'out.Makefile_PL'); $o->fix_make; } sub make { my ($o) = @_; my $make = $o->{ILSM}{MAKE} || $Config::Config{make} or croak "Can't locate your make binary"; local $ENV{MAKEFLAGS} = $ENV{MAKEFLAGS} =~ s/(--jobserver-fds=[\d,]+)// if $ENV{MAKEFLAGS}; $o->system_call("$make", 'out.make'); } sub make_install { my ($o) = @_; my $make = $o->{ILSM}{MAKE} || $Config::Config{make} or croak "Can't locate your make binary"; if ($ENV{MAKEFLAGS}) { # Avoid uninitialized warnings local $ENV{MAKEFLAGS} = $ENV{MAKEFLAGS} =~ s/(--jobserver-fds=[\d,]+)//; } $o->system_call("$make pure_install", 'out.make_install'); } sub cleanup { my ($o) = @_; my ($modpname, $modfname, $install_lib) = @{$o->{API}}{qw(modpname modfname install_lib)}; if ($o->{API}{cleanup}) { $o->rmpath( File::Spec->catdir($o->{API}{directory},'build'), $modpname ); my $autodir = File::Spec->catdir($install_lib,'auto',$modpname); my @files = ( ".packlist", map "$modfname.$_", qw( bs exp lib ) ); my @paths = grep { -e } map { File::Spec->catfile($autodir,$_) } @files; unlink($_) || die "Can't delete file $_: $!" for @paths; } } sub system_call { my ($o, $cmd, $output_file) = @_; my $build_noisy = defined $ENV{PERL_INLINE_BUILD_NOISY} ? $ENV{PERL_INLINE_BUILD_NOISY} : $o->{CONFIG}{BUILD_NOISY}; # test this functionality with: #perl -MInline=C,Config,BUILD_NOISY,1,FORCE_BUILD,1 -e "use Inline C => q[void inline_warner() { int *x = 2; }]" if (not $build_noisy) { $cmd = "$cmd > $output_file 2>&1"; } ($cmd) = $cmd =~ /(.*)/ if $o->UNTAINT; system($cmd) == 0 or croak($o->build_error_message($cmd, $output_file, $build_noisy)); } sub build_error_message { my ($o, $cmd, $output_file, $build_noisy) = @_; my $build_dir = $o->{API}{build_dir}; my $output = ''; if (not $build_noisy and open(OUTPUT, $output_file) ) { local $/; $output = ; close OUTPUT; } my $errcode = $? >> 8; $output .= <{API}{language} code. The command that failed was: \"$cmd\" with error code $errcode The build directory was: $build_dir To debug the problem, cd to the build directory, and inspect the output files. END if ($cmd =~ /^make >/) { for (sort keys %ENV) { $output .= "Environment $_ = '$ENV{$_}'\n" if /^(?:MAKE|PATH)/; } } return $output; } #============================================================================== # This routine fixes problems with the MakeMaker Makefile. #============================================================================== my %fixes = ( INSTALLSITEARCH => 'install_lib', INSTALLDIRS => 'installdirs', XSUBPPARGS => 'xsubppargs', INSTALLSITELIB => 'install_lib', ); sub fix_make { use strict; my (@lines, $fix); my $o = shift; $o->{ILSM}{install_lib} = $o->{API}{install_lib}; $o->{ILSM}{installdirs} = 'site'; open(MAKEFILE, '< Makefile') or croak "Can't open Makefile for input: $!\n"; @lines = ; close MAKEFILE; open(MAKEFILE, '> Makefile') or croak "Can't open Makefile for output: $!\n"; for (@lines) { if (/^(\w+)\s*=\s*\S+.*$/ and $fix = $fixes{$1} ) { my $fixed = $o->{ILSM}{$fix}; print MAKEFILE "$1 = $fixed\n"; } else { print MAKEFILE; } } close MAKEFILE; } sub quote_space { # Do nothing if $ENV{NO_INSANE_DIRNAMES} is set return $_[0] if $ENV{NO_INSANE_DIRNAMES}; # If $_[0] contains one or more doublequote characters, assume # that whitespace has already been quoted as required. Hence, # do nothing other than immediately return $_[0] as is. # We currently don't properly handle tabs either, so we'll # do the same if $_[0] =~ /\t/. return $_[0] if ($_[0] =~ /"/ || $_[0] =~ /\t/); # We want to split on /\s\-I/ not /\-I/ my @in = split /\s\-I/, $_[0]; my $s = @in - 1; my %s; my %q; # First up, let's reinstate the ' ' characters that split # removed for (my $i = 0; $i < $s; $i++) { $in[$i] .= ' '; } # This for{} block dies if it finds that any of the ' -I' # occurrences in $_[0] are part of a directory name. for (my $i = 1; $i < $s; $i++) { my $t = $in[$i + 1]; while ($t =~ /\s$/) {chop $t} die "Found a '", $in[$i], "-I", $t, "' directory.", " INC Config argument is ambiguous.", " Please use doublequotes to signify your intentions" if -d ($in[$i] . "-I" . $t); } $s++; # Now the same as scalar(@in) # Remove (but also Keep track of the amount of) whitespace # at the end of each element of @in. for (my $i = 0; $i < $s; $i++) { my $count = 0; while ($in[$i] =~ /\s$/) { chop $in[$i]; $count++; } $s{$i} = $count; } # Note which elements of @in still contain whitespace. These # (and only these) elements will be quoted for (my $i = 0; $i < $s; $i++) { $q{$i} = 1 if $in[$i] =~ /\s/; } # Reinstate the occurrences of '-I' that were removed by split(), # insert any quotes that are needed, reinstate the whitespace # that was removed earlier, then join() the array back together # again. for (my $i = 0; $i < $s; $i++) { $in[$i] = '-I' . $in[$i] if $i; $in[$i] = '"' . $in[$i] . '"' if $q{$i}; $in[$i] .= ' ' x $s{$i}; } # Note: If there was no whitespace that needed quoting, the # original argument should not have changed in any way. my $out = join '', @in; $out =~ s/"\-I\s+\//"\-I\//g; $_[0] = $out; } #============================================================================== # This routine used by C/t/09parser to test that the expected parser is in use #============================================================================== sub _parser_test { my $dir = shift; my $file = "$dir/parser_id"; warn "$file: $!" if !open(TEST_FH, '>>', $file); print TEST_FH $_[0]; warn "$file: $!" if !close(TEST_FH); } 1; pegex-parser.t100644001750001750 162513465524127 15241 0ustar00tinatina000000000000Inline-C-0.81/tuse Test::More; BEGIN { plan skip_all => '$ENV{PERL_INLINE_DEVELOPER_TEST} not set' unless defined $ENV{PERL_INLINE_DEVELOPER_TEST}; plan tests => 2; } use YAML::XS; use File::Path qw/ rmtree /; sub remove_inline_dirs { for $dir (glob "_Inline*") { rmtree $dir; } } BEGIN { remove_inline_dirs() } END { remove_inline_dirs() } use Inline C => <<'END', USING => '::Parser::Pegex'; SV* JAxH(char* x) { return newSVpvf ("Just Another %s Hacker",x); } END is JAxH('Inline'), "Just Another Inline Hacker", 'initial Inline code parsed'; my $got = Dump($main::data); my $want = <<'...'; --- done: JAxH: 1 function: JAxH: arg_names: - x arg_types: - char * return_type: SV * functions: - JAxH ... is $got, $want, 'parse worked'; # left in comments per ingy wish # io('want')->print($want); # io('got')->print($got); # system('diff -u want got'); # system('rm want got'); TestInlineC.pm100644001750001750 3505413465524127 15214 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; package TestInlineC; BEGIN { $ENV{PERL_PEGEX_AUTO_COMPILE} = 'Inline::C::Parser::Pegex::Grammar'; } use Test::More(); use YAML::XS; use Parse::RecDescent; use Inline::C::Parser::RecDescent; use Pegex::Parser; use Inline::C::Parser::Pegex::Grammar; use Inline::C::Parser::Pegex::AST; use base 'Exporter'; our @EXPORT = qw(test); sub test { my ($input, $label) = @_; my $prd_data = prd_parse($input); my $parser = Pegex::Parser->new( grammar => Inline::C::Parser::Pegex::Grammar->new, receiver => Inline::C::Parser::Pegex::AST->new, debug => $ENV{DEBUG} # || 1, ); my $pegex_data = $parser->parse($input)->{function}; my $prd_dump = Dump $prd_data; my $pegex_dump = Dump $pegex_data; $label = "Pegex matches PRD: $label"; # Carry over TODO from caller. local $TestInlineC::TODO = do { no strict 'refs'; ${ caller . '::TODO' }; }; Test::More::cmp_ok($pegex_dump, 'eq', $prd_dump, $label); ($prd_data, $pegex_data); } require Inline::C; sub prd_parse { my ($input) = @_; $main::RD_HINT++; my $grammar = Inline::C::Parser::RecDescent::grammar(); my $parser = Parse::RecDescent->new( $grammar ); $parser->{data}{typeconv} = TYPECONV(); $parser->code($input); my $data = $parser->{data}; my $functions = $data->{function}; for my $name (keys %$functions) { if ($functions->{$name}{args}) { for my $arg (@{$functions->{$name}{args}}) { delete $arg->{offset}; } } } $parser->{data}{function}; } use constant TYPECONV => { 'valid_rtypes' => { 'wchar_t' => 1, 'int' => 1, 'caddr_t' => 1, 'Boolean' => 1, 'bool' => 1, 'FileHandle' => 1, 'wchar_t *' => 1, 'void *' => 1, 'unsigned char *' => 1, 'AV *' => 1, 'SysRetLong' => 1, 'Result' => 1, 'unsigned int' => 1, 'time_t' => 1, 'CV *' => 1, 'SysRet' => 1, 'ssize_t' => 1, 'unsigned short' => 1, 'double' => 1, 'SV *' => 1, 'PerlIO *' => 1, 'OutputStream' => 1, 'I32' => 1, 'InOutStream' => 1, 'UV' => 1, 'U16' => 1, 'IV' => 1, 'char *' => 1, 'unsigned char' => 1, 'FILE *' => 1, 'bool_t' => 1, 'unsigned long' => 1, 'char **' => 1, 'size_t' => 1, 'unsigned' => 1, 'I16' => 1, 'float' => 1, 'I8' => 1, 'STRLEN' => 1, 'U8' => 1, 'SVREF' => 1, 'U32' => 1, 'const char *' => 1, 'char' => 1, 'HV *' => 1, 'void' => 1, 'long' => 1, 'NV' => 1, 'unsigned long *' => 1, 'InputStream' => 1, 'Time_t *' => 1, 'short' => 1 }, 'output_expr' => { 'T_PACKED' => ' XS_pack_$ntype($arg, $var); ', 'T_UV' => ' sv_setuv($arg, (UV)$var); ', 'T_IV' => ' sv_setiv($arg, (IV)$var); ', 'T_REF_IV_REF' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)new $ntype($var)); ', 'T_U_LONG' => ' sv_setuv($arg, (UV)$var); ', 'T_STDIO' => ' { GV *gv = newGVgen("$Package"); PerlIO *fp = PerlIO_importFILE($var,0); if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &PL_sv_undef; } ', 'T_PTR' => ' sv_setiv($arg, PTR2IV($var)); ', 'T_NV' => ' sv_setnv($arg, (NV)$var); ', 'T_FLOAT' => ' sv_setnv($arg, (double)$var); ', 'T_DOUBLE' => ' sv_setnv($arg, (double)$var); ', 'T_OPAQUE' => ' sv_setpvn($arg, (char *)&$var, sizeof($var)); ', 'T_LONG' => ' sv_setiv($arg, (IV)$var); ', 'T_U_INT' => ' sv_setuv($arg, (UV)$var); ', 'T_ARRAY' => ' { U32 ix_$var; EXTEND(SP,size_$var); for (ix_$var = 0; ix_$var < size_$var; ix_$var++) { ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM } } ', 'T_PTRDESC' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)new\\U${type}_DESC\\E($var)); ', 'T_OPAQUEPTR' => ' sv_setpvn($arg, (char *)$var, sizeof(*$var)); ', 'T_ENUM' => ' sv_setiv($arg, (IV)$var); ', 'T_INOUT' => ' { GV *gv = newGVgen("$Package"); if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &PL_sv_undef; } ', 'T_AVREF' => ' $arg = newRV((SV*)$var); ', 'T_SVREF' => ' $arg = newRV((SV*)$var); ', 'T_HVREF_REFCOUNT_FIXED' => ' $arg = newRV_noinc((SV*)$var); ', 'T_U_CHAR' => ' sv_setuv($arg, (UV)$var); ', 'T_SV' => ' $arg = $var; ', 'T_REFREF' => ' NOT_IMPLEMENTED ', 'T_IN' => ' { GV *gv = newGVgen("$Package"); if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &PL_sv_undef; } ', 'T_INT' => ' sv_setiv($arg, (IV)$var); ', 'T_OUT' => ' { GV *gv = newGVgen("$Package"); if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &PL_sv_undef; } ', 'T_U_SHORT' => ' sv_setuv($arg, (UV)$var); ', 'T_PV' => ' sv_setpv((SV*)$arg, $var); ', 'T_CVREF' => ' $arg = newRV((SV*)$var); ', 'T_CHAR' => ' sv_setpvn($arg, (char *)&$var, 1); ', 'T_PACKEDARRAY' => ' XS_pack_$ntype($arg, $var, count_$ntype); ', 'T_BOOL' => ' ${"$var" eq "RETVAL" ? \\"$arg = boolSV($var);" : \\"sv_setsv($arg, boolSV($var));"} ', 'T_AVREF_REFCOUNT_FIXED' => ' $arg = newRV_noinc((SV*)$var); ', 'T_HVREF' => ' $arg = newRV((SV*)$var); ', 'T_PTRREF' => ' sv_setref_pv($arg, Nullch, (void*)$var); ', 'T_REFOBJ' => ' NOT IMPLEMENTED ', 'T_REF_IV_PTR' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)$var); ', 'T_SHORT' => ' sv_setiv($arg, (IV)$var); ', 'T_CVREF_REFCOUNT_FIXED' => ' $arg = newRV_noinc((SV*)$var); ', 'T_SYSRET' => ' if ($var != -1) { if ($var == 0) sv_setpvn($arg, "0 but true", 10); else sv_setiv($arg, (IV)$var); } ', 'T_PTROBJ' => ' sv_setref_pv($arg, \\"${ntype}\\", (void*)$var); ', 'T_SVREF_REFCOUNT_FIXED' => ' $arg = newRV_noinc((SV*)$var); ' }, 'input_expr' => { 'T_PTR' => ' $var = INT2PTR($type,SvIV($arg)) ', 'T_NV' => ' $var = ($type)SvNV($arg) ', 'T_DOUBLE' => ' $var = (double)SvNV($arg) ', 'T_FLOAT' => ' $var = (float)SvNV($arg) ', 'T_PACKED' => ' $var = XS_unpack_$ntype($arg) ', 'T_IV' => ' $var = ($type)SvIV($arg) ', 'T_UV' => ' $var = ($type)SvUV($arg) ', 'T_REF_IV_REF' => ' if (sv_isa($arg, \\"${ntype}\\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *INT2PTR($type *, tmp); } else Perl_croak(aTHX_ \\"%s: %s is not of type %s\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\", \\"$ntype\\") ', 'T_STDIO' => ' $var = PerlIO_findFILE(IoIFP(sv_2io($arg))) ', 'T_U_LONG' => ' $var = (unsigned long)SvUV($arg) ', 'T_HVREF_REFCOUNT_FIXED' => ' STMT_START { SV* const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){ $var = (HV*)SvRV(xsub_tmp_sv); } else{ Perl_croak(aTHX_ \\"%s: %s is not a HASH reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_U_CHAR' => ' $var = (unsigned char)SvUV($arg) ', 'T_ARRAY' => ' U32 ix_$var = $argoff; $var = $ntype(items -= $argoff); while (items--) { DO_ARRAY_ELEM; ix_$var++; } /* this is the number of elements in the array */ ix_$var -= $argoff ', 'T_PTRDESC' => ' if (sv_isa($arg, \\"${ntype}\\")) { IV tmp = SvIV((SV*)SvRV($arg)); ${type}_desc = (\\U${type}_DESC\\E*) tmp; $var = ${type}_desc->ptr; } else Perl_croak(aTHX_ \\"%s: %s is not of type %s\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\", \\"$ntype\\") ', 'T_OPAQUEPTR' => ' $var = ($type)SvPV_nolen($arg) ', 'T_INOUT' => ' $var = IoIFP(sv_2io($arg)) ', 'T_ENUM' => ' $var = ($type)SvIV($arg) ', 'T_AVREF' => ' STMT_START { SV* const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){ $var = (AV*)SvRV(xsub_tmp_sv); } else{ Perl_croak(aTHX_ \\"%s: %s is not an ARRAY reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_SVREF' => ' STMT_START { SV* const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv)){ $var = SvRV(xsub_tmp_sv); } else{ Perl_croak(aTHX_ \\"%s: %s is not a reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_U_INT' => ' $var = (unsigned int)SvUV($arg) ', 'T_OPAQUE' => ' $var = *($type *)SvPV_nolen($arg) ', 'T_LONG' => ' $var = (long)SvIV($arg) ', 'T_CVREF' => ' STMT_START { HV *st; GV *gvp; SV * const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); $var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0); if (!$var) { Perl_croak(aTHX_ \\"%s: %s is not a CODE reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_CHAR' => ' $var = (char)*SvPV_nolen($arg) ', 'T_PACKEDARRAY' => ' $var = XS_unpack_$ntype($arg) ', 'T_INT' => ' $var = (int)SvIV($arg) ', 'T_OUT' => ' $var = IoOFP(sv_2io($arg)) ', 'T_U_SHORT' => ' $var = (unsigned short)SvUV($arg) ', 'T_PV' => ' $var = ($type)SvPV_nolen($arg) ', 'T_IN' => ' $var = IoIFP(sv_2io($arg)) ', 'T_REFREF' => ' if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *INT2PTR($type,tmp); } else Perl_croak(aTHX_ \\"%s: %s is not a reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\") ', 'T_SV' => ' $var = $arg ', 'T_SYSRET' => ' $var NOT IMPLEMENTED ', 'T_PTROBJ' => ' if (SvROK($arg) && sv_derived_from($arg, \\"${ntype}\\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type,tmp); } else Perl_croak(aTHX_ \\"%s: %s is not of type %s\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\", \\"$ntype\\") ', 'T_SVREF_REFCOUNT_FIXED' => ' STMT_START { SV* const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv)){ $var = SvRV(xsub_tmp_sv); } else{ Perl_croak(aTHX_ \\"%s: %s is not a reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_REF_IV_PTR' => ' if (sv_isa($arg, \\"${ntype}\\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type, tmp); } else Perl_croak(aTHX_ \\"%s: %s is not of type %s\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\", \\"$ntype\\") ', 'T_SHORT' => ' $var = (short)SvIV($arg) ', 'T_CVREF_REFCOUNT_FIXED' => ' STMT_START { HV *st; GV *gvp; SV * const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); $var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0); if (!$var) { Perl_croak(aTHX_ \\"%s: %s is not a CODE reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_REFOBJ' => ' if (sv_isa($arg, \\"${ntype}\\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *INT2PTR($type,tmp); } else Perl_croak(aTHX_ \\"%s: %s is not of type %s\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\", \\"$ntype\\") ', 'T_BOOL' => ' $var = (bool)SvTRUE($arg) ', 'T_AVREF_REFCOUNT_FIXED' => ' STMT_START { SV* const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){ $var = (AV*)SvRV(xsub_tmp_sv); } else{ Perl_croak(aTHX_ \\"%s: %s is not an ARRAY reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_HVREF' => ' STMT_START { SV* const xsub_tmp_sv = $arg; SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){ $var = (HV*)SvRV(xsub_tmp_sv); } else{ Perl_croak(aTHX_ \\"%s: %s is not a HASH reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\"); } } STMT_END ', 'T_PTRREF' => ' if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type,tmp); } else Perl_croak(aTHX_ \\"%s: %s is not a reference\\", ${$ALIAS?\\q[GvNAME(CvGV(cv))]:\\qq[\\"$pname\\"]}, \\"$var\\") ' }, 'valid_types' => { 'unsigned int' => 1, 'SysRet' => 1, 'CV *' => 1, 'time_t' => 1, 'ssize_t' => 1, 'unsigned short' => 1, 'double' => 1, 'SV *' => 1, 'PerlIO *' => 1, 'I32' => 1, 'InOutStream' => 1, 'OutputStream' => 1, 'UV' => 1, 'U16' => 1, 'char *' => 1, 'IV' => 1, 'wchar_t' => 1, 'int' => 1, 'bool' => 1, 'Boolean' => 1, 'caddr_t' => 1, 'void *' => 1, 'wchar_t *' => 1, 'FileHandle' => 1, 'AV *' => 1, 'unsigned char *' => 1, 'SysRetLong' => 1, 'Result' => 1, 'const char *' => 1, 'HV *' => 1, 'char' => 1, 'unsigned long *' => 1, 'InputStream' => 1, 'long' => 1, 'NV' => 1, 'Time_t *' => 1, 'short' => 1, 'unsigned char' => 1, 'bool_t' => 1, 'FILE *' => 1, 'char **' => 1, 'unsigned long' => 1, 'size_t' => 1, 'unsigned' => 1, 'I16' => 1, 'float' => 1, 'U8' => 1, 'I8' => 1, 'STRLEN' => 1, 'U32' => 1, 'SVREF' => 1 }, 'type_kind' => { 'U32' => 'T_U_LONG', 'SVREF' => 'T_SVREF', 'STRLEN' => 'T_UV', 'I8' => 'T_IV', 'U8' => 'T_UV', 'I16' => 'T_IV', 'float' => 'T_FLOAT', 'size_t' => 'T_UV', 'unsigned' => 'T_UV', 'unsigned long' => 'T_UV', 'char **' => 'T_PACKEDARRAY', 'FILE *' => 'T_STDIO', 'bool_t' => 'T_IV', 'unsigned char' => 'T_U_CHAR', 'short' => 'T_IV', 'Time_t *' => 'T_PV', 'NV' => 'T_NV', 'long' => 'T_IV', 'InputStream' => 'T_IN', 'unsigned long *' => 'T_OPAQUEPTR', 'char' => 'T_CHAR', 'HV *' => 'T_HVREF', 'const char *' => 'T_PV', 'Result' => 'T_U_CHAR', 'SysRetLong' => 'T_SYSRET', 'unsigned char *' => 'T_PV', 'AV *' => 'T_AVREF', 'FileHandle' => 'T_PTROBJ', 'void *' => 'T_PTR', 'wchar_t *' => 'T_PV', 'Boolean' => 'T_BOOL', 'caddr_t' => 'T_PV', 'bool' => 'T_BOOL', 'int' => 'T_IV', 'wchar_t' => 'T_IV', 'IV' => 'T_IV', 'char *' => 'T_PV', 'U16' => 'T_U_SHORT', 'UV' => 'T_UV', 'OutputStream' => 'T_OUT', 'InOutStream' => 'T_INOUT', 'I32' => 'T_IV', 'PerlIO *' => 'T_INOUT', 'double' => 'T_DOUBLE', 'SV *' => 'T_SV', 'unsigned short' => 'T_UV', 'ssize_t' => 'T_IV', 'CV *' => 'T_CVREF', 'time_t' => 'T_NV', 'SysRet' => 'T_SYSRET', 'unsigned int' => 'T_UV' } }; 1; C.pod100644001750001750 4774613465524127 15117 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline=pod =for comment DO NOT EDIT. This Pod was generated by Swim v0.1.46. See http://github.com/ingydotnet/swim-pm#readme =encoding utf8 =head1 NAME Inline::C - C Language Support for Inline =for html inline-c-pm =head1 VERSION This document describes L version B<0.81>. =head1 DESCRIPTION C is a module that allows you to write Perl subroutines in C. Since version 0.30 the Inline module supports multiple programming languages and each language has its own support module. This document describes how to use Inline with the C programming language. It also goes a bit into Perl C internals. If you want to start working with programming examples right away, check out L. For more information on Inline in general, see L. =head1 USAGE You never actually use C directly. It is just a support module for using C with C. So the usage is always: use Inline C => ...; or bind Inline C => ...; =head1 FUNCTION DEFINITIONS The Inline grammar for C recognizes certain function definitions (or signatures) in your C code. If a signature is recognized by Inline, then it will be available in Perl-space. That is, Inline will generate the "glue" necessary to call that function as if it were a Perl subroutine. If the signature is not recognized, Inline will simply ignore it, with no complaints. It will not be available from Perl-space, although it I be available from C-space. Inline looks for ANSI/prototype style function definitions. They must be of the form: return-type function-name ( type-name-pairs ) { ... } The most common types are: C, C, C, C, and C. But you can use any type for which Inline can find a typemap. Inline uses the C file distributed with Perl as the default. You can specify more typemaps with the C configuration option. A return type of C may also be used. The following are examples of valid function definitions. int Foo(double num, char* str) { void Foo(double num, char* str) { void Foo(SV*, ...) { long Foo(int i, int j, ...) { SV* Foo(void) { # 'void' arg invalid with the ParseRecDescent parser. # Works only with the ParseRegExp parser. # See the section on `using` (below). SV* Foo() { # Alternative to specifying 'void' arg. Is valid with # both the ParseRecDescent and ParseRegExp parsers. The following definitions would not be recognized: Foo(int i) { # no return type int Foo(float f) { # no (default) typemap for float int Foo(num, str) double num; char* str; { Notice that Inline only looks for function I, not function I. Definitions are the syntax directly preceding a function body. Also Inline does not scan external files, like headers. Only the code passed to Inline is used to create bindings; although other libraries can linked in, and called from C-space. =head1 C CONFIGURATION OPTIONS For information on how to specify Inline configuration options, see L. This section describes each of the configuration options available for C. Most of the options correspond either to MakeMaker or XS options of the same name. See L and L. =over =item C Specifies extra statements to automatically included. They will be added onto the defaults. A newline char will be automatically added. use Inline C => config => auto_include => '#include "yourheader.h"'; =item C If you C<< enable => autowrap >>, Inline::C will parse function declarations (prototype statements) in your C code. For each declaration it can bind to, it will create a dummy wrapper that will call the real function which may be in an external library. This is a nice convenience for functions that would otherwise just require an empty wrapper function. This is similar to the base functionality you get from C. It can be very useful for binding to external libraries. =item C Specifies C code to be executed in the XS C section. Corresponds to the XS parameter. =item C Specify which compiler to use. =item C Specify compiler flags - same as ExtUtils::MakeMaker's C option. Whatever gets specified here replaces the default C<$Config{ccflags}>. Often, you'll want to add an extra flag or two without clobbering the default flags in which case you could instead use C (see below) or, if Config.pm has already been loaded: use Inline C => Config => ccflags => $Config{ccflags} . " -DXTRA -DTOO"; =item C Extend compiler flags. Sets C to $Config{ccflags} followed by a space, followed by the specified value: use Inline C => config => ccflagsex => "-DXTRA -DTOO"; =item C =back Specify preprocessor flags. Passed to C C preprocessor by C in L. use Inline C => <<'END', CPPFLAGS => ' -DPREPROCESSOR_DEFINE', FILTERS => 'Preprocess'; use Inline C => <<'END', CPPFLAGS => ' -DPREPROCESSOR_DEFINE=4321', FILTERS => 'Preprocess'; =over =item C Allows you to specify a list of source code filters. If more than one is requested, be sure to group them with an array ref. The filters can either be subroutine references or names of filters provided by the supplementary Inline::Filters module. Your source code will be filtered just before it is parsed by Inline. The MD5 fingerprint is generated before filtering. Source code filters can be used to do things like stripping out POD documentation, pre-expanding C<#include> statements or whatever else you please. For example: use Inline C => DATA => filters => [Strip_POD => \&MyFilter => Preprocess ]; Filters are invoked in the order specified. See L for more information. If a filter is an array reference, it is assumed to be a usage of a filter plug- in named by the first element of that array reference. The rest of the elements of the array reference are used as arguments to the filter. For example, consider a C parameter like this: use Inline C => DATA => filters => [ [ Ragel => '-G2' ] ]; In order for Inline::C to process this filter, it will attempt to require the module L and will then call the C function in that package with the argument C<'-G2'>. This function will return the actual filtering function. =item C Specifies an include path to use. Corresponds to the MakeMaker parameter. Expects a fully qualified path. use Inline C => config => inc => '-I/inc/path'; =item C Specify which linker to use. =item C Specify which linker flags to use. NOTE: These flags will completely override the existing flags, instead of just adding to them. So if you need to use those too, you must respecify them here. =item C Specifies external libraries that should be linked into your code. Corresponds to the MakeMaker parameter. Provide a fully qualified path with the C<-L> switch if the library is in a location where it won't be found automatically. use Inline C => config => libs => '-lyourlib'; or use Inline C => config => libs => '-L/your/path -lyourlib'; =item C Specify the name of the 'make' utility to use. =item C Specifies a user compiled object that should be linked in. Corresponds to the MakeMaker parameter. Expects a fully qualified path. use Inline C => config => myextlib => '/your/path/yourmodule.so'; =item C This controls the MakeMaker C setting. By setting this value to C<'-g'>, you can turn on debugging support for your Inline extensions. This will allow you to be able to set breakpoints in your C code using a debugger like gdb. =item C Specifies a prefix that will be automatically stripped from C functions when they are bound to Perl. Useful for creating wrappers for shared library API-s, and binding to the original names in Perl. Also useful when names conflict with Perl internals. Corresponds to the XS parameter. use Inline C => config => prefix => 'ZLIB_'; =item C Specifies code that will precede the inclusion of all files specified in C (ie C, C, C, C and anything else that might have been added to C by the user). If the specified value identifies a file, the contents of that file will be inserted, otherwise the specified value is inserted. use Inline C => config => pre_head => $code_or_filename; =item C Corresponds to the XS keyword 'PROTOTYPE'. See the perlxs documentation for both 'PROTOTYPES' and 'PROTOTYPE'. As an example, the following will set the PROTOTYPE of the 'foo' function to '$', and disable prototyping for the 'bar' function. use Inline C => config => prototype => {foo => '$', bar => 'DISABLE'} =item C Corresponds to the XS keyword 'PROTOTYPES'. Can take only values of 'ENABLE' or 'DISABLE'. (Contrary to XS, default value is 'DISABLE'). See the perlxs documentation for both 'PROTOTYPES' and 'PROTOTYPE'. use Inline C => config => prototypes => 'ENABLE'; =item C Specifies extra typemap files to use. These types will modify the behaviour of the C parsing. Corresponds to the MakeMaker parameter. Specify either a fully qualified path or a path relative to the cwd (ie relative to what the cwd is at the time the script is loaded). use Inline C => config => typemaps => '/your/path/typemap'; =item C Specifies which parser to use. The default is L, which uses the L module. The other options are C<::Parser::Pegex> and C<::Parser::RegExp>, which uses the L and L modules that ship with L. use Inline C => config => using => '::Parser::Pegex'; Note that the following old options are deprecated, but still work at this time: =over =item * C =item * C =item * C =back =back =head1 C-PERL BINDINGS This section describes how the C variables get mapped to C variables and back again. First, you need to know how C passes arguments back and forth to subroutines. Basically it uses a stack (also known as the B). When a sub is called, all of the parenthesized arguments get expanded into a list of scalars and pushed onto the B. The subroutine then pops all of its parameters off of the B. When the sub is done, it pushes all of its return values back onto the B. The B is an array of scalars known internally as C's. The B is actually an array of B or C; therefore every element of the B is natively a C. For I about this, read C. So back to variable mapping. XS uses a thing known as "typemaps" to turn each C into a C type and back again. This is done through various XS macro calls, casts and the Perl API. See C. XS allows you to define your own typemaps as well for fancier non-standard types such as C- ed structs. Inline uses the default Perl typemap file for its default types. This file is called C, or something similar, depending on your Perl installation. It has definitions for over 40 types, which are automatically used by Inline. (You should probably browse this file at least once, just to get an idea of the possibilities.) Inline parses your code for these types and generates the XS code to map them. The most commonly used types are: =over =item * C =item * C =item * C =item * C =item * C =item * C =back If you need to deal with a type that is not in the defaults, just use the generic C type in the function definition. Then inside your code, do the mapping yourself. Alternatively, you can create your own typemap files and specify them using the C configuration option. A return type of C has a special meaning to Inline. It means that you plan to push the values back onto the B yourself. This is what you need to do to return a list of values. If you really don't want to return anything (the traditional meaning of C) then simply don't push anything back. If ellipsis or C<...> is used at the end of an argument list, it means that any number of Cs may follow. Again you will need to pop the values off of the C yourself. See L<"EXAMPLES"> below. =head1 THE INLINE STACK MACROS When you write Inline C, the following lines are automatically prepended to your code (by default): #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "INLINE.h" The file C defines a set of macros that are useful for handling the Perl Stack from your C functions. =over =item C You'll need to use this one, if you want to use the others. It sets up a few local variables: C, C, C and C, for use by the other macros. It's not important to know what they do, but I mention them to avoid possible name conflicts. NOTE: Since this macro declares variables, you'll need to put it with your other variable declarations at the top of your function. It must come before any executable statements and before any other C macros. =item C Returns the number of arguments passed in on the Stack. =item C Refers to a particular C in the Stack, where C is an index number starting from zero. Can be used to get or set the value. =item C Use this before pushing anything back onto the Stack. It resets the internal Stack pointer to the beginning of the Stack. =item C Push a return value back onto the Stack. The value must be of type C. =item C After you have pushed all of your return values, you must call this macro. =item C Return C items on the Stack. =item C A special macro to indicate that you really don't want to return anything. Same as: Inline_Stack_Return(0); Please note that this macro actually B from your function. =back Each of these macros is available in 3 different styles to suit your coding tastes. The following macros are equivalent. Inline_Stack_Vars inline_stack_vars INLINE_STACK_VARS All of this functionality is available through XS macro calls as well. So why duplicate the functionality? There are a few reasons why I decided to offer this set of macros. First, as a convenient way to access the Stack. Second, for consistent, self documenting, non-cryptic coding. Third, for future compatibility. It occurred to me that if a lot of people started using XS macros for their C code, the interface might break under Perl6. By using this set, hopefully I will be able to insure future compatibility of argument handling. Of course, if you use the rest of the Perl API, your code will most likely break under Perl6. So this is not a 100% guarantee. But since argument handling is the most common interface you're likely to use, it seemed like a wise thing to do. =head1 WRITING C SUBROUTINES The definitions of your C functions will fall into one of the following four categories. For each category there are special considerations. =over =item C This is the simplest case. You have a non C return type and a fixed length argument list. You don't need to worry about much. All the conversions will happen automatically. =item C In this category you have a C return type. This means that either you want to return nothing, or that you want to return a list. In the latter case you'll need to push values onto the B yourself. There are a few Inline macros that make this easy. Code something like this: int i, max; SV* my_sv[10]; Inline_Stack_Vars; Inline_Stack_Reset; for (i = 0; i < max; i++) Inline_Stack_Push(my_sv[i]); Inline_Stack_Done; After resetting the Stack pointer, this code pushes a series of return values. At the end it uses C to mark the end of the return stack. If you really want to return nothing, then don't use the C macros. If you must use them, then set use C at the end of your function. =item C In this category you have an unfixed number of arguments. This means that you'll have to pop values off the B yourself. Do it like this: int i; Inline_Stack_Vars; for (i = 0; i < Inline_Stack_Items; i++) handle_sv(Inline_Stack_Item(i)); The return type of C is C. =item C In this category you have both a C return type and an unfixed number of arguments. Just combine the techniques from Categories 3 and 4. =back =head1 EXAMPLES Here are a few examples. Each one is a complete program that you can try running yourself. For many more examples see L. =head2 Example #1 - Greetings This example will take one string argument (a name) and print a greeting. The function is called with a string and with a number. In the second case the number is forced to a string. Notice that you do not need to C<< #include >>. The C header file which gets included by default, automatically loads the standard C header files for you. use Inline 'C'; greet('Ingy'); greet(42); __END__ __C__ void greet(char* name) { printf("Hello %s!\n", name); } =head2 Example #2 - and Salutations This is similar to the last example except that the name is passed in as a C (pointer to Scalar Value) rather than a string (C). That means we need to convert the C to a string ourselves. This is accomplished using the C function which is part of the C internal API. See C for more info. One problem is that C doesn't automatically convert strings to numbers, so we get a little surprise when we try to greet C<42>. The program segfaults, a common occurrence when delving into the guts of Perl. use Inline 'C'; greet('Ingy'); greet(42); __END__ __C__ void greet(SV* sv_name) { printf("Hello %s!\n", SvPVX(sv_name)); } =head2 Example #3 - Fixing the problem We can fix the problem in Example #2 by using the C function instead. This function will stringify the C if it does not contain a string. C returns the length of the string as it's second parameter. Since we don't care about the length, we can just put C there, which is a special variable designed for that purpose. use Inline 'C'; greet('Ingy'); greet(42); __END__ __C__ void greet(SV* sv_name) { printf("Hello %s!\n", SvPV(sv_name, PL_na)); } =head1 SEE ALSO For general information about Inline see L. For sample programs using Inline with C see L. For information on supported languages and platforms see L. For information on writing your own Inline Language Support Module, see L. Inline's mailing list is inline@perl.org To subscribe, send email to inline-subscribe@perl.org =head1 BUGS AND DEFICIENCIES If you use C function names that happen to be used internally by Perl, you will get a load error at run time. There is currently no functionality to prevent this or to warn you. For now, a list of Perl's internal symbols is packaged in the Inline module distribution under the filename C<'symbols.perl'>. Avoid using these in your code. =head1 AUTHORS Ingy döt Net Sisyphus =head1 COPYRIGHT AND LICENSE Copyright 2000-2019. Ingy döt Net. Copyright 2008, 2010-2014. Sisyphus. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut 06parseregexp.t100644001750001750 121613465524127 15326 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Inline C => Config => USING => 'Inline::C::Parser::RegExp'; use Inline C => <<'EOC'; void foo() { printf( "Hello World\n" ); } void foo2() { Inline_Stack_Vars; int i; Inline_Stack_Reset; if(0) printf( "Hello World again\n" ); /* tests balanced quotes bugfix */ for(i = 24; i < 30; ++ i) Inline_Stack_Push(sv_2mortal(newSViv(i))); Inline_Stack_Done; Inline_Stack_Return(6); } EOC my @z = foo2(); is(scalar(@z), 6); done_testing; 18quote_space.t100644001750001750 744713465524127 15330 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use Cwd; require Inline::C; my $t = 10; print "1..$t\n"; my $ok = 1; my $expected; my @t1 = ( '-I/foo -I/bar', ' -I/foo -I/bar -I/baz ', ' -I/foo -I" - I/? ', ' -I/for-Ian -I/for-Ingy -I/for-some-Idiocy ', 'some_crap -I-I-I -I/for-Ian -I/for-Ingy -I/for-some-Idiocy -I/foo -I/bar ', ' -I/foo -I/bar -I/fubar', ); for my $e1(@t1) { $expected = $e1; my $got = Inline::C::quote_space($e1); unless($got eq $expected) { $ok = 0; warn "\nGot: **$got**\n", "Expected: **$expected**\n"; } } if ($ok) { print "ok 1\n" } else { print "not ok 1\n" } my @t2 = ( '-I/foo and fu -I/bar', ' -I/foo -I/bar and baa -I/baz ', ' -I/foo and fu -I" - I/? ', ' -I/for-Ian -I/for-Ingy and me -I/for-some-Idiocy ', 'some crap -I-I-I -I/for-Ian -I/for-Ingy -I/for-some Idiocy -I/foo -I/bar ', '-I/foo -I/for-Ian and me -I/for -I/an -I/fu bar', ' -I /foo -I /bar', ); for my $e2 (@t2) {Inline::C::quote_space($e2)} if ($t2[0] eq '"-I/foo and fu" -I/bar') { print "ok 2\n" } else { warn "\n2\nGot: **$t2[0]**\n", "Expected: **\"-I/foo and fu\" -I/bar**\n"; print "not ok 2\n"; } if ($t2[1] eq ' -I/foo "-I/bar and baa" -I/baz ') { print "ok 3\n" } else { warn "\n3\nGot: **$t2[1]**\n", "Expected: ** -I/foo \"-I/bar and baa\" -I/baz **\n"; print "not ok 3\n"; } if ($t2[2] eq ' -I/foo and fu -I" - I/? ') { print "ok 4\n"; } else { warn "\n4\nGot: **$t2[2]**\n", "Expected: ** -I/foo and fu -I\" - I/? **\n"; print "not ok 4\n"; } if ($t2[3] eq ' -I/for-Ian "-I/for-Ingy and me" -I/for-some-Idiocy ') { print "ok 5\n" } else { warn "\n5\nGot: **$t2[3]**\n", "Expected: ** -I/for-Ian \"-I/for-Ingy and me\" -I/for-some-Idiocy **\n"; print "not ok 5\n"; } if ($t2[4] eq '"some crap" -I-I-I -I/for-Ian -I/for-Ingy "-I/for-some Idiocy" -I/foo -I/bar ') { print "ok 6\n" } else { warn "\n6\nGot: **$t2[4]**\n", "Expected: **\"some crap\" -I-I-I -I/for-Ian -I/for-Ingy \"-I/for-some Idiocy\" -I/foo -I/bar **\n"; print "not ok 6\n"; } if ($t2[5] eq '-I/foo "-I/for-Ian and me" -I/for -I/an "-I/fu bar"') {print "ok 7\n"} else { warn "\n7\nGot: **$t2[5]**\n", "Expected: **-I/foo \"-I/for-Ian and me\" -I/for -I/an \"-I/fu bar\"**\n"; print "not ok 7\n"; } if ($t2[6] eq ' "-I/foo" "-I/bar"') { print "ok 8\n" } else { warn "\n8\nGot: **$t2[6]**\n", "Expected: ** \"-I/foo\" \"-I/bar\"**\n"; print "not ok 8\n"; } $ENV{NO_INSANE_DIRNAMES} = 1; my $got = Inline::C::quote_space('-I/foo and fu -I/bar'); if ($got eq '-I/foo and fu -I/bar') { print "ok 9\n" } else { warn "\n9\nGot: **$got**\n", "Expected: **-I/foo and fu -I/bar**\n"; print "not ok 9\n"; } delete $ENV{NO_INSANE_DIRNAMES}; my $have_file_path; my $newdir = Cwd::getcwd(); $newdir .= '/foo -I/'; eval {require File::Path;}; if ($@) { warn "\nSkipping remaining tests - couldn't load File::Path\n"; for(10 .. $t) {print "ok $_\n"} exit 0; } else { $have_file_path = 1 } unless(File::Path::mkpath($newdir)) { unless(-d $newdir) { warn "\n Skipping remaining tests - couldn't create $newdir directory.\n", "Assuming this platform doesn't support spaces in directory names\n"; for(10 .. $t) {print "ok $_\n"} exit 0; } } my $stest = " -I/here and there -I$newdir -I/foo -I/bar "; eval {Inline::C::quote_space($stest);}; if ($@ =~ /\/foo \-I\/' directory\./) { print "ok 10\n" } else { warn "\n\$\@: $@\n"; print "not ok 10\n"; } END { File::Path::rmtree($newdir) if $have_file_path; warn "Failed to remove $newdir" if -d $newdir; }; soldier_typemap100644001750001750 37113465524127 15552 0ustar00tinatina000000000000Inline-C-0.81/tSoldier * SOLDIER INPUT SOLDIER $var = INT2PTR($type, SvIV(SvRV($arg))) OUTPUT SOLDIER $arg = newSViv(0); sv_setiv(newSVrv($arg, \"Soldier\"), (IV)$var); SvREADONLY_on(SvRV($arg)); $arg; 22read_DATA_2.t100644001750001750 127413465524127 14730 0ustar00tinatina000000000000Inline-C-0.81/t# This file checks that a bug in Inline::read_DATA() has been fixed. # The bug existed up to and including Inline-0.52. use strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Inline C => 'DATA'; print "1..1\n"; my $foo = foo1() + foo2(); if($foo == 15) {print "ok 1\n"} else { warn "\$foo: $foo\n"; print "not ok 1\n"; } __DATA__ __C__ #ifndef __Python__ #define __Python__ 8 #endif int foo1() { int ret; if(__Python__ == 8) { ret = __Python__ - 1; } else ret = 7; return ret; } int foo2() { if(__Python__ == 8) return __Python__; else return 8; } 27inline_maker.t100644001750001750 355713465524127 15453 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Test::More; use Config; use IPC::Cmd qw/run/; require version; use File::Path; use Cwd; use File::Copy::Recursive qw(rcopy); use autodie; my @make_targets = qw(test install); my $CLEANUP = 1; push @make_targets, qw(realclean) if $CLEANUP; my ($example_modules_dir) = grep { -e } map { File::Spec->rel2abs(File::Spec->catdir($_, 'modules')) } qw(eg example); plan skip_all => "No 'example' or 'eg' directory." unless $example_modules_dir; require Inline; plan skip_all => "Inline version 0.64+ required for this." unless version->parse($Inline::VERSION) >= version->parse(0.64); my $lib_dir = File::Spec->rel2abs('lib'); my $base_dir = File::Spec->rel2abs($TestInlineSetup::DIR); my $src_dir = File::Spec->catdir($base_dir, 'src dir'); my $inst_dir = File::Spec->catdir($base_dir, 'inst dir'); mkpath $inst_dir; my $cwd = getcwd; # loop the list of modules and try to build them. for my $module (lsdir($example_modules_dir)) { rcopy $module, $src_dir or die "rcopy $module $src_dir: $!\n"; chdir $src_dir; my $buffer = ''; my $cmd = [$^X, "-I$lib_dir", 'Makefile.PL', "INSTALL_BASE=$inst_dir"]; my @result = run(command => $cmd, verbose => 0, buffer => \$buffer); ok($result[0], "$module Makefile creation"); diag "Error: $result[1]\n", $buffer unless $result[0]; map { do_make($_) } @make_targets; chdir $cwd; rmtree $src_dir if $CLEANUP; rmtree $inst_dir if $CLEANUP; } sub lsdir { my $dir = shift; local *DIR; opendir DIR, $dir or die "$dir: $!"; map File::Spec->catdir($dir, $_), grep !/^\./, readdir DIR; } sub do_make { my $target = shift; my $buffer = ''; my $cmd = [$Config{make}, $target]; my @result = run(command => $cmd, verbose => 0, buffer => \$buffer); ok($result[0], "make $target"); diag $buffer unless $result[0]; } done_testing; 14void_arg_PRD.t100644001750001750 263013465524127 15300 0ustar00tinatina000000000000Inline-C-0.81/t# Tests handling of the "void" arg with Parse::RecDescent parser. # Tests 4 onwards are not expected to pass - so we make them TODO. use strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Inline C => Config => FORCE_BUILD => 1, USING => 'Inline::C::Parser::RecDescent'; my $c_text = <<'EOC'; void foo1(void) { printf("Hello from foo1\n"); } int foo2(void) { return 42; } SV * foo3(void) { return newSVnv(42.0); } void foo4() { printf("Hello from foo4\n"); } int foo5() { return 42; } SV * foo6() { return newSVnv(42.0); } void foo7( void ) { printf("Hello from foo7\n"); } int foo8( void ) { return 43; } SV * foo9( void ) { return newSVnv(43.0); } void foo10 ( void ) { printf("Hello from foo10\n"); } int foo11 ( void ) { return 44; } SV * foo12 ( void ) { return newSVnv(44.0); } EOC Inline->bind(C => $c_text); sub run_tests { for my $f (qw(foo4)) { eval "$f();"; is($@, '', $f); } for my $f (qw(foo5 foo6)) { no strict 'refs'; is(&$f, 42, $f); } for my $f (qw(foo1 foo2 foo3 foo7 foo8 foo9 foo10 foo11 foo12)) { TODO: { local $TODO = "Not expected to succeed with Inline::C::Parser::RecDescent parser"; eval "$f();"; is($@, '', $f); }; } } run_tests(); done_testing; share000755001750001750 013465524127 13145 5ustar00tinatina000000000000Inline-C-0.81inline-c.pgx100644001750001750 271113465524127 15524 0ustar00tinatina000000000000Inline-C-0.81/share# This is the Pegex grammar for Inline::C # Note: # # Use the following environment variables for dev: # # export PERL_PEGEX_DEBUG=1 # export PERL_PEGEX_AUTO_COMPILE=1 # # To recompile the grammar without AUTO COMPILE, just run: # # perl -Ilib -MInline::C::ParsePegex::Grammar=compile # # And that will put changes to this file into Inline::C::ParsePegex::Grammar. %grammar inline-c %version 0.0.1 # C code is 1 or more 'parts' code: part+ # The only parts we care about are function definitions and declarations, but # not those inside a comment. part: =ALL ( | comment | function_definition | function_declaration | anything_else ) comment: /- SLASH SLASH [^ BREAK ]* BREAK / | /- SLASH STAR (: [^ STAR ]+ | STAR (! SLASH))* STAR SLASH ([ TAB ]*)? / # int foo_ () { return -1; }\n function_definition: rtype /( identifier )/ - LPAREN arg* % COMMA /- RPAREN - LCURLY -/ function_declaration: rtype /( identifier )/ - LPAREN arg_decl* % COMMA /- RPAREN - SEMI -/ rtype: /- (: rtype1 | rtype2 ) -/ rtype1: / modifier*( type_identifier ) - ( STAR*) / rtype2: / modifier+ STAR*/ arg: /(: type - ( identifier)|( DOT DOT DOT ))/ arg_decl: /( type WS* identifier*| DOT DOT DOT )/ type: / WS*(: type1 | type2 ) WS* / type1: / modifier*( type_identifier ) WS*( STAR* )/ type2: / modifier* STAR* / modifier: /(: (:unsigned|long|extern|const)\b WS* )/ identifier: /(: WORD+ )/ type_identifier: /(: WORD+ )/ anything_else: / ANY* (: EOL | EOS ) / 07typemap_multi.t100644001750001750 220413465524127 15671 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; my $t = $Bin; use Test::More; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; my $obj = Soldier->new('Benjamin', 'Private', 11111); is($obj->get_serial, 11111); is($obj->get_name, 'Benjamin'); is($obj->get_rank, 'Private'); done_testing; package Soldier; BEGIN { $t = -d 'test' ? 'test' : 't'; } use Inline C => Config => USING => 'Inline::C::Parser::RegExp', TYPEMAPS => ["$t/typemap", "$t/soldier_typemap"]; use Inline C => <<'END'; typedef struct { char* name; char* rank; long serial; } Soldier; Soldier * new(char* class, char* name, char* rank, long serial) { Soldier* soldier; New(42, soldier, 1, Soldier); soldier->name = savepv(name); soldier->rank = savepv(rank); soldier->serial = serial; return soldier; } char* get_name(Soldier * obj) { return obj->name; } char* get_rank(Soldier * obj) { return obj->rank; } long get_serial(Soldier * obj) { return obj->serial; } void DESTROY(Soldier* obj) { Safefree(obj->name); Safefree(obj->rank); Safefree(obj); } END TestInlineSetup.pm100644001750001750 330013465524127 16077 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; package TestInlineSetup; use File::Path; use File::Spec; use constant IS_WIN32 => $^O eq 'MSWin32' ; sub import { my ($package, $option) = @_; $option ||= ''; } BEGIN { if (exists $ENV{PERL_INSTALL_ROOT}) { warn "\nIgnoring \$ENV{PERL_INSTALL_ROOT} in $0\n"; delete $ENV{PERL_INSTALL_ROOT}; } # Suppress "Set up gcc environment ..." warning. # (Affects ActivePerl only.) $ENV{ACTIVEPERL_CONFIG_SILENT} = 1; } our $DIR; BEGIN { ($_, $DIR) = caller(2); $DIR =~ s/.*?(\w+)\.t$/$1/ or die; $DIR = "_Inline_$DIR.$$"; rmtree($DIR) if -d $DIR; mkdir($DIR) or die "$DIR: $!\n"; } my $absdir = File::Spec->rel2abs($DIR); ($absdir) = $absdir =~ /(.*)/; # untaint my $startpid = $$; END { if($$ == $startpid) { # only when original process exits # On Windows we need to first unload the dll's we're about to clobber. # (Based on code found in ExtUtils::ParseXS) if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) { my $match = $0; $match =~ s/\\/\//g; $match = '_' . (split /\//, $match)[-1]; $match =~ s/\.(t|p)$//; for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) { if ($DynaLoader::dl_modules[$i] =~ /$match|\bxsmode\b|\bSoldier_|\bBAR_|\bBAZ_|\bFOO_|\bPROTO[1-4]_|\beval_/ ) { my $ret; #on Win32, DLLs are ref counted by OS, the DLL may be do { # boot()ed from multiple psuedoforks, and have multiple refs $ret = DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]); } while (IS_WIN32 && $ret); # so loop while refcount exhausted to force demapping } } } rmtree($absdir); } } 1; author-pod-syntax.t100644001750001750 45413465524127 16224 0ustar00tinatina000000000000Inline-C-0.81/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 11default_readonly.t100644001750001750 137113465524127 16320 0ustar00tinatina000000000000Inline-C-0.81/t# Checks that Inline's bind function still works when $_ is readonly. (Bug #55607) # Thanks Marty O'Brien. use strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; # The following construct not allowed under # strictures (refs). Hence strictures for # refs have been turned off. { no strict ('refs'); for ('function') { $_->(); } } if(foo(15) == 30) {print "ok 1\n"} else { warn "Expected 30, got ", foo(15), "\n"; print "not ok 1\n"; } sub function { use Inline C => Config => USING => 'Inline::C::Parser::RegExp'; Inline->bind(C => <<'__CODE__'); int foo(SV * x) { return (int)SvIV(x) * 2; } __CODE__ } bar000755001750001750 013465524127 13052 5ustar00tinatina000000000000Inline-C-0.81/tfind_me_in_bar.h100755001750001750 6713465524127 16244 0ustar00tinatina000000000000Inline-C-0.81/t/bar/* This file used by t/19INC.t */ #include foo000755001750001750 013465524127 13071 5ustar00tinatina000000000000Inline-C-0.81/tfind_me_in_foo.h100755001750001750 6613465524127 16301 0ustar00tinatina000000000000Inline-C-0.81/t/foo/* This file used by t/19INC.t */ #include C000755001750001750 013465524127 14211 5ustar00tinatina000000000000Inline-C-0.81/lib/InlineParser.pm100644001750001750 7013465524127 16100 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/Cuse strict; use warnings; package Inline::C::Parser; 1 000-require-modules.t100644001750001750 42213465524127 16230 0ustar00tinatina000000000000Inline-C-0.81/t# This test does a basic `use` check on all the code. use Test::More; use File::Find; sub test { s{^lib/(.*)\.pm$}{$1} or return; s{/}{::}g; ok eval("require $_; 1"), "require $_;$@"; } find { wanted => \&test, no_chdir => 1, }, 'lib'; done_testing; Cookbook.pod100644001750001750 12574213465524127 16676 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C=pod =for comment DO NOT EDIT. This Pod was generated by Swim v0.1.46. See http://github.com/ingydotnet/swim-pm#readme =encoding utf8 =head1 NAME Inline::C::Cookbook - A Cornucopia of Inline C Recipes =head1 DESCRIPTION It's a lot easier for most of us to cook a meal from a recipe, rather than just throwing things into a pot until something edible forms. So it is with programming as well. C makes C programming for Perl as easy as possible. Having a set of easy to understand samples, makes it simpler yet. This Cookbook is intended to be an evergrowing repository of small yet complete coding examples; each showing how to accomplish a particular task with Inline. Each example is followed by a short discussion, explaining in detail the particular features that are being demonstrated. Many of these recipes are adapted from email discussions I have had with Inline users around the world. It has been my experience so far, that Inline provides an elegant solution to almost all problems involving Perl and C. Bon Appetit! =head1 APPETIZERS =head2 Hello, world =over =item Problem =back It seems that the first thing any programmer wants to do when he learns a new programming technique is to use it to greet the Earth. How can I do this using Inline? =over =item Solution use Inline C => <<'...'; void greet() { printf("Hello, world\n"); } ... greet; =item Discussion Nothing too fancy here. We define a single C function C which prints a message to STDOUT. One thing to note is that since the Inline code comes before the function call to C, we can call it as a bareword (no parentheses). =item See Also See L and L for basic info about C. =item Credits =over =item * Brian Kernigan =item * Dennis Ritchie =back =back =head2 One Liner =over =item Problem A concept is valid in Perl only if it can be shown to work in one line. Can Inline reduce the complexities of Perl/C interaction to a one-liner? =item Solution perl -e 'use Inline C=>q{void greet(){printf("Hello, world\n");}};greet' =item Discussion Try doing that in XS :-) =item See Also My email signature of late is: perl -le 'use Inline C=>q{SV*JAxH(char*x){return newSVpvf("Just Another %s Hacker",x);}};print JAxH+Perl' A bit fancier but a few bytes too long to qualify as a true one liner :-( =item Credits "Eli the Bearded" gave me the idea that I should have an Inline one-liner as a signature. =back =head1 MEAT & POTATOES =head2 Data Types =over =item Problem How do I pass different types of data to and from Inline C functions; like strings, numbers and integers? =item Solution # vowels.pl use Inline 'C'; $filename = $ARGV[0]; die "Usage: perl vowels.pl filename\n" unless -f $filename; $text = join '', <>; # slurp input file $vp = vowel_scan($text); # call our function $vp = sprintf("%03.1f", $vp * 100); # format for printing print "The letters in $filename are $vp% vowels.\n"; __END__ __C__ /* Find percentage of vowels to letters */ double vowel_scan(char* str) { int letters = 0; int vowels = 0; int i = 0; char c; char normalize = 'a' ^ 'A'; /* normalize forces lower case in ASCII; upper in EBCDIC */ char A = normalize | 'a'; char E = normalize | 'e'; char I = normalize | 'i'; char O = normalize | 'o'; char U = normalize | 'u'; char Z = normalize | 'z'; while(c = str[i++]) { c |= normalize; if (c >= A && c <= Z) { letters++; if (c == A || c == E || c == I || c == O || c == U) vowels++; } } return letters ? ((double) vowels / letters) : 0.0; } =item Discussion This script takes a file name from the command line and prints the ratio of vowels to letters in that file. C uses an Inline C function called C, that takes a string argument, and returns the percentage of vowels as a floating point number between 0 and 1. It handles upper and lower case letters, and works with ASCII and EBCDIC. It is also quite fast. Running this script produces: > perl vowels.pl /usr/dict/words The letters in /usr/dict/words are 37.5% vowels. It is very important to note that the examples in this cookbook use C to mean a string. Internally Perl has various mechanisms to deal with strings that contain characters with code points above 255, using Unicode. This means that naively treating strings as C, an array of 8-bit characters, can lead to problems. You need to be aware of this and consider using a UTF-8 library to deal with strings. =item See Also The Perl Journal vol #19 has an article about Inline which uses this example. =item Credits This example was reprinted by permission of The Perl Journal. It was edited to work with Inline v0.30 and higher. =back =head2 Variable Argument Lists =over =item Problem =back How do I pass a variable-sized list of arguments to an Inline C function? =over =item Solution greet(qw(Sarathy Jan Sparky Murray Mike)); use Inline C => <<'END_OF_C_CODE'; void greet(SV* name1, ...) { Inline_Stack_Vars; int i; for (i = 0; i < Inline_Stack_Items; i++) printf("Hello %s!\n", SvPV(Inline_Stack_Item(i), PL_na)); Inline_Stack_Void; } END_OF_C_CODE =item Discussion This little program greets a group of people, such as my coworkers. We use the C ellipsis syntax: "C<...>", since the list can be of any size. Since there are no types or names associated with each argument, we can't expect XS to handle the conversions for us. We'll need to pop them off the B ourselves. Luckily there are two functions (macros) that make this a very easy task. First, we need to begin our function with a "C" statement. This defines a few internal variables that we need to access the B. Now we can use "C", which returns an integer containing the number of arguments passed to us from Perl. B It is important to I use "C" macros when there is an ellipsis (C<...>) in the argument list, I the function has a return type of void. Second, we use the C function to access each argument where "0 <= x < items". B When using a variable length argument list, you have to specify at least one argument before the ellipsis. (On my compiler, anyway.) When XS does it's argument checking, it will complain if you pass in less than the number of I arguments. Therefore, there is currently no way to pass an empty list when a variable length list is expected. =item See Also =item Credits =back =head2 Multiple Return Values =over =item Problem How do I return a list of values from a C function? =item Solution print map {"$_\n"} get_localtime(time); use Inline C => <<'END_OF_C_CODE'; #include void get_localtime(SV * utc) { const time_t utc_ = (time_t)SvIV(utc); struct tm *ltime = localtime(&utc_); Inline_Stack_Vars; Inline_Stack_Reset; Inline_Stack_Push(sv_2mortal(newSViv(ltime->tm_year))); Inline_Stack_Push(sv_2mortal(newSViv(ltime->tm_mon))); Inline_Stack_Push(sv_2mortal(newSViv(ltime->tm_mday))); Inline_Stack_Push(sv_2mortal(newSViv(ltime->tm_hour))); Inline_Stack_Push(sv_2mortal(newSViv(ltime->tm_min))); Inline_Stack_Push(sv_2mortal(newSViv(ltime->tm_sec))); Inline_Stack_Push(sv_2mortal(newSViv(ltime->tm_isdst))); Inline_Stack_Done; } END_OF_C_CODE =item Discussion Perl is a language where it is common to return a list of values from a subroutine call instead of just a single value. C is not such a language. In order to accomplish this in C we need to manipulate the Perl call stack by hand. Luckily, Inline provides macros to make this easy. This example calls the system C, and returns each of the parts of the time struct; much like the perl builtin C. On each stack push, we are creating a new Perl integer (SVIV) and mortalizing it. The sv_2mortal() call makes sure that the reference count is set properly. Without it, the program would leak memory. NOTE: The C<#include> statement is not really needed, because Inline automatically includes the Perl headers which include almost all standard system calls. =item See Also For more information on the Inline stack macros, see L. =item Credits Richard Anderson contributed the original idea for this snippet. =back =head2 Multiple Return Values (Another Way) =over =item Problem How can I pass back more than one value without using the Perl Stack? =item Solution use Inline::Files; use Inline 'C'; my ($foo, $bar); change($foo, $bar); print "\$foo = $foo\n"; print "\$bar = $bar\n"; __C__ int change(SV* var1, SV* var2) { sv_setpvn(var1, "Perl Rocks!", 11); sv_setpvn(var2, "Inline Rules!", 13); return 1; } =item Discussion Most perl function interfaces return values as a list of one or more scalars. Very few like C, will modify an input scalar in place. On the other hand, in C you do this quite often. Values are passed in by reference and modified in place by the called function. It turns out that we can do that with Inline as well. The secret is to use a type of 'C' for each argument that is to be modified. This ensures passing by reference, because no typemapping is needed. The function can then use the Perl5 API to operate on that argument. When control returns to Perl, the argument will retain the value set by the C function. In this example we passed in 2 empty scalars and assigned values directly to them. =item See Also =item Credits Ned Konz brought this behavior to my attention. He also pointed out that he is not the world famous computer cyclist Steve Roberts ( L ), but he is close ( L ). Thanks Ned. =back =head2 Taking an array-ref as an argument =over =item Problem How can I take a Perl array-ref as an argument in my C function? =item Solution SV *sum(SV *array) { int total = 0; int numelts, i; if ((!SvROK(array)) || (SvTYPE(SvRV(array)) != SVt_PVAV) || ((numelts = av_len((AV *)SvRV(array))) < 0) ) { return &PL_sv_undef; } for (i = 0; i <= numelts; i++) { total += SvIV(*av_fetch((AV *)SvRV(array), i, 0)); } return newSViv(total); } =item Discussion This example returns C if given a non-ref, or a non-array-ref, or a ref to an empty array. You can see how you might expand this to take more than one array-ref. =back =head2 Using Memory =over =item Problem How should I allocate buffers in my Inline C code? =item Solution print greeting('Ingy'); use Inline C => <<'END_OF_C_CODE'; SV* greeting(SV* sv_name) { return (newSVpvf("Hello %s!\n", SvPV(sv_name, PL_na))); } END_OF_C_CODE =item Discussion In this example we will return the greeting to the caller, rather than printing it. This would seem mighty easy, except for the fact that we need to allocate a small buffer to create the greeting. I would urge you to stay away from Cing your own buffer. Just use Perl's built in memory management. In other words, just create a new Perl string scalar. The function C does just that. And C includes C functionality. The other problem is getting rid of this new scalar. How will the ref count get decremented after we pass the scalar back? Perl also provides a function called C. Mortal variables die when the context goes out of scope. In other words, Perl will wait until the new scalar gets passed back and then decrement the ref count for you, thereby making it eligible for garbage collection. See C. In this example the C call gets done under the hood by XS, because we declared the return type to be C. To view the generated XS code, run the command "C". This will leave the build directory intact and tell you where to find it. =item See Also =item Credits =back =head2 Direct Access to Perl variables =over =item Problem Can I write an Inline C function that can access a Perl variable directly without having to pass it as an argument? =item Solution use strict; use warnings; use Inline C => "DATA"; our $mesh_data = "MESH-POINTS 0.0 0.0 0.5 0.25 1.0 0.5 1.5 0.75"; CalcSurfaceHeights(); __DATA__ __C__ #define N_MP 4 void CalcSurfaceHeights() { double x[N_MP], y[N_MP], z; int ix; char *mesh_data = SvPV_nolen(get_sv("main::mesh_data", 0)); sscanf(mesh_data, "MESH-POINTS %lf%lf%lf%lf%lf%lf%lf%lf", x, y, x+1, y+1, x+2, y+2, x+3, y+3); for (ix=0; ix < N_MP; ix++) { z = 0.5*( sin(x[ix]) + sin(y[ix]) ); printf("Surface-Height: %6.3f Mesh-Point: %6.2f, %6.2f\n", z, x[ix], y[ix]); } } =item Discussion There are really only two points that need an explanation to understand why the above code works. In the Perl section, you will notice the declaration our $mesh_data = "..."; For Perl variables to be directly accessible from Inline::C functions, they must be declared as package variables. Lexical variables, those declared with B, cannot be accessed this way. In the C code section of the example, the following line is what makes direct access to the Perl variable work; char *mesh_data = SvPV_nolen(get_sv("main::mesh_data", 0)) Here SvPV_nolen() returns a pointer to the C string contained in the scalar variable. The "_nolen" variation ignores the length of the C string. Hence, the function takes only a single argument, which is the SV* of the scalar variable. We could have used the usual two-argument form of B and, since we don't care about the string length, specified B for the second argument. The function call would then change to, SvPV(get_sv("main::mesh_data", 0), PL_na) The function B returns the SV* of a named scalar package variable. It takes a C string, containing the fully qualified name of the variable, as the first argument. The second argument contains flag values related to data type. Since we are only reading the scalar variable, in our example, a value of 0 can be used. =item See Also =over =item * perldoc perlguts =item * perldoc perlapi =back =item Credits The code example and description were inspired by a discussion thread on the Inline mailing list (inline@perl.org). =back =head1 FAST FOOD =head2 Inline CGI =over =item Problem How do I use Inline securely in a CGI environment? =item Solution #!/usr/bin/perl use CGI qw(:standard); use Inline Config => DIRECTORY => '/usr/local/apache/Inline'; print header, start_html('Inline CGI Example'), h1(JAxH('Inline')), end_html; use Inline C => < to a build area on your disk whenever it compiles code. Most CGI scripts don't (and shouldn't) be able to create a directory and write into it. The solution is to explicitly tell Inline which directory to use with the 'use Inline Config => DIRECTORY => ...' line. Then you need to give write access to that directory from the web server (CGI script). If you see this as a security hole, then there is another option. Give write access to yourself, but read-only access to the CGI script. Then run the script once by hand (from the command line). This will cause Inline to precompile the C code. That way the CGI will only need read access to the build directory (to load in the shared library from there). Just remember that whenever you change the C code, you need to precompile it again. =item See Also See L for more information on using the C module. =item Credits =back =head2 mod_perl =over =item Problem =back How do I use Inline with mod_perl? =over =item Solution package Factorial; use strict; use Inline Config => DIRECTORY => '/usr/local/apache/Inline', enable => 'UNTAINT'; use Inline 'C'; Inline->init; sub handler { my $r = shift; $r->send_http_header('text/plain'); printf "%3d! = %10d\n", $_, factorial($_) for 1..100; return Apache::Constants::OK; } 1; __DATA__ __C__ double factorial(double x) { if (x < 2) return 1; return x * factorial(x - 1) } =item Discussion This is a fully functional mod_perl handler that prints out the factorial values for the numbers 1 to 100. Since we are using Inline under mod_perl, there are a few considerations to , um, consider. First, mod_perl handlers are usually run with C<-T> taint detection. Therefore, we need to enable the UNTAINT option. The next thing to deal with is the fact that this handler will most likely be loaded after Perl's compile time. Since we are using the DATA section, we need to use the special C call. And of course we need to specify a DIRECTORY that mod_perl can compile into. I Other than that, this is a pretty straightforward mod_perl handler, tuned for even more speed! =item See Also See Stas Bekman's upcoming O'Reilly book on mod_perl to which this example was contributed. =back =head2 Object Oriented Inline =over =item Problem =back How do I implement Object Oriented programming in Perl using C objects? =over =item Solution my $obj1 = Soldier->new('Benjamin', 'Private', 11111); my $obj2 = Soldier->new('Sanders', 'Colonel', 22222); my $obj3 = Soldier->new('Matt', 'Sergeant', 33333); for my $obj ($obj1, $obj2, $obj3) { print $obj->get_serial, ") ", $obj->get_name, " is a ", $obj->get_rank, "\n"; } #--------------------------------------------------------- package Soldier; use Inline C => <<'END'; /* Allocate memory with Newx if it's available - if it's an older perl that doesn't have Newx then we resort to using New. */ #ifndef Newx # define Newx(v,n,t) New(0,v,n,t) #endif typedef struct { char* name; char* rank; long serial; } Soldier; SV* new(const char * classname, const char * name, const char * rank, long serial) { Soldier * soldier; SV * obj; SV * obj_ref; Newx(soldier, 1, Soldier); soldier->name = savepv(name); soldier->rank = savepv(rank); soldier->serial = serial; obj = newSViv((IV)soldier); obj_ref = newRV_noinc(obj); sv_bless(obj_ref, gv_stashpv(classname, GV_ADD)); SvREADONLY_on(obj); return obj_ref; } char* get_name(SV* obj) { return ((Soldier*)SvIV(SvRV(obj)))->name; } char* get_rank(SV* obj) { return ((Soldier*)SvIV(SvRV(obj)))->rank; } long get_serial(SV* obj) { return ((Soldier*)SvIV(SvRV(obj)))->serial; } void DESTROY(SV* obj) { Soldier* soldier = (Soldier*)SvIV(SvRV(obj)); Safefree(soldier->name); Safefree(soldier->rank); Safefree(soldier); } END =item Discussion =back Damian Conway has given us myriad ways of implementing OOP in Perl. This is one he might not have thought of. The interesting thing about this example is that it uses Perl for all the OO bindings while using C for the attributes and methods. If you examine the Perl code everything looks exactly like a regular OO example. There is a C method and several accessor methods. The familiar 'arrow syntax' is used to invoke them. In the class definition (second part) the Perl C statement is used to name the object class or namespace. But that's where the similarities end Inline takes over. The idea is that we call a C subroutine called C which returns a blessed scalar. The scalar contains a readonly integer which is a C pointer to a Soldier struct. This is our object. The C function needs to malloc the memory for the struct and then copy the initial values into it using C. This also allocates more memory (which we have to keep track of). The accessor methods are pretty straightforward. They return the current value of their attribute. The last method C is called automatically by Perl whenever an object goes out of scope. This is where we can free all the memory used by the object. That's it. It's a very simplistic example. It doesn't show off any advanced OO features, but it is pretty cool to see how easy the implementation can be. The important Perl call is C which creates a blessed scalar. =over =item See Also =back Read "Object Oriented Perl" by Damian Conway, for more useful ways of doing OOP in Perl. You can learn more Perl calls in L. If you don't have Perl 5.6.0 or higher, visit L =head1 THE MAIN COURSE =head2 Exposing Shared Libraries =over =item Problem You have this great C library and you want to be able to access parts of it with Perl. =item Solution print get('http://www.axkit.org'); use Inline C => Config => LIBS => '-lghttp'; use Inline C => <<'END_OF_C_CODE'; #include char *get(SV* uri) { SV* buffer; ghttp_request* request; buffer = NEWSV(0,0); request = ghttp_request_new(); ghttp_set_uri(request, SvPV(uri, PL_na)); ghttp_set_header(request, http_hdr_Connection, "close"); ghttp_prepare(request); ghttp_process(request); sv_catpv(buffer, ghttp_get_body(request)); ghttp_request_destroy(request); return SvPV(buffer, PL_na); } END_OF_C_CODE =item Discussion This example fetches and prints the HTML from L Itrequires the GNOME http libraries. L One of the most common questions I get is "How can I use Inline to make use of some shared library?". Although it has always been possible to do so, the configuration was ugly, and there were no specific examples. With version 0.30 and higher, you can specify the use of shared libraries easily with something like this: use Inline C => Config => LIBS => '-lghttp'; use Inline C => "code ..."; or use Inline C => "code ...", LIBS => '-lghttp'; To specify a specific library path, use: use Inline C => "code ...", LIBS => '-L/your/lib/path -lyourlib'; To specify an include path use: use Inline C => "code ...", LIBS => '-lghttp', INC => '-I/your/inc/path'; =item See Also The C and C configuration options are formatted and passed into MakeMaker. For more info see L. For more options see L. =item Credits This code was written by Matt Sergeant , author of many CPAN modules. The configuration syntax has been modified for use with Inline v0.30. =back =head2 Automatic Function Wrappers =over =item Problem You have some functions in a C library that you want to access from Perl exactly as you would from C. =item Solution The error function C is probably defined in your standard math library. Annoyingly, Perl does not let you access it. To print out a small table of its values, just say: perl -le 'use Inline C => q{ double erf(double); }, enable => "autowrap"; print "$_ @{[erf($_)]}" for (0..10)' The excellent C implements Term::ReadLine using the GNU ReadLine library. Here is an easy way to access just C from that library: package MyTerm; use Inline C => Config => enable => autowrap => LIBS => "-lreadline -lncurses -lterminfo -ltermcap "; use Inline C => q{ char * readline(char *); }; package main; my $x = MyTerm::readline("xyz: "); Note however that it fails to C the memory returned by readline, and that C offers a much richer interface. =item Discussion We access existing functions by merely showing Inline their declarations, rather than a full definition. Of course the function declared must exist, either in a library already linked to Perl or in a library specified using the C option. The first example wraps a function from the standard math library, so Inline requires no additional C directive. The second uses the Config option to specify the libraries that contain the actual compiled C code. This behavior is always disabled by default. You must enable the C option to make it work. =item See Also =over =item * C =item * C =back =item Credits GNU ReadLine was written by Brian Fox and Chet Ramey . Term::ReadLine::Gnu was written by Hiroo Hayashi . Both are far richer than the slim interface given here! The idea of producing wrapper code given only a function declaration is taken from Swig by David M. Beazley . Ingy's inline editorial insight: This entire entry was contributed by Ariel Scolnicov . Ariel also first suggested the idea for Inline to support function declaration processing. =back =head2 Replacing h2xs =over =item Problem You have a complete C library that you want to access from Perl exactly as you would from C. =item Solution Just say: use IO::All; use Inline C => sub { io('allheaders.h')->all =~ s/LEPT_DLL extern//gr }, enable => "autowrap", libs => '-lleptonica'; =item Discussion In principle, you can use h2xs to wrap a C library into an XS module. One problem with this is that the C parser code is a little out of date. Also, since it works by generating a number of files, maintaining it when the C library changes is a certain amount of work. Using Inline to do the work is much easier. If the header file needs some processing, like removing some text that a full C compiler can deal with, but the Inline::C parser cannot, as in the example above? Well, Perl is good at text-processing. =back =head2 Complex Data =over =item Problem =back How do I deal with complex data types like hashes in Inline C? =over =item Solution use Inline C => <<'END_OF_C_CODE'; void dump_hash(SV* hash_ref) { HV* hash; HE* hash_entry; int num_keys, i; SV* sv_key; SV* sv_val; if (! SvROK(hash_ref)) croak("hash_ref is not a reference"); hash = (HV*)SvRV(hash_ref); num_keys = hv_iterinit(hash); for (i = 0; i < num_keys; i++) { hash_entry = hv_iternext(hash); sv_key = hv_iterkeysv(hash_entry); sv_val = hv_iterval(hash, hash_entry); printf("%s => %s\n", SvPV(sv_key, PL_na), SvPV(sv_val, PL_na)); } return; } END_OF_C_CODE my %hash = ( Author => "Ingy döt Net", Nickname => "INGY", Module => "Inline.pm", Version => "0.30", Language => "C", ); dump_hash(\%hash); =item Discussion The world is not made of scalars alone, although they are definitely the easiest creatures to deal with, when doing Inline stuff. Sometimes we need to deal with arrays, hashes, and code references, among other things. Since Perl subroutine calls only pass scalars as arguments, we'll need to use the argument type C and pass references to more complex types. The above program dumps the key/value pairs of a hash. To figure it out, just curl up with L for a couple hours. Actually, its fairly straight forward once you are familiar with the calls. Note the C function call. This is the proper way to die from your C extensions. =item See Also See L for information about the Perl5 internal API. =item Credits =back =head2 Hash of Lists =over =item Problem =back How do I create a Hash of Lists from C? =over =item Solution use Inline 'C'; use Data::Dumper; $hash_ref = load_data("./cartoon.txt"); print Dumper $hash_ref; __END__ __C__ static int next_word(char**, char*); SV* load_data(char* file_name) { char buffer[100], word[100], * pos; AV* array; HV* hash = newHV(); FILE* fh = fopen(file_name, "r"); while (fgets(pos = buffer, sizeof(buffer), fh)) { if (next_word(&pos, word)) { array = newAV(); hv_store(hash, word, strlen(word), newRV_noinc((SV*)array), 0); while (next_word(&pos, word)) av_push(array, newSVpvf("%s", word)); } } fclose(fh); return newRV_noinc((SV*) hash); } static int next_word(char** text_ptr, char* word) { char* text = *text_ptr; while(*text != '\0' && *text <= ' ') text++; if (*text <= ' ') return 0; while(*text != '\0' && *text > ' ') { *word++ = *text++; } *word = '\0'; *text_ptr = text; return 1; } =item Discussion This is one of the larger recipes. But when you consider the number of calories it has, it's not so bad. The function C takes the name of a file as it's input. The file C might look like: flintstones fred barney jetsons george jane elroy simpsons homer marge bart The function will read the file, parsing each line into words. Then it will create a new hash, whereby the first word in a line becomes a hash key and the remaining words are put into an array whose reference becomes the hash value. The output looks like this: $VAR1 = { 'flintstones' => [ 'fred', 'barney' ], 'simpsons' => [ 'homer', 'marge', 'bart' ], 'jetsons' => [ 'george', 'jane', 'elroy' ] }; =item See Also See L for information about the Perl5 internal API. =item Credits Al Danial requested a solution to this on comp.lang.perl.misc. He borrowed the idea from the "Hash of Lists" example in the Camel book. =back =head1 JUST DESSERTS =head2 Win32 =over =item Problem How do I access Win32 DLL-s using Inline? =item Solution use Inline C => DATA => LIBS => '-luser32'; $text = "@ARGV" || 'Inline.pm works with MSWin32. Scary...'; WinBox('Inline Text Box', $text); __END__ __C__ #include int WinBox(char* Caption, char* Text) { return MessageBoxA(0, Text, Caption, 0); } =item Discussion This example runs on MS Windows. It makes a text box appear on the screen which contains a message of your choice. The important thing is that its proof that you can use Inline to interact with Windows DLL-s. Very scary indeed. 8-o To use Inline on Windows with ActivePerl ( L )you'll need MS Visual Studio. You can also use the Cygwin environment,available at L . =item See Also See L for more info on MSWin32 programming with Inline. =item Credits This example was adapted from some sample code written by Garrett Goebel =back =head2 Embedding Perl in C =over =item Problem How do I use Perl from a regular C program? =item Solution #!/usr/bin/cpr int main(void) { printf("Using Perl version %s from a C program!\n\n", CPR_eval("use Config; $Config{version};")); CPR_eval("use Data::Dumper;"); CPR_eval("print Dumper \\%INC;"); return 0; } =item Discussion By using CPR. (C Perl Run) This example uses another Inline module, C, available separately on CPAN. When you install this module it also installs a binary interpreter called C. (The path may be different on your system) When you feed a C program to the CPR interpreter, it automatically compiles and runs your code using Inline. This gives you full access to the Perl internals. CPR also provides a set of easy to use C macros for calling Perl internals. This means that you can effectively "run" C source code by putting a CPR hashbang as the first line of your C program. =item See Also See L for more information on using CPR. C can be obtained from L =item Credits Randal Schwartz , Randolph Bentson , Richard Anderson , and Tim Maher helped me figure out how to write a program that would work as a hashbang. =back =head1 ENTERTAINING GUESTS As of version 0.30, Inline has the ability to work in cooperation with other modules that want to expose a C API of their own. The general syntax for doing this is: use Inline with => 'Module'; use Inline C => ... ; This tells C to pass configuration options to Inline. Options like typemaps, include paths, and external libraries, are all resolved automatically so you can just concentrate on writing the functions. =head2 Event handling with Event.pm =over =item Problem You need to write a C callback for the C module. Can this be done more easily with Inline? =item Solution use Inline with => 'Event'; Event->timer(desc => 'Timer #1', interval => 2, cb => \&my_callback, ); Event->timer(desc => 'Timer #2', interval => 3, cb => \&my_callback, ); print "Starting...\n"; Event::loop; use Inline C => <<'END'; void my_callback(pe_event* event) { pe_timer * watcher = event->up; printf("%s\n\tEvent priority = %d\n\tWatcher priority = %d\n\n", SvPVX(watcher->base.desc), event->prio, watcher->base.prio ); } END =item Discussion The first line tells Inline to load the C module. Inline then queries C for configuration information. It gets the name and location of Event's header files, typemaps and shared objects. The parameters that C returns look like: INC => "-I $path/Event", TYPEMAPS => "$path/Event/typemap", MYEXTLIB => "$path/auto/Event/Event.$so", AUTO_INCLUDE => '#include "EventAPI.h"', BOOT => 'I_EVENT_API("Inline");', Doing all of this automatically allows you, the programmer, to simply write a function that receives a pointer of type C<'pe_event*'>. This gives you access to the C structure that was passed to you. In this example, I simply print values out of the structure. The Perl code defines 2 timer events which each invoke the same callback. The first one, every two seconds, and the second one, every three seconds. As of this writing, C is the only CPAN module that works in cooperation with Inline. =item See Also Read the C documentation for more information. It contains a tutorial showing several examples of using Inline with C. =item Credits Jochen Stenzel originally came up with the idea of mixing Inline and C. He also authored the C tutorial. Joshua Pritikin is the author of C. =back =head1 FOOD FOR THOUGHT =head2 Calling C from both Perl and C =over =item Problem I'd like to be able to call the same C function from both Perl and C. Also I like to define a C function that B get bound to Perl. How do I do that? =item Solution print "9 + 5 = ", add(9, 5), "\n"; print "SQRT(9^2 + 5^2) = ", pyth(9, 5), "\n"; print "9 * 5 = ", mult(9, 5), "\n"; use Inline C => <<'END_C'; int add(int x, int y) { return x + y; } static int mult(int x, int y) { return x * y; } double pyth(int x, int y) { return sqrt(add(mult(x, x), mult(y, y))); } END_C =item Discussion The program produces: 9 + 5 = 14 SQRT(9^2 + 5^2) = 10.295630140987 Can't locate auto/main/mult.al in @INC ... Every Inline function that is bound to Perl is also callable by C. You don't have to do anything special. Inline arranges it so that all the typemap code gets done by XS and is out of sight. By the time the C function receives control, everything has been converted from Perl to C. Of course if your function manipulates the Perl Stack, you probably don't want to call it from C (unless you I know what you're doing). If you declare a function as C, Inline won't bind it to Perl. That's why we were able to call C from C but the call failed from Perl. =back =head2 Calling Perl from C =over =item Problem So now that I can call C from Perl, how do I call a Perl subroutine from an Inline C function. =item Solution use Inline 'C'; for(1..5) { c_func_1('This is the first line'); c_func_2('This is the second line'); print "\n"; } sub perl_sub_1 { print map "$_\n", @_; } __DATA__ __C__ void c_func_2(SV* text) { dSP; ENTER; SAVETMPS; XPUSHs(sv_2mortal(newSVpvf("Plus an extra line"))); PUTBACK; call_pv("perl_sub_1", G_DISCARD); FREETMPS; LEAVE; } void c_func_1(SV* text) { c_func_2(text); } =item Discussion This demo previously made use of Inline Stack macros only - but that's not the correct way to do it. Instead, base the callbacks on the perlcall documentation (as we're now doing). Actually, this program demonstrates calling a C function which calls another C function which in turn calls a Perl subroutine. The nice thing about Inline C functions is that you can call them from both Perl-space B C-space. That's because Inline creates a wrapper function around each C function. When you use Perl to call C you're actually calling that function's wrapper. The wrapper handles typemapping and Stack management, and then calls your C function. The first time we call C which calls C. The second time we call C directly. C calls the Perl subroutine (C) using the internal C function. It has to put arguments on the stack by hand. Since there is already one argument on the stack when we enter the function, the C ( which is equivalent to an C ) adds a second argument. We iterate through a 'for' loop 5 times just to demonstrate that things still work correctly when we do that. (This was where the previous rendition, making use solely of Inline Stack macros, fell down.) =item See Also See L for more information about Stack macros. See L for more information about the Perl5 internal API. =back =head2 Evaling C =over =item Problem I've totally lost my marbles and I want to generate C code at run time, and C it into Perl. How do I do this? =item Solution use Inline; use Code::Generator; my $c_code = generate('foo_function'); Inline->bind(C => $c_code); foo_function(1, 2, 3); =item Discussion I can't think of a real life application where you would want to generate C code on the fly, but at least I know how I would do it. :) The C function of Inline let's you bind (compileIexecute) C functions at run time. It takes all of the same arguments as C<< use Inline C => ... >>. The nice thing is that once a particular snippet is compiled, it remains cached so that it doesn't need to be compiled again. I can imagine that someday a mad scientist will dream up a self generating modeling system that would run faster and faster over time. If you know such a person, have them drop me a line. =back =head2 Providing a pure perl alternative =over =item Problem I want to write a script that will use a C subroutine if Inline::C is installed, but will otherwise use an equivalent pure perl subroutine if Inline::C is not already installed. How do I do this? =item Solution use strict; use warnings; eval { require Inline; Inline->import (C => Config => BUILD_NOISY => 1); Inline->import (C =><<'EOC'); int foo() { warn("Using Inline\n"); return 42; } EOC }; if ($@) { *foo =\&bar; } sub bar { warn("Using Pure Perl Implementation\n"); return 42; } my $x = foo(); print "$x\n"; =item Discussion If Inline::C is installed and functioning properly, the C sub foo is called by the perl code. Otherwise, $@ gets set, and the equivalent pure perl function bar is instead called. Note, too, that the pure perl sub bar can still be explicitly called even if Inline::C is available. =back =head2 Accessing Fortran subs using Inline::C =over =item Problem I've been given a neat little sub written in fortran that takes, as its args, two integers and returns their product. And I would like to use that sub as is from Inline::C. By way of example, let's say that the fortran source file is named 'prod.f', and that it looks like this: integer function sqarea(r,s) integer r, s sqarea = r*s return end =item Solution We can't access that code directly, but we can compile it into a library which we B then access from Inline::C. Using gcc we could run: gfortran -c prod.f -o prod.o ar cru libprod.a prod.o The function is then accessible as follows: use warnings; use Inline C => Config => LIBS => '-L/full/path/to/libprod_location -lprod -lgfortran'; use Inline C => <<' EOC'; int wrap_sqarea(int a, int b) { return sqarea_(&a, &b); } EOC $x = 15; $y = $x + 3; $ret = wrap_sqarea($x, $y); print "Product of $x and $y is $ret\n"; =item Discussion Note firstly that, although the function is specified as 'sqarea' in the source file, gfortran appends an underscore to the name when the source is compiled. (I don't know if B fortran compilers do this.) Therefore Inline::C needs to call the function as 'sqarea_'. Secondly, because fortran subs pass args by reference, we need to pass the B of the two integer args to sqarea() when we call it from our Inline::C sub. If using g77 instead of gfortran, the only necessary change is that we specify '-lg2c' instead of '-lgfortran' in our 'LIBS' setting. =back =head1 SEE ALSO For generic information about Inline, see L. For information about using Inline with C see L. For information on supported languages and platforms see L. For information on writing your own Inline language support module, see L. Inline's mailing list is inline@perl.org To subscribe, send email to inline-subscribe@perl.org =head1 AUTHORS Ingy döt Net Sisyphus =head1 COPYRIGHT AND LICENSE Copyright 2000-2019. Ingy döt Net. Copyright 2008, 2010-2014. Sisyphus. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut test_header000755001750001750 013465524127 14575 5ustar00tinatina000000000000Inline-C-0.81/ttest_header.h100755001750001750 10413465524127 17353 0ustar00tinatina000000000000Inline-C-0.81/t/test_header /* used by 33intended_double_quotes.t */ #define TEST_DEFINE 2113 iquote_test.h100644001750001750 3113465524127 17405 0ustar00tinatina000000000000Inline-C-0.81/t/test_header#define DESIRED_HEADER 1 ParsePegex.pod100644001750001750 132513465524127 17121 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C=pod =for comment DO NOT EDIT. This Pod was generated by Swim v0.1.46. See http://github.com/ingydotnet/swim-pm#readme =encoding utf8 =head1 NAME Inline::C::ParsePegex - Yet Another Inline::C Parser =head1 SYNOPSIS use Inline C => DATA => USING => ParsePegex; =head1 DESCRIPTION This is another version of Inline::C's parser. It is based on Pegex. =head1 AUTHORS Ingy döt Net Sisyphus =head1 COPYRIGHT AND LICENSE Copyright 2000-2019. Ingy döt Net. Copyright 2008, 2010-2014. Sisyphus. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut 33intended_double_quotes.t100755001750001750 442213465524127 17532 0ustar00tinatina000000000000Inline-C-0.81/t # The "test_header.h" we intend to load is ./test_header.h (which defines TEST_DEFINE to 2112). # With MS compilers expect that the unintended ./test_header/test_header.h (which defines # TEST_DEFINE to 2113) will instead be loaded. use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Config; BEGIN { use Cwd; $cwd = getcwd; my $separator = $^O =~ /MSWin32/ ? ';' : ':'; { no warnings 'uninitialized'; # $ENV{INCLUDE} is used by Microsoft toolset # We can't prepend $Bin/test_header to $ENV{INCLUDE} because the lack of "-iquote" capability # can have unacceptable consequences if we do that. So we append $Bin/test_header to $ENV{INCLUDE} # and then witness (courtesy of this test) that doing so still results in the inclusion # of the unintended header. $ENV{INCLUDE} .= ";" . qq{"$Bin/test_header"}; # $ENV{CPATH} used by gcc toolset # The "-iquote" capability means that we *can* prepend $Bin/test_header to $ENV{CPATH}, # so we do just that, and test that the intended "test_header.h" still gets included. $ENV{CPATH} = qq{"$Bin/test_header"} . $separator . $ENV{CPATH}; } }; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; use Inline C => Config => # BUILD_NOISY => 1, FORCE_BUILD => 1, ; use Inline C => <<'EOC'; #include "test_header.h" int foo() { #if TEST_DEFINE == 2112 return 1; #elif TEST_DEFINE == 2113 return -1; #else return 0; #endif } EOC my $ret = foo(); if(($Config{osname} eq 'MSWin32') and ($Config{cc} =~ /\b(cl\b|clarm|icl)/)) { # Expect MS compilers to load the unintended header file. # If intended header is loaded then this test fails, indicating that we # need to rewrite this test and remove the hard-coded warning emitted # by validate() in C.pm. if($ret == -1) { warn "\n # TODO: wrong header file was loaded\n"; print "ok 1\n"; } elsif($ret == 1) { warn "\n TODO unexpectedly passed.\n", " The hard coded warning being emitted by the\n", " validate() sub in C.pm needs to be removed\n"; print "not ok 1\n"; } else { warn "\nUnexpected error - should be investigated\n"; print "not ok 1\n"; } } else { if($ret == 1) { print "ok 1\n" } else { print "not ok 1\n" } } ParseRegExp.pod100644001750001750 140213465524127 17237 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C=pod =for comment DO NOT EDIT. This Pod was generated by Swim v0.1.46. See http://github.com/ingydotnet/swim-pm#readme =encoding utf8 =head1 NAME Inline::C::ParseRegExp - The New and Improved Inline::C Parser =head1 SYNOPSIS use Inline C => DATA => USING => ParseRegExp; =head1 DESCRIPTION This module is a much faster version of Inline::C's Parse::RecDescent parser. It is based on regular expressions instead. =head1 AUTHOR Mitchell N Charity =head1 COPYRIGHT AND LICENSE Copyright 2000-2019. Ingy döt Net. Copyright 2008, 2010-2014. Sisyphus. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut Parser000755001750001750 013465524127 15445 5ustar00tinatina000000000000Inline-C-0.81/lib/Inline/CPegex.pm100644001750001750 134013465524127 17211 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C/Parseruse strict; use warnings; package Inline::C::Parser::Pegex; use Pegex::Parser; use Inline::C::Parser::Pegex::Grammar; use Inline::C::Parser::Pegex::AST; sub register { { extends => [qw(C)], overrides => [qw(get_parser)], } } sub get_parser { my $o = shift; Inline::C::_parser_test($o->{CONFIG}{DIRECTORY}, "Inline::C::Parser::Pegex::get_parser called\n") if $o->{CONFIG}{_TESTING}; bless {}, 'Inline::C::Parser::Pegex' } sub code { my($self,$code) = @_; $main::data = $self->{data} = Pegex::Parser->new( grammar => Inline::C::Parser::Pegex::Grammar->new, receiver => Inline::C::Parser::Pegex::AST->new, # debug => 1, )->parse($code); return 1; } 1; RegExp.pm100644001750001750 1307613465524127 17364 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C/Parseruse strict; use warnings; package Inline::C::Parser::RegExp; use Carp; sub register { { extends => [qw(C)], overrides => [qw(get_parser)], } } sub get_parser { Inline::C::_parser_test($_[0]->{CONFIG}{DIRECTORY}, "Inline::C::Parser::RegExp::get_parser called\n") if $_[0]->{CONFIG}{_TESTING}; bless {}, 'Inline::C::Parser::RegExp' } sub code { my ($self,$code) = @_; # These regular expressions were derived from Regexp::Common v0.01. my $RE_comment_C = q{(?:(?:\/\*)(?:(?:(?!\*\/)[\s\S])*)(?:\*\/))}; my $RE_comment_Cpp = q{(?:\/\*(?:(?!\*\/)[\s\S])*\*\/|\/\/[^\n]*\n)}; my $RE_quoted = ( q{(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\")} . q{|(?:\')(?:[^\\\']*(?:\\.[^\\\']*)*)(?:\'))} ); our $RE_balanced_brackets; $RE_balanced_brackets = qr'(?:[{]((?:(?>[^{}]+)|(??{$RE_balanced_brackets}))*)[}])'; our $RE_balanced_parens; $RE_balanced_parens = qr'(?:[(]((?:(?>[^()]+)|(??{$RE_balanced_parens}))*)[)])'; # First, we crush out anything potentially confusing. # The order of these _does_ matter. $code =~ s/$RE_comment_C/ /go; $code =~ s/$RE_comment_Cpp/ /go; $code =~ s/^\#.*(\\\n.*)*//mgo; #$code =~ s/$RE_quoted/\"\"/go; # Buggy, if included. $code =~ s/$RE_balanced_brackets/{ }/go; $self->{_the_code_most_recently_parsed} = $code; # Simplifies debugging. my $normalize_type = sub { # Normalize a type for lookup in a typemap. my($type) = @_; # Remove "extern". # But keep "static", "inline", "typedef", etc, # to cause desirable typemap misses. $type =~ s/\bextern\b//g; # Whitespace: only single spaces, none leading or trailing. $type =~ s/\s+/ /g; $type =~ s/^\s//; $type =~ s/\s$//; # Adjacent "derivative characters" are not separated by whitespace, # but _are_ separated from the adjoining text. # [ Is really only * (and not ()[]) needed??? ] $type =~ s/\*\s\*/\*\*/g; $type =~ s/(?<=[^ \*])\*/ \*/g; return $type; }; # The decision of what is an acceptable declaration was originally # derived from Inline::C::grammar.pm version 0.30 (Inline 0.43). my $re_plausible_place_to_begin_a_declaration = qr { # The beginning of a line, possibly indented. # (Accepting indentation allows for C code to be aligned with # its surrounding perl, and for backwards compatibility with # Inline 0.43). (?m: ^ ) \s* }xo; # Instead of using \s , we don't tolerate blank lines. # This matches user expectation better than allowing arbitrary # vertical whitespace. my $sp = qr{[ \t]|\n(?![ \t]*\n)}; my $re_type = qr{ ( (?: \w+ $sp* )+? # words (?: \* $sp* )* # stars ) }xo; my $re_identifier = qr{ (\w+) $sp* }xo; $code =~ s/\bconst\b//g; # Remove "const" qualifier - it's not wanted here. while ($code =~ m{ $re_plausible_place_to_begin_a_declaration ( $re_type $re_identifier $RE_balanced_parens $sp* (\;|\{) ) }xgo ) { my ($type, $identifier, $args, $what) = ($2,$3,$4,$5); $args = "" if $args =~ /^\s+$/; my $is_decl = $what eq ';'; my $function = $identifier; my $return_type = &$normalize_type($type); my @arguments = split ',', $args; goto RESYNC if $is_decl && !$self->{data}{AUTOWRAP}; goto RESYNC if $self->{data}{done}{$function}; goto RESYNC if !defined $self->{data}{typeconv}{valid_rtypes}{$return_type}; my(@arg_names,@arg_types); my $dummy_name = 'arg1'; foreach my $arg (@arguments) { my $arg_no_space = $arg; $arg_no_space =~ s/\s//g; # If $arg_no_space is 'void', there will be no identifier. if (my($type, $identifier) = $arg =~ /^\s*$re_type(?:$re_identifier)?\s*$/o ) { my $arg_name = $identifier; my $arg_type = &$normalize_type($type); if ((!defined $arg_name) && ($arg_no_space ne 'void')) { goto RESYNC if !$is_decl; $arg_name = $dummy_name++; } goto RESYNC if ((!defined $self->{data}{typeconv}{valid_types}{$arg_type}) && ($arg_no_space ne 'void')); # Push $arg_name onto @arg_names iff it's defined. Otherwise ($arg_no_space # was 'void'), push the empty string onto @arg_names (to avoid uninitialized # warnings emanating from C.pm). defined($arg_name) ? push(@arg_names,$arg_name) : push(@arg_names, ''); if ($arg_name) {push(@arg_types,$arg_type)} else {push(@arg_types,'')} # $arg_no_space was 'void' - this push() avoids 'uninitialized' warnings from C.pm } elsif ($arg =~ /^\s*\.\.\.\s*$/) { push(@arg_names,'...'); push(@arg_types,'...'); } else { goto RESYNC; } } # Commit. push @{$self->{data}{functions}}, $function; $self->{data}{function}{$function}{return_type}= $return_type; $self->{data}{function}{$function}{arg_names} = [@arg_names]; $self->{data}{function}{$function}{arg_types} = [@arg_types]; $self->{data}{done}{$function} = 1; next; RESYNC: # Skip the rest of the current line, and continue. $code =~ /\G[^\n]*\n/gc; } return 1; # We never fail. } 1; 32include_dirs_double_quotes.t100644001750001750 143113465524127 20375 0ustar00tinatina000000000000Inline-C-0.81/tuse strict; use warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use TestInlineSetup; use Config; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; print "1..1\n"; use Inline C => Config => # BUILD_NOISY => 1, FORCE_BUILD => 1, CCFLAGS => $Config{ccflags}; # DEV NOTE: do not actually test CPPFLAGS effect on Inline::Filters here, # only test the ability to pass CPPFLAGS argument through Inline::C; # see t/Preprocess_cppflags.t in Inline::Filters for real tests use Inline C => <<'END' => CPPFLAGS => ' -DPREPROCESSOR_DEFINE'; #include "test_header.h" int foo() { return TEST_DEFINE; } END my $foo_retval = foo(); if ( $foo_retval == 2112 ) { print "ok 1\n"; } else { warn "\n Expected: 2112\n Got: $foo_retval\n"; print "not ok 1\n"; } ParseRecDescent.pod100644001750001750 150013465524127 20063 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C=pod =for comment DO NOT EDIT. This Pod was generated by Swim v0.1.46. See http://github.com/ingydotnet/swim-pm#readme =encoding utf8 =head1 NAME Inline::C::ParseRecDescent - The Classic Inline::C Parser =head1 SYNOPSIS use Inline C => DATA => USING => ParseRecDescent; =head1 DESCRIPTION This module is Inline::C's original Parse::RecDescent based parser. It was previously packaged as Inline::C::grammar. Try Inline::C::ParseRegExp for an alternative. =head1 AUTHORS Ingy döt Net Sisyphus =head1 COPYRIGHT AND LICENSE Copyright 2000-2019. Ingy döt Net. Copyright 2008, 2010-2014. Sisyphus. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut Pegex000755001750001750 013465524127 16515 5ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C/ParserAST.pm100644001750001750 200013465524127 17632 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C/Parser/Pegexuse strict; use warnings; package Inline::C::Parser::Pegex::AST; use Pegex::Base; extends 'Pegex::Tree'; has data => {}; sub initial { my ($self) = @_; my $data = { functions => [], function => {}, done => {}, }; $self->data($data); } sub final { my ($self, $got) = @_; return $self->{data}; } sub got_function_definition { my ($self, $ast) = @_; my ($rtype, $name, $args) = @$ast; my ($rname, $rstars) = @$rtype; my $data = $self->data; my $def = $data->{function}{$name} = {}; push @{$data->{functions}}, $name; $def->{return_type} = $rname . ($rstars ? " $rstars" : ''); $def->{arg_names} = []; $def->{arg_types} = []; for my $arg (@$args) { my ($type, $stars, $name) = @$arg; push @{$def->{arg_names}}, $name; push @{$def->{arg_types}}, $type . ($stars ? " $stars" : ''); } $data->{done}{$name} = 1; return; } sub got_arg { my ($self, $ast) = @_; pop @$ast; return $ast; } 1; t000755001750001750 013465524127 16506 5ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01boo.t100755001750001750 66013465524127 17577 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01/tuse warnings; use Test::More; use Boo; use Boo::Far; use Boo::Far::Faz; is Boo::boo(), "Hello from Boo", 'perl sub'; is Boo::Far::boofar(), "Hello from Boo::Far", 'inline c 1 deep'; is Boo::Far::Faz::boofarfaz(), "Hello from Boo::Far::Faz", 'inline c 2 deep'; is $Boo::VERSION, '2.01', 'Boo $VERSION'; is $Boo::Far::VERSION, '2.01', 'Boo::Far $VERSION'; is $Boo::Far::Faz::VERSION, '2.01', 'Boo::Far::Faz $VERSION'; done_testing; 31include_dirs_angle_brackets.t100644001750001750 100713465524127 20465 0ustar00tinatina000000000000Inline-C-0.81/tuse warnings; use diagnostics; use FindBin '$Bin'; use lib $Bin; use Config; BEGIN { use Cwd; $cwd = getcwd; }; use TestInlineSetup; use Inline Config => DIRECTORY => $TestInlineSetup::DIR; use Test::More tests => 1; use Inline C => Config => # BUILD_NOISY => 1, FORCE_BUILD => 1, INC => qq{-I"$Bin/test_header"}; use Inline C => <<'EOC'; #include int foo() { #if defined(DESIRED_HEADER) return 1; #endif return 0; } EOC my $ret = foo(); is($ret, 1, 'load correct header file'); RecDescent.pm100644001750001750 1007013465524127 20200 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C/Parseruse strict; use warnings; package Inline::C::Parser::RecDescent; use Carp; sub register { { extends => [qw(C)], overrides => [qw(get_parser)], } } sub get_parser { my $o = shift; Inline::C::_parser_test($o->{CONFIG}{DIRECTORY}, "Inline::C::Parser::RecDescent::get_parser called\n") if $o->{CONFIG}{_TESTING}; eval { require Parse::RecDescent }; croak <new(grammar()) } sub grammar { <<'END'; code: part(s) { return 1; } part: comment | function_definition { my $function = $item[1][0]; $return = 1, last if $thisparser->{data}{done}{$function}++; push @{$thisparser->{data}{functions}}, $function; $thisparser->{data}{function}{$function}{return_type} = $item[1][1]; $thisparser->{data}{function}{$function}{arg_types} = [map {ref $_ ? $_->[0] : '...'} @{$item[1][2]}]; $thisparser->{data}{function}{$function}{arg_names} = [map {ref $_ ? $_->[1] : '...'} @{$item[1][2]}]; } | function_declaration { $return = 1, last unless $thisparser->{data}{AUTOWRAP}; my $function = $item[1][0]; $return = 1, last if $thisparser->{data}{done}{$function}++; my $dummy = 'arg1'; push @{$thisparser->{data}{functions}}, $function; $thisparser->{data}{function}{$function}{return_type} = $item[1][1]; $thisparser->{data}{function}{$function}{arg_types} = [map {ref $_ ? $_->[0] : '...'} @{$item[1][2]}]; $thisparser->{data}{function}{$function}{arg_names} = [map {ref $_ ? ($_->[1] || $dummy++) : '...'} @{$item[1][2]}]; } | anything_else comment: m{\s* // [^\n]* \n }x | m{\s* /\* (?:[^*]+|\*(?!/))* \*/ ([ \t]*)? }x function_definition: rtype IDENTIFIER '(' (s?) ')' '{' { [@item[2,1], $item[4]] } function_declaration: rtype IDENTIFIER '(' (s?) ')' ';' { [@item[2,1], $item[4]] } rtype: rtype1 | rtype2 rtype1: modifier(s?) TYPE star(s?) { $return = $item[2]; $return = join ' ',@{$item[1]},$return if @{$item[1]} and $item[1][0] ne 'extern'; $return .= join '',' ',@{$item[3]} if @{$item[3]}; return undef unless (defined $thisparser->{data}{typeconv} {valid_rtypes}{$return}); } rtype2: modifier(s) star(s?) { $return = join ' ',@{$item[1]}; $return .= join '',' ',@{$item[2]} if @{$item[2]}; return undef unless (defined $thisparser->{data}{typeconv} {valid_rtypes}{$return}); } arg: type IDENTIFIER {[@item[1,2]]} | '...' arg_decl: type IDENTIFIER(s?) {[$item[1], $item[2][0] || '']} | '...' type: type1 | type2 type1: modifier(s?) TYPE star(s?) { $return = $item[2]; $return = join ' ',@{$item[1]},$return if @{$item[1]}; $return .= join '',' ',@{$item[3]} if @{$item[3]}; return undef unless (defined $thisparser->{data}{typeconv} {valid_types}{$return}); } type2: modifier(s) star(s?) { $return = join ' ',@{$item[1]}; $return .= join '',' ',@{$item[2]} if @{$item[2]}; return undef unless (defined $thisparser->{data}{typeconv} {valid_types}{$return}); } modifier: 'unsigned' | 'long' | 'extern' | 'const' star: '*' IDENTIFIER: /\w+/ TYPE: /\w+/ anything_else: /.*/ END } my $hack = sub { # Appease -w using Inline::Files print Parse::RecDescent::IN ''; print Parse::RecDescent::IN ''; print Parse::RecDescent::TRACE_FILE ''; print Parse::RecDescent::TRACE_FILE ''; }; 1; Boo-2.01000755001750001750 013465524127 16243 5ustar00tinatina000000000000Inline-C-0.81/example/modulesMANIFEST100755001750001750 16413465524127 17520 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01lib/Boo.pm lib/Boo/Far.pm lib/Boo/Far/Faz.pm Makefile.PL MANIFEST This list of files t/boo.t lib000755001750001750 013465524127 17011 5ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01Boo.pm100755001750001750 12213465524127 20204 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01/libpackage Boo; $Boo::VERSION = '2.01'; sub boo { return "Hello from Boo"; } 1; Grammar.pm100644001750001750 654013465524127 20606 0ustar00tinatina000000000000Inline-C-0.81/lib/Inline/C/Parser/Pegexpackage Inline::C::Parser::Pegex::Grammar; use Pegex::Base; extends 'Pegex::Grammar'; # Actual Pegex grammar text is in this file: use constant file => 'ext/inline-c-pgx/inline-c.pgx'; # This method is autocompiled using: # # `perl -Ilib -MInline::C::Parser::Pegex::Grammar=compile` # sub make_tree { # Generated/Inlined by Pegex::Grammar (0.58) { '+grammar' => 'inline-c', '+toprule' => 'code', '+version' => '0.0.1', 'ALL' => { '.rgx' => qr/\G[\s\S]/ }, 'COMMA' => { '.rgx' => qr/\G,/ }, 'LPAREN' => { '.rgx' => qr/\G\(/ }, '_' => { '.rgx' => qr/\G\s*/ }, 'anything_else' => { '.rgx' => qr/\G.*(?:\r?\n|\z)/ }, 'arg' => { '.rgx' => qr/\G(?:\s*(?:(?:(?:unsigned|long|extern|const)\b\s*)*((?:\w+))\s*(\**)|(?:(?:unsigned|long|extern|const)\b\s*)*\**)\s*\s*((?:\w+))|(\.\.\.))/ }, 'arg_decl' => { '.rgx' => qr/\G(\s*(?:(?:(?:unsigned|long|extern|const)\b\s*)*((?:\w+))\s*(\**)|(?:(?:unsigned|long|extern|const)\b\s*)*\**)\s*\s*(?:\w+)*|\.\.\.)/ }, 'code' => { '+min' => 1, '.ref' => 'part' }, 'comment' => { '.any' => [ { '.rgx' => qr/\G\s*\/\/[^\n]*\n/ }, { '.rgx' => qr/\G\s*\/\*(?:[^\*]+|\*(?!\/))*\*\/([\t]*)?/ } ] }, 'function_declaration' => { '.all' => [ { '.ref' => 'rtype' }, { '.rgx' => qr/\G((?:\w+))/ }, { '.ref' => '_' }, { '.ref' => 'LPAREN' }, { '+max' => 1, '.all' => [ { '.ref' => 'arg_decl' }, { '+min' => 0, '-flat' => 1, '.all' => [ { '.ref' => 'COMMA' }, { '.ref' => 'arg_decl' } ] } ] }, { '.rgx' => qr/\G\s*\)\s*;\s*/ } ] }, 'function_definition' => { '.all' => [ { '.ref' => 'rtype' }, { '.rgx' => qr/\G((?:\w+))/ }, { '.ref' => '_' }, { '.ref' => 'LPAREN' }, { '+max' => 1, '.all' => [ { '.ref' => 'arg' }, { '+min' => 0, '-flat' => 1, '.all' => [ { '.ref' => 'COMMA' }, { '.ref' => 'arg' } ] } ] }, { '.rgx' => qr/\G\s*\)\s*\{\s*/ } ] }, 'part' => { '.all' => [ { '+asr' => 1, '.ref' => 'ALL' }, { '.any' => [ { '.ref' => 'comment' }, { '.ref' => 'function_definition' }, { '.ref' => 'function_declaration' }, { '.ref' => 'anything_else' } ] } ] }, 'rtype' => { '.rgx' => qr/\G\s*(?:(?:(?:unsigned|long|extern|const)\b\s*)*((?:\w+))\s*(\**)|(?:(?:unsigned|long|extern|const)\b\s*)+\**)\s*/ } } } 1; Makefile.PL100755001750001750 31213465524127 20334 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01use Inline::MakeMaker; WriteMakefile( NAME => 'Boo', VERSION_FROM => 'lib/Boo.pm', PREREQ_PM => { Inline::C => 0.57 }, clean => { FILES => '_Inline *.inl' }, ); Boo000755001750001750 013465524127 17530 5ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01/libFar.pm100755001750001750 32213465524127 20716 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01/lib/Boopackage Boo::Far; $Boo::Far::VERSION = '2.01'; use Inline Config => NAME => 'Boo::Far' => VERSION => '2.01'; use Inline C => <<'EOC'; SV * boofar() { return(newSVpv("Hello from Boo::Far", 0)); } EOC 1; Math-Simple-1.23000755001750001750 013465524127 17647 5ustar00tinatina000000000000Inline-C-0.81/example/modulesChanges100755001750001750 17413465524127 21267 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Math-Simple-1.23Revision history for Perl extension Math::Simple. 1.23 Sun May 6 22:07:57 2001 - Sample CPAN module using Inline test.pl100755001750001750 16313465524127 21306 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Math-Simple-1.23use strict; use Test::More tests => 2; use Math::Simple qw(add subtract); is add(5, 7), 12; is subtract(5, 7), -2; MANIFEST100755001750001750 5713465524127 21105 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Math-Simple-1.23Changes MANIFEST Makefile.PL Simple.pm test.pl Simple.pm100755001750001750 70313465524127 21561 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Math-Simple-1.23package Math::Simple; $VERSION = '1.23'; use base 'Exporter'; @EXPORT_OK = qw(add subtract); use strict; use Inline C => 'DATA', # you can change "C" to "Foo" if move __Foo__ section VERSION => '1.23', NAME => 'Math::Simple'; 1; #__Foo__ #foo-sub foo-add { $_[0] + $_[1] } #foo-sub foo-subtract { $_[0] - $_[1] } __DATA__ __C__ int add (int x, int y) { return x + y; } int subtract (int x, int y) { return x - y; } Far000755001750001750 013465524127 20240 5ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01/lib/BooFaz.pm100755001750001750 35113465524127 21440 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01/lib/Boo/Farpackage Boo::Far::Faz; $Boo::Far::Faz::VERSION = '2.01'; use Inline Config => NAME => 'Boo::Far::Faz' => VERSION => '2.01'; use Inline C => <<'EOC'; SV * boofarfaz() { return(newSVpv("Hello from Boo::Far::Faz", 0)); } EOC 1; Makefile.PL100755001750001750 25613465524127 21747 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Math-Simple-1.23use Inline::MakeMaker; WriteMakefile( NAME => 'Math::Simple', VERSION_FROM => 'Simple.pm', PREREQ_PM => { Inline::C => 0.57 }, ); data.txt100644001750001750 7213465524127 22011 0ustar00tinatina000000000000Inline-C-0.81/example/modules/Boo-2.01/lib/Boo/FarThis file should not get picked up by the Inline process.