Re: What sort of Makefile.PL should h2xs write?

Message-ID: <20010923230055.Y4971@plum.flirble.org>

(with "sample_constants" changed to "fallback")

p4raw-id: //depot/perl@12169

1 files changed, 105 insertions, 31 deletions

diff --git a/utils/h2xs.PL b/utils/h2xs.PL
index 4e5319bad1..e57779c47f 100644
--- a/utils/h2xs.PL
+++ b/utils/h2xs.PL
@@ -425,6 +425,7 @@ See L<perlxs> and L<perlxstut> for additional details.
 
 =cut
 
+# ' # Grr
 use strict;
 
 
@@ -438,7 +439,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 +474,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.
@@ -562,6 +564,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 = '';
@@ -743,7 +747,7 @@ 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/' : '';
 
@@ -758,6 +762,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) {
@@ -905,23 +911,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
@@ -1227,19 +1223,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" : '';
 
@@ -1250,6 +1251,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 *
@@ -1268,11 +1273,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;
 
@@ -1663,7 +1663,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.
@@ -1689,7 +1690,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:
@@ -1698,8 +1709,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
@@ -1905,6 +1976,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!