A user might belong to only a single group
[p5sagit/p5-mst-13.2.git] / utils / h2xs.PL
index 0a065ec..2a7b1c4 100644 (file)
@@ -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>
 
@@ -425,6 +426,7 @@ See L<perlxs> and L<perlxstut> for additional details.
 
 =cut
 
+# ' # Grr
 use strict;
 
 
@@ -438,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 @_;
@@ -472,7 +475,7 @@ 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.
@@ -549,8 +552,20 @@ if( $opt_b ){
     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;
@@ -562,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 = '';
@@ -740,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/' : '';
 
@@ -757,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) {
@@ -811,7 +831,7 @@ if( ! $opt_X ){  # use XS, unless it was disabled
       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' => \@styles;
-      $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
+      $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]);
 
       push @$fdecls_parsed, @{ $c->get('parsed_fdecls') };
       push(@$fdecls, @{$c->get('fdecls')});
@@ -870,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;
@@ -903,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
@@ -1111,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
 #
@@ -1225,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" : '';
 
@@ -1248,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 *
@@ -1266,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;
 
@@ -1661,7 +1676,8 @@ else
   $prereq_pm = '';
 }
 
-print PL <<END;
+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.
@@ -1687,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:
@@ -1696,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
@@ -1903,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!