A user might belong to only a single group
[p5sagit/p5-mst-13.2.git] / utils / h2xs.PL
index 292a461..2a7b1c4 100644 (file)
@@ -43,9 +43,9 @@ h2xs - convert .h C header files to Perl extensions
 
 =head1 SYNOPSIS
 
-B<h2xs> [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<h2xs> [B<OPTIONS> ...] [headerfile ... [extra_libraries]]
 
-B<h2xs> B<-h>
+B<h2xs> B<-h>|B<-?>|B<--help>
 
 =head1 DESCRIPTION
 
@@ -126,7 +126,8 @@ 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>, B<--omit-constant>
 
@@ -197,6 +198,17 @@ 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<h2xs> 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<Test::More> rather then C<Test> which is the default for versions before
+5.7.2 .   C<Test::More> will be added to PREREQ_PM in the generated
+C<Makefile.PL>.
+
+=item B<--use-old-tests>
+
+Will force the generation of test code that uses the older C<Test> module.
+
 =item B<-v>, B<--version>=I<version>
 
 Specify a version number for this extension.  This version number is added
@@ -414,6 +426,7 @@ See L<perlxs> and L<perlxstut> for additional details.
 
 =cut
 
+# ' # Grr
 use strict;
 
 
@@ -427,7 +440,8 @@ 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 @_;
@@ -461,7 +475,9 @@ 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
+    -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
     -v, --version         Specify a version number for this extension.
     -x, --autogen-xsubs   Autogenerate XSUBs using C::Scan.
 
@@ -492,7 +508,9 @@ my ($opt_A,
     $opt_v,
     $opt_x,
     $opt_b,
-    $opt_t
+    $opt_t,
+    $new_test,
+    $old_test
    );
 
 Getopt::Long::Configure('bundling');
@@ -519,7 +537,9 @@ my %options = (
                 'const-subs|s=s'     => \$opt_s,
                 'default-type|t=s'   => \$opt_t,
                 'version|v=s'        => \$opt_v,
-                'autogen-xsubs|x=s'  => \$opt_x
+                'autogen-xsubs|x=s'  => \$opt_x,
+                'use-new-tests'      => \$new_test,
+                'use-old-tests'      => \$old_test
               );
 
 GetOptions(%options) || usage;
@@ -529,11 +549,23 @@ 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 = sprintf("%d.%03d%02d",$maj,$min,$sub);
+    } else {
+        $compat_version = sprintf("%d.%03d%03d",$maj,$min,$sub);
+    }
+} else {
+    my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d\d\d?)/;
+    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_v ){
        $TEMPLATE_VERSION = $opt_v;
@@ -545,6 +577,8 @@ $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 = '';
@@ -723,9 +757,10 @@ 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);
+my ($ext, $nested, @modparts, $modfname, $modpname, $constsfname);
 
 $ext = chdir 'ext' ? 'ext/' : '';
 
@@ -740,6 +775,8 @@ else {
        @modparts = ();
        $modfname = $modpname = $module;
 }
+# Don't trip up if someone calls their module 'constants'
+$constsfname = $modfname eq 'constants' ? 'constdefs' : 'constants';
 
 
 if ($opt_O) {
@@ -791,9 +828,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')});
@@ -852,7 +890,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;
@@ -885,23 +924,13 @@ 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;
-use strict;
-use warnings;
-END
-}
+print PM "use warnings;\n" unless $compat_version < 5.006;
 
 unless( $opt_X || $opt_c || $opt_A ){
        # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
@@ -1093,7 +1122,7 @@ if ($opt_x && $opt_a) {
 }
 
 my $pod = <<"END" unless $opt_P;
-## Below is stub documentation for your module. You better edit it!
+## Below is stub documentation for your module. You'd better edit it!
 #
 #=head1 NAME
 #
@@ -1104,6 +1133,13 @@ my $pod = <<"END" unless $opt_P;
 #  use $module;
 #  blah blah blah
 #
+#=head1 ABSTRACT
+#
+#  This should be the abstract for $module.
+#  The abstract is used when making PPD (Perl Package Description) files.
+#  If you don't want an ABSTRACT you should also edit Makefile.PL to
+#  remove the ABSTRACT_FROM option.
+#
 #=head1 DESCRIPTION
 #
 #Stub documentation for $module, created by h2xs. It looks like the
@@ -1200,19 +1236,24 @@ sub td_is_struct {
   return ($struct_typedefs{$otype} = $out);
 }
 
-my $types = {};
-# Important. Passing an undef scalar doesn't cause the
-# autovivified hashref to appear back out in this scope.
+print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls;
 
 if( ! $opt_c ) {
-  print XS constant_types(), "\n";
-  foreach (C_constant ($module, undef, $opt_t, $types, undef, undef,
-           @const_names)) {
-    print XS $_, "\n";
-  }
+  # We write the "sample" files used when this module is built by perl without
+  # ExtUtils::Constant.
+  # h2xs will later check that these are the same as those generated by the
+  # code embedded into Makefile.PL
+  warn "Writing $ext$modpname/fallback.c\n";
+  warn "Writing $ext$modpname/fallback.xs\n";
+  WriteConstants ( C_FILE =>       "fallback.c",
+                   XS_FILE =>      "fallback.xs",
+                   DEFAULT_TYPE => $opt_t,
+                   NAME =>         $module,
+                   NAMES =>        \@const_names,
+                 );
+  print XS "#include \"$constsfname.c\"\n";
 }
 
-print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls;
 
 my $prefix = defined $opt_p ? "PREFIX = $opt_p" : '';
 
@@ -1223,6 +1264,10 @@ MODULE = $module         PACKAGE = $module               $prefix
 
 END
 
+# If a constant() function was #included then output a corresponding
+# XS declaration:
+print XS "INCLUDE: $constsfname.xs\n" unless $opt_c;
+
 foreach (sort keys %const_xsub) {
     print XS <<"END";
 char *
@@ -1241,11 +1286,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;
 
@@ -1562,6 +1602,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;
@@ -1623,14 +1665,26 @@ EOP
 warn "Writing $ext$modpname/Makefile.PL\n";
 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
 
-print PL <<END;
+my $prereq_pm;
+
+if ( $compat_version < 5.00702 and $new_test )
+{
+  $prereq_pm = q%'Test::More'  =>  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>') : ()),
@@ -1649,7 +1703,17 @@ EOC
 $Icomment    'INC'             => '$I', # e.g., '${Ihelp}-I/usr/include/other'
 END
 
-  my $C = grep $_ ne "$modfname.c", (glob '*.c'), (glob '*.cc'), (glob '*.C');
+  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"}
+    (glob '*.c'), (glob '*.cc'), (glob '*.C');
   my $Cpre = ($C ? '' : '# ');
   my $Ccomment = ($C ? '' : <<EOC);
        # Un-comment this if you add C files to link with later:
@@ -1658,8 +1722,68 @@ EOC
   print PL <<END;
 $Ccomment    $Cpre\'OBJECT'            => '\$(O_FILES)', # link all the C files too
 END
-}
+} # ' # Grr
 print PL ");\n";
+if (!$opt_c) {
+  my $generate_code =
+    WriteMakefileSnippet ( C_FILE =>       "$constsfname.c",
+                           XS_FILE =>      "$constsfname.xs",
+                           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 $constsfname.c and $constsfname.xs
+  # 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: \$!";
+}
+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 ('c', 'xs') {
+      if (compare("fallback.$_", "$constsfname.$_")) {
+        warn << "EOM";
+Files "$ext$modpname/fallback.$_" and "$ext$modpname/$constsfname.$_" 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/$constsfname.c and $ext$modpname/$constsfname.xs
+correctly.
+Please report the circumstances of this bug in h2xs version $H2XS_VERSION
+using the perlbug script.
+EOM
+    } else {
+      unlink "$constsfname.c", "$constsfname.xs";
+    }
+  }
+}
 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
 
 # Create a simple README since this is a CPAN requirement
@@ -1669,6 +1793,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
@@ -1697,7 +1833,7 @@ DEPENDENCIES
 
 This module requires these other modules and libraries:
 
-  blah blah blah
+  $rm_prereq
 
 COPYRIGHT AND LICENCE
 
@@ -1720,6 +1856,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'
@@ -1728,22 +1865,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: \$\@";
@@ -1759,14 +1908,51 @@ if (\$fail) {
 }
 
 _END_
+  }
 }
-print EX <<'_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_;
 #########################
 
-# 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) {
@@ -1803,6 +1989,9 @@ 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!