From: Ilya Zakharevich Date: Fri, 6 Sep 1996 10:09:20 +0000 (-0400) Subject: updated h2xs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5273d82d757306e0c7b051d69688db38786199a1;p=p5sagit%2Fp5-mst-13.2.git updated h2xs Changes: a) Docs and examples for -x updated; b) Path to xxxx.h would not be changed to /usr/include/xxxx.h unless this file exists (outside of VMS, I'm afraid to make an error there). - Useful with -x option, when the file may be eaten via -I inside -F. c) .h file would be scanned only if needed. d) typemap would be generated (with T_PTROBJ). e) Documentation (=list) for autogenerated guys would be included into POD. f) duplicated XSUBs would not be generated; g) arguments to XSUBs being arrays are recognized (note that xsubpp would probably choke on such guys). -x option requires C-Scan-0.3 (releases a couple of minutes ago to ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl should propagate to CPAN soon). --- diff --git a/utils/h2xs.PL b/utils/h2xs.PL index f7a38ab..78f9647 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -127,6 +127,11 @@ option is specified, the name of the header file may look like C. In this case NAME1 is used instead of the specified string, but XSUBS are emited only for the declarations included from file NAME2. +Note that some types of arguments/return-values for functions may +result in XSUB-declarations/typemap-entries which need +hand-editing. Such may be objects which cannot be converted from/to a +pointer (like C), pointers to functions, or arrays. + =item B<-F> Additional flags to specify to C preprocessor when scanning header for @@ -172,16 +177,16 @@ function declarations. Should not be used without B<-x>. h2xs -n DCE::rgynbase -p sec_rgy_ \ -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase - # Make XS with defines in perl.h, and function declarations + # Make XS without defines in perl.h, but with function declarations # 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. - h2xs -xn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" \ - ../perl5_003_01/perl.h + # 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 # Same with function declaration in proto.h as visible from perl.h. - perl H:\get\perl\perl5_003_01.try\utils\h2xs -xn perl1 \ - ../perl5_003_01/perl.h,proto.h + h2xs -xAn perl2 perl.h,proto.h =head1 ENVIRONMENT @@ -267,33 +272,39 @@ if( $path_h ){ } } elsif ($^O eq 'os2') { - $path_h = "/usr/include/$path_h" unless $path_h =~ m#^([a-z]:)?[./]#i; + $path_h = "/usr/include/$path_h" + if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h"; + } + else { + $path_h = "/usr/include/$path_h" + if $path_h !~ m#^[./]# and -r "/usr/include/$path_h"; } - else { $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#; } - die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h ); - - # Scan the header file (we should deal with nested header files) - # Record the names of simple #define constants into const_names - # Function prototypes are not (currently) processed. - open(CH, "<$path_h") || die "Can't open $path_h: $!\n"; - while () { - if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) { + + if (!$opt_c) { + die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h ); + # Scan the header file (we should deal with nested header files) + # Record the names of simple #define constants into const_names + # Function prototypes are not (currently) processed. + open(CH, "<$path_h") || die "Can't open $path_h: $!\n"; + while () { + if (/^ #[ \t]*define\s+([\$\w]+)\b\s*[^("]/) { print "Matched $_ ($1)\n"; $_ = $1; next if /^_.*_h_*$/i; # special case, but for what? if (defined $opt_p) { - if (!/^$opt_p(\d)/) { - ++$prefix{$_} if s/^$opt_p//; - } - else { - warn "can't remove $opt_p prefix from '$_'!\n"; - } + if (!/^$opt_p(\d)/) { + ++$prefix{$_} if s/^$opt_p//; + } + else { + warn "can't remove $opt_p prefix from '$_'!\n"; + } } $const_names{$_}++; - } + } + } + close(CH); + @const_names = sort keys %const_names; } - close(CH); - @const_names = sort keys %const_names; } @@ -336,9 +347,36 @@ if( $nested ){ mkdir($modpname, 0777); chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; +my %types_seen; +my %std_types; +my $fdecls; +my $fdecls_parsed; + if( ! $opt_X ){ # use XS, unless it was disabled open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; + if ($opt_x) { + require C::Scan; # Run-time directive + require Config; # Run-time directive + warn "Scanning typemaps...\n"; + get_typemap(); + my $c; + my $filter; + my $filename = $path_h; + my $addflags = $opt_F || ''; + if ($fullpath =~ /,/) { + $filename = $`; + $filter = $'; + } + warn "Scanning $filename for functions...\n"; + $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, + 'add_cppflags' => $addflags; + $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); + + $fdecls_parsed = $c->get('parsed_fdecls'); + $fdecls = $c->get('fdecls'); + } } + open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"; $" = "\n\t"; @@ -476,6 +514,27 @@ END $author = "A. U. Thor"; $email = 'a.u.thor@a.galaxy.far.far.away'; +my $const_doc = ''; +my $fdecl_doc = ''; +if (@const_names and not $opt_P) { + $const_doc = <[1]} @$args; my @argtypes = map { normalize_type( $_->[0] ) } @$args; + my @argarrays = map { $_->[4] || '' } @$args; my $numargs = @$args; if ($numargs and $argtypes[-1] eq '...') { $numargs--; @@ -660,46 +725,85 @@ EOP for $arg (0 .. $numargs - 1) { print $fh <<"EOP"; - $argtypes[$arg] $argnames[$arg] + $argtypes[$arg] $argnames[$arg]$argarrays[$arg] EOP } } -my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*'; +# Should be called before any actual call to normalize_type(). +sub get_typemap { + # We do not want to read ./typemap by obvios reasons. + my @tm = qw(../../../typemap ../../typemap ../typemap); + my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap"; + unshift @tm, $stdtypemap; + my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ; + my $image; + + foreach $typemap (@tm) { + next unless -e $typemap ; + # skip directories, binary files etc. + warn " Scanning $typemap\n"; + warn("Warning: ignoring non-text typemap file '$typemap'\n"), next + unless -T $typemap ; + open(TYPEMAP, $typemap) + or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; + my $mode = 'Typemap'; + while () { + next if /^\s*\#/; + if (/^INPUT\s*$/) { $mode = 'Input'; next; } + elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; } + elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; } + elsif ($mode eq 'Typemap') { + next if /^\s*($|\#)/ ; + if ( ($type, $image) = + /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o + # This may reference undefined functions: + and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) { + normalize_type($type); + } + } + } + close(TYPEMAP) or die "Cannot close $typemap: $!"; + } + %std_types = %types_seen; + %types_seen = (); +} + sub normalize_type { + my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*'; my $type = shift; $type =~ s/$ignore_mods//go; + $type =~ s/([\]\[()])/ \1 /g; $type =~ s/\s+/ /g; $type =~ s/\s+$//; $type =~ s/^\s+//; $type =~ s/\b\*/ */g; $type =~ s/\*\b/* /g; $type =~ s/\*\s+(?=\*)/*/g; + $types_seen{$type}++ + unless $type eq '...' or $type eq 'void' or $std_types{$type}; $type; } if ($opt_x) { - require C::Scan; # Run-time directive - require Config; # Run-time directive - my $c; - my $filter; - my $filename = $path_h; - my $addflags = $opt_F || ''; - if ($fullpath =~ /,/) { - $filename = $`; - $filter = $'; - } - $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, - 'add_cppflags' => $addflags; - $c->set('includeDirs' => [$Config::Config{shrpdir}]); - - my $fdec = $c->get('parsed_fdecls'); - - for $decl (@$fdec) { print_decl(\*XS, $decl) } + for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) } } close XS; + +if (%types_seen) { + my $type; + warn "Writing $ext$modpname/typemap\n"; + open TM, ">typemap" or die "Cannot open typemap file for write: $!"; + + for $type (keys %types_seen) { + print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n" + } + + close TM or die "Cannot close typemap file for write: $!"; +} + } # if( ! $opt_X ) warn "Writing $ext$modpname/Makefile.PL\n";