X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/069eb725e1419981deda33fe3e16b94f7d885fbd..4c31e473d8698ee4d43e3e2b98feb4fae2cdcc94:/utils/h2xs.PL diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 7ec7dea..d62e96e 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -101,7 +101,7 @@ Allows a pre-existing extension directory to be overwritten. =item B<-P>, B<--omit-pod> -Omit the autogenerated stub POD section. +Omit the autogenerated stub POD section. =item B<-X>, B<--omit-XS> @@ -169,7 +169,7 @@ not found in standard include directories. =item B<-g>, B<--global> -Include code for safely storing static data in the .xs file. +Include code for safely storing static data in the .xs file. Extensions that do no make use of static data can ignore this option. =item B<-h>, B<-?>, B<--help> @@ -305,7 +305,7 @@ also the section on L>. # Extension is ONC::RPC. h2xs -cfn ONC::RPC - + # Extension is Lib::Foo which works at least with Perl5.005_03. # Constants are created for all #defines and enums h2xs can find # in foo.h. @@ -316,7 +316,7 @@ also the section on L>. # whose names do not start with 'bar_'. h2xs -b 5.5.3 -e '^bar_' -n Lib::Foo foo.h - # Makefile.PL will look for library -lrpc in + # Makefile.PL will look for library -lrpc in # additional directory /opt/net/lib h2xs rpcsvc/rusers -L/opt/net/lib -lrpc @@ -326,7 +326,7 @@ also the section on L>. # Extension is DCE::rgynbase # prefix "sec_rgy_" is dropped from perl function names - # subroutines are created for sec_rgy_wildcard_name and + # subroutines are created for sec_rgy_wildcard_name and # sec_rgy_wildcard_sid h2xs -n DCE::rgynbase -p sec_rgy_ \ -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase @@ -335,7 +335,7 @@ also the section on L>. # visible from perl.h. Name of the extension is perl1. # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)= # Extra backslashes below because the string is passed to shell. - # Note that a directory with perl header files would + # Note that a directory with perl header files would # be added automatically to include path. h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h @@ -352,7 +352,7 @@ also the section on L>. Suppose that you have some C files implementing some functionality, and the corresponding header files. How to create an extension which -makes this functionality accessable in Perl? The example below +makes this functionality accessible in Perl? The example below assumes that the header files are F and I, and you want the perl module be named as C. If you need some preprocessor directives and/or @@ -492,7 +492,7 @@ See L and L for additional details. use strict; -my( $H2XS_VERSION ) = ' $Revision: 1.22 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.23 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; my $compat_version = $]; @@ -504,6 +504,7 @@ $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); use File::Compare; +use File::Path; sub usage { warn "@_\n" if @_; @@ -521,18 +522,19 @@ OPTIONS: -O, --overwrite-ok Allow overwriting of a pre-existing extension directory. -P, --omit-pod Omit the stub POD section. -X, --omit-XS Omit the XS portion (implies both -c and -f). - -a, --gen-accessors Generate get/set accessors for struct and union members (used with -x). - -b, --compat-version Specify a perl version to be backwards compatibile with + -a, --gen-accessors Generate get/set accessors for struct and union members + (used with -x). + -b, --compat-version Specify a perl version to be backwards compatibile with. -c, --omit-constant Omit the constant() function and specialised AUTOLOAD from the XS file. -d, --debugging Turn on debugging messages. -e, --omit-enums Omit constants from enums in the constant() function. - If a pattern is given, only the matching enums are + If a pattern is given, only the matching enums are ignored. -f, --force Force creation of the extension even if the C header does not exist. - -g, --global Include code for safely storing static data in the .xs file. - -h, -?, --help Display this help message + -g, --global Include code for safely storing static data in the .xs file. + -h, -?, --help Display this help message. -k, --omit-const-func Omit 'const' attribute on function arguments (used with -x). -m, --gen-tied-var Generate tied variables for access to declared @@ -542,16 +544,18 @@ OPTIONS: -p, --remove-prefix Specify a prefix which should be removed from the Perl function names. -s, --const-subs Create subroutines for specified macros. - -t, --default-type Default type for autoloaded constants (default is IV) - --use-new-tests Use Test::More in backward compatible modules - --use-old-tests Use the module Test rather than Test::More - --skip-exporter Do not export symbols - --skip-ppport Do not use portability layer - --skip-autoloader Do not use the module C - --skip-strict Do not use the pragma C - --skip-warnings Do not use the pragma C + -t, --default-type Default type for autoloaded constants (default is IV). + --use-new-tests Use Test::More in backward compatible modules. + --use-old-tests Use the module Test rather than Test::More. + --skip-exporter Do not export symbols. + --skip-ppport Do not use portability layer. + --skip-autoloader Do not use the module C. + --skip-strict Do not use the pragma C. + --skip-warnings Do not use the pragma C. -v, --version Specify a version number for this extension. -x, --autogen-xsubs Autogenerate XSUBs using C::Scan. + --use-xsloader Use XSLoader in backward compatible modules (ignored + when used with -X). extra_libraries are any libraries that might be needed for loading the @@ -591,9 +595,11 @@ my ($opt_A, $skip_autoloader, $skip_strict, $skip_warnings, + $use_xsloader ); Getopt::Long::Configure('bundling'); +Getopt::Long::Configure('pass_through'); my %options = ( 'omit-autoload|A' => \$opt_A, @@ -628,6 +634,7 @@ my %options = ( 'skip-autoloader' => \$skip_autoloader, 'skip-warnings' => \$skip_warnings, 'skip-strict' => \$skip_strict, + 'use-xsloader' => \$use_xsloader, ); GetOptions(%options) || usage; @@ -636,10 +643,10 @@ usage if $opt_h; if( $opt_b ){ usage "You cannot use -b and -m at the same time.\n" if ($opt_b && $opt_m); - $opt_b =~ /^\d+\.\d+\.\d+/ || + $opt_b =~ /^v?(\d+)\.(\d+)\.(\d+)/ || usage "You must provide the backwards compatibility version in X.Y.Z form. " . "(i.e. 5.5.0)\n"; - my ($maj,$min,$sub) = split(/\./,$opt_b,3); + my ($maj,$min,$sub) = ($1,$2,$3); if ($maj < 5 || ($maj == 5 && $min < 6)) { $compat_version = $sub ? sprintf("%d.%03d%02d",$maj,$min,$sub) : @@ -699,7 +706,8 @@ $opt_c = $opt_f = 1 if $opt_X; $opt_t ||= 'IV'; -my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; +my %const_xsub; +%const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; my $extralibs = ''; @@ -707,9 +715,10 @@ my @path_h; while (my $arg = shift) { if ($arg =~ /^-l/i) { - $extralibs = "$arg @ARGV"; - last; + $extralibs .= "$arg "; + next; } + last if $extralibs; push(@path_h, $arg); } @@ -822,7 +831,7 @@ if( @path_h ){ } if (!$opt_c) { - die "Can't find $tmp_path_h in @dirs\n" + die "Can't find $tmp_path_h in @dirs\n" if ( ! $opt_f && ! -f "$rel_path_h" ); # Scan the header file (we should deal with nested header files) # Record the names of simple #define constants into const_names @@ -831,7 +840,7 @@ if( @path_h ){ defines: while () { if ($pre_sub_tri_graphs) { - # Preprocess all tri-graphs + # Preprocess all tri-graphs # including things stuck in quoted string constants. s/\?\?=/#/g; # | ??=| #| s/\?\?\!/|/g; # | ??!| || @@ -879,25 +888,26 @@ if( @path_h ){ close(CH); } else { - use Fcntl qw/SEEK_SET/; - seek CH, 0, SEEK_SET; + # Work from miniperl too - on "normal" systems + my $SEEK_SET = eval 'use Fcntl qw/SEEK_SET/; SEEK_SET' or 0; + seek CH, 0, $SEEK_SET; my $src = do { local $/; }; close CH; no warnings 'uninitialized'; - - # Remove C and C++ comments + + # Remove C and C++ comments $src =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs; - - while ($src =~ /(\benum\s*([\w_]*)\s*\{\s([\s\w=,]+)\})/gsc) { - my ($enum_name, $enum_body) = - $1 =~ /enum\s*([\w_]*)\s*\{\s([\s\w=,]+)\}/gs; + + while ($src =~ /\benum\s*([\w_]*)\s*\{\s([^}]+)\}/gsc) { + my ($enum_name, $enum_body) = ($1, $2); # skip enums matching $opt_e next if $opt_e && $enum_name =~ /$opt_e/; my $val = 0; for my $item (split /,/, $enum_body) { - my ($key, $declared_val) = $item =~ /(\w*)\s*=\s*(.*)/; - $val = length($declared_val) ? $declared_val : 1 + $val; - $seen_define{$key} = $declared_val; + next if $item =~ /\A\s*\Z/; + my ($key, $declared_val) = $item =~ /(\w+)\s*(?:=\s*(.*))?/; + $val = defined($declared_val) && length($declared_val) ? $declared_val : 1 + $val; + $seen_define{$key} = $val; $const_names{$key}++; } } # while (...) @@ -909,7 +919,6 @@ if( @path_h ){ # Save current directory so that C::Scan can use it my $cwd = File::Spec->rel2abs( File::Spec->curdir ); -my ($ext, $nested, @modparts, $modfname, $modpname); # As Ilya suggested, use a name that contains - and then it can't clash with # the names of any packages. A directory 'fallback' will clash with any # new pragmata down the fallback:: tree, but that seems unlikely. @@ -917,20 +926,13 @@ my $constscfname = 'const-c.inc'; my $constsxsfname = 'const-xs.inc'; my $fallbackdirname = 'fallback'; -$ext = chdir 'ext' ? 'ext/' : ''; - -if( $module =~ /::/ ){ - $nested = 1; - @modparts = split(/::/,$module); - $modfname = $modparts[-1]; - $modpname = join('/',@modparts); -} -else { - $nested = 0; - @modparts = (); - $modfname = $modpname = $module; -} +my $ext = chdir 'ext' ? 'ext/' : ''; +my @modparts = split(/::/,$module); +my $modpname = join('-', @modparts); +my $modfname = pop @modparts; +my $modpmdir = join '/', 'lib', @modparts; +my $modpmname = join '/', $modpmdir, $modfname.'.pm'; if ($opt_O) { warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname; @@ -938,14 +940,7 @@ if ($opt_O) { else { die "Won't overwrite existing $ext$modpname\n" if -e $modpname; } -if( $nested ){ - my $modpath = ""; - foreach (@modparts){ - -d "$modpath$_" || mkdir("$modpath$_", 0777); - $modpath .= "$_/"; - } -} --d "$modpname" || mkdir($modpname, 0777); +-d "$modpname" || mkpath([$modpname], 0, 0775); chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; my %types_seen; @@ -991,6 +986,8 @@ if( ! $opt_X ){ # use XS, unless it was disabled 'add_cppflags' => $addflags, 'c_styles' => \@styles; $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]); + $c->get('keywords')->{'__restrict'} = 1; + push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); @@ -1064,7 +1061,7 @@ if( ! $opt_X ){ # use XS, unless it was disabled $n = keys %td; my ($k, $v); while (($k, $v) = each %seen_define) { - # print("found '$k'=>'$v'\n"), + # print("found '$k'=>'$v'\n"), $bad_macs{$k} = $td{$k} = $td{$v} if exists $td{$v}; } } @@ -1077,10 +1074,11 @@ if( ! $opt_X ){ # use XS, unless it was disabled } my @const_names = sort keys %const_names; -open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"; +-d $modpmdir || mkpath([$modpmdir], 0, 0775); +open(PM, ">$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n"; $" = "\n\t"; -warn "Writing $ext$modpname/$modfname.pm\n"; +warn "Writing $ext$modpname/$modpmname\n"; print PM <<"END"; package $module; @@ -1107,7 +1105,7 @@ print PM <<'END' unless $skip_exporter; require Exporter; END -my $use_Dyna = (not $opt_X and $compat_version < 5.006); +my $use_Dyna = (not $opt_X and $compat_version < 5.006 and not $use_xsloader); print PM <<"END" if $use_Dyna; # use DynaLoader, unless XS was disabled require DynaLoader; END @@ -1133,7 +1131,7 @@ if ( $compat_version < 5.006 ) { # Determine @ISA. my @modISA; -push @modISA, 'Exporter' unless $skip_exporter; +push @modISA, 'Exporter' unless $skip_exporter; push @modISA, 'DynaLoader' if $use_Dyna; # no XS my $myISA = "our \@ISA = qw(@modISA);"; $myISA =~ s/^our // if $compat_version < 5.006; @@ -1229,7 +1227,7 @@ print PM <<"END"; __END__ END -my ($email,$author); +my ($email,$author,$licence); eval { my $username; @@ -1242,9 +1240,18 @@ eval { } }; +$author =~ s/'/\\'/g if defined $author; $author ||= "A. U. Thor"; $email ||= 'a.u.thor@a.galaxy.far.far.away'; +$licence = sprintf << "DEFAULT", $^V; +Copyright (C) ${\(1900 + (localtime) [5])} by $author + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version %vd or, +at your option, any later version of Perl 5 you may have available. +DEFAULT + my $revhist = ''; $revhist = <) { @@ -1780,7 +1791,7 @@ sub normalize_type { # Second arg: do not strip const's before \* my $do_keep_deep_const = shift; # If $do_keep_deep_const this is heuristical only my $keep_deep_const = ($do_keep_deep_const ? '\b(?![^(,)]*\*)' : ''); - my $ignore_mods + my $ignore_mods = "(?:\\b(?:(?:__const__|const)$keep_deep_const|static|inline|__inline__)\\b\\s*)*"; if ($do_keep_deep_const) { # Keep different compiled /RExen/o separately! $type =~ s/$ignore_mods//go; @@ -1795,7 +1806,7 @@ sub normalize_type { # Second arg: do not strip const's before \* $type =~ s/\* (?=\*)/*/g; $type =~ s/\. \. \./.../g; $type =~ s/ ,/,/g; - $types_seen{$type}++ + $types_seen{$type}++ unless $type eq '...' or $type eq 'void' or $std_types{$type}; $type; } @@ -1878,15 +1889,16 @@ EOP warn "Writing $ext$modpname/Makefile.PL\n"; open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; -my $prereq_pm; +my $prereq_pm = ''; if ( $compat_version < 5.00702 and $new_test ) { - $prereq_pm = q%'Test::More' => 0%; + $prereq_pm .= q%'Test::More' => 0, %; } -else + +if ( $compat_version < 5.00600 and !$opt_X and $use_xsloader) { - $prereq_pm = ''; + $prereq_pm .= q%'XSLoader' => 0, %; } print PL <<"END"; @@ -1896,10 +1908,10 @@ use ExtUtils::MakeMaker; # the contents of the Makefile that is written. WriteMakefile( NAME => '$module', - VERSION_FROM => '$modfname.pm', # finds \$VERSION + VERSION_FROM => '$modpmname', # finds \$VERSION PREREQ_PM => {$prereq_pm}, # e.g., Module::Name => 1.1 (\$] >= 5.005 ? ## Add these new keywords supported since 5.005 - (ABSTRACT_FROM => '$modfname.pm', # retrieve abstract from module + (ABSTRACT_FROM => '$modpmname', # retrieve abstract from module AUTHOR => '$author <$email>') : ()), END if (!$opt_X) { # print C stuff, unless XS is disabled @@ -2045,16 +2057,13 @@ COPYRIGHT AND LICENCE Put the correct copyright and licence information here. -Copyright (C) $thisyear $author - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +$licence _RMEND_ close(RM) || die "Can't close $ext$modpname/README: $!\n"; my $testdir = "t"; -my $testfile = "$testdir/1.t"; +my $testfile = "$testdir/$modpname.t"; unless (-d "$testdir") { mkdir "$testdir" or die "Cannot mkdir $testdir: $!\n"; } @@ -2065,7 +2074,7 @@ open EX, ">$testfile" or die "Can't create $ext$modpname/$testfile: $!\n"; print EX <<_END_; # Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl 1.t' +# `make test'. After `make install' it should work as `perl $modpname.t' ######################### @@ -2104,7 +2113,7 @@ _END_ print "# pass: \$\@"; } else { print "# fail: \$\@"; - \$fail = 1; + \$fail = 1; } } if (\$fail) { @@ -2179,7 +2188,7 @@ EOP warn "Writing $ext$modpname/MANIFEST\n"; open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!"; -my @files = grep { -f } (<*>, , <$fallbackdirname/*>); +my @files = grep { -f } (<*>, , <$fallbackdirname/*>, <$modpmdir/*>); if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); }