This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #20636] Make h2xs skip #define macros with empty rhs
[perl5.git] / utils / h2xs.PL
index 8b43191..6b2c78f 100644 (file)
@@ -66,6 +66,9 @@ the library path determined by Configure.  That path can be augmented
 by including arguments of the form B<-L/another/library/path> in the
 extra-libraries argument.
 
+In spite of its name, I<h2xs> may also be used to create a skeleton pure
+Perl module. See the B<-X> option.
+
 =head1 OPTIONS
 
 =over 5
@@ -101,12 +104,12 @@ Allows a pre-existing extension directory to be overwritten.
 
 =item B<-P>, B<--omit-pod>
 
-Omit the autogenerated stub POD section. 
+Omit the autogenerated stub POD section.
 
 =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.
+Omit the XS portion. Used to generate a skeleton pure Perl module.
+C<-c> and C<-f> are implicitly enabled.
 
 =item B<-a>, B<--gen-accessors>
 
@@ -169,7 +172,7 @@ not found in standard include directories.
 
 =item B<-g>, B<--global>
 
-Include code for safely storing static data in the .xs file. 
+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>
@@ -231,7 +234,7 @@ of C<h2xs> may gain the ability to make educated guesses.
 
 When B<--compat-version> (B<-b>) is present the generated tests will use
 C<Test::More> rather than C<Test> which is the default for versions before
-5.7.2 .   C<Test::More> will be added to PREREQ_PM in the generated
+5.6.2.  C<Test::More> will be added to PREREQ_PM in the generated
 C<Makefile.PL>.
 
 =item B<--use-old-tests>
@@ -305,7 +308,10 @@ also the section on L<LIMITATIONS of B<-x>>.
 
     # Extension is ONC::RPC.
     h2xs -cfn ONC::RPC
-    
+
+    # Extension is a pure Perl module with no XS code.
+    h2xs -X My::Module
+
     # Extension is Lib::Foo which works at least with Perl5.005_03.
     # Constants are created for all #defines and enums h2xs can find
     # in foo.h.
@@ -316,7 +322,7 @@ also the section on L<LIMITATIONS of B<-x>>.
     # whose names do not start with 'bar_'.
     h2xs -b 5.5.3 -e '^bar_' -n Lib::Foo foo.h
 
-    # Makefile.PL will look for library -lrpc in 
+    # Makefile.PL will look for library -lrpc in
     # additional directory /opt/net/lib
     h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
 
@@ -326,7 +332,7 @@ also the section on L<LIMITATIONS of B<-x>>.
 
     # Extension is DCE::rgynbase
     # prefix "sec_rgy_" is dropped from perl function names
-    # subroutines are created for sec_rgy_wildcard_name and 
+    # subroutines are created for sec_rgy_wildcard_name and
     # sec_rgy_wildcard_sid
     h2xs -n DCE::rgynbase -p sec_rgy_ \
     -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase
@@ -335,7 +341,7 @@ also the section on L<LIMITATIONS of B<-x>>.
     # visible from perl.h. Name of the extension is perl1.
     # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)=
     # Extra backslashes below because the string is passed to shell.
-    # Note that a directory with perl header files would 
+    # Note that a directory with perl header files would
     #  be added automatically to include path.
     h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h
 
@@ -352,7 +358,7 @@ also the section on L<LIMITATIONS of B<-x>>.
 
 Suppose that you have some C files implementing some functionality,
 and the corresponding header files.  How to create an extension which
-makes this functionality accessable in Perl?  The example below
+makes this functionality accessible in Perl?  The example below
 assumes that the header files are F<interface_simple.h> and
 I<interface_hairy.h>, and you want the perl module be named as
 C<Ext::Ension>.  If you need some preprocessor directives and/or
@@ -522,18 +528,19 @@ OPTIONS:
     -O, --overwrite-ok    Allow overwriting of a pre-existing extension directory.
     -P, --omit-pod        Omit the stub POD section.
     -X, --omit-XS         Omit the XS portion (implies both -c and -f).
-    -a, --gen-accessors   Generate get/set accessors for struct and union members                           (used with -x).
-    -b, --compat-version  Specify a perl version to be backwards compatibile with
+    -a, --gen-accessors   Generate get/set accessors for struct and union members
+                          (used with -x).
+    -b, --compat-version  Specify a perl version to be backwards compatible with.
     -c, --omit-constant   Omit the constant() function and specialised AUTOLOAD
                           from the XS file.
     -d, --debugging       Turn on debugging messages.
     -e, --omit-enums      Omit constants from enums in the constant() function.
-                          If a pattern is given, only the matching enums are 
+                          If a pattern is given, only the matching enums are
                           ignored.
     -f, --force           Force creation of the extension even if the C header
                           does not exist.
-    -g, --global          Include code for safely storing static data in the .xs file. 
-    -h, -?, --help        Display this help message
+    -g, --global          Include code for safely storing static data in the .xs file.
+    -h, -?, --help        Display this help message.
     -k, --omit-const-func Omit 'const' attribute on function arguments
                           (used with -x).
     -m, --gen-tied-var    Generate tied variables for access to declared
@@ -543,16 +550,18 @@ 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 (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<AutoLoader>
-        --skip-strict     Do not use the pragma C<strict>
-        --skip-warnings   Do not use the pragma C<warnings>
+    -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<AutoLoader>.
+        --skip-strict     Do not use the pragma C<strict>.
+        --skip-warnings   Do not use the pragma C<warnings>.
     -v, --version         Specify a version number for this extension.
     -x, --autogen-xsubs   Autogenerate XSUBs using C::Scan.
+        --use-xsloader    Use XSLoader in backward compatible modules (ignored
+                          when used with -X).
 
 extra_libraries
          are any libraries that might be needed for loading the
@@ -592,6 +601,7 @@ my ($opt_A,
     $skip_autoloader,
     $skip_strict,
     $skip_warnings,
+    $use_xsloader
    );
 
 Getopt::Long::Configure('bundling');
@@ -630,6 +640,7 @@ my %options = (
                 'skip-autoloader'    => \$skip_autoloader,
                 'skip-warnings'      => \$skip_warnings,
                 'skip-strict'        => \$skip_strict,
+                'use-xsloader'       => \$use_xsloader,
               );
 
 GetOptions(%options) || usage;
@@ -638,18 +649,16 @@ 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+/ ||
+    $opt_b =~ /^v?(\d+)\.(\d+)\.(\d+)/ ||
     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);
+    my ($maj,$min,$sub) = ($1,$2,$3);
     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);
+        $compat_version = sprintf("%d.%03d%03d",$maj,$min,$sub);
     }
 } else {
     my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d*)/;
@@ -701,7 +710,8 @@ $opt_c = $opt_f = 1 if $opt_X;
 
 $opt_t ||= 'IV';
 
-my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
+my %const_xsub;
+%const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
 
 my $extralibs = '';
 
@@ -779,7 +789,7 @@ if( @path_h ){
     }
     else {
       @paths = (File::Spec->curdir(), $Config{usrinc},
-               (split ' ', $Config{locincpth}), '/usr/include');
+               (split / +/, $Config{locincpth} // ""), '/usr/include');
     }
     foreach my $path_h (@path_h) {
         $name ||= $path_h;
@@ -825,7 +835,7 @@ if( @path_h ){
     }
 
     if (!$opt_c) {
-      die "Can't find $tmp_path_h in @dirs\n" 
+      die "Can't find $tmp_path_h in @dirs\n"
        if ( ! $opt_f && ! -f "$rel_path_h" );
       # Scan the header file (we should deal with nested header files)
       # Record the names of simple #define constants into const_names
@@ -834,7 +844,7 @@ if( @path_h ){
     defines:
       while (<CH>) {
        if ($pre_sub_tri_graphs) {
-           # Preprocess all tri-graphs 
+           # Preprocess all tri-graphs
            # including things stuck in quoted string constants.
            s/\?\?=/#/g;                         # | ??=|  #|
            s/\?\?\!/|/g;                        # | ??!|  ||
@@ -852,6 +862,10 @@ if( @path_h ){
            $rest =~ s!/\*.*?(\*/|\n)|//.*!!g; # Remove comments
            $rest =~ s/^\s+//;
            $rest =~ s/\s+$//;
+           if ($rest eq '') {
+             print("Skip empty $def\n") if $opt_d;
+             next defines;
+           }
            # Cannot do: (-1) and ((LHANDLE)3) are OK:
            #print("Skip non-wordy $def => $rest\n"),
            #  next defines if $rest =~ /[^\w\$]/;
@@ -883,26 +897,27 @@ if( @path_h ){
       }
       else {
        # Work from miniperl too - on "normal" systems
-        my $SEEK_SET = eval 'use Fcntl qw/SEEK_SET/; SEEK_SET' or 0;
+        my $SEEK_SET = eval 'use Fcntl qw/SEEK_SET/; SEEK_SET' || 0;
         seek CH, 0, $SEEK_SET;
         my $src = do { local $/; <CH> };
         close CH;
         no warnings 'uninitialized';
-        
-        # Remove C and C++ comments 
+
+        # Remove C and C++ comments
         $src =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs;
-        
-        while ($src =~ /(\benum\s*([\w_]*)\s*\{\s([\s\w=,]+)\})/gsc) {
-            my ($enum_name, $enum_body) = 
-                $1 =~ /enum\s*([\w_]*)\s*\{\s([\s\w=,]+)\}/gs;
+        $src =~ s#//.*$##gm;
+
+       while ($src =~ /\benum\s*([\w_]*)\s*\{\s([^}]+)\}/gsc) {
+           my ($enum_name, $enum_body) = ($1, $2);
             # skip enums matching $opt_e
             next if $opt_e && $enum_name =~ /$opt_e/;
             my $val = 0;
             for my $item (split /,/, $enum_body) {
-                my ($key, $declared_val) = $item =~ /(\w*)\s*=\s*(.*)/;
-                $val = length($declared_val) ? $declared_val : 1 + $val;
-                $seen_define{$key} = $declared_val;
-                $const_names{$key}++;
+                next if $item =~ /\A\s*\Z/;
+                my ($key, $declared_val) = $item =~ /(\w+)\s*(?:=\s*(.*))?/;
+                $val = defined($declared_val) && length($declared_val) ? $declared_val : 1 + $val;
+                $seen_define{$key} = $val;
+                $const_names{$key} = { name => $key, macro => 1 };
             }
         } # while (...)
       } # if (!defined $opt_e or $opt_e)
@@ -921,13 +936,13 @@ my $constsxsfname = 'const-xs.inc';
 my $fallbackdirname = 'fallback';
 
 my $ext = chdir 'ext' ? 'ext/' : '';
-  
+
 my @modparts  = split(/::/,$module);
 my $modpname  = join('-', @modparts);
 my $modfname  = pop @modparts;
 my $modpmdir  = join '/', 'lib', @modparts;
 my $modpmname = join '/', $modpmdir, $modfname.'.pm';
-  
+
 if ($opt_O) {
        warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
 }
@@ -980,6 +995,8 @@ if( ! $opt_X ){  # use XS, unless it was disabled
        'add_cppflags' => $addflags, 'c_styles' => \@styles;
       $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]);
 
+      $c->get('keywords')->{'__restrict'} = 1;
+
       push @$fdecls_parsed, @{ $c->get('parsed_fdecls') };
       push(@$fdecls, @{$c->get('fdecls')});
 
@@ -1053,7 +1070,7 @@ if( ! $opt_X ){  # use XS, unless it was disabled
       $n = keys %td;
       my ($k, $v);
       while (($k, $v) = each %seen_define) {
-       # print("found '$k'=>'$v'\n"), 
+       # print("found '$k'=>'$v'\n"),
        $bad_macs{$k} = $td{$k} = $td{$v} if exists $td{$v};
       }
     }
@@ -1064,7 +1081,14 @@ if( ! $opt_X ){  # use XS, unless it was disabled
     }
   }
 }
-my @const_names = sort keys %const_names;
+my (@const_specs, @const_names);
+
+for (sort(keys(%const_names))) {
+    my $v = $const_names{$_};
+    
+    push(@const_specs, ref($v) ? $v : $_);
+    push(@const_names, $_);
+}
 
 -d $modpmdir || mkpath([$modpmdir], 0, 0775);
 open(PM, ">$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n";
@@ -1097,7 +1121,7 @@ print PM <<'END' unless $skip_exporter;
 require Exporter;
 END
 
-my $use_Dyna = (not $opt_X and $compat_version < 5.006);
+my $use_Dyna = (not $opt_X and $compat_version < 5.006 and not $use_xsloader);
 print PM <<"END" if $use_Dyna;  # use DynaLoader, unless XS was disabled
 require DynaLoader;
 END
@@ -1123,7 +1147,7 @@ if ( $compat_version < 5.006 ) {
 
 # Determine @ISA.
 my @modISA;
-push @modISA, 'Exporter'       unless $skip_exporter; 
+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;
@@ -1232,6 +1256,7 @@ eval {
        }
      };
 
+$author =~ s/'/\\'/g if defined $author;
 $author ||= "A. U. Thor";
 $email  ||= 'a.u.thor@a.galaxy.far.far.away';
 
@@ -1307,7 +1332,8 @@ if ($opt_x && $opt_a) {
 my $licence_hash = $licence;
 $licence_hash =~ s/^/#/gm;
 
-my $pod = <<"END" unless $opt_P;
+my $pod;
+$pod = <<"END" unless $opt_P;
 ## Below is stub documentation for your module. You'd better edit it!
 #
 #=head1 NAME
@@ -1451,7 +1477,7 @@ if( ! $opt_c ) {
                    XS_FILE =>      $xsfallback,
                    DEFAULT_TYPE => $opt_t,
                    NAME =>         $module,
-                   NAMES =>        \@const_names,
+                   NAMES =>        \@const_specs,
                  );
   print XS "#include \"$constscfname\"\n";
 }
@@ -1615,7 +1641,7 @@ _to_ptr(THIS)
                croak("Size \%d of packed data != expected \%d",
                        len, sizeof(THIS));
            RETVAL = ($name *)s;
-       }   
+       }
        else
            croak("THIS is not of type $name");
     OUTPUT:
@@ -1702,7 +1728,7 @@ sub accessor_docs {
 #  my \$buffer = $name->new();
 #  my \$obj = \$buffer->_to_ptr();
 #
-#This exersizes the following two methods, and an additional class
+#This exercises the following two methods, and an additional class
 #C<$name>, the internal representation of which is a reference to a
 #packed string with the C structure.  Keep in mind that \$buffer should
 #better survive longer than \$obj.
@@ -1748,9 +1774,9 @@ sub get_typemap {
     next unless -e $typemap ;
     # skip directories, binary files etc.
     warn " Scanning $typemap\n";
-    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next 
+    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
       unless -T $typemap ;
-    open(TYPEMAP, $typemap) 
+    open(TYPEMAP, $typemap)
       or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
     my $mode = 'Typemap';
     while (<TYPEMAP>) {
@@ -1779,9 +1805,9 @@ sub get_typemap {
 sub normalize_type {           # Second arg: do not strip const's before \*
   my $type = shift;
   my $do_keep_deep_const = shift;
-  # If $do_keep_deep_const this is heuristical only
+  # If $do_keep_deep_const this is heuristic only
   my $keep_deep_const = ($do_keep_deep_const ? '\b(?![^(,)]*\*)' : '');
-  my $ignore_mods 
+  my $ignore_mods
     = "(?:\\b(?:(?:__const__|const)$keep_deep_const|static|inline|__inline__)\\b\\s*)*";
   if ($do_keep_deep_const) {   # Keep different compiled /RExen/o separately!
     $type =~ s/$ignore_mods//go;
@@ -1796,7 +1822,7 @@ sub normalize_type {              # Second arg: do not strip const's before \*
   $type =~ s/\* (?=\*)/*/g;
   $type =~ s/\. \. \./.../g;
   $type =~ s/ ,/,/g;
-  $types_seen{$type}++ 
+  $types_seen{$type}++
     unless $type eq '...' or $type eq 'void' or $std_types{$type};
   $type;
 }
@@ -1879,15 +1905,20 @@ EOP
 warn "Writing $ext$modpname/Makefile.PL\n";
 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
 
-my $prereq_pm;
+my $prereq_pm = '';
 
-if ( $compat_version < 5.00702 and $new_test )
+if ( $compat_version < 5.006002 and $new_test )
 {
-  $prereq_pm = q%'Test::More'  =>  0%;
+  $prereq_pm .= q%'Test::More'  =>  0, %;
 }
-else
+elsif ( $compat_version < 5.006002 )
+{
+  $prereq_pm .= q%'Test'        =>  0, %;
+}
+
+if ( $compat_version < 5.006 and !$opt_X and $use_xsloader)
 {
-  $prereq_pm = '';
+  $prereq_pm .= q%'XSLoader'    =>  0, %;
 }
 
 print PL <<"END";
@@ -1935,7 +1966,7 @@ if (!$opt_c) {
                            XS_FILE =>      $constsxsfname,
                            DEFAULT_TYPE => $opt_t,
                            NAME =>         $module,
-                           NAMES =>        \@const_names,
+                           NAMES =>        \@const_specs,
                  );
   print PL <<"END";
 if  (eval {require ExtUtils::Constant; 1}) {
@@ -1994,7 +2025,7 @@ EOM
 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
 
 # Create a simple README since this is a CPAN requirement
-# and it doesnt hurt to have one
+# and it doesn't hurt to have one
 warn "Writing $ext$modpname/README\n";
 open(RM, ">README") || die "Can't create $ext$modpname/README:$!\n";
 my $thisyear = (gmtime)[5] + 1900;
@@ -2003,13 +2034,17 @@ my $rmheadeq = "=" x length($rmhead);
 
 my $rm_prereq;
 
-if ( $compat_version < 5.00702 and $new_test )
+if ( $compat_version < 5.006002 and $new_test )
 {
-   $rm_prereq = 'Test::More';
+  $rm_prereq = 'Test::More';
+}
+elsif ( $compat_version < 5.006002 )
+{
+  $rm_prereq = 'Test';
 }
 else
 {
-   $rm_prereq = 'blah blah blah';
+  $rm_prereq = 'blah blah blah';
 }
 
 print RM <<_RMEND_;
@@ -2062,18 +2097,21 @@ 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 $modpname.t'
+# Before 'make install' is performed this script should be runnable with
+# 'make test'. After 'make install' it should work as 'perl $modpname.t'
 
 #########################
 
 # change 'tests => $tests' to 'tests => last_test_to_print';
 
+use strict;
+use warnings;
+
 _END_
 
 my $test_mod = 'Test::More';
 
-if ( $old_test or ($compat_version < 5.007 and not $new_test ))
+if ( $old_test or ($compat_version < 5.006002 and not $new_test ))
 {
   my $test_mod = 'Test';
 
@@ -2102,7 +2140,7 @@ _END_
     print "# pass: \$\@";
   } else {
     print "# fail: \$\@";
-    \$fail = 1;    
+    \$fail = 1;
   }
 }
 if (\$fail) {