X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2xs.PL;h=df89626b91fabc58e26d5d06bf9a4d401485dddf;hb=abc0a0153433fe6596e1ca3a6b5572dc424d0f11;hp=1d60d6919110ded984fcfdbc7a85841f37cb0c59;hpb=181f5113b42dc68c705079ab45842d952c071b37;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 1d60d69..df89626 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -43,9 +43,9 @@ h2xs - convert .h C header files to Perl extensions =head1 SYNOPSIS -B [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [B<-b> compat_version] [headerfile ... [extra_libraries]] +B [B ...] [headerfile ... [extra_libraries]] -B B<-h> +B B<-h>|B<-?>|B<--help> =head1 DESCRIPTION @@ -70,39 +70,45 @@ extra-libraries argument. =over 5 -=item B<-A> +=item B<-A>, B<--omit-autoload> Omit all autoload facilities. This is the same as B<-c> but also removes the S> statement from the .pm file. -=item B<-C> +=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 the POD template. -=item B<-F> I +=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> I +=item B<-M>, B<--func-mask>=I selects functions/macros to process. -=item B<-O> +=item B<-O>, B<--overwrite-ok> Allows a pre-existing extension directory to be overwritten. -=item B<-P> +=item B<-P>, B<--omit-pod> Omit the autogenerated stub POD section. -=item B<-X> +=item B<-X>, B<--omit-XS> Omit the XS portion. Used to generate templates for a module which is not XS-based. C<-c> and C<-f> are implicitly enabled. -=item B<-a> +=item B<-a>, B<--gen-accessors> Generate an accessor method for each element of structs and unions. The generated methods are named after the element name; will return the current @@ -116,7 +122,7 @@ two methods are constructed for the structure type itself, C<_to_ptr> which returns a Ptr type pointing to the same structure, and a C method to construct and return a new structure, initialised to zeroes. -=item B<-b> I +=item B<-b>, B<--compat-version>=I Generates a .pm file which is backwards compatible with the specified perl version. @@ -126,41 +132,47 @@ For versions < 5.6.0, the changes are. - no 'use warnings' Specifying a compatibility version higher than the version of perl you -are using to run h2xs will have no effect. +are using to run h2xs will have no effect. If unspecified h2xs will default +to compatibility with the version of perl you are using to run h2xs. -=item B<-c> +=item B<-c>, B<--omit-constant> Omit C from the .xs file and corresponding specialised C from the .pm file. -=item B<-d> +=item B<-d>, B<--debugging> Turn on debugging messages. -=item B<-f> +=item B<-f>, B<--force> Allows an extension to be created for a header even if that header is not found in standard include directories. -=item B<-h> +=item B<-g>, B<--global> + +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> Print the usage, help and version for this h2xs and exit. -=item B<-k> +=item B<-k>, B<--omit-const-func> For function arguments declared as C, omit the const attribute in the generated XS code. -=item B<-m> +=item B<-m>, B<--gen-tied-var> B: for each variable declared in the header file(s), declare a perl variable of the same name magically tied to the C variable. -=item B<-n> I +=item B<-n>, B<--name>=I Specifies a name to be used for the extension, e.g., S<-n RPC::DCE> -=item B<-o> I +=item B<-o>, B<--opaque-re>=I Use "opaque" data type for the C types matched by the regular expression, even if these types are C-equivalent to types @@ -176,33 +188,66 @@ The type-to-match is whitewashed (except for commas, which have no whitespace before them, and multiple C<*> which have no whitespace between them). -=item B<-p> I +=item B<-p>, B<--remove-prefix>=I Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_> This sets up the XS B keyword and removes the prefix from functions that are autoloaded via the C mechanism. -=item B<-s> I +=item B<-s>, B<--const-subs>=I Create a perl subroutine for the specified macros rather than autoload with the constant() subroutine. These macros are assumed to have a return type of B, e.g., S<-s sec_rgy_wildcard_name,sec_rgy_wildcard_sid>. -=item B<-t> I +=item B<-t>, B<--default-type>=I Specify the internal type that the constant() mechanism uses for macros. The default is IV (signed integer). Currently all macros found during the header scanning process will be assumed to have this type. Future versions of C may gain the ability to make educated guesses. -=item B<-v> I +=item B<--use-new-tests> + +When B<--compat-version> (B<-b>) is present the generated tests will use +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. + +=item B<--use-old-tests> + +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> +=item B<-x>, B<--autogen-xsubs> Automatically generate XSUBs basing on function declarations in the header file. The package C should be installed. If this @@ -414,81 +459,212 @@ See L and L for additional details. =cut +# ' # Grr 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 = $]; -use Getopt::Std; +use Getopt::Long; use Config; use Text::Wrap; $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; -use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload); +use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); +use File::Compare; sub usage { warn "@_\n" if @_; die < + --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. + extra_libraries are any libraries that might be needed for loading the extension, e.g. -lm would try to link in the math library. EOFUSAGE } - -getopts("ACF:M:OPXacdfhkmn:o:p:s:v:xb:t:") || usage; -use vars qw($opt_A $opt_C $opt_F $opt_M $opt_O $opt_P $opt_X $opt_a $opt_c - $opt_d $opt_f $opt_h $opt_k $opt_m $opt_n $opt_o $opt_p $opt_s - $opt_v $opt_x $opt_b $opt_t); +my ($opt_A, + $opt_B, + $opt_C, + $opt_F, + $opt_M, + $opt_O, + $opt_P, + $opt_X, + $opt_a, + $opt_c, + $opt_d, + $opt_f, + $opt_g, + $opt_h, + $opt_k, + $opt_m, + $opt_n, + $opt_o, + $opt_p, + $opt_s, + $opt_v, + $opt_x, + $opt_b, + $opt_t, + $new_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, + 'overwrite_ok|O' => \$opt_O, + 'omit-pod|P' => \$opt_P, + 'omit-XS|X' => \$opt_X, + 'gen-accessors|a' => \$opt_a, + 'compat-version|b=s' => \$opt_b, + 'omit-constant|c' => \$opt_c, + 'debugging|d' => \$opt_d, + 'force|f' => \$opt_f, + 'global|g' => \$opt_g, + 'help|h|?' => \$opt_h, + 'omit-const-func|k' => \$opt_k, + 'gen-tied-var|m' => \$opt_m, + 'name|n=s' => \$opt_n, + 'opaque-re|o=s' => \$opt_o, + 'remove-prefix|p=s' => \$opt_p, + 'const-subs|s=s' => \$opt_s, + 'default-type|t=s' => \$opt_t, + 'version|v=s' => \$opt_v, + 'autogen-xsubs|x' => \$opt_x, + 'use-new-tests' => \$new_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; 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+/ || - usage "You must provide the backwards compatibility version in X.Y.Z form. " . - "(i.e. 5.5.0)\n"; + 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); - $compat_version = sprintf("%d.%03d%02d",$maj,$min,$sub); -} + if ($maj < 5 || ($maj == 5 && $min < 6)) { + $compat_version = + $sub ? sprintf("%d.%03d%02d",$maj,$min,$sub) : + sprintf("%d.%03d", $maj,$min); + } else { + $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*)/; + $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 +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; +$opt_t ||= 'IV'; + my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; my $extralibs = ''; @@ -539,8 +715,11 @@ EOD } } elsif ($opt_o or $opt_F) { - warn <catdir('ext', $epath) if -d 'ext'; @@ -630,7 +809,7 @@ if( @path_h ){ s/\?\?/}/g; # | ??>| }| } - if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^" \t])(.*)/) { + if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^"\s])(.*)/) { my $def = $1; my $rest = $2; $rest =~ s!/\*.*?(\*/|\n)|//.*!!g; # Remove comments @@ -667,9 +846,16 @@ 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. +my $constscfname = 'const-c.inc'; +my $constsxsfname = 'const-xs.inc'; +my $fallbackdirname = 'fallback'; $ext = chdir 'ext' ? 'ext/' : ''; @@ -717,9 +903,14 @@ my %vdecl_hash; my @vdecls; if( ! $opt_X ){ # use XS, unless it was disabled + 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; @@ -735,9 +926,10 @@ if( ! $opt_X ){ # use XS, unless it was disabled $filter = $'; } warn "Scanning $filename for functions...\n"; + my @styles = $Config{gccversion} ? qw(C++ C9X GNU) : qw(C++ C9X); $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, - 'add_cppflags' => $addflags, 'c_styles' => [qw(C++ C9X)]; - $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); + 'add_cppflags' => $addflags, 'c_styles' => \@styles; + $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]); push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); @@ -796,7 +988,8 @@ if( ! $opt_X ){ # use XS, unless it was disabled } @fnames_no_prefix = @fnames; @fnames_no_prefix - = sort map { ++$prefix{$_} if s/^$opt_p(?!\d)//; $_ } @fnames_no_prefix; + = sort map { ++$prefix{$_} if s/^$opt_p(?!\d)//; $_ } @fnames_no_prefix + if defined $opt_p; # Remove macros which expand to typedefs print "Typedefs are @td.\n" if $opt_d; my %td = map {($_, $_)} @td; @@ -829,23 +1022,17 @@ open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n" $" = "\n\t"; warn "Writing $ext$modpname/$modfname.pm\n"; -if ( $compat_version < 5.006 ) { print PM <<"END"; package $module; use $compat_version; -use strict; END -} -else { -print PM <<"END"; -package $module; -use 5.006; +print PM <<"END" unless $skip_strict; use strict; -use warnings; END -} + +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 @@ -855,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"; } @@ -876,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. @@ -910,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; @@ -925,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 @@ -967,12 +1172,14 @@ END my ($email,$author); eval { - my $user; - ($user,$author) = (getpwuid($>))[0,6]; - $author =~ s/,.*$//; # in case of sub fields - my $domain = $Config{'mydomain'}; - $domain =~ s/^\.//; - $email = "$user\@$domain"; + my $username; + ($username,$author) = (getpwuid($>))[0,6]; + if (defined $username && defined $author) { + $author =~ s/,.*$//; # in case of sub fields + my $domain = $Config{'mydomain'}; + $domain =~ s/^\.//; + $email = "$username\@$domain"; + } }; $author ||= "A. U. Thor"; @@ -995,7 +1202,7 @@ $revhist = < should be removed. # #EOD - $exp_doc .= <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 \"$constscfname\"\n"; } -print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls; my $prefix = defined $opt_p ? "PREFIX = $opt_p" : ''; @@ -1167,6 +1412,22 @@ MODULE = $module PACKAGE = $module $prefix END +# If a constant() function was #included then output a corresponding +# XS declaration: +print XS "INCLUDE: $constsxsfname\n" unless $opt_c; + +print XS <<"END" if $opt_g; + +BOOT: +{ + MY_CXT_INIT; + /* If any of the fields in the my_cxt_t struct need + to be initialised, do it here. + */ +} + +END + foreach (sort keys %const_xsub) { print XS <<"END"; char * @@ -1185,11 +1446,6 @@ $_() END } -# If a constant() function was written then output a corresponding -# XS declaration: -# XXX IVs -print XS XS_constant ($module, $types) unless $opt_c; - my %seen_decl; my %typemap; @@ -1506,6 +1762,8 @@ sub assign_typemap_entry { print "Type mutation via typedefs: $otype ==> $type\n" if $opt_d; $entry = assign_typemap_entry($type); } + # XXX good do better if our UV happens to be long long + return "T_NV" if $type =~ /^(unsigned\s+)?long\s+(long|double)\z/; $entry ||= $typemap{$otype} || (td_is_struct($type) ? "T_OPAQUE_STRUCT" : "T_PTROBJ"); $typemap{$otype} = $entry; @@ -1567,14 +1825,26 @@ EOP warn "Writing $ext$modpname/Makefile.PL\n"; open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; -print PL < 0%; +} +else +{ + $prereq_pm = ''; +} + +print PL <<"END"; +use $compat_version; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => '$module', 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION - 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + '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 AUTHOR => '$author <$email>') : ()), @@ -1593,7 +1863,8 @@ EOC $Icomment 'INC' => '$I', # e.g., '${Ihelp}-I/usr/include/other' END - my $C = grep $_ ne "$modfname.c", (glob '*.c'), (glob '*.cc'), (glob '*.C'); + my $C = grep {$_ ne "$modfname.c"} + (glob '*.c'), (glob '*.cc'), (glob '*.C'); my $Cpre = ($C ? '' : '# '); my $Ccomment = ($C ? '' : < '\$(O_FILES)', # link all the C files too END -} +} # ' # Grr print PL ");\n"; +if (!$opt_c) { + my $generate_code = + WriteMakefileSnippet ( C_FILE => $constscfname, + XS_FILE => $constsxsfname, + DEFAULT_TYPE => $opt_t, + NAME => $module, + NAMES => \@const_names, + ); + 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 $constscfname and $constsxsfname + # files to replace their "fallback" counterparts before distributing your + # changes. +$generate_code +} +else { + use File::Copy; + 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 + + eval $generate_code; + if ($@) { + warn <<"EOM"; +Attempting to test constant code in $ext$modpname/Makefile.PL: +$generate_code +__END__ +gave unexpected error $@ +Please report the circumstances of this bug in h2xs version $H2XS_VERSION +using the perlbug script. +EOM + } else { + my $fail; + + foreach my $file ($constscfname, $constsxsfname) { + my $fallback = File::Spec->catfile($fallbackdirname, $file); + if (compare($file, $fallback)) { + warn << "EOM"; +Files "$ext$modpname/$fallbackdirname/$file" and "$ext$modpname/$file" differ. +EOM + $fail++; + } + } + if ($fail) { + warn fill ('','', <<"EOM") . "\n"; +It appears that the code in $ext$modpname/Makefile.PL does not autogenerate +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 $constscfname, $constsxsfname; + } + } +} close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n"; # Create a simple README since this is a CPAN requirement @@ -1613,6 +1946,18 @@ open(RM, ">README") || die "Can't create $ext$modpname/README:$!\n"; my $thisyear = (gmtime)[5] + 1900; my $rmhead = "$modpname version $TEMPLATE_VERSION"; my $rmheadeq = "=" x length($rmhead); + +my $rm_prereq; + +if ( $compat_version < 5.00702 and $new_test ) +{ + $rm_prereq = 'Test::More'; +} +else +{ + $rm_prereq = 'blah blah blah'; +} + print RM <<_RMEND_; $rmhead $rmheadeq @@ -1641,7 +1986,7 @@ DEPENDENCIES This module requires these other modules and libraries: - blah blah blah + $rm_prereq COPYRIGHT AND LICENCE @@ -1664,6 +2009,7 @@ warn "Writing $ext$modpname/$testfile\n"; my $tests = @const_names ? 2 : 1; 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' @@ -1672,22 +2018,34 @@ print EX <<_END_; # change 'tests => $tests' to 'tests => last_test_to_print'; +_END_ + +my $test_mod = 'Test::More'; + +if ( $old_test or ($compat_version < 5.007 and not $new_test )) +{ + my $test_mod = 'Test'; + + print EX <<_END_; use Test; BEGIN { plan tests => $tests }; use $module; ok(1); # If we made it this far, we're ok. _END_ -if (@const_names) { - my $const_names = join " ", @const_names; - print EX <<'_END_'; + + if (@const_names) { + my $const_names = join " ", @const_names; + print EX <<'_END_'; my $fail; foreach my $constname (qw( _END_ - print EX wrap ("\t", "\t", $const_names); - print EX (")) {\n"); - print EX <<_END_; + + print EX wrap ("\t", "\t", $const_names); + print EX (")) {\n"); + + print EX <<_END_; next if (eval "my \\\$a = \$constname; 1"); if (\$\@ =~ /^Your vendor has not defined $module macro \$constname/) { print "# pass: \$\@"; @@ -1703,14 +2061,51 @@ if (\$fail) { } _END_ + } +} +else +{ + print EX <<_END_; +use Test::More tests => $tests; +BEGIN { use_ok('$module') }; + +_END_ + + if (@const_names) { + my $const_names = join " ", @const_names; + print EX <<'_END_'; + +my $fail = 0; +foreach my $constname (qw( +_END_ + + print EX wrap ("\t", "\t", $const_names); + print EX (")) {\n"); + + print EX <<_END_; + next if (eval "my \\\$a = \$constname; 1"); + if (\$\@ =~ /^Your vendor has not defined $module macro \$constname/) { + print "# pass: \$\@"; + } else { + print "# fail: \$\@"; + \$fail = 1; + } + +} + +ok( \$fail == 0 , 'Constants' ); +_END_ + } } -print EX <<'_END_'; + +print EX <<_END_; ######################### -# Insert your test code below, the Test module is use()ed here so read -# its man page ( perldoc Test ) for help writing this test script. +# Insert your test code below, the $test_mod module is use()ed here so read +# its man page ( perldoc $test_mod ) for help writing this test script. _END_ + close(EX) || die "Can't close $ext$modpname/$testfile: $!\n"; unless ($opt_C) { @@ -1731,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); }