X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2xs.PL;h=df89626b91fabc58e26d5d06bf9a4d401485dddf;hb=abc0a0153433fe6596e1ca3a6b5572dc424d0f11;hp=9b7584c9bbc93ee5696f228d4ba0f380aa03d607;hpb=9de3b7c3f04d243540e2a381092bf0f918b7fe9e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 9b7584c..df89626 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -75,6 +75,11 @@ extra-libraries argument. Omit all autoload facilities. This is the same as B<-c> but also removes the S> statement from the .pm file. +=item B<-B>, B<--beta-version> + +Use an alpha/beta style version number. Causes version number to +be "0.00_01" unless B<-v> is specified. + =item B<-C>, B<--omit-changes> Omits creation of the F file, and adds a HISTORY section to @@ -83,7 +88,8 @@ the POD template. =item B<-F>, B<--cpp-flags>=I Additional flags to specify to C preprocessor when scanning header for -function declarations. Should not be used without B<-x>. +function declarations. Writes these options in the generated F +too. =item B<-M>, B<--func-mask>=I @@ -206,7 +212,7 @@ of C may gain the ability to make educated guesses. =item B<--use-new-tests> When B<--compat-version> (B<-b>) is present the generated tests will use -C rather then C which is the default for versions before +C rather than C which is the default for versions before 5.7.2 . C will be added to PREREQ_PM in the generated C. @@ -214,10 +220,32 @@ C. Will force the generation of test code that uses the older C module. +=item B<--skip-exporter> + +Do not use C and/or export any symbol. + +=item B<--skip-ppport> + +Do not use C: no portability to older version. + +=item B<--skip-autoloader> + +Do not use the module C; but keep the constant() function +and C for constants. + +=item B<--skip-strict> + +Do not use the pragma C. + +=item B<--skip-warnings> + +Do not use the pragma C. + =item B<-v>, B<--version>=I Specify a version number for this extension. This version number is added -to the templates. The default is 0.01. +to the templates. The default is 0.01, or 0.00_01 if C<-B> is specified. +The version specified should be numeric. =item B<-x>, B<--autogen-xsubs> @@ -435,7 +463,7 @@ See L and L for additional details. use strict; -my( $H2XS_VERSION ) = ' $Revision: 1.21 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.22 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; my $compat_version = $]; @@ -447,7 +475,6 @@ $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); use File::Compare; -use Devel::PPPort; sub usage { warn "@_\n" if @_; @@ -456,9 +483,10 @@ h2xs [OPTIONS ... ] [headerfile [extra_libraries]] version: $H2XS_VERSION OPTIONS: -A, --omit-autoload Omit all autoloading facilities (implies -c). + -B, --beta-version Use beta \$VERSION of 0.00_01 (ignored if -v). -C, --omit-changes Omit creating the Changes file, add HISTORY heading to stub POD. - -F, --cpp-flags Additional flags for C preprocessor (used with -x). + -F, --cpp-flags Additional flags for C preprocessor/compile. -M, --func-mask Mask to select C functions/macros (default is select all). -O, --overwrite-ok Allow overwriting of a pre-existing extension directory. @@ -485,6 +513,11 @@ OPTIONS: -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. @@ -495,6 +528,7 @@ EOFUSAGE } my ($opt_A, + $opt_B, $opt_C, $opt_F, $opt_M, @@ -518,13 +552,19 @@ my ($opt_A, $opt_b, $opt_t, $new_test, - $old_test + $old_test, + $skip_exporter, + $skip_ppport, + $skip_autoloader, + $skip_strict, + $skip_warnings, ); Getopt::Long::Configure('bundling'); my %options = ( 'omit-autoload|A' => \$opt_A, + 'beta-version|B' => \$opt_B, 'omit-changes|C' => \$opt_C, 'cpp-flags|F=s' => \$opt_F, 'func-mask|M=s' => \$opt_M, @@ -548,7 +588,12 @@ my %options = ( 'version|v=s' => \$opt_v, 'autogen-xsubs|x' => \$opt_x, 'use-new-tests' => \$new_test, - 'use-old-tests' => \$old_test + 'use-old-tests' => \$old_test, + 'skip-exporter' => \$skip_exporter, + 'skip-ppport' => \$skip_ppport, + 'skip-autoloader' => \$skip_autoloader, + 'skip-warnings' => \$skip_warnings, + 'skip-strict' => \$skip_strict, ); GetOptions(%options) || usage; @@ -562,12 +607,17 @@ if( $opt_b ){ . "(i.e. 5.5.0)\n"; my ($maj,$min,$sub) = split(/\./,$opt_b,3); if ($maj < 5 || ($maj == 5 && $min < 6)) { - $compat_version = sprintf("%d.%03d%02d",$maj,$min,$sub); + $compat_version = + $sub ? sprintf("%d.%03d%02d",$maj,$min,$sub) : + sprintf("%d.%03d", $maj,$min); } else { - $compat_version = sprintf("%d.%03d%03d",$maj,$min,$sub); + $compat_version = + $sub ? sprintf("%d.%03d%03d",$maj,$min,$sub) : + sprintf("%d.%03d", $maj,$min); } } else { - my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d\d\d?)/; + my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d*)/; + $sub ||= 0; warn sprintf <<'EOF', $maj,$min,$sub; Defaulting to backwards compatibility with perl %d.%d.%d If you intend this module to be compatible with earlier perl versions, please @@ -576,12 +626,39 @@ specify a minimum perl version with the -b option. EOF } +if( $opt_B ){ + $TEMPLATE_VERSION = '0.00_01'; +} + if( $opt_v ){ $TEMPLATE_VERSION = $opt_v; + + # check if it is numeric + my $temp_version = $TEMPLATE_VERSION; + my $beta_version = $temp_version =~ s/(\d)_(\d\d)/$1$2/; + my $notnum; + { + local $SIG{__WARN__} = sub { $notnum = 1 }; + use warnings 'numeric'; + $temp_version = 0+$temp_version; + } + + if ($notnum) { + my $module = $opt_n || 'Your::Module'; + warn <<"EOF"; +You have specified a non-numeric version. Unless you supply an +appropriate VERSION class method, users may not be able to specify a +minimum required version with C. + +EOF + } + else { + $opt_B = $beta_version; + } } # -A implies -c. -$opt_c = 1 if $opt_A; +$skip_autoloader = $opt_c = 1 if $opt_A; # -X implies -c and -f $opt_c = $opt_f = 1 if $opt_X; @@ -638,8 +715,11 @@ EOD } } elsif ($opt_o or $opt_F) { - warn <rel2abs( File::Spec->curdir ); -my ($ext, $nested, @modparts, $modfname, $modpname, $constsfname); +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. +my $constscfname = 'const-c.inc'; +my $constsxsfname = 'const-xs.inc'; +my $fallbackdirname = 'fallback'; $ext = chdir 'ext' ? 'ext/' : ''; @@ -785,8 +870,6 @@ else { @modparts = (); $modfname = $modpname = $module; } -# Don't trip up if someone calls their module 'constants' -$constsfname = $modfname eq 'constants' ? 'constdefs' : 'constants'; if ($opt_O) { @@ -820,13 +903,14 @@ my %vdecl_hash; my @vdecls; if( ! $opt_X ){ # use XS, unless it was disabled - warn "Writing $ext$modpname/ppport.h\n"; - Devel::PPPort::WriteFile('ppport.h') - || die "Can't create $ext$modpname/ppport.h: $!\n"; - + unless ($skip_ppport) { + require Devel::PPPort; + warn "Writing $ext$modpname/ppport.h\n"; + Devel::PPPort::WriteFile('ppport.h') + || die "Can't create $ext$modpname/ppport.h: $!\n"; + } open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; if ($opt_x) { - require Config; # Run-time directive warn "Scanning typemaps...\n"; get_typemap(); my @td; @@ -942,9 +1026,13 @@ print PM <<"END"; package $module; use $compat_version; +END + +print PM <<"END" unless $skip_strict; use strict; END -print PM "use warnings;\n" unless $compat_version < 5.006; + +print PM "use warnings;\n" unless $skip_warnings or $compat_version < 5.006; unless( $opt_X || $opt_c || $opt_A ){ # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and @@ -954,18 +1042,19 @@ use Carp; END } -print PM <<'END'; +print PM <<'END' unless $skip_exporter; require Exporter; END -print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled +my $use_Dyna = (not $opt_X and $compat_version < 5.006); +print PM <<"END" if $use_Dyna; # use DynaLoader, unless XS was disabled require DynaLoader; END # Are we using AutoLoader or not? -unless ($opt_A) { # no autoloader whatsoever. +unless ($skip_autoloader) { # no autoloader whatsoever. unless ($opt_c) { # we're doing the AUTOLOAD print PM "use AutoLoader;\n"; } @@ -975,24 +1064,26 @@ unless ($opt_A) { # no autoloader whatsoever. } if ( $compat_version < 5.006 ) { - if ( $opt_X || $opt_c || $opt_A ) { - print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);'; - } else { - print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);'; - } + my $vars = '$VERSION @ISA'; + $vars .= ' @EXPORT @EXPORT_OK %EXPORT_TAGS' unless $skip_exporter; + $vars .= ' $AUTOLOAD' unless $opt_X || $opt_c || $opt_A; + $vars .= ' $XS_VERSION' if $opt_B && !$opt_X; + print PM "use vars qw($vars);"; } # Determine @ISA. -my $myISA = 'our @ISA = qw(Exporter'; # We seem to always want this. -$myISA .= ' DynaLoader' unless $opt_X; # no XS -$myISA .= ');'; +my @modISA; +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; print PM "\n$myISA\n\n"; my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls); -my $tmp=<<"END"; +my $tmp=''; +$tmp .= <<"END" unless $skip_exporter; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @@ -1009,10 +1100,16 @@ our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } ); our \@EXPORT = qw( @const_names ); -our \$VERSION = '$TEMPLATE_VERSION'; END +$tmp .= "our \$VERSION = '$TEMPLATE_VERSION';\n"; +if ($opt_B) { + $tmp .= "our \$XS_VERSION = \$VERSION;\n" unless $opt_X; + $tmp .= "\$VERSION = eval \$VERSION; # see L\n"; +} +$tmp .= "\n"; + $tmp =~ s/^our //mg if $compat_version < 5.006; print PM $tmp; @@ -1024,9 +1121,18 @@ if (@vdecls) { print PM autoload ($module, $compat_version) unless $opt_c or $opt_X; if( ! $opt_X ){ # print bootstrap, unless XS is disabled - print PM <<"END"; + if ($use_Dyna) { + $tmp = <<"END"; bootstrap $module \$VERSION; END + } else { + $tmp = <<"END"; +require XSLoader; +XSLoader::load('$module', \$VERSION); +END + } + $tmp =~ s:\$VERSION:\$XS_VERSION:g if $opt_B; + print PM $tmp; } # tying the variables can happen only after bootstrap @@ -1096,7 +1202,7 @@ $revhist = < should be removed. # #EOD - $exp_doc .= < "fallback.c", - XS_FILE => "fallback.xs", + unless (-d $fallbackdirname) { + mkdir "$fallbackdirname" or die "Cannot mkdir $fallbackdirname: $!\n"; + } + warn "Writing $ext$modpname/$fallbackdirname/$constscfname\n"; + warn "Writing $ext$modpname/$fallbackdirname/$constsxsfname\n"; + my $cfallback = File::Spec->catfile($fallbackdirname, $constscfname); + my $xsfallback = File::Spec->catfile($fallbackdirname, $constsxsfname); + WriteConstants ( C_FILE => $cfallback, + XS_FILE => $xsfallback, DEFAULT_TYPE => $opt_t, NAME => $module, NAMES => \@const_names, ); - print XS "#include \"$constsfname.c\"\n"; + print XS "#include \"$constscfname\"\n"; } @@ -1298,7 +1414,7 @@ END # If a constant() function was #included then output a corresponding # XS declaration: -print XS "INCLUDE: $constsfname.xs\n" unless $opt_c; +print XS "INCLUDE: $constsxsfname\n" unless $opt_c; print XS <<"END" if $opt_g; @@ -1747,16 +1863,7 @@ EOC $Icomment 'INC' => '$I', # e.g., '${Ihelp}-I/usr/include/other' END - if (!$opt_c) { - print PL <<"END"; - # Without this the constants xs files are spotted, and cause rules to be - # added to delete the similarly names C files, which isn't what we want. - 'XS' => {'$modfname.xs' => '$modfname.c'}, - realclean => {FILES => '$constsfname.c $constsfname.xs'}, -END - } - - my $C = grep {$_ ne "$modfname.c" && $_ ne "fallback.c"} + my $C = grep {$_ ne "$modfname.c"} (glob '*.c'), (glob '*.cc'), (glob '*.C'); my $Cpre = ($C ? '' : '# '); my $Ccomment = ($C ? '' : < "$constsfname.c", - XS_FILE => "$constsfname.xs", + WriteMakefileSnippet ( C_FILE => $constscfname, + XS_FILE => $constsxsfname, DEFAULT_TYPE => $opt_t, NAME => $module, NAMES => \@const_names, @@ -1779,17 +1886,18 @@ if (!$opt_c) { print PL <<"END"; if (eval {require ExtUtils::Constant; 1}) { # If you edit these definitions to change the constants used by this module, - # you will need to use the generated $constsfname.c and $constsfname.xs + # you will need to use the generated $constscfname and $constsxsfname # files to replace their "fallback" counterparts before distributing your # changes. $generate_code } else { use File::Copy; - copy ('fallback.c', '$constsfname.c') - or die "Can't copy fallback.c to $constsfname.c: \$!"; - copy ('fallback.xs', '$constsfname.xs') - or die "Can't copy fallback.xs to $constsfname.xs: \$!"; + use File::Spec; + foreach my \$file ('$constscfname', '$constsxsfname') { + my \$fallback = File::Spec->catfile('$fallbackdirname', \$file); + copy (\$fallback, \$file) or die "Can't copy \$fallback to \$file: \$!"; + } } END @@ -1806,10 +1914,11 @@ EOM } else { my $fail; - foreach ('c', 'xs') { - if (compare("fallback.$_", "$constsfname.$_")) { + foreach my $file ($constscfname, $constsxsfname) { + my $fallback = File::Spec->catfile($fallbackdirname, $file); + if (compare($file, $fallback)) { warn << "EOM"; -Files "$ext$modpname/fallback.$_" and "$ext$modpname/$constsfname.$_" differ. +Files "$ext$modpname/$fallbackdirname/$file" and "$ext$modpname/$file" differ. EOM $fail++; } @@ -1817,14 +1926,14 @@ EOM if ($fail) { warn fill ('','', <<"EOM") . "\n"; It appears that the code in $ext$modpname/Makefile.PL does not autogenerate -the files $ext$modpname/$constsfname.c and $ext$modpname/$constsfname.xs +the files $ext$modpname/$constscfname and $ext$modpname/$constsxsfname correctly. - + Please report the circumstances of this bug in h2xs version $H2XS_VERSION using the perlbug script. EOM } else { - unlink "$constsfname.c", "$constsfname.xs"; + unlink $constscfname, $constsxsfname; } } } @@ -2017,7 +2126,7 @@ EOP warn "Writing $ext$modpname/MANIFEST\n"; open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!"; -my @files = grep { -f } (<*>, ); +my @files = grep { -f } (<*>, , <$fallbackdirname/*>); if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); } @@ -2033,9 +2142,6 @@ if ($^O eq 'VMS') { $_ = 'Makefile.PL' if $_ eq 'makefile.pl'; } } -if (!$opt_c) { - @files = grep {$_ ne "$constsfname.c" and $_ ne "$constsfname.xs"} @files; -} print MANI join("\n",@files), "\n"; close MANI; !NO!SUBS!