From b30707e4885ca231ff72a496671faa7830e8002a Mon Sep 17 00:00:00 2001
From: "Todd C. Miller" <millert@cvs.openbsd.org>
Date: Mon, 9 Aug 2004 18:10:42 +0000
Subject: merge 5.8.5 into HEAD remove now-unused files crank libperl shared
 library major number update Makefile.bsd-wrapper tweak openbsd hints file for
 arm and m68k

---
 gnu/usr.bin/perl/utils/c2ph.PL    | 26 +++++++----
 gnu/usr.bin/perl/utils/h2ph.PL    | 93 +++++++++++++++++++++++++++++++++++----
 gnu/usr.bin/perl/utils/h2xs.PL    | 12 +++--
 gnu/usr.bin/perl/utils/perlbug.PL | 22 ++++++---
 4 files changed, 127 insertions(+), 26 deletions(-)

(limited to 'gnu/usr.bin/perl/utils')

diff --git a/gnu/usr.bin/perl/utils/c2ph.PL b/gnu/usr.bin/perl/utils/c2ph.PL
index 91ecc04552b..9334aa10436 100644
--- a/gnu/usr.bin/perl/utils/c2ph.PL
+++ b/gnu/usr.bin/perl/utils/c2ph.PL
@@ -278,8 +278,9 @@ Anyway, here it is.  Should run on perl v4 or greater.  Maybe less.
 
 =cut
 
-$RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
+$RCSID = '$Id: c2ph.PL,v 1.7 2003/12/03 03:02:50 millert Exp $';
 
+use File::Temp;
 
 ######################################################################
 
@@ -480,6 +481,13 @@ sub defvar {
     printf "%-16s%-15s  %s\n", $var, eval "\$$var", $msg;
 }
 
+sub safedir {
+    $SAFEDIR = File::Temp::tempdir("c2ph.XXXXXX", TMPDIR => 1, CLEANUP => 1)
+      unless (defined($SAFEDIR));
+}
+
+undef $SAFEDIR;
+
 $recurse = 1;
 
 if (@ARGV) {
@@ -495,15 +503,15 @@ if (@ARGV) {
     }
     elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
 	local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
-	$chdir = "cd $dir; " if $dir;
+	$chdir = "cd $dir && " if $dir;
 	&system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
 	$ARGV[0] =~ s/\.c$/.s/;
     }
     else {
-	$TMPDIR = tempdir(CLEANUP => 1);
-	$TMP = "$TMPDIR/c2ph.$$.c";
+	&safedir;
+	$TMP = "$SAFEDIR/c2ph.$$.c";
 	&system("cat @ARGV > $TMP") && exit 1;
-	&system("cd $TMPDIR; $CC $CFLAGS $DEFINES $TMP") && exit 1;
+	&system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1;
 	unlink $TMP;
 	$TMP =~ s/\.c$/.s/;
 	@ARGV = ($TMP);
@@ -1274,8 +1282,8 @@ sub fetch_template {
 }
 
 sub compute_intrinsics {
-    $TMPDIR ||= tempdir(CLEANUP => 1);
-    local($TMP) = "$TMPDIR/c2ph-i.$$.c";
+    &safedir;
+    local($TMP) = "$SAFEDIR/c2ph-i.$$.c";
     open (TMP, ">$TMP") || die "can't open $TMP: $!";
     select(TMP);
 
@@ -1303,7 +1311,7 @@ EOF
     close TMP;
 
     select(STDOUT);
-    open(PIPE, "cd $TMPDIR && $CC $TMP && $TMPDIR/a.out|");
+    open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|");
     while (<PIPE>) {
 	chop;
 	split(' ',$_,2);;
@@ -1312,7 +1320,7 @@ EOF
 	$intrinsics{$_[1]} = $template{$_[0]};
     }
     close(PIPE) || die "couldn't read intrinsics!";
-    unlink($TMP, '$TMPDIR/a.out');
+    unlink($TMP, '$SAFEDIR/a.out');
     print STDERR "done\n" if $trace;
 }
 
diff --git a/gnu/usr.bin/perl/utils/h2ph.PL b/gnu/usr.bin/perl/utils/h2ph.PL
index d28dc731f08..106336e4cab 100644
--- a/gnu/usr.bin/perl/utils/h2ph.PL
+++ b/gnu/usr.bin/perl/utils/h2ph.PL
@@ -58,13 +58,14 @@ my $Dest_dir = $opt_d || $Config{installsitearch};
 die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
     unless -d $Dest_dir;
 
-my @isatype = split(' ',<<END);
+my @isatype = qw(
 	char	uchar	u_char
 	short	ushort	u_short
 	int	uint	u_int
 	long	ulong	u_long
 	FILE	key_t	caddr_t
-END
+	float	double	size_t
+);
 
 my %isatype;
 @isatype{@isatype} = (1) x @isatype;
@@ -133,9 +134,9 @@ while (defined (my $file = next_file())) {
 		s/\(\w+\s*\(\*\)\s*\(\w*\)\)\s*(-?\d+)/$1/; # (int (*)(foo_t))0
 		if (s/^\(([\w,\s]*)\)//) {
 		    $args = $1;
-    	    	    my $proto = '() ';
+		    my $proto = '() ';
 		    if ($args ne '') {
-    	    	    	$proto = '';
+			$proto = '';
 			foreach my $arg (split(/,\s*/,$args)) {
 			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
 			    $curargs{$arg} = 1;
@@ -146,6 +147,7 @@ while (defined (my $file = next_file())) {
 		    s/^\s+//;
 		    expr();
 		    $new =~ s/(["\\])/\\$1/g;       #"]);
+		  EMIT:
 		    $new = reindent($new);
 		    $args = reindent($args);
 		    if ($t ne '') {
@@ -268,7 +270,7 @@ while (defined (my $file = next_file())) {
 	    } elsif(/^ident\s+(.*)/) {
 		print OUT $t, "# $1\n";
 	    }
-	} elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) {
+	} elsif (/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) { # { for vi
 	    until(/\{[^}]*\}.*;/ || /;/) {
 		last unless defined ($next = next_line($file));
 		chomp $next;
@@ -300,6 +302,75 @@ while (defined (my $file = next_file())) {
 			       "unless defined(\&$enum_name);\n");
 		}
 	    }
+	} elsif (/^(?:__extension__\s+)?(?:extern|static)\s+(?:__)?inline(?:__)?\s+/
+	    and !/;\s*$/ and !/{\s*}\s*$/)
+	{ # { for vi
+	    # This is a hack to parse the inline functions in the glibc headers.
+	    # Warning: massive kludge ahead. We suppose inline functions
+	    # are mainly constructed like macros.
+	    while (1) {
+		last unless defined ($next = next_line($file));
+		chomp $next;
+		undef $_, last if $next =~ /__THROW\s*;/
+			       or $next =~ /^(__extension__|extern|static)\b/;
+		$_ .= " $next";
+		print OUT "# $next\n" if $opt_D;
+		last if $next =~ /^}|^{.*}\s*$/;
+	    }
+	    next if not defined; # because it's only a prototype
+	    s/\b(__extension__|extern|static|(?:__)?inline(?:__)?)\b//g;
+	    # violently drop #ifdefs
+	    s/#\s*if.*?#\s*endif//g
+		and print OUT "# some #ifdef were dropped here -- fill in the blanks\n";
+	    if (s/^(?:\w|\s|\*)*\s(\w+)\s*//) {
+		$name = $1;
+	    } else {
+		warn "name not found"; next; # shouldn't occur...
+	    }
+	    my @args;
+	    if (s/^\(([^()]*)\)\s*(\w+\s*)*//) {
+		for my $arg (split /,/, $1) {
+		    if ($arg =~ /(\w+)\s*$/) {
+			$curargs{$1} = 1;
+			push @args, $1;
+		    }
+		}
+	    }
+	    $args = (
+		@args
+		? "local(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t    "
+		: ""
+	    );
+	    my $proto = @args ? '' : '() ';
+	    $new = '';
+	    s/\breturn\b//g; # "return" doesn't occur in macros usually...
+	    expr();
+	    # try to find and perlify local C variables
+	    our @local_variables = (); # needs to be a our(): (?{...}) bug workaround
+	    {
+		use re "eval";
+		my $typelist = join '|', keys %isatype;
+		$new =~ s['
+		  (?:(?:un)?signed\s+)?
+		  (?:long\s+)?
+		  (?:$typelist)\s+
+		  (\w+)
+		  (?{ push @local_variables, $1 })
+		  ']
+		 [my \$$1]gx;
+		$new =~ s['
+		  (?:(?:un)?signed\s+)?
+		  (?:long\s+)?
+		  (?:$typelist)\s+
+		  ' \s+ &(\w+) \s* ;
+		  (?{ push @local_variables, $1 })
+		  ]
+		 [my \$$1;]gx;
+	     }
+	    $new =~ s/&$_\b/\$$_/g for @local_variables;
+	    $new =~ s/(["\\])/\\$1/g;       #"]);
+	    # now that's almost like a macro (we hope)
+	    goto EMIT;
 	}
     }
     $Is_converted{$file} = 1;
@@ -308,7 +379,7 @@ while (defined (my $file = next_file())) {
         $next = '';
     } else {
         print OUT "1;\n";
-    queue_includes_from($file) if ($opt_a);
+	queue_includes_from($file) if $opt_a;
     }
 }
 
@@ -380,10 +451,16 @@ sub expr {
         };
 	# Eliminate typedefs
 	/\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ && do {
+	    my $doit = 1;
 	    foreach (split /\s+/, $1) {  # Make sure all the words are types,
-		last unless ($isatype{$_} or $_ eq 'struct' or $_ eq 'union');
+	        unless($isatype{$_} or $_ eq 'struct' or $_ eq 'union'){
+		    $doit = 0;
+		    last;
+		}
+	    }
+	    if( $doit ){
+		s/\([\w\s]+[\*\s]*\)// && next;      # then eliminate them.
 	    }
-	    s/\([\w\s]+[\*\s]*\)// && next;      # then eliminate them.
 	};
 	# struct/union member, including arrays:
 	s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
diff --git a/gnu/usr.bin/perl/utils/h2xs.PL b/gnu/usr.bin/perl/utils/h2xs.PL
index ef2063d1cf3..18e73c2fffa 100644
--- a/gnu/usr.bin/perl/utils/h2xs.PL
+++ b/gnu/usr.bin/perl/utils/h2xs.PL
@@ -492,7 +492,7 @@ See L<perlxs> and L<perlxstut> for additional details.
 use strict;
 
 
-my( $H2XS_VERSION ) = ' $Revision: 1.7 $ ' =~ /\$Revision:\s+([^\s]+)/;
+my( $H2XS_VERSION ) = ' $Revision: 1.8 $ ' =~ /\$Revision:\s+([^\s]+)/;
 my $TEMPLATE_VERSION = '0.01';
 my @ARGS = @ARGV;
 my $compat_version = $];
@@ -701,7 +701,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 = '';
 
@@ -899,7 +900,7 @@ if( @path_h ){
             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*(.*)/;
+                my ($key, $declared_val) = $item =~ /(\w+)\s*=\s*(.*)/;
                 $val = length($declared_val) ? $declared_val : 1 + $val;
                 $seen_define{$key} = $declared_val;
                 $const_names{$key}++;
@@ -980,6 +981,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')});
 
@@ -1307,7 +1310,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
diff --git a/gnu/usr.bin/perl/utils/perlbug.PL b/gnu/usr.bin/perl/utils/perlbug.PL
index b9906f8acfe..8f3e6a0d2c1 100644
--- a/gnu/usr.bin/perl/utils/perlbug.PL
+++ b/gnu/usr.bin/perl/utils/perlbug.PL
@@ -89,9 +89,12 @@ BEGIN {
     $::HaveSend = ($@ eq "");
     eval "use Mail::Util;";
     $::HaveUtil = ($@ eq "");
+    # use secure tempfiles wherever possible
+    eval "require File::Temp;";
+    $::HaveTemp = ($@ eq "");
 };
 
-my $Version = "1.34";
+my $Version = "1.35";
 
 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
 # Changed in 1.07 to see more sendmail execs, and added pipe output.
@@ -130,6 +133,7 @@ my $Version = "1.34";
 # Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
 # Changed in 1.33 Don't require -t STDOUT for -ok.
 # Changed in 1.34 Added Message-Id RFOLEY 18-06-2002 
+# Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004
 
 # TODO: - Allow the user to re-name the file on mail failure, and
 #       make sure failure (transmission-wise) of Mail::Send is
@@ -958,10 +962,18 @@ EOF
 }
 
 sub filename {
-    my $dir = File::Spec->tmpdir();
-    $filename = "bugrep0$$";
-    $filename++ while -e File::Spec->catfile($dir, $filename);
-    $filename = File::Spec->catfile($dir, $filename);
+    if ($::HaveTemp) {
+	# Good. Use a secure temp file
+	my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
+	close($fh);
+	return $filename;
+    } else {
+	# Bah. Fall back to doing things less securely.
+	my $dir = File::Spec->tmpdir();
+	$filename = "bugrep0$$";
+	$filename++ while -e File::Spec->catfile($dir, $filename);
+	$filename = File::Spec->catfile($dir, $filename);
+    }
 }
 
 sub paraprint {
-- 
cgit v1.2.3