diff options
| -rwxr-xr-x | gnu/usr.bin/perl/Porting/checkcfgvar.pl | 203 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/unicore/NamedSequences.txt | 446 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/t/io/through.t | 15 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/t/lib/cygwin.t | 51 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/t/op/chr.t | 82 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/t/op/getppid.t | 131 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/t/op/negate.t | 88 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/t/op/sselect.t | 81 |
8 files changed, 161 insertions, 936 deletions
diff --git a/gnu/usr.bin/perl/Porting/checkcfgvar.pl b/gnu/usr.bin/perl/Porting/checkcfgvar.pl index 3ebde3a2d15..0a7b24e743c 100755 --- a/gnu/usr.bin/perl/Porting/checkcfgvar.pl +++ b/gnu/usr.bin/perl/Porting/checkcfgvar.pl @@ -1,180 +1,101 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w +# # Check that the various config.sh-clones have (at least) all the # same symbols as the top-level config_h.SH so that the (potentially) # needed symbols are not lagging after how Configure thinks the world # is laid out. # -# VMS is probably not handled properly here, due to their own -# rather elaborate DCL scripting. +# VMS is not handled here, due to their own rather elaborate DCL scripting. # use strict; -use warnings; -use autodie; - -sub usage -{ - my $err = shift and select STDERR; - print "usage: $0 [--list] [--regen] [--default=value]\n"; - exit $err; - } # usage - -use Getopt::Long; -my $opt_l = 0; -my $opt_r = 0; -my $default; -my $tap = 0; -my $test; -GetOptions ( - "help|?" => sub { usage (0); }, - "l|list!" => \$opt_l, - "regen" => \$opt_r, - "default=s" => \$default, - "tap" => \$tap, - ) or usage (1); - -require 'regen/regen_lib.pl' if $opt_r; my $MASTER_CFG = "config_h.SH"; -# Inclusive bounds on the main part of the file, $section == 1 below: -my $first = qr/^Author=/; -my $last = qr/^zip=/; +my %MASTER_CFG; my @CFG = ( + # This list contains both 5.8.x and 5.9.x files, # we check from MANIFEST whether they are expected to be present. - # We can't base our check on $], because that's the version of the - # perl that we are running, not the version of the source tree. "Cross/config.sh-arm-linux", + "epoc/config.sh", "NetWare/config.wc", "symbian/config.sh", "uconfig.sh", - "uconfig64.sh", "plan9/config_sh.sample", + "vos/config.alpha.def", + "vos/config.ga.def", + "win32/config.bc", "win32/config.gc", "win32/config.vc", - "win32/config.ce", - "configure.com", - "Porting/config.sh", + "win32/config.vc64", + "wince/config.ce", ); -my @MASTER_CFG; -{ - my %seen; - open my $fh, '<', $MASTER_CFG; - while (<$fh>) { - while (/[^\\]\$([a-z]\w+)/g) { - my $v = $1; - next if $v =~ /^(CONFIG_H|CONFIG_SH)$/; - $seen{$v}++; +sub read_file { + my ($fn, $sub) = @_; + if (open(my $fh, $fn)) { + local $_; + while (<$fh>) { + &$sub; } + } else { + die "$0: Failed to open '$fn' for reading: $!\n"; } - close $fh; - @MASTER_CFG = sort keys %seen; } -my %MANIFEST; - -{ - open my $fh, '<', 'MANIFEST'; - while (<$fh>) { - $MANIFEST{$1}++ if /^(.+?)\t/; +sub config_h_SH_reader { + my $cfg = shift; + return sub { + return if 1../^echo \"Extracting \$CONFIG_H/; + while (/[^\\]\$(\w+)/g) { + my $v = $1; + next if $v =~ /^(CONFIG_H|CONFIG_SH)$/; + $cfg->{$v}++; + } } - close $fh; } -printf "1..%d\n", 2 * @CFG if $tap; - -for my $cfg (sort @CFG) { - unless (exists $MANIFEST{$cfg}) { - print STDERR "[skipping not-expected '$cfg']\n"; - next; - } - my %cfg; - my $section = 0; - my @lines; - - open my $fh, '<', $cfg; +read_file($MASTER_CFG, + config_h_SH_reader(\%MASTER_CFG)); - if ($cfg eq 'configure.com') { - ++$cfg{startperl}; # Cheat. +my %MANIFEST; - while (<$fh>) { - next if /^\#/ || /^\s*$/ || /^\:/; - s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace - ++$cfg{$1} if /^\$\s+WC "(\w+)='(?:.*)'"$/; - } - } else { - while (<$fh>) { - if ($_ =~ $first) { - die "$cfg:$.:section=$section:$_" unless $section == 0; - $section = 1; - } - push @{$lines[$section]}, $_; - next if /^\#/ || /^\s*$/ || /^\:/; - if ($_ =~ $last) { - die "$cfg:$.:section=$section:$_" unless $section == 1; - $section = 2; - } - # foo='bar' - # foo=bar - # (optionally with a trailing comment) - if (/^(\w+)=(?:'.*'|[^'].*)(?: #.*)?$/) { - ++$cfg{$1}; - } else { - warn "$cfg:$.:$_"; - } - } - } - close $fh; +read_file("MANIFEST", + sub { + $MANIFEST{$1}++ if /^(.+?)\t/; + }); - ++$test; - my $missing; - if ($cfg eq 'configure.com') { - print "ok $test # skip $cfg doesn't need to be sorted\n" - if $tap; - } elsif (join("", @{$lines[1]}) eq join("", sort @{$lines[1]})) { - print "ok $test - $cfg sorted\n" - if $tap; - } elsif ($tap) { - print "not ok $test - $cfg is not sorted\n"; - } elsif ($opt_r || $opt_l) { - # A reference to an empty array is true, hence this flags the - # file for later attention by --regen and --list, even if - # nothing is missing. Actual sort and output are done later. - $missing = []; - } else { - print "$cfg: unsorted\n" - } +my @MASTER_CFG = sort keys %MASTER_CFG; +sub check_cfg { + my ($fn, $cfg) = @_; for my $v (@MASTER_CFG) { - # This only creates a reference in $missing if something is missing: - push @$missing, $v unless exists $cfg{$v}; + print "$fn: missing '$v'\n" unless exists $cfg->{$v}; } +} - ++$test; - if ($missing) { - if ($tap) { - print "not ok $test - $cfg missing keys @$missing\n"; - } elsif ($opt_l) { - # print the name once, however many problems - print "$cfg\n"; - } elsif ($opt_r && $cfg ne 'configure.com') { - if (defined $default) { - push @{$lines[1]}, map {"$_='$default'\n"} @$missing; - } else { - print "$cfg: missing '$_', use --default to add it\n" - foreach @$missing; - } - - @{$lines[1]} = sort @{$lines[1]}; - my $fh = open_new($cfg); - print $fh @{$_} foreach @lines; - close_and_rename($fh); - } else { - print "$cfg: missing '$_'\n" foreach @$missing; - } - } elsif ($tap) { - print "ok $test - $cfg has no missing keys\n"; +for my $cfg (@CFG) { + unless (exists $MANIFEST{$cfg}) { + print "[skipping not-expected '$cfg']\n"; + next; } + my %cfg; + read_file($cfg, + sub { + return if /^\#/ || /^\s*$/; + # foo='bar' + # foo=bar + # $foo='bar' # VOS 5.8.x specialty + # $foo=bar # VOS 5.8.x specialty + if (/^\$?(\w+)='(.*)'$/) { + $cfg{$1}++; + } + elsif (/^\$?(\w+)=(.*)$/) { + $cfg{$1}++; + } else { + warn "$cfg:$.:$_"; + } + }); + check_cfg($cfg, \%cfg); } diff --git a/gnu/usr.bin/perl/lib/unicore/NamedSequences.txt b/gnu/usr.bin/perl/lib/unicore/NamedSequences.txt index e1ae2b740e5..c880c50b911 100644 --- a/gnu/usr.bin/perl/lib/unicore/NamedSequences.txt +++ b/gnu/usr.bin/perl/lib/unicore/NamedSequences.txt @@ -1,25 +1,14 @@ -# NamedSequences-6.3.0.txt -# Date: 2012-11-14, 21:51:00 GMT [KW] +# NamedSequences-4.1.0.txt +# Date: 2005-214, 13:10 PST [KW] # # Unicode Character Database -# Copyright (c) 1991-2012 Unicode, Inc. +# Copyright (c) 1991-2005 Unicode, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html -# For documentation, see http://www.unicode.org/reports/tr44/ +# For documentation, see UCD.html # # Format: # Name of Sequence; Code Point Sequence for USI # -# Code point sequences in the UCD use spaces as delimiters. -# The corresponding format for a USI in ISO/IEC 10646 uses -# comma delimitation and angle brackets. Thus, a named sequence -# of the form: -# -# EXAMPLE NAME;1000 1001 1002 -# -# in this data file, would correspond to a 10646 USI as follows: -# -# <1000, 1001, 1002> -# # Note: The order of entries in this file is not significant. # However, entries are generally in script order corresponding # to block order in the Unicode Standard, to make it easier @@ -29,6 +18,7 @@ LATIN CAPITAL LETTER A WITH MACRON AND GRAVE;0100 0300 LATIN SMALL LETTER A WITH MACRON AND GRAVE;0101 0300 +LATIN SMALL LETTER A WITH ACUTE AND OGONEK;00E1 0328 LATIN CAPITAL LETTER E WITH VERTICAL LINE BELOW;0045 0329 LATIN SMALL LETTER E WITH VERTICAL LINE BELOW;0065 0329 LATIN CAPITAL LETTER E WITH VERTICAL LINE BELOW AND GRAVE;00C8 0329 @@ -53,406 +43,12 @@ LATIN CAPITAL LETTER S WITH VERTICAL LINE BELOW;0053 0329 LATIN SMALL LETTER S WITH VERTICAL LINE BELOW;0073 0329 LATIN CAPITAL LETTER U WITH MACRON AND GRAVE;016A 0300 LATIN SMALL LETTER U WITH MACRON AND GRAVE;016B 0300 - -# Additions for Lithuanian. Provisional 2006-05-18, Approved 2007-10-19 - -LATIN CAPITAL LETTER A WITH OGONEK AND ACUTE;0104 0301 -LATIN SMALL LETTER A WITH OGONEK AND ACUTE;0105 0301 -LATIN CAPITAL LETTER A WITH OGONEK AND TILDE;0104 0303 -LATIN SMALL LETTER A WITH OGONEK AND TILDE;0105 0303 -LATIN CAPITAL LETTER E WITH OGONEK AND ACUTE;0118 0301 -LATIN SMALL LETTER E WITH OGONEK AND ACUTE;0119 0301 -LATIN CAPITAL LETTER E WITH OGONEK AND TILDE;0118 0303 -LATIN SMALL LETTER E WITH OGONEK AND TILDE;0119 0303 -LATIN CAPITAL LETTER E WITH DOT ABOVE AND ACUTE;0116 0301 -LATIN SMALL LETTER E WITH DOT ABOVE AND ACUTE;0117 0301 -LATIN CAPITAL LETTER E WITH DOT ABOVE AND TILDE;0116 0303 -LATIN SMALL LETTER E WITH DOT ABOVE AND TILDE;0117 0303 -LATIN SMALL LETTER I WITH DOT ABOVE AND GRAVE;0069 0307 0300 -LATIN SMALL LETTER I WITH DOT ABOVE AND TILDE;0069 0307 0303 -LATIN CAPITAL LETTER I WITH OGONEK AND ACUTE;012E 0301 -LATIN SMALL LETTER I WITH OGONEK AND DOT ABOVE AND ACUTE;012F 0307 0301 -LATIN CAPITAL LETTER I WITH OGONEK AND TILDE;012E 0303 -LATIN SMALL LETTER I WITH OGONEK AND DOT ABOVE AND TILDE;012F 0307 0303 -LATIN CAPITAL LETTER J WITH TILDE;004A 0303 -LATIN SMALL LETTER J WITH DOT ABOVE AND TILDE;006A 0307 0303 -LATIN CAPITAL LETTER L WITH TILDE;004C 0303 -LATIN SMALL LETTER L WITH TILDE;006C 0303 -LATIN CAPITAL LETTER M WITH TILDE;004D 0303 -LATIN SMALL LETTER M WITH TILDE;006D 0303 -LATIN CAPITAL LETTER R WITH TILDE;0052 0303 -LATIN SMALL LETTER R WITH TILDE;0072 0303 -LATIN CAPITAL LETTER U WITH OGONEK AND ACUTE;0172 0301 -LATIN SMALL LETTER U WITH OGONEK AND ACUTE;0173 0301 -LATIN CAPITAL LETTER U WITH OGONEK AND TILDE;0172 0303 -LATIN SMALL LETTER U WITH OGONEK AND TILDE;0173 0303 -LATIN CAPITAL LETTER U WITH MACRON AND ACUTE;016A 0301 -LATIN SMALL LETTER U WITH MACRON AND ACUTE;016B 0301 -LATIN CAPITAL LETTER U WITH MACRON AND TILDE;016A 0303 -LATIN SMALL LETTER U WITH MACRON AND TILDE;016B 0303 - -# Entries for JIS X 0213 compatibility mapping. -# Provisional: 2008-11-07, Approved 2010-05-14 - -LATIN SMALL LETTER AE WITH GRAVE;00E6 0300 -LATIN SMALL LETTER OPEN O WITH GRAVE;0254 0300 -LATIN SMALL LETTER OPEN O WITH ACUTE;0254 0301 -LATIN SMALL LETTER TURNED V WITH GRAVE;028C 0300 -LATIN SMALL LETTER TURNED V WITH ACUTE;028C 0301 -LATIN SMALL LETTER SCHWA WITH GRAVE;0259 0300 -LATIN SMALL LETTER SCHWA WITH ACUTE;0259 0301 -LATIN SMALL LETTER HOOKED SCHWA WITH GRAVE;025A 0300 -LATIN SMALL LETTER HOOKED SCHWA WITH ACUTE;025A 0301 - -# Entries for Uyghur and Chagatai. -# Provisional: N/A, Approved: 2012-11-08 - -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH ALEF;0626 0627 -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH WAW;0626 0648 -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH ALEF MAKSURA;0626 0649 -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH OE;0626 06C6 -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH U;0626 06C7 -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH YU;0626 06C8 -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH E;0626 06D0 -ARABIC SEQUENCE YEH WITH HAMZA ABOVE WITH AE;0626 06D5 -ARABIC SEQUENCE NOON WITH KEHEH;0646 06A9 - -# Entry for a Bangla entity. -# Provisional: 2009-08-10, Approved 2010-05-14 -# -# Note that this same sequence is also used for the ASSAMESE LETTER KSSA. - -BENGALI LETTER KHINYA;0995 09CD 09B7 - -# Additions for Tamil. Provisional 2008-02-08, Approved 2009-08-14 -# -# A visual display of the Tamil named sequences is available -# in the documentation for the Unicode Standard. See Section 9.6, Tamil in -# http://www.unicode.org/versions/latest/ - -TAMIL CONSONANT K; 0B95 0BCD -TAMIL CONSONANT NG; 0B99 0BCD -TAMIL CONSONANT C; 0B9A 0BCD -TAMIL CONSONANT NY; 0B9E 0BCD -TAMIL CONSONANT TT; 0B9F 0BCD -TAMIL CONSONANT NN; 0BA3 0BCD -TAMIL CONSONANT T; 0BA4 0BCD -TAMIL CONSONANT N; 0BA8 0BCD -TAMIL CONSONANT P; 0BAA 0BCD -TAMIL CONSONANT M; 0BAE 0BCD -TAMIL CONSONANT Y; 0BAF 0BCD -TAMIL CONSONANT R; 0BB0 0BCD -TAMIL CONSONANT L; 0BB2 0BCD -TAMIL CONSONANT V; 0BB5 0BCD -TAMIL CONSONANT LLL;0BB4 0BCD -TAMIL CONSONANT LL; 0BB3 0BCD -TAMIL CONSONANT RR; 0BB1 0BCD -TAMIL CONSONANT NNN;0BA9 0BCD -TAMIL CONSONANT J; 0B9C 0BCD -TAMIL CONSONANT SH; 0BB6 0BCD -TAMIL CONSONANT SS; 0BB7 0BCD -TAMIL CONSONANT S; 0BB8 0BCD -TAMIL CONSONANT H; 0BB9 0BCD -TAMIL CONSONANT KSS;0B95 0BCD 0BB7 0BCD - -TAMIL SYLLABLE KAA; 0B95 0BBE -TAMIL SYLLABLE KI; 0B95 0BBF -TAMIL SYLLABLE KII; 0B95 0BC0 -TAMIL SYLLABLE KU; 0B95 0BC1 -TAMIL SYLLABLE KUU; 0B95 0BC2 -TAMIL SYLLABLE KE; 0B95 0BC6 -TAMIL SYLLABLE KEE; 0B95 0BC7 -TAMIL SYLLABLE KAI; 0B95 0BC8 -TAMIL SYLLABLE KO; 0B95 0BCA -TAMIL SYLLABLE KOO; 0B95 0BCB -TAMIL SYLLABLE KAU; 0B95 0BCC - -TAMIL SYLLABLE NGAA; 0B99 0BBE -TAMIL SYLLABLE NGI; 0B99 0BBF -TAMIL SYLLABLE NGII; 0B99 0BC0 -TAMIL SYLLABLE NGU; 0B99 0BC1 -TAMIL SYLLABLE NGUU; 0B99 0BC2 -TAMIL SYLLABLE NGE; 0B99 0BC6 -TAMIL SYLLABLE NGEE; 0B99 0BC7 -TAMIL SYLLABLE NGAI; 0B99 0BC8 -TAMIL SYLLABLE NGO; 0B99 0BCA -TAMIL SYLLABLE NGOO; 0B99 0BCB -TAMIL SYLLABLE NGAU; 0B99 0BCC - -TAMIL SYLLABLE CAA; 0B9A 0BBE -TAMIL SYLLABLE CI; 0B9A 0BBF -TAMIL SYLLABLE CII; 0B9A 0BC0 -TAMIL SYLLABLE CU; 0B9A 0BC1 -TAMIL SYLLABLE CUU; 0B9A 0BC2 -TAMIL SYLLABLE CE; 0B9A 0BC6 -TAMIL SYLLABLE CEE; 0B9A 0BC7 -TAMIL SYLLABLE CAI; 0B9A 0BC8 -TAMIL SYLLABLE CO; 0B9A 0BCA -TAMIL SYLLABLE COO; 0B9A 0BCB -TAMIL SYLLABLE CAU; 0B9A 0BCC - -TAMIL SYLLABLE NYAA; 0B9E 0BBE -TAMIL SYLLABLE NYI; 0B9E 0BBF -TAMIL SYLLABLE NYII; 0B9E 0BC0 -TAMIL SYLLABLE NYU; 0B9E 0BC1 -TAMIL SYLLABLE NYUU; 0B9E 0BC2 -TAMIL SYLLABLE NYE; 0B9E 0BC6 -TAMIL SYLLABLE NYEE; 0B9E 0BC7 -TAMIL SYLLABLE NYAI; 0B9E 0BC8 -TAMIL SYLLABLE NYO; 0B9E 0BCA -TAMIL SYLLABLE NYOO; 0B9E 0BCB -TAMIL SYLLABLE NYAU; 0B9E 0BCC - -TAMIL SYLLABLE TTAA; 0B9F 0BBE -TAMIL SYLLABLE TTI; 0B9F 0BBF -TAMIL SYLLABLE TTII; 0B9F 0BC0 -TAMIL SYLLABLE TTU; 0B9F 0BC1 -TAMIL SYLLABLE TTUU; 0B9F 0BC2 -TAMIL SYLLABLE TTE; 0B9F 0BC6 -TAMIL SYLLABLE TTEE; 0B9F 0BC7 -TAMIL SYLLABLE TTAI; 0B9F 0BC8 -TAMIL SYLLABLE TTO; 0B9F 0BCA -TAMIL SYLLABLE TTOO; 0B9F 0BCB -TAMIL SYLLABLE TTAU; 0B9F 0BCC - -TAMIL SYLLABLE NNAA; 0BA3 0BBE -TAMIL SYLLABLE NNI; 0BA3 0BBF -TAMIL SYLLABLE NNII; 0BA3 0BC0 -TAMIL SYLLABLE NNU; 0BA3 0BC1 -TAMIL SYLLABLE NNUU; 0BA3 0BC2 -TAMIL SYLLABLE NNE; 0BA3 0BC6 -TAMIL SYLLABLE NNEE; 0BA3 0BC7 -TAMIL SYLLABLE NNAI; 0BA3 0BC8 -TAMIL SYLLABLE NNO; 0BA3 0BCA -TAMIL SYLLABLE NNOO; 0BA3 0BCB -TAMIL SYLLABLE NNAU; 0BA3 0BCC - -TAMIL SYLLABLE TAA; 0BA4 0BBE -TAMIL SYLLABLE TI; 0BA4 0BBF -TAMIL SYLLABLE TII; 0BA4 0BC0 -TAMIL SYLLABLE TU; 0BA4 0BC1 -TAMIL SYLLABLE TUU; 0BA4 0BC2 -TAMIL SYLLABLE TE; 0BA4 0BC6 -TAMIL SYLLABLE TEE; 0BA4 0BC7 -TAMIL SYLLABLE TAI; 0BA4 0BC8 -TAMIL SYLLABLE TO; 0BA4 0BCA -TAMIL SYLLABLE TOO; 0BA4 0BCB -TAMIL SYLLABLE TAU; 0BA4 0BCC - -TAMIL SYLLABLE NAA; 0BA8 0BBE -TAMIL SYLLABLE NI; 0BA8 0BBF -TAMIL SYLLABLE NII; 0BA8 0BC0 -TAMIL SYLLABLE NU; 0BA8 0BC1 -TAMIL SYLLABLE NUU; 0BA8 0BC2 -TAMIL SYLLABLE NE; 0BA8 0BC6 -TAMIL SYLLABLE NEE; 0BA8 0BC7 -TAMIL SYLLABLE NAI; 0BA8 0BC8 -TAMIL SYLLABLE NO; 0BA8 0BCA -TAMIL SYLLABLE NOO; 0BA8 0BCB -TAMIL SYLLABLE NAU; 0BA8 0BCC - -TAMIL SYLLABLE PAA; 0BAA 0BBE -TAMIL SYLLABLE PI; 0BAA 0BBF -TAMIL SYLLABLE PII; 0BAA 0BC0 -TAMIL SYLLABLE PU; 0BAA 0BC1 -TAMIL SYLLABLE PUU; 0BAA 0BC2 -TAMIL SYLLABLE PE; 0BAA 0BC6 -TAMIL SYLLABLE PEE; 0BAA 0BC7 -TAMIL SYLLABLE PAI; 0BAA 0BC8 -TAMIL SYLLABLE PO; 0BAA 0BCA -TAMIL SYLLABLE POO; 0BAA 0BCB -TAMIL SYLLABLE PAU; 0BAA 0BCC - -TAMIL SYLLABLE MAA; 0BAE 0BBE -TAMIL SYLLABLE MI; 0BAE 0BBF -TAMIL SYLLABLE MII; 0BAE 0BC0 -TAMIL SYLLABLE MU; 0BAE 0BC1 -TAMIL SYLLABLE MUU; 0BAE 0BC2 -TAMIL SYLLABLE ME; 0BAE 0BC6 -TAMIL SYLLABLE MEE; 0BAE 0BC7 -TAMIL SYLLABLE MAI; 0BAE 0BC8 -TAMIL SYLLABLE MO; 0BAE 0BCA -TAMIL SYLLABLE MOO; 0BAE 0BCB -TAMIL SYLLABLE MAU; 0BAE 0BCC - -TAMIL SYLLABLE YAA; 0BAF 0BBE -TAMIL SYLLABLE YI; 0BAF 0BBF -TAMIL SYLLABLE YII; 0BAF 0BC0 -TAMIL SYLLABLE YU; 0BAF 0BC1 -TAMIL SYLLABLE YUU; 0BAF 0BC2 -TAMIL SYLLABLE YE; 0BAF 0BC6 -TAMIL SYLLABLE YEE; 0BAF 0BC7 -TAMIL SYLLABLE YAI; 0BAF 0BC8 -TAMIL SYLLABLE YO; 0BAF 0BCA -TAMIL SYLLABLE YOO; 0BAF 0BCB -TAMIL SYLLABLE YAU; 0BAF 0BCC - -TAMIL SYLLABLE RAA; 0BB0 0BBE -TAMIL SYLLABLE RI; 0BB0 0BBF -TAMIL SYLLABLE RII; 0BB0 0BC0 -TAMIL SYLLABLE RU; 0BB0 0BC1 -TAMIL SYLLABLE RUU; 0BB0 0BC2 -TAMIL SYLLABLE RE; 0BB0 0BC6 -TAMIL SYLLABLE REE; 0BB0 0BC7 -TAMIL SYLLABLE RAI; 0BB0 0BC8 -TAMIL SYLLABLE RO; 0BB0 0BCA -TAMIL SYLLABLE ROO; 0BB0 0BCB -TAMIL SYLLABLE RAU; 0BB0 0BCC - -TAMIL SYLLABLE LAA; 0BB2 0BBE -TAMIL SYLLABLE LI; 0BB2 0BBF -TAMIL SYLLABLE LII; 0BB2 0BC0 -TAMIL SYLLABLE LU; 0BB2 0BC1 -TAMIL SYLLABLE LUU; 0BB2 0BC2 -TAMIL SYLLABLE LE; 0BB2 0BC6 -TAMIL SYLLABLE LEE; 0BB2 0BC7 -TAMIL SYLLABLE LAI; 0BB2 0BC8 -TAMIL SYLLABLE LO; 0BB2 0BCA -TAMIL SYLLABLE LOO; 0BB2 0BCB -TAMIL SYLLABLE LAU; 0BB2 0BCC - -TAMIL SYLLABLE VAA; 0BB5 0BBE -TAMIL SYLLABLE VI; 0BB5 0BBF -TAMIL SYLLABLE VII; 0BB5 0BC0 -TAMIL SYLLABLE VU; 0BB5 0BC1 -TAMIL SYLLABLE VUU; 0BB5 0BC2 -TAMIL SYLLABLE VE; 0BB5 0BC6 -TAMIL SYLLABLE VEE; 0BB5 0BC7 -TAMIL SYLLABLE VAI; 0BB5 0BC8 -TAMIL SYLLABLE VO; 0BB5 0BCA -TAMIL SYLLABLE VOO; 0BB5 0BCB -TAMIL SYLLABLE VAU; 0BB5 0BCC - -TAMIL SYLLABLE LLLAA; 0BB4 0BBE -TAMIL SYLLABLE LLLI; 0BB4 0BBF -TAMIL SYLLABLE LLLII; 0BB4 0BC0 -TAMIL SYLLABLE LLLU; 0BB4 0BC1 -TAMIL SYLLABLE LLLUU; 0BB4 0BC2 -TAMIL SYLLABLE LLLE; 0BB4 0BC6 -TAMIL SYLLABLE LLLEE; 0BB4 0BC7 -TAMIL SYLLABLE LLLAI; 0BB4 0BC8 -TAMIL SYLLABLE LLLO; 0BB4 0BCA -TAMIL SYLLABLE LLLOO; 0BB4 0BCB -TAMIL SYLLABLE LLLAU; 0BB4 0BCC - -TAMIL SYLLABLE LLAA; 0BB3 0BBE -TAMIL SYLLABLE LLI; 0BB3 0BBF -TAMIL SYLLABLE LLII; 0BB3 0BC0 -TAMIL SYLLABLE LLU; 0BB3 0BC1 -TAMIL SYLLABLE LLUU; 0BB3 0BC2 -TAMIL SYLLABLE LLE; 0BB3 0BC6 -TAMIL SYLLABLE LLEE; 0BB3 0BC7 -TAMIL SYLLABLE LLAI; 0BB3 0BC8 -TAMIL SYLLABLE LLO; 0BB3 0BCA -TAMIL SYLLABLE LLOO; 0BB3 0BCB -TAMIL SYLLABLE LLAU; 0BB3 0BCC - -TAMIL SYLLABLE RRAA; 0BB1 0BBE -TAMIL SYLLABLE RRI; 0BB1 0BBF -TAMIL SYLLABLE RRII; 0BB1 0BC0 -TAMIL SYLLABLE RRU; 0BB1 0BC1 -TAMIL SYLLABLE RRUU; 0BB1 0BC2 -TAMIL SYLLABLE RRE; 0BB1 0BC6 -TAMIL SYLLABLE RREE; 0BB1 0BC7 -TAMIL SYLLABLE RRAI; 0BB1 0BC8 -TAMIL SYLLABLE RRO; 0BB1 0BCA -TAMIL SYLLABLE RROO; 0BB1 0BCB -TAMIL SYLLABLE RRAU; 0BB1 0BCC - -TAMIL SYLLABLE NNNAA; 0BA9 0BBE -TAMIL SYLLABLE NNNI; 0BA9 0BBF -TAMIL SYLLABLE NNNII; 0BA9 0BC0 -TAMIL SYLLABLE NNNU; 0BA9 0BC1 -TAMIL SYLLABLE NNNUU; 0BA9 0BC2 -TAMIL SYLLABLE NNNE; 0BA9 0BC6 -TAMIL SYLLABLE NNNEE; 0BA9 0BC7 -TAMIL SYLLABLE NNNAI; 0BA9 0BC8 -TAMIL SYLLABLE NNNO; 0BA9 0BCA -TAMIL SYLLABLE NNNOO; 0BA9 0BCB -TAMIL SYLLABLE NNNAU; 0BA9 0BCC - -TAMIL SYLLABLE JAA; 0B9C 0BBE -TAMIL SYLLABLE JI; 0B9C 0BBF -TAMIL SYLLABLE JII; 0B9C 0BC0 -TAMIL SYLLABLE JU; 0B9C 0BC1 -TAMIL SYLLABLE JUU; 0B9C 0BC2 -TAMIL SYLLABLE JE; 0B9C 0BC6 -TAMIL SYLLABLE JEE; 0B9C 0BC7 -TAMIL SYLLABLE JAI; 0B9C 0BC8 -TAMIL SYLLABLE JO; 0B9C 0BCA -TAMIL SYLLABLE JOO; 0B9C 0BCB -TAMIL SYLLABLE JAU; 0B9C 0BCC - -TAMIL SYLLABLE SHAA; 0BB6 0BBE -TAMIL SYLLABLE SHI; 0BB6 0BBF -TAMIL SYLLABLE SHII; 0BB6 0BC0 -TAMIL SYLLABLE SHU; 0BB6 0BC1 -TAMIL SYLLABLE SHUU; 0BB6 0BC2 -TAMIL SYLLABLE SHE; 0BB6 0BC6 -TAMIL SYLLABLE SHEE; 0BB6 0BC7 -TAMIL SYLLABLE SHAI; 0BB6 0BC8 -TAMIL SYLLABLE SHO; 0BB6 0BCA -TAMIL SYLLABLE SHOO; 0BB6 0BCB -TAMIL SYLLABLE SHAU; 0BB6 0BCC - -TAMIL SYLLABLE SSAA; 0BB7 0BBE -TAMIL SYLLABLE SSI; 0BB7 0BBF -TAMIL SYLLABLE SSII; 0BB7 0BC0 -TAMIL SYLLABLE SSU; 0BB7 0BC1 -TAMIL SYLLABLE SSUU; 0BB7 0BC2 -TAMIL SYLLABLE SSE; 0BB7 0BC6 -TAMIL SYLLABLE SSEE; 0BB7 0BC7 -TAMIL SYLLABLE SSAI; 0BB7 0BC8 -TAMIL SYLLABLE SSO; 0BB7 0BCA -TAMIL SYLLABLE SSOO; 0BB7 0BCB -TAMIL SYLLABLE SSAU; 0BB7 0BCC - -TAMIL SYLLABLE SAA; 0BB8 0BBE -TAMIL SYLLABLE SI; 0BB8 0BBF -TAMIL SYLLABLE SII; 0BB8 0BC0 -TAMIL SYLLABLE SU; 0BB8 0BC1 -TAMIL SYLLABLE SUU; 0BB8 0BC2 -TAMIL SYLLABLE SE; 0BB8 0BC6 -TAMIL SYLLABLE SEE; 0BB8 0BC7 -TAMIL SYLLABLE SAI; 0BB8 0BC8 -TAMIL SYLLABLE SO; 0BB8 0BCA -TAMIL SYLLABLE SOO; 0BB8 0BCB -TAMIL SYLLABLE SAU; 0BB8 0BCC - -TAMIL SYLLABLE HAA; 0BB9 0BBE -TAMIL SYLLABLE HI; 0BB9 0BBF -TAMIL SYLLABLE HII; 0BB9 0BC0 -TAMIL SYLLABLE HU; 0BB9 0BC1 -TAMIL SYLLABLE HUU; 0BB9 0BC2 -TAMIL SYLLABLE HE; 0BB9 0BC6 -TAMIL SYLLABLE HEE; 0BB9 0BC7 -TAMIL SYLLABLE HAI; 0BB9 0BC8 -TAMIL SYLLABLE HO; 0BB9 0BCA -TAMIL SYLLABLE HOO; 0BB9 0BCB -TAMIL SYLLABLE HAU; 0BB9 0BCC - -TAMIL SYLLABLE KSSA; 0B95 0BCD 0BB7 -TAMIL SYLLABLE KSSAA; 0B95 0BCD 0BB7 0BBE -TAMIL SYLLABLE KSSI; 0B95 0BCD 0BB7 0BBF -TAMIL SYLLABLE KSSII; 0B95 0BCD 0BB7 0BC0 -TAMIL SYLLABLE KSSU; 0B95 0BCD 0BB7 0BC1 -TAMIL SYLLABLE KSSUU; 0B95 0BCD 0BB7 0BC2 -TAMIL SYLLABLE KSSE; 0B95 0BCD 0BB7 0BC6 -TAMIL SYLLABLE KSSEE; 0B95 0BCD 0BB7 0BC7 -TAMIL SYLLABLE KSSAI; 0B95 0BCD 0BB7 0BC8 -TAMIL SYLLABLE KSSO; 0B95 0BCD 0BB7 0BCA -TAMIL SYLLABLE KSSOO; 0B95 0BCD 0BB7 0BCB -TAMIL SYLLABLE KSSAU; 0B95 0BCD 0BB7 0BCC - -TAMIL SYLLABLE SHRII; 0BB6 0BCD 0BB0 0BC0 - -# Sinhala medial consonants and "reph" form -# Provisional 2010-05-13, Approved 2011-08-05 - -SINHALA CONSONANT SIGN YANSAYA;0DCA 200D 0DBA -SINHALA CONSONANT SIGN RAKAARAANSAYA;0DCA 200D 0DBB -SINHALA CONSONANT SIGN REPAYA;0DBB 0DCA 200D - +GURMUKHI HALF YA;0A2F 0A4D +GURMUKHI PARI CA;0A4D 0A1A +GURMUKHI PARI TA;0A4D 0A24 +GURMUKHI PARI NA;0A4D 0A28 +GURMUKHI PARI YA;0A4D 0A2F +GURMUKHI PARI VA;0A4D 0A35 GEORGIAN LETTER U-BRJGU;10E3 0302 KHMER CONSONANT SIGN COENG KA;17D2 1780 KHMER CONSONANT SIGN COENG KHA;17D2 1781 @@ -495,25 +91,5 @@ KHMER INDEPENDENT VOWEL SIGN COENG RYY;17D2 17AC KHMER INDEPENDENT VOWEL SIGN COENG QE;17D2 17AF KHMER VOWEL SIGN OM;17BB 17C6 KHMER VOWEL SIGN AAM;17B6 17C6 - -# Entries for JIS X 0213 compatibility mapping. -# Provisional: 2008-11-07, Approved 2010-05-14 - -HIRAGANA LETTER BIDAKUON NGA;304B 309A -HIRAGANA LETTER BIDAKUON NGI;304D 309A -HIRAGANA LETTER BIDAKUON NGU;304F 309A -HIRAGANA LETTER BIDAKUON NGE;3051 309A -HIRAGANA LETTER BIDAKUON NGO;3053 309A -KATAKANA LETTER BIDAKUON NGA;30AB 309A -KATAKANA LETTER BIDAKUON NGI;30AD 309A -KATAKANA LETTER BIDAKUON NGU;30AF 309A -KATAKANA LETTER BIDAKUON NGE;30B1 309A -KATAKANA LETTER BIDAKUON NGO;30B3 309A -KATAKANA LETTER AINU CE;30BB 309A -KATAKANA LETTER AINU TU;30C4 309A -KATAKANA LETTER AINU TO;30C8 309A KATAKANA LETTER AINU P;31F7 309A MODIFIER LETTER EXTRA-HIGH EXTRA-LOW CONTOUR TONE BAR;02E5 02E9 -MODIFIER LETTER EXTRA-LOW EXTRA-HIGH CONTOUR TONE BAR;02E9 02E5 - -# EOF diff --git a/gnu/usr.bin/perl/t/io/through.t b/gnu/usr.bin/perl/t/io/through.t index 315de90b861..60c75c99217 100755 --- a/gnu/usr.bin/perl/t/io/through.t +++ b/gnu/usr.bin/perl/t/io/through.t @@ -1,14 +1,16 @@ #!./perl BEGIN { + if ($^O eq 'VMS') { + print "1..0 # Skip on VMS -- too picky about line endings for record-oriented pipes\n"; + exit; + } chdir 't' if -d 't'; @INC = '../lib'; - require './test.pl'; - skip_all("VMS too picky about line endings for record-oriented pipes") - if $^O eq 'VMS'; } use strict; +require './test.pl'; my $Perl = which_perl(); @@ -88,8 +90,7 @@ sub testfile ($$$$$$) { my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_; my @data = grep length, split /(.{1,$write_c})/s, $str; - my $filename = tempfile(); - open my $fh, '>', $filename or die; + open my $fh, '>', 'io_io.tmp' or die; select $fh; binmode $fh, ':crlf' if defined $main::use_crlf && $main::use_crlf == 1; @@ -105,7 +106,7 @@ sub testfile ($$$$$$) { die "Unrecognized write: '$how_w'"; } close $fh or die "close: $!"; - open $fh, '<', $filename or die; + open $fh, '<', 'io_io.tmp' or die; binmode $fh, ':crlf' if defined $main::use_crlf && $main::use_crlf == 1; testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why"); @@ -142,4 +143,6 @@ for my $s (1..2) { } } +unlink 'io_io.tmp'; + 1; diff --git a/gnu/usr.bin/perl/t/lib/cygwin.t b/gnu/usr.bin/perl/t/lib/cygwin.t index 9033d3fb53d..01485461439 100755 --- a/gnu/usr.bin/perl/t/lib/cygwin.t +++ b/gnu/usr.bin/perl/t/lib/cygwin.t @@ -3,11 +3,13 @@ BEGIN { chdir 't' if -d 't'; @INC = ('../lib'); - require './test.pl'; - skip_all('cygwin specific test') unless $^O eq 'cygwin'; + unless ($^O eq "cygwin") { + print "1..0 # skipped: cygwin specific test\n"; + exit 0; + } } -plan(tests => 16); +use Test::More tests => 4; is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($$)), $$, "perl pid translates to itself"); @@ -27,46 +29,3 @@ close($ps); is(Cygwin::winpid_to_pid($catwinpid), $catpid, "winpid to pid"); is(Cygwin::pid_to_winpid($catpid), $catwinpid, "pid to winpid"); close($cat); - -is(Cygwin::win_to_posix_path("t\\lib"), "t/lib", "win to posix path: t/lib"); -is(Cygwin::posix_to_win_path("t/lib"), "t\\lib", "posix to win path: t\\lib"); - -use Win32; -use Cwd; -my $pwd = getcwd(); -chdir("/"); -my $winpath = Win32::GetCwd(); -is(Cygwin::posix_to_win_path("/", 1), $winpath, "posix to absolute win path"); -chdir($pwd); -is(Cygwin::win_to_posix_path($winpath, 1), "/", "win to absolute posix path"); - -my $mount = join '', `/usr/bin/mount`; -$mount =~ m|on /usr/bin type .+ \((\w+)[,\)]|m; -my $binmode = $1 =~ /binmode|binary/; -is(Cygwin::is_binmount("/"), $binmode ? 1 : '', "check / for binmount"); - -my $rootmnt = Cygwin::mount_flags("/"); -ok($binmode ? ($rootmnt =~ /,(binmode|binary)/) : ($rootmnt =~ /,textmode/), "check / mount_flags"); -is(Cygwin::mount_flags("/cygdrive") =~ /,cygdrive/, 1, "check cygdrive mount_flags"); - -# Cygdrive mount prefix -my @flags = split(/,/, Cygwin::mount_flags('/cygdrive')); -my $prefix = pop(@flags); -ok($prefix, "cygdrive mount prefix = " . (($prefix) ? $prefix : '<none>')); -chomp(my $prefix2 = `df | grep -i '^c: ' | cut -d% -f2 | xargs`); -$prefix2 =~ s/\/c$//i; -if (! $prefix2) { - $prefix2 = '/'; -} -is($prefix, $prefix2, 'cygdrive mount prefix'); - -my @mnttbl = Cygwin::mount_table(); -ok(@mnttbl > 0, "non empty mount_table"); -for $i (@mnttbl) { - if ($i->[0] eq '/') { - is($i->[2].",".$i->[3], $rootmnt, "same root mount flags"); - last; - } -} - -ok(Cwd->cwd(), "bug#38628 legacy"); diff --git a/gnu/usr.bin/perl/t/op/chr.t b/gnu/usr.bin/perl/t/op/chr.t index 57b4adeb2c6..94450ec1cc0 100755 --- a/gnu/usr.bin/perl/t/op/chr.t +++ b/gnu/usr.bin/perl/t/op/chr.t @@ -6,7 +6,7 @@ BEGIN { require "test.pl"; } -plan tests => 42; +plan tests => 26; # Note that t/op/ord.t already tests for chr() <-> ord() rountripping. @@ -19,64 +19,32 @@ is(chr(127), "\x7F"); is(chr(128), "\x80"); is(chr(255), "\xFF"); -is(chr(-0.1), "\x{FFFD}"); # The U+FFFD Unicode replacement character. -is(chr(-1 ), "\x{FFFD}"); -is(chr(-2 ), "\x{FFFD}"); -is(chr(-3.0), "\x{FFFD}"); -{ - use bytes; # Backward compatibility. - is(chr(-0.1), "\x00"); - is(chr(-1 ), "\xFF"); - is(chr(-2 ), "\xFE"); - is(chr(-3.0), "\xFD"); -} - -# Make sure -1 is treated the same way when coming from a tied variable -sub TIESCALAR {bless[]} -sub STORE { $_[0][0] = $_[1] } -sub FETCH { $_[0][0] } -tie $t, ""; -$t = -1; is chr $t, chr -1, 'chr $tied when $tied is -1'; -$t = -2; is chr $t, chr -2, 'chr $tied when $tied is -2'; -$t = -1.1; is chr $t, chr -1.1, 'chr $tied when $tied is -1.1'; -$t = -2.2; is chr $t, chr -2.2, 'chr $tied when $tied is -2.2'; +# is(chr(-1), undef); # Shouldn't it be? -# And that stringy scalars are treated likewise -is chr "-1", chr -1, 'chr "-1" eq chr -1'; -is chr "-2", chr -2, 'chr "-2" eq chr -2'; -is chr "-1.1", chr -1.1, 'chr "-1.1" eq chr -1.1'; -is chr "-2.2", chr -2.2, 'chr "-2.2" eq chr -2.2'; +# Check UTF-8. -# Check UTF-8 (not UTF-EBCDIC). -SKIP: { - skip "no UTF-8 on EBCDIC", 21 if chr(193) eq 'A'; - -sub hexes { - no warnings 'utf8'; # avoid surrogate and beyond Unicode warnings - join(" ",unpack "U0 (H2)*", chr $_[0]); -} +sub hexes { join(" ",map{sprintf"%02x",$_}unpack("C*",chr($_[0]))) } # The following code points are some interesting steps in UTF-8. - is(hexes( 0x100), "c4 80"); - is(hexes( 0x7FF), "df bf"); - is(hexes( 0x800), "e0 a0 80"); - is(hexes( 0xFFF), "e0 bf bf"); - is(hexes( 0x1000), "e1 80 80"); - is(hexes( 0xCFFF), "ec bf bf"); - is(hexes( 0xD000), "ed 80 80"); - is(hexes( 0xD7FF), "ed 9f bf"); - is(hexes( 0xD800), "ed a0 80"); # not strict utf-8 (surrogate area begin) - is(hexes( 0xDFFF), "ed bf bf"); # not strict utf-8 (surrogate area end) - is(hexes( 0xE000), "ee 80 80"); - is(hexes( 0xFFFF), "ef bf bf"); - is(hexes( 0x10000), "f0 90 80 80"); - is(hexes( 0x3FFFF), "f0 bf bf bf"); - is(hexes( 0x40000), "f1 80 80 80"); - is(hexes( 0xFFFFF), "f3 bf bf bf"); - is(hexes(0x100000), "f4 80 80 80"); - is(hexes(0x10FFFF), "f4 8f bf bf"); # Unicode (4.1) last code point - is(hexes(0x110000), "f4 90 80 80"); - is(hexes(0x1FFFFF), "f7 bf bf bf"); # last four byte encoding - is(hexes(0x200000), "f8 88 80 80 80"); -} +is(hexes( 0x100), "c4 80"); +is(hexes( 0x7FF), "df bf"); +is(hexes( 0x800), "e0 a0 80"); +is(hexes( 0xFFF), "e0 bf bf"); +is(hexes( 0x1000), "e1 80 80"); +is(hexes( 0xCFFF), "ec bf bf"); +is(hexes( 0xD000), "ed 80 80"); +is(hexes( 0xD7FF), "ed 9f bf"); +is(hexes( 0xD800), "ed a0 80"); # not strict utf-8 (surrogate area begin) +is(hexes( 0xDFFF), "ed bf bf"); # not strict utf-8 (surrogate area end) +is(hexes( 0xE000), "ee 80 80"); +is(hexes( 0xFFFF), "ef bf bf"); +is(hexes( 0x10000), "f0 90 80 80"); +is(hexes( 0x3FFFF), "f0 bf bf bf"); +is(hexes( 0x40000), "f1 80 80 80"); +is(hexes( 0xFFFFF), "f3 bf bf bf"); +is(hexes(0x100000), "f4 80 80 80"); +is(hexes(0x10FFFF), "f4 8f bf bf"); # Unicode (4.1) last code point +is(hexes(0x110000), "f4 90 80 80"); +is(hexes(0x1FFFFF), "f7 bf bf bf"); # last four byte encoding +is(hexes(0x200000), "f8 88 80 80 80"); diff --git a/gnu/usr.bin/perl/t/op/getppid.t b/gnu/usr.bin/perl/t/op/getppid.t index a8d0f2cb3b8..cb486888bec 100755 --- a/gnu/usr.bin/perl/t/op/getppid.t +++ b/gnu/usr.bin/perl/t/op/getppid.t @@ -1,11 +1,7 @@ #!./perl # Test that getppid() follows UNIX semantics: when the parent process -# dies, the child is reparented to the init process -# The init process is usually 1, but doesn't have to be, and there's no -# standard way to find out what it is, so the only portable way to go it so -# attempt 2 reparentings and see if the PID both orphaned grandchildren get is -# the same. (and not ours) +# dies, the child is reparented to the init process (pid 1). BEGIN { chdir 't' if -d 't'; @@ -13,103 +9,46 @@ BEGIN { } use strict; +use Config; BEGIN { - require './test.pl'; - skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid)); - plan (8); + for my $syscall (qw(pipe fork waitpid getppid)) { + if (!$Config{"d_$syscall"}) { + print "1..0 # Skip: no $syscall\n"; + exit; + } + } + print "1..3\n"; } -# No, we don't want any zombies. kill 0, $ppid spots zombies :-( -$SIG{CHLD} = 'IGNORE'; - -sub fork_and_retrieve { - my $which = shift; - pipe my ($r, $w) or die "pipe: $!\n"; - my $pid = fork; defined $pid or die "fork: $!\n"; +pipe my ($r, $w) or die "pipe: $!\n"; +my $pid = fork; defined $pid or die "fork: $!\n"; - if ($pid) { - # parent - close $w or die "close: $!\n"; - $_ = <$r>; - chomp; - die "Garbled output '$_'" - unless my ($how, $first, $second) = /^([a-z]+),(\d+),(\d+)\z/; - cmp_ok ($first, '>=', 1, "Parent of $which grandchild"); - my $message = "grandchild waited until '$how'"; - cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild") - ? note ($message) : diag ($message); - - SKIP: { - skip("Orphan processes are not reparented on QNX", 1) - if $^O eq 'nto'; - isnt($first, $second, - "Orphaned $which grandchild got a new parent"); - } - return $second; +if ($pid) { + # parent + close $w; + waitpid($pid, 0) == $pid or die "waitpid: $!\n"; + print <$r>; +} +else { + # child + close $r; + my $pid2 = fork; defined $pid2 or die "fork: $!\n"; + if ($pid2) { + close $w; + sleep 1; } else { - # child - # Prevent test.pl from thinking that we failed to run any tests. - $::NO_ENDING = 1; - close $r or die "close: $!\n"; - - pipe my ($r2, $w2) or die "pipe: $!\n"; - pipe my ($r3, $w3) or die "pipe: $!\n"; - my $pid2 = fork; defined $pid2 or die "fork: $!\n"; - if ($pid2) { - close $w or die "close: $!\n"; - close $w2 or die "close: $!\n"; - close $r3 or die "close: $!\n"; - # Wait for our child to signal that it's read our PID: - <$r2>; - # Implicit close of $w3: - exit 0; - } - else { - # grandchild - close $r2 or die "close: $!\n"; - close $w3 or die "close: $!\n"; - my $ppid1 = getppid(); - # kill 0 isn't portable: - my $can_kill0 = eval { - kill 0, $ppid1; - }; - my $how = $can_kill0 ? 'undead' : 'sleep'; - - # Tell immediate parent to exit: - close $w2 or die "close: $!\n"; - # Wait for it to (start to) exit: - <$r3>; - # Which sadly isn't enough to be sure that it has exited - often we - # get switched in during its shutdown, after $w3 closes but before - # it exits and we get reparented. - if ($can_kill0) { - # use kill 0 where possible. Try 10 times, then give up: - for (0..9) { - my $got = kill 0, $ppid1; - die "kill: $!" unless defined $got; - if (!$got) { - $how = 'kill'; - last; - } - sleep 1; - } - } else { - # Fudge it by waiting a bit more: - sleep 2; - } - my $ppid2 = getppid(); - print $w "$how,$ppid1,$ppid2\n"; - } - exit 0; + # grandchild + my $ppid1 = getppid(); + print $w "not " if $ppid1 <= 1; + print $w "ok 1 # ppid1=$ppid1\n"; + sleep 2; + my $ppid2 = getppid(); + print $w "not " if $ppid1 == $ppid2; + print $w "ok 2 # ppid2=$ppid2, ppid1!=ppid2\n"; + print $w "not " if $ppid2 != 1; + print $w "ok 3 # ppid2=1\n"; } + exit 0; } - -my $first = fork_and_retrieve("first"); -my $second = fork_and_retrieve("second"); -SKIP: { - skip ("Orphan processes are not reparented on QNX", 1) if $^O eq 'nto'; - is ($first, $second, "Both orphaned grandchildren get the same new parent"); -} -isnt ($first, $$, "And that new parent isn't this process"); diff --git a/gnu/usr.bin/perl/t/op/negate.t b/gnu/usr.bin/perl/t/op/negate.t index 3b02e35f20a..fb8d4b49e85 100755 --- a/gnu/usr.bin/perl/t/op/negate.t +++ b/gnu/usr.bin/perl/t/op/negate.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 46; +plan tests => 16; # Some of these will cause warnings if left on. Here we're checking the # functionality, not the warnings. @@ -18,12 +18,8 @@ is(- -10, 10, "Simple numeric negation to positive"); is(-"10", -10, "Negation of a positive string to negative"); is(-"10.0", -10, "Negation of a positive decimal sting to negative"); is(-"10foo", -10, "Negation of a numeric-lead string returns negation of numeric"); -is(-"-10", 10, 'Negation of string starting with "-" returns a positive number - integer'); -"-10" =~ /(.*)/; -is(-$1, 10, 'Negation of magical string starting with "-" - integer'); -is(-"-10.0", 10.0, 'Negation of string starting with "-" returns a positive number - decimal'); -"-10.0" =~ /(.*)/; -is(-$1, 10.0, 'Negation of magical string starting with "-" - decimal'); +is(-"-10", "+10", 'Negation of string starting with "-" returns a string starting with "+" - numeric'); +is(-"-10.0", "+10.0", 'Negation of string starting with "-" returns a string starting with "+" - decimal'); is(-"-10foo", "+10foo", 'Negation of string starting with "-" returns a string starting with "+" - non-numeric'); is(-"xyz", "-xyz", 'Negation of a negative string adds "-" to the front'); is(-"-xyz", "+xyz", "Negation of a negative string to positive"); @@ -32,80 +28,4 @@ is(-bareword, "-bareword", "Negation of bareword treated like a string"); is(- -bareword, "+bareword", "Negation of -bareword returns string +bareword"); is(-" -10", 10, "Negation of a whitespace-lead numeric string"); is(-" -10.0", 10, "Negation of a whitespace-lead decimal string"); -is(-" -10foo", 10, - "Negation of a whitespace-lead sting starting with a numeric"); - -$x = "dogs"; -()=0+$x; -is -$x, '-dogs', 'cached numeric value does not sabotage string negation'; - -is(-"97656250000000000", -97656250000000000, '-bigint vs -"bigint"'); -"9765625000000000" =~ /(\d+)/; -is -$1, -"$1", '-$1 vs -"$1" with big int'; - -$a = "%apples"; -chop($au = "%apples\x{100}"); -is(-$au, -$a, 'utf8 flag makes no difference for string negation'); -is -"\x{100}", 0, '-(non-ASCII) is equivalent to -(punct)'; - -sub TIESCALAR { bless[] } -sub STORE { $_[0][0] = $_[1] } -sub FETCH { $_[0][0] } - -tie $t, ""; -$a = "97656250000000000"; -() = 0+$a; -$t = $a; -is -$t, -97656250000000000, 'magic str+int dualvar'; - -{ # Repeat most of the tests under use integer - use integer; - is(- 10, -10, "Simple numeric negation to negative"); - is(- -10, 10, "Simple numeric negation to positive"); - is(-"10", -10, "Negation of a positive string to negative"); - is(-"10.0", -10, "Negation of a positive decimal sting to negative"); - is(-"10foo", -10, - "Negation of a numeric-lead string returns negation of numeric"); - is(-"-10", 10, - 'Negation of string starting with "-" returns a positive number -' - .' integer'); - "-10" =~ /(.*)/; - is(-$1, 10, 'Negation of magical string starting with "-" - integer'); - is(-"-10.0", 10, - 'Negation of string starting with "-" returns a positive number - ' - .'decimal'); - "-10.0" =~ /(.*)/; - is(-$1, 10, 'Negation of magical string starting with "-" - decimal'); - is(-"-10foo", "+10foo", - 'Negation of string starting with "-" returns a string starting ' - .'with "+" - non-numeric'); - is(-"xyz", "-xyz", - 'Negation of a negative string adds "-" to the front'); - is(-"-xyz", "+xyz", "Negation of a negative string to positive"); - is(-"+xyz", "-xyz", "Negation of a positive string to negative"); - is(-bareword, "-bareword", - "Negation of bareword treated like a string"); - is(- -bareword, "+bareword", - "Negation of -bareword returns string +bareword"); - is(-" -10", 10, "Negation of a whitespace-lead numeric string"); - is(-" -10.0", 10, "Negation of a whitespace-lead decimal string"); - is(-" -10foo", 10, - "Negation of a whitespace-lead sting starting with a numeric"); - - $x = "dogs"; - ()=0+$x; - is -$x, '-dogs', - 'cached numeric value does not sabotage string negation'; - - $a = "%apples"; - chop($au = "%apples\x{100}"); - is(-$au, -$a, 'utf8 flag makes no difference for string negation'); - is -"\x{100}", 0, '-(non-ASCII) is equivalent to -(punct)'; -} - -# [perl #120288] use integer should not stop barewords from being quoted -{ - use strict; - use integer; - is eval "return -a"||$@, "-a", '-bareword under strict+integer'; -} +is(-" -10foo", 10, "Negation of a whitespace-lead sting starting with a numeric") diff --git a/gnu/usr.bin/perl/t/op/sselect.t b/gnu/usr.bin/perl/t/op/sselect.t index 879c9d52316..0f877b1eff4 100755 --- a/gnu/usr.bin/perl/t/op/sselect.t +++ b/gnu/usr.bin/perl/t/op/sselect.t @@ -1,93 +1,32 @@ #!./perl -my $hires; BEGIN { chdir 't' if -d 't'; @INC = ('.', '../lib'); - $hires = eval 'use Time::HiResx "time"; 1'; } require 'test.pl'; -plan (15); +plan (9); my $blank = ""; eval {select undef, $blank, $blank, 0}; -is ($@, "", 'select undef $blank $blank 0'); +is ($@, ""); eval {select $blank, undef, $blank, 0}; -is ($@, "", 'select $blank undef $blank 0'); +is ($@, ""); eval {select $blank, $blank, undef, 0}; -is ($@, "", 'select $blank $blank undef 0'); +is ($@, ""); eval {select "", $blank, $blank, 0}; -is ($@, "", 'select "" $blank $blank 0'); +is ($@, ""); eval {select $blank, "", $blank, 0}; -is ($@, "", 'select $blank "" $blank 0'); +is ($@, ""); eval {select $blank, $blank, "", 0}; -is ($@, "", 'select $blank $blank "" 0'); - -# Test with read-only copy-on-write empty string -my($rocow) = keys%{{""=>undef}}; -Internals::SvREADONLY($rocow,1); -eval {select $rocow, $blank, $blank, 0}; -is ($@, "", 'select $rocow $blank $blank 0'); -eval {select $blank, $rocow, $blank, 0}; -is ($@, "", 'select $blank $rocow $blank 0'); -eval {select $blank, $blank, $rocow, 0}; -is ($@, "", 'select $blank $blank $rocow 0'); +is ($@, ""); eval {select "a", $blank, $blank, 0}; -like ($@, qr/^Modification of a read-only value attempted/, - 'select "a" $blank $blank 0'); +like ($@, qr/^Modification of a read-only value attempted/); eval {select $blank, "a", $blank, 0}; -like ($@, qr/^Modification of a read-only value attempted/, - 'select $blank "a" $blank 0'); +like ($@, qr/^Modification of a read-only value attempted/); eval {select $blank, $blank, "a", 0}; -like ($@, qr/^Modification of a read-only value attempted/, - 'select $blank $blank "a" 0'); - -my $sleep = 3; -# Actual sleep time on Windows may be rounded down to an integral -# multiple of the system clock tick interval. Clock tick interval -# is configurable, but usually about 15.625 milliseconds. -# time() however (if we haven;t loaded Time::HiRes), doesn't return -# fractional values, so the observed delay may be 1 second short. -# -# There is also a report that old linux kernels may return 0.5ms early: -# <20110520081714.GC17549@mars.tony.develop-help.com>. -# - -my $under = $hires ? 0.1 : 1; - -my $t0 = time; -select(undef, undef, undef, $sleep); -my $t1 = time; -my $diff = $t1-$t0; -ok($diff >= $sleep-$under, "select(u,u,u,\$sleep): at least $sleep seconds have passed"); -note("diff=$diff under=$under"); - -my $empty = ""; -vec($empty,0,1) = 0; -$t0 = time; -select($empty, undef, undef, $sleep); -$t1 = time; -$diff = $t1-$t0; -ok($diff >= $sleep-$under, "select(\$e,u,u,\$sleep): at least $sleep seconds have passed"); -note("diff=$diff under=$under"); - -# [perl #120102] CORE::select ignoring timeout var's magic - -{ - package RT120102; - - my $count = 0; - - sub TIESCALAR { bless [] } - sub FETCH { $count++; 0.1 } - - my $sleep; - - tie $sleep, 'RT120102'; - select (undef, undef, undef, $sleep); - ::is($count, 1, 'RT120102'); -} +like ($@, qr/^Modification of a read-only value attempted/); |