diff options
94 files changed, 2723 insertions, 252 deletions
@@ -836,26 +836,37 @@ lib/unicode/Index.txt Unicode character database lib/unicode/Is/ASCII.pl Unicode character database lib/unicode/Is/Alnum.pl Unicode character database lib/unicode/Is/Alpha.pl Unicode character database +lib/unicode/Is/BidiAL.pl Unicode character database lib/unicode/Is/BidiAN.pl Unicode character database lib/unicode/Is/BidiB.pl Unicode character database +lib/unicode/Is/BidiBN.pl Unicode character database lib/unicode/Is/BidiCS.pl Unicode character database lib/unicode/Is/BidiEN.pl Unicode character database lib/unicode/Is/BidiES.pl Unicode character database lib/unicode/Is/BidiET.pl Unicode character database lib/unicode/Is/BidiL.pl Unicode character database +lib/unicode/Is/BidiLRE.pl Unicode character database +lib/unicode/Is/BidiLRO.pl Unicode character database +lib/unicode/Is/BidiNSM.pl Unicode character database lib/unicode/Is/BidiON.pl Unicode character database +lib/unicode/Is/BidiPDF.pl Unicode character database lib/unicode/Is/BidiR.pl Unicode character database +lib/unicode/Is/BidiRLE.pl Unicode character database +lib/unicode/Is/BidiRLO.pl Unicode character database lib/unicode/Is/BidiS.pl Unicode character database lib/unicode/Is/BidiWS.pl Unicode character database lib/unicode/Is/C.pl Unicode character database lib/unicode/Is/Cc.pl Unicode character database +lib/unicode/Is/Cf.pl Unicode character database lib/unicode/Is/Cn.pl Unicode character database lib/unicode/Is/Cntrl.pl Unicode character database lib/unicode/Is/Co.pl Unicode character database +lib/unicode/Is/Cs.pl Unicode character database lib/unicode/Is/DCcircle.pl Unicode character database lib/unicode/Is/DCcompat.pl Unicode character database lib/unicode/Is/DCfinal.pl Unicode character database lib/unicode/Is/DCfont.pl Unicode character database +lib/unicode/Is/DCfraction.pl Unicode character database lib/unicode/Is/DCinital.pl Unicode character database lib/unicode/Is/DCinitial.pl Unicode character database lib/unicode/Is/DCisolated.pl Unicode character database @@ -909,34 +920,53 @@ lib/unicode/Is/Lt.pl Unicode character database lib/unicode/Is/Lu.pl Unicode character database lib/unicode/Is/M.pl Unicode character database lib/unicode/Is/Mc.pl Unicode character database +lib/unicode/Is/Me.pl Unicode character database lib/unicode/Is/Mirrored.pl Unicode character database lib/unicode/Is/Mn.pl Unicode character database lib/unicode/Is/N.pl Unicode character database lib/unicode/Is/Nd.pl Unicode character database +lib/unicode/Is/Nl.pl Unicode character database lib/unicode/Is/No.pl Unicode character database lib/unicode/Is/P.pl Unicode character database +lib/unicode/Is/Pc.pl Unicode character database lib/unicode/Is/Pd.pl Unicode character database lib/unicode/Is/Pe.pl Unicode character database +lib/unicode/Is/Pf.pl Unicode character database +lib/unicode/Is/Pi.pl Unicode character database lib/unicode/Is/Po.pl Unicode character database lib/unicode/Is/Print.pl Unicode character database lib/unicode/Is/Ps.pl Unicode character database lib/unicode/Is/Punct.pl Unicode character database lib/unicode/Is/S.pl Unicode character database lib/unicode/Is/Sc.pl Unicode character database +lib/unicode/Is/Sk.pl Unicode character database lib/unicode/Is/Sm.pl Unicode character database lib/unicode/Is/So.pl Unicode character database lib/unicode/Is/Space.pl Unicode character database lib/unicode/Is/SylA.pl Unicode character database +lib/unicode/Is/SylAA.pl Unicode character database +lib/unicode/Is/SylAAI.pl Unicode character database +lib/unicode/Is/SylAI.pl Unicode character database lib/unicode/Is/SylC.pl Unicode character database lib/unicode/Is/SylE.pl Unicode character database +lib/unicode/Is/SylEE.pl Unicode character database lib/unicode/Is/SylI.pl Unicode character database +lib/unicode/Is/SylII.pl Unicode character database +lib/unicode/Is/SylN.pl Unicode character database lib/unicode/Is/SylO.pl Unicode character database +lib/unicode/Is/SylOO.pl Unicode character database lib/unicode/Is/SylU.pl Unicode character database lib/unicode/Is/SylV.pl Unicode character database lib/unicode/Is/SylWA.pl Unicode character database +lib/unicode/Is/SylWAA.pl Unicode character database lib/unicode/Is/SylWC.pl Unicode character database lib/unicode/Is/SylWE.pl Unicode character database +lib/unicode/Is/SylWEE.pl Unicode character database lib/unicode/Is/SylWI.pl Unicode character database +lib/unicode/Is/SylWII.pl Unicode character database +lib/unicode/Is/SylWO.pl Unicode character database +lib/unicode/Is/SylWOO.pl Unicode character database +lib/unicode/Is/SylWU.pl Unicode character database lib/unicode/Is/SylWV.pl Unicode character database lib/unicode/Is/Syllable.pl Unicode character database lib/unicode/Is/Upper.pl Unicode character database @@ -423,6 +423,7 @@ L<perlcall>. #define G_NOARGS 8 /* Don't construct a @_ array. */ #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ #define G_NODEBUG 32 /* Disable debugging at toplevel. */ +#define G_METHOD 64 /* Calling method. */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -269,6 +269,7 @@ #define instr Perl_instr #define io_close Perl_io_close #define invert Perl_invert +#define is_gv_magical Perl_is_gv_magical #define is_uni_alnum Perl_is_uni_alnum #define is_uni_alnumc Perl_is_uni_alnumc #define is_uni_idfirst Perl_is_uni_idfirst @@ -1719,6 +1720,7 @@ #define instr(a,b) Perl_instr(aTHX_ a,b) #define io_close(a,b) Perl_io_close(aTHX_ a,b) #define invert(a) Perl_invert(aTHX_ a) +#define is_gv_magical(a,b,c) Perl_is_gv_magical(aTHX_ a,b,c) #define is_uni_alnum(a) Perl_is_uni_alnum(aTHX_ a) #define is_uni_alnumc(a) Perl_is_uni_alnumc(aTHX_ a) #define is_uni_idfirst(a) Perl_is_uni_idfirst(aTHX_ a) @@ -3367,6 +3369,8 @@ #define io_close Perl_io_close #define Perl_invert CPerlObj::Perl_invert #define invert Perl_invert +#define Perl_is_gv_magical CPerlObj::Perl_is_gv_magical +#define is_gv_magical Perl_is_gv_magical #define Perl_is_uni_alnum CPerlObj::Perl_is_uni_alnum #define is_uni_alnum Perl_is_uni_alnum #define Perl_is_uni_alnumc CPerlObj::Perl_is_uni_alnumc @@ -1567,6 +1567,7 @@ p |U32 |intro_my Ap |char* |instr |const char* big|const char* little p |bool |io_close |IO* io|bool not_implicit p |OP* |invert |OP* cmd +dp |bool |is_gv_magical |char *name|STRLEN len|U32 flags Ap |bool |is_uni_alnum |U32 c Ap |bool |is_uni_alnumc |U32 c Ap |bool |is_uni_idfirst |U32 c diff --git a/ext/Devel/Peek/Peek.pm b/ext/Devel/Peek/Peek.pm index 080251bb5e..1ef29b476f 100644 --- a/ext/Devel/Peek/Peek.pm +++ b/ext/Devel/Peek/Peek.pm @@ -58,7 +58,7 @@ C<CV>. Devel::Peek also supplies C<SvREFCNT()>, C<SvREFCNT_inc()>, and C<SvREFCNT_dec()> which can query, increment, and decrement reference counts on SVs. This document will take a passive, and safe, approach to data debugging and for that it will describe only the C<Dump()> -function. For format of output of mstats() see +function. For more information on the format of output of mstat() see L<perldebug/Using C<$ENV{PERL_DEBUG_MSTATS}>>. Function C<DumpArray()> allows dumping of multiple values (useful when you diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 9416f70809..d4d9c334b0 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -565,9 +565,9 @@ sub chmod { sub fstat { usage "fstat(fd)" if @_ != 1; local *TMP; - open(TMP, "<&$_[0]"); # Gross. + CORE::open(TMP, "<&$_[0]"); # Gross. my @l = CORE::stat(TMP); - close(TMP); + CORE::close(TMP); @l; } @@ -1580,3 +1580,110 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } } } + +/* +=for apidoc is_gv_magical + +Returns C<TRUE> if given the name of a magical GV. + +Currently only useful internally when determining if a GV should be +created even in rvalue contexts. + +C<flags> is not used at present but available for future extension to +allow selecting particular classes of magical variable. + +=cut +*/ +bool +Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags) +{ + if (!len) + return FALSE; + + switch (*name) { + case 'I': + if (len == 3 && strEQ(name, "ISA")) + goto yes; + break; + case 'O': + if (len == 8 && strEQ(name, "OVERLOAD")) + goto yes; + break; + case 'S': + if (len == 3 && strEQ(name, "SIG")) + goto yes; + break; + case '\027': /* $^W & $^WARNING_BITS */ + if (len == 1 + || (len == 12 && strEQ(name, "\027ARNING_BITS")) + || (len == 17 && strEQ(name, "\027IDE_SYSTEM_CALLS"))) + { + goto yes; + } + break; + + case '&': + case '`': + case '\'': + case ':': + case '?': + case '!': + case '-': + case '#': + case '*': + case '[': + case '^': + case '~': + case '=': + case '%': + case '.': + case '(': + case ')': + case '<': + case '>': + case ',': + case '\\': + case '/': + case '|': + case '+': + case ';': + case ']': + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\010': /* $^H */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\014': /* $^L */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\023': /* $^S */ + case '\024': /* $^T */ + case '\026': /* $^V */ + if (len == 1) + goto yes; + break; + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + if (len > 1) { + char *end = name + len; + while (--end > name) { + if (!isDIGIT(*end)) + return FALSE; + } + } + yes: + return TRUE; + default: + break; + } + return FALSE; +} diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 57a8146dae..1e6c61a4c8 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -231,7 +231,9 @@ invoke Perl images. sub find_perl { my($self, $ver, $names, $dirs, $trace) = @_; my($name,$dir,$vmsfile,@sdirs,@snames,@cand); + my($rslt); my($inabs) = 0; + local *TCF; # Check in relative directories first, so we pick up the current # version of Perl if we're running MakeMaker as part of the main build. @sdirs = sort { my($absa) = $self->file_name_is_absolute($a); @@ -277,15 +279,28 @@ sub find_perl { foreach $name (@cand) { print "Checking $name\n" if ($trace >= 2); # If it looks like a potential command, try it without the MCR - if ($name =~ /^[\w\-\$]+$/ && - `$name -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) { + if ($name =~ /^[\w\-\$]+$/) { + open(TCF,">temp_mmvms.com") || die('unable to open temp file'); + print TCF "\$ set message/nofacil/nosever/noident/notext\n"; + print TCF "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n"; + close TCF; + $rslt = `\@temp_mmvms.com` ; + unlink('temp_mmvms.com'); + if ($rslt =~ /VER_OK/) { print "Using PERL=$name\n" if $trace; return $name; } + } next unless $vmsfile = $self->maybe_command($name); $vmsfile =~ s/;[\d\-]*$//; # Clip off version number; we can use a newer version as well print "Executing $vmsfile\n" if ($trace >= 2); - if (`MCR $vmsfile -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) { + open(TCF,">temp_mmvms.com") || die('unable to open temp file'); + print TCF "\$ set message/nofacil/nosever/noident/notext\n"; + print TCF "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n"; + close TCF; + $rslt = `\@temp_mmvms.com`; + unlink('temp_mmvms.com'); + if ($rslt =~ /VER_OK/) { print "Using PERL=MCR $vmsfile\n" if $trace; return "MCR $vmsfile"; } @@ -1018,7 +1033,7 @@ sub dist { # Sanitize these for use in $(DISTVNAME) filespec $attribs{VERSION} =~ s/[^\w\$]/_/g; - $attribs{NAME} =~ s/[^\w\$]/_/g; + $attribs{NAME} =~ s/[^\w\$]/-/g; return ExtUtils::MM_Unix::dist($self,%attribs); } @@ -1194,8 +1209,8 @@ $(BASEEXT).opt : Makefile.PL s/.*[:>\/\]]//; # Trim off dir spec $upcase ? uc($_) : $_; } split ' ', $self->eliminate_macros($self->{OBJECT}); - my($tmp,@lines,$elt) = ''; - my $tmp = shift @omods; + my($tmp, @lines,$elt) = ''; + $tmp = shift @omods; foreach $elt (@omods) { $tmp .= ",$elt"; if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } @@ -1652,6 +1667,9 @@ dist : $(DIST_DEFAULT) zipdist : $(DISTVNAME).zip $(NOECHO) $(NOOP) +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + $(DISTVNAME).zip : distdir $(PREOP) $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*; @@ -1661,7 +1679,7 @@ $(DISTVNAME).zip : distdir $(DISTVNAME).tar$(SUFFIX) : distdir $(PREOP) $(TO_UNIX) - $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)] + $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...] $(RM_RF) $(DISTVNAME) $(COMPRESS) $(DISTVNAME).tar $(POSTOP) diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index a34cd4f9ea..0260678570 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -1,4 +1,3 @@ -# $Header: /home/rmb1/misc/CVS/perl5.005_61/lib/ExtUtils/typemap,v 1.3 1999/09/13 09:46:43 rmb1 Exp $ # basic C types int T_IV unsigned T_UV diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index d2be87c660..cc06ca636d 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -40,6 +40,11 @@ sub eliminate_macros { my($self,$path) = @_; return '' unless $path; $self = {} unless ref $self; + + if ($path =~ /\s/) { + return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path; + } + my($npath) = unixify($path); my($complex) = 0; my($head,$macro,$tail); @@ -89,6 +94,12 @@ sub fixpath { $self = bless {} unless ref $self; my($fixedpath,$prefix,$name); + if ($path =~ /\s/) { + return join ' ', + map { $self->fixpath($_,$force_path) } + split /\s+/, $path; + } + if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { $fixedpath = vmspath($self->eliminate_macros($path)); diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 9902741134..6d4e8b90b3 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -8,7 +8,7 @@ use FileHandle; use strict; our($VERSION, $verbose, $switches, $have_devel_corestack, $curtest, - @ISA, @EXPORT, @EXPORT_OK); + $columns, @ISA, @EXPORT, @EXPORT_OK); $have_devel_corestack = 0; $VERSION = "1.1604"; @@ -27,36 +27,18 @@ my $subtests_skipped = 0; @EXPORT= qw(&runtests); @EXPORT_OK= qw($verbose $switches); -format STDOUT_TOP = -Failed Test Status Wstat Total Fail Failed List of failed -------------------------------------------------------------------------------- -. - -format STDOUT = -@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##% ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -{ $curtest->{name}, - $curtest->{estat}, - $curtest->{wstat}, - $curtest->{max}, - $curtest->{failed}, - $curtest->{percent}, - $curtest->{canon} -} -~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - $curtest->{canon} -. - - $verbose = 0; $switches = "-w"; +$columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80; sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f } sub runtests { my(@tests) = @_; local($|) = 1; - my($test,$te,$ok,$next,$max,$pct,$totok,$totbonus,@failed,%failedtests); + my($test,$te,$ok,$next,$max,$pct,$totbonus,@failed,%failedtests); my $totmax = 0; + my $totok = 0; my $files = 0; my $bad = 0; my $good = 0; @@ -304,7 +286,54 @@ sub runtests { $pct = sprintf("%.2f", $good / $total * 100); my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.", $totmax - $totok, $totmax, 100*$totok/$totmax; + # Create formats + # First, figure out max length of test names + my $failed_str = "Failed Test"; + my $middle_str = " Status Wstat Total Fail Failed "; + my $list_str = "List of Failed"; + my $max_namelen = length($failed_str); my $script; + foreach $script (keys %failedtests) { + $max_namelen = + (length $failedtests{$script}->{name} > $max_namelen) ? + length $failedtests{$script}->{name} : $max_namelen; + } + my $list_len = $columns - length($middle_str) - $max_namelen; + if ($list_len < length($list_str)) { + $list_len = length($list_str); + $max_namelen = $columns - length($middle_str) - $list_len; + if ($max_namelen < length($failed_str)) { + $max_namelen = length($failed_str); + $columns = $max_namelen + length($middle_str) + $list_len; + } + } + + my $fmt_top = "format STDOUT_TOP =\n" + . sprintf("%-${max_namelen}s", $failed_str) + . $middle_str + . $list_str . "\n" + . "-" x $columns + . "\n.\n"; + my $fmt = "format STDOUT =\n" + . "@" . "<" x ($max_namelen - 1) + . " @>> @>>>> @>>>> @>>> ^##.##% " + . "^" . "<" x ($list_len - 1) . "\n" + . '{ $curtest->{name}, $curtest->{estat},' + . ' $curtest->{wstat}, $curtest->{max},' + . ' $curtest->{failed}, $curtest->{percent},' + . ' $curtest->{canon}' + . "\n}\n" + . "~~" . " " x ($columns - $list_len - 2) . "^" + . "<" x ($list_len - 1) . "\n" + . '$curtest->{canon}' + . "\n.\n"; + + eval $fmt_top; + die $@ if $@; + eval $fmt; + die $@ if $@; + + # Now write to formats for $script (sort keys %failedtests) { $curtest = $failedtests{$script}; write; @@ -323,16 +352,9 @@ sub runtests { my $tried_devel_corestack; sub corestatus { my($st) = @_; - my($ret); eval {require 'wait.ph'}; - if ($@) { - SWITCH: { - $ret = ($st & 0200); # Tim says, this is for 90% - } - } else { - $ret = WCOREDUMP($st); - } + my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200; eval { require Devel::CoreStack; $have_devel_corestack++ } unless $tried_devel_corestack++; @@ -516,6 +538,12 @@ switches used to invoke perl on each test. For example, setting C<HARNESS_PERL_SWITCHES> to "-W" will run all tests with all warnings enabled. +If C<HARNESS_COLUMNS> is set, then this value will be used for the +width of the terminal. If it is not set then it will default to +C<COLUMNS>. If this is not set, it will default to 80. Note that users +of Bourne-sh based shells will need to C<export COLUMNS> for this +module to use that variable. + Harness sets C<HARNESS_ACTIVE> before executing the individual tests. This allows the tests to determine if they are being executed through the harness or by any other means. diff --git a/lib/unicode/Is/BidiAL.pl b/lib/unicode/Is/BidiAL.pl new file mode 100644 index 0000000000..e04f2f562d --- /dev/null +++ b/lib/unicode/Is/BidiAL.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +061b +061f +0621 063a +0640 064a +066d +0671 06d5 +06e5 06e6 +06fa 06fe +0700 070d +0710 +0712 072c +0780 07a5 +fb50 fbb1 +fbd3 fd3d +fd50 fd8f +fd92 fdc7 +fdf0 fdfb +fe70 fe72 +fe74 +fe76 fefc +END diff --git a/lib/unicode/Is/BidiBN.pl b/lib/unicode/Is/BidiBN.pl new file mode 100644 index 0000000000..795a4a9f40 --- /dev/null +++ b/lib/unicode/Is/BidiBN.pl @@ -0,0 +1,15 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0000 0008 +000e 001b +007f 0084 +0086 009f +070f +180b 180e +200b 200d +206a 206f +feff +fff9 fffb +END diff --git a/lib/unicode/Is/BidiLRE.pl b/lib/unicode/Is/BidiLRE.pl new file mode 100644 index 0000000000..ef2a6e462f --- /dev/null +++ b/lib/unicode/Is/BidiLRE.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202a +END diff --git a/lib/unicode/Is/BidiLRO.pl b/lib/unicode/Is/BidiLRO.pl new file mode 100644 index 0000000000..e9958c4b81 --- /dev/null +++ b/lib/unicode/Is/BidiLRO.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202d +END diff --git a/lib/unicode/Is/BidiNSM.pl b/lib/unicode/Is/BidiNSM.pl new file mode 100644 index 0000000000..191bc052a9 --- /dev/null +++ b/lib/unicode/Is/BidiNSM.pl @@ -0,0 +1,97 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0300 034e +0360 0362 +0483 0486 +0488 0489 +0591 05a1 +05a3 05b9 +05bb 05bd +05bf +05c1 05c2 +05c4 +064b 0655 +0670 +06d6 06e4 +06e7 06e8 +06ea 06ed +0711 +0730 074a +07a6 07b0 +0901 0902 +093c +0941 0948 +094d +0951 0954 +0962 0963 +0981 +09bc +09c1 09c4 +09cd +09e2 09e3 +0a02 +0a3c +0a41 0a42 +0a47 0a48 +0a4b 0a4d +0a70 0a71 +0a81 0a82 +0abc +0ac1 0ac5 +0ac7 0ac8 +0acd +0b01 +0b3c +0b3f +0b41 0b43 +0b4d +0b56 +0b82 +0bc0 +0bcd +0c3e 0c40 +0c46 0c48 +0c4a 0c4d +0c55 0c56 +0cbf +0cc6 +0ccc 0ccd +0d41 0d43 +0d4d +0dca +0dd2 0dd4 +0dd6 +0e31 +0e34 0e3a +0e47 0e4e +0eb1 +0eb4 0eb9 +0ebb 0ebc +0ec8 0ecd +0f18 0f19 +0f35 +0f37 +0f39 +0f71 0f7e +0f80 0f84 +0f86 0f87 +0f90 0f97 +0f99 0fbc +0fc6 +102d 1030 +1032 +1036 1037 +1039 +1058 1059 +17b7 17bd +17c6 +17c9 17d3 +18a9 +20d0 20e3 +302a 302f +3099 309a +fb1e +fe20 fe23 +END diff --git a/lib/unicode/Is/BidiPDF.pl b/lib/unicode/Is/BidiPDF.pl new file mode 100644 index 0000000000..4a3eedd564 --- /dev/null +++ b/lib/unicode/Is/BidiPDF.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202c +END diff --git a/lib/unicode/Is/BidiRLE.pl b/lib/unicode/Is/BidiRLE.pl new file mode 100644 index 0000000000..d789246ddb --- /dev/null +++ b/lib/unicode/Is/BidiRLE.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202b +END diff --git a/lib/unicode/Is/BidiRLO.pl b/lib/unicode/Is/BidiRLO.pl new file mode 100644 index 0000000000..fcb81acc93 --- /dev/null +++ b/lib/unicode/Is/BidiRLO.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +202e +END diff --git a/lib/unicode/Is/Cf.pl b/lib/unicode/Is/Cf.pl new file mode 100644 index 0000000000..896c3e6cd6 --- /dev/null +++ b/lib/unicode/Is/Cf.pl @@ -0,0 +1,12 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +070f +180b 180e +200c 200f +202a 202e +206a 206f +feff +fff9 fffb +END diff --git a/lib/unicode/Is/Cn.pl b/lib/unicode/Is/Cn.pl index ec287c456a..3c686154c1 100644 --- a/lib/unicode/Is/Cn.pl +++ b/lib/unicode/Is/Cn.pl @@ -2,4 +2,358 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +0220 0221 +0234 024f +02ae 02af +02ef 02ff +034f 035f +0363 0373 +0376 0379 +037b 037d +037f 0383 +038b +038d +03a2 +03cf +03d8 03d9 +03f4 03ff +0487 +048a 048b +04c5 04c6 +04c9 04ca +04cd 04cf +04f6 04f7 +04fa 0530 +0557 0558 +0560 +0588 +058b 0590 +05a2 +05ba +05c5 05cf +05eb 05ef +05f5 060b +060d 061a +061c 061e +0620 +063b 063f +0656 065f +066e 066f +06ee 06ef +06ff +070e +072d 072f +074b 077f +07b1 0900 +0904 +093a 093b +094e 094f +0955 0957 +0971 0980 +0984 +098d 098e +0991 0992 +09a9 +09b1 +09b3 09b5 +09ba 09bb +09bd +09c5 09c6 +09c9 09ca +09ce 09d6 +09d8 09db +09de +09e4 09e5 +09fb 0a01 +0a03 0a04 +0a0b 0a0e +0a11 0a12 +0a29 +0a31 +0a34 +0a37 +0a3a 0a3b +0a3d +0a43 0a46 +0a49 0a4a +0a4e 0a58 +0a5d +0a5f 0a65 +0a75 0a80 +0a84 +0a8c +0a8e +0a92 +0aa9 +0ab1 +0ab4 +0aba 0abb +0ac6 +0aca +0ace 0acf +0ad1 0adf +0ae1 0ae5 +0af0 0b00 +0b04 +0b0d 0b0e +0b11 0b12 +0b29 +0b31 +0b34 0b35 +0b3a 0b3b +0b44 0b46 +0b49 0b4a +0b4e 0b55 +0b58 0b5b +0b5e +0b62 0b65 +0b71 0b81 +0b84 +0b8b 0b8d +0b91 +0b96 0b98 +0b9b +0b9d +0ba0 0ba2 +0ba5 0ba7 +0bab 0bad +0bb6 +0bba 0bbd +0bc3 0bc5 +0bc9 +0bce 0bd6 +0bd8 0be6 +0bf3 0c00 +0c04 +0c0d +0c11 +0c29 +0c34 +0c3a 0c3d +0c45 +0c49 +0c4e 0c54 +0c57 0c5f +0c62 0c65 +0c70 0c81 +0c84 +0c8d +0c91 +0ca9 +0cb4 +0cba 0cbd +0cc5 +0cc9 +0cce 0cd4 +0cd7 0cdd +0cdf +0ce2 0ce5 +0cf0 0d01 +0d04 +0d0d +0d11 +0d29 +0d3a 0d3d +0d44 0d45 +0d49 +0d4e 0d56 +0d58 0d5f +0d62 0d65 +0d70 0d81 +0d84 +0d97 0d99 +0db2 +0dbc +0dbe 0dbf +0dc7 0dc9 +0dcb 0dce +0dd5 +0dd7 +0de0 0df1 +0df5 0e00 +0e3b 0e3e +0e5c 0e80 +0e83 +0e85 0e86 +0e89 +0e8b 0e8c +0e8e 0e93 +0e98 +0ea0 +0ea4 +0ea6 +0ea8 0ea9 +0eac +0eba +0ebe 0ebf +0ec5 +0ec7 +0ece 0ecf +0eda 0edb +0ede 0eff +0f48 +0f6b 0f70 +0f8c 0f8f +0f98 +0fbd +0fcd 0fce +0fd0 0fff +1022 +1028 +102b +1033 1035 +103a 103f +105a 109f +10c6 10cf +10f7 10fa +10fc 10ff +115a 115e +11a3 11a7 +11fa 11ff +1207 +1247 +1249 +124e 124f +1257 +1259 +125e 125f +1287 +1289 +128e 128f +12af +12b1 +12b6 12b7 +12bf +12c1 +12c6 12c7 +12cf +12d7 +12ef +130f +1311 +1316 1317 +131f +1347 +135b 1360 +137d 139f +13f5 1400 +1677 167f +169d 169f +16f1 177f +17dd 17df +17ea 17ff +180f +181a 181f +1878 187f +18aa 1dff +1e9c 1e9f +1efa 1eff +1f16 1f17 +1f1e 1f1f +1f46 1f47 +1f4e 1f4f +1f58 +1f5a +1f5c +1f5e +1f7e 1f7f +1fb5 +1fc5 +1fd4 1fd5 +1fdc +1ff0 1ff1 +1ff5 +1fff +2047 +204e 2069 +2071 2073 +208f 209f +20b0 20cf +20e4 20ff +213b 2152 +2184 218f +21f4 21ff +22f2 22ff +237c +239b 23ff +2427 243f +244b 245f +24eb 24ff +2596 259f +25f8 25ff +2614 2618 +2672 2700 +2705 +270a 270b +2728 +274c +274e +2753 2755 +2757 +275f 2760 +2768 2775 +2795 2797 +27b0 +27bf 27ff +2900 2e7f +2e9a +2ef4 2eff +2fd6 2fef +2ffc 2fff +303b 303d +3040 +3095 3098 +309f 30a0 +30ff 3104 +312d 3130 +318f +31b8 31ff +321d 321f +3244 325f +327c 327e +32b1 32bf +32cc 32cf +32ff +3377 337a +33de 33df +33ff +4db6 4dff +9fa6 9fff +a48d a48f +a4a2 a4a3 +a4b4 +a4c1 +a4c5 +a4c7 abff +d7a4 d7ff +fa2e faff +fb07 fb12 +fb18 fb1c +fb37 +fb3d +fb3f +fb42 +fb45 +fbb2 fbd2 +fd40 fd4f +fd90 fd91 +fdc8 fdef +fdfc fe1f +fe24 fe2f +fe45 fe48 +fe53 +fe67 +fe6c fe6f +fe73 +fe75 +fefd fefe +ff00 +ff5f ff60 +ffbf ffc1 +ffc8 ffc9 +ffd0 ffd1 +ffd8 ffd9 +ffdd ffdf +ffe7 +ffef fff8 END diff --git a/lib/unicode/Is/Cs.pl b/lib/unicode/Is/Cs.pl new file mode 100644 index 0000000000..8888fb5f3c --- /dev/null +++ b/lib/unicode/Is/Cs.pl @@ -0,0 +1,8 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +d800 db7f +db80 dbff +dc00 dfff +END diff --git a/lib/unicode/Is/DCfraction.pl b/lib/unicode/Is/DCfraction.pl new file mode 100644 index 0000000000..fc2dd6755d --- /dev/null +++ b/lib/unicode/Is/DCfraction.pl @@ -0,0 +1,7 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +00bc 00be +2153 215f +END diff --git a/lib/unicode/Is/Graph.pl b/lib/unicode/Is/Graph.pl index 9c94bb722c..156f1711af 100644 --- a/lib/unicode/Is/Graph.pl +++ b/lib/unicode/Is/Graph.pl @@ -265,7 +265,8 @@ return <<'END'; 1fdd 1fef 1ff2 1ff4 1ff6 1ffe -2000 200b +2000 2008 +200b 2010 2029 202f 2046 2048 204d diff --git a/lib/unicode/Is/Me.pl b/lib/unicode/Is/Me.pl new file mode 100644 index 0000000000..00f446d87d --- /dev/null +++ b/lib/unicode/Is/Me.pl @@ -0,0 +1,9 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0488 0489 +06dd 06de +20dd 20e0 +20e2 20e3 +END diff --git a/lib/unicode/Is/Nl.pl b/lib/unicode/Is/Nl.pl new file mode 100644 index 0000000000..8f1af469bb --- /dev/null +++ b/lib/unicode/Is/Nl.pl @@ -0,0 +1,9 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +2160 2183 +3007 +3021 3029 +3038 303a +END diff --git a/lib/unicode/Is/Pc.pl b/lib/unicode/Is/Pc.pl new file mode 100644 index 0000000000..342efac344 --- /dev/null +++ b/lib/unicode/Is/Pc.pl @@ -0,0 +1,12 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +005f +203f 2040 +30fb +fe33 fe34 +fe4d fe4f +ff3f +ff65 +END diff --git a/lib/unicode/Is/Pf.pl b/lib/unicode/Is/Pf.pl new file mode 100644 index 0000000000..166c64bbb6 --- /dev/null +++ b/lib/unicode/Is/Pf.pl @@ -0,0 +1,9 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +00bb +2019 +201d +203a +END diff --git a/lib/unicode/Is/Pi.pl b/lib/unicode/Is/Pi.pl new file mode 100644 index 0000000000..7f2243d5d8 --- /dev/null +++ b/lib/unicode/Is/Pi.pl @@ -0,0 +1,10 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +00ab +2018 +201b 201c +201f +2039 +END diff --git a/lib/unicode/Is/Punct.pl b/lib/unicode/Is/Punct.pl index 8fd1e8e183..9e8684d6fc 100644 --- a/lib/unicode/Is/Punct.pl +++ b/lib/unicode/Is/Punct.pl @@ -8,45 +8,45 @@ return <<'END'; 003a 003b 003f 0040 005b 005d -005f -007b -007d -00a1 -00ab -00ad -00b7 -00bb -00bf -037e -0387 +005f +007b +007d +00a1 +00ab +00ad +00b7 +00bb +00bf +037e +0387 055a 055f 0589 058a -05be -05c0 -05c3 +05be +05c0 +05c3 05f3 05f4 -060c -061b -061f +060c +061b +061f 066a 066d -06d4 +06d4 0700 070d 0964 0965 -0970 -0df4 -0e4f +0970 +0df4 +0e4f 0e5a 0e5b 0f04 0f12 0f3a 0f3d -0f85 +0f85 104a 104f -10fb +10fb 1361 1368 166d 166e 169b 169c 16eb 16ed 17d4 17da -17dc +17dc 1800 180a 2010 2027 2030 2043 @@ -58,14 +58,14 @@ return <<'END'; 3001 3003 3008 3011 3014 301f -3030 -30fb +3030 +30fb fd3e fd3f fe30 fe44 fe49 fe52 fe54 fe61 -fe63 -fe68 +fe63 +fe68 fe6a fe6b ff01 ff03 ff05 ff0a @@ -73,8 +73,8 @@ ff0c ff0f ff1a ff1b ff1f ff20 ff3b ff3d -ff3f -ff5b -ff5d +ff3f +ff5b +ff5d ff61 ff65 END diff --git a/lib/unicode/Is/Sk.pl b/lib/unicode/Is/Sk.pl new file mode 100644 index 0000000000..b5f6e591a7 --- /dev/null +++ b/lib/unicode/Is/Sk.pl @@ -0,0 +1,27 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +005e +0060 +00a8 +00af +00b4 +00b8 +02b9 02ba +02c2 02cf +02d2 02df +02e5 02ed +0374 0375 +0384 0385 +1fbd +1fbf 1fc1 +1fcd 1fcf +1fdd 1fdf +1fed 1fef +1ffd 1ffe +309b 309c +ff3e +ff40 +ffe3 +END diff --git a/lib/unicode/Is/Space.pl b/lib/unicode/Is/Space.pl index 4121ef49b8..701329ff82 100644 --- a/lib/unicode/Is/Space.pl +++ b/lib/unicode/Is/Space.pl @@ -2,13 +2,13 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; -0009 000a -000c 000d -0020 -00a0 -1680 +0009 000d +0020 +0085 +00a0 +1680 2000 200b 2028 2029 -202f -3000 +202f +3000 END diff --git a/lib/unicode/Is/SylA.pl b/lib/unicode/Is/SylA.pl index ec287c456a..be1107822d 100644 --- a/lib/unicode/Is/SylA.pl +++ b/lib/unicode/Is/SylA.pl @@ -2,4 +2,157 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1203 +120b +1213 +121b +1223 +122b +1233 +123b +1243 +1253 +1263 +126b +1273 +127b +1283 +1293 +129b +12a3 +12ab +12bb +12cb +12d3 +12db +12e3 +12eb +12f3 +12fb +1303 +130b +131b +1323 +132b +1333 +133b +1343 +134b +1353 +13a0 +13a6 13a7 +13ad +13b3 +13b9 +13be 13bf +13c6 +13cc +13d3 13d4 +13dc 13dd +13e3 +13e9 +13ef +140a +1438 +1455 +146a +1472 +1490 +14aa +14c7 +14da +14f4 +1515 +152d +154b +154d +1559 +1566 +156e +1573 +1579 +1583 +1589 +158d +1593 +159a +159e +15a4 +15ac +15b3 +15b7 +15bb +15bf +15c3 +15c9 +15cf +15d5 +15e1 +15e7 +15ed +15f4 +15fa +1600 +1607 +160d +1613 +161b +1621 +1627 +162d +1633 +1639 +163f +1645 +164d +1653 +1659 +1660 +1666 +166c +1675 +30a1 30a2 +30ab 30ac +30b5 30b6 +30bf 30c0 +30ca +30cf 30d1 +30de +30e3 30e4 +30e9 +30ee 30ef +30f5 +30f7 +32d0 +32d5 +32da +32df +32e4 +32e9 +32ee +32f3 +32f6 +32fb +ff67 +ff6c +ff71 +ff76 +ff7b +ff80 +ff85 +ff8a +ff8f +ff94 +ff97 +ff9c +3041 3042 +304b 304c +3055 3056 +305f 3060 +306a +306f 3071 +307e +3083 3084 +3089 +308e 308f END diff --git a/lib/unicode/Is/SylAA.pl b/lib/unicode/Is/SylAA.pl new file mode 100644 index 0000000000..45d6692de7 --- /dev/null +++ b/lib/unicode/Is/SylAA.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +140b +1439 +1456 +1473 +1491 +14ab +14c8 +14db +14f5 +1516 +152e +154c +155a +1567 +157a +1584 +1594 +15a5 +15ad +1676 +END diff --git a/lib/unicode/Is/SylAAI.pl b/lib/unicode/Is/SylAAI.pl new file mode 100644 index 0000000000..a8b03d4c6c --- /dev/null +++ b/lib/unicode/Is/SylAAI.pl @@ -0,0 +1,19 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1402 +1430 +144d +146c +148a +14a4 +14c1 +14d4 +14ee +1527 +1545 +1554 +157e +158e +END diff --git a/lib/unicode/Is/SylAI.pl b/lib/unicode/Is/SylAI.pl new file mode 100644 index 0000000000..b70d793bc6 --- /dev/null +++ b/lib/unicode/Is/SylAI.pl @@ -0,0 +1,7 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +141c +166f 1670 +END diff --git a/lib/unicode/Is/SylC.pl b/lib/unicode/Is/SylC.pl index ec287c456a..e2a1601dd3 100644 --- a/lib/unicode/Is/SylC.pl +++ b/lib/unicode/Is/SylC.pl @@ -2,4 +2,69 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1205 +120d +1215 +121d +1225 +122d +1235 +123d +1245 +1255 +1265 +126d +1275 +127d +1285 +1295 +129d +12a5 +12ad +12bd +12cd +12d5 +12dd +12e5 +12ed +12f5 +12fd +1305 +130d +131d +1325 +132d +1335 +133d +1345 +134d +1355 +13c0 +13cd +141d +142b 142e +1449 144b +1466 +1483 +1485 1488 +14a1 +14bb 14bf +14d0 14d2 +14ea 14ec +1505 1506 +1508 150b +1525 +153e 1540 +1550 1552 +155d +156a +156f +157b 157d +1585 +1595 1596 +159f +15a6 +15ae 15af +30f3 +ff9d END diff --git a/lib/unicode/Is/SylE.pl b/lib/unicode/Is/SylE.pl index ec287c456a..b3c3e60437 100644 --- a/lib/unicode/Is/SylE.pl +++ b/lib/unicode/Is/SylE.pl @@ -2,4 +2,146 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1204 +120c +1214 +121c +1224 +122c +1234 +123c +1244 +1254 +1264 +126c +1274 +127c +1284 +1294 +129c +12a4 +12ac +12bc +12cc +12d4 +12dc +12e4 +12ec +12f4 +12fc +1304 +130c +131c +1324 +132c +1334 +133c +1344 +134c +1354 +13a1 +13a8 +13ae +13b4 +13ba +13c1 +13c7 +13ce +13d5 13d6 +13de +13e4 +13ea +13f0 +1401 +142f +144c +1467 +146b +1489 +14a3 +14c0 +14d3 +14ed +1510 +1526 +1542 1544 +1553 +155e 155f +156b +1570 +1574 +1586 +158a +1597 +159b +15a7 +15b0 +15b4 +15b8 +15bc +15c0 +15c6 +15cc +15d2 +15de +15e4 +15ea +15f1 +15f7 +15fd +1604 +160a +1610 +1617 +161e +1624 +162a +1630 +1636 +163c +1642 +164a +1650 +1656 +165d +1663 +1669 +30a7 30a8 +30b1 30b2 +30bb 30bc +30c6 30c7 +30cd +30d8 30da +30e1 +30ec +30f1 +30f6 +30f9 +32d3 +32d8 +32dd +32e2 +32e7 +32ec +32f1 +32f9 +32fd +ff6a +ff74 +ff79 +ff7e +ff83 +ff88 +ff8d +ff92 +ff9a +3047 3048 +3051 3052 +305b 305c +3066 3067 +306d +3078 307a +3081 +308c +3091 END diff --git a/lib/unicode/Is/SylEE.pl b/lib/unicode/Is/SylEE.pl new file mode 100644 index 0000000000..0a22f78f65 --- /dev/null +++ b/lib/unicode/Is/SylEE.pl @@ -0,0 +1,34 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1408 +1436 +1453 +15c7 +15cd +15d3 +15df +15e5 +15eb +15f2 +15f8 +15fe +1605 +160b +1611 +1618 +161f +1625 +162b +1631 +1637 +163d +1643 +164b +1651 +1657 +165e +1664 +166a +END diff --git a/lib/unicode/Is/SylI.pl b/lib/unicode/Is/SylI.pl index ec287c456a..f80790ce44 100644 --- a/lib/unicode/Is/SylI.pl +++ b/lib/unicode/Is/SylI.pl @@ -2,4 +2,153 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1202 +120a +1212 +121a +1222 +122a +1232 +123a +1242 +1252 +1262 +126a +1272 +127a +1282 +1292 +129a +12a2 +12aa +12ba +12ca +12d2 +12da +12e2 +12ea +12f2 +12fa +1302 +130a +131a +1322 +132a +1332 +133a +1342 +134a +1352 +13a2 +13a9 +13af +13b5 +13bb +13c2 +13c8 +13cf +13d7 13d8 +13df +13e5 +13eb +13f1 +1403 +1409 +1431 +1437 +144e +1454 +1468 +146d +148b +14a5 +14c2 +14d5 +14ef +1511 +1528 +1541 +1546 +1555 +1560 1561 +156c +1571 +1575 +157f +1587 +158b +158f +1598 +159c +15a0 +15a8 +15b1 +15b5 +15b9 +15bd +15c1 +15c8 +15ce +15d4 +15e0 +15e6 +15ec +15f3 +15f9 +15ff +1606 +160c +1612 +1619 161a +1620 +1626 +162c +1632 +1638 +163e +1644 +164c +1652 +1658 +165f +1665 +166b +1671 +30a3 30a4 +30ad 30ae +30b7 30b8 +30c1 30c2 +30cb +30d2 30d4 +30df +30ea +30f0 +30f8 +32d1 +32d6 +32db +32e0 +32e5 +32ea +32ef +32f7 +32fc +ff68 +ff72 +ff77 +ff7c +ff81 +ff86 +ff8b +ff90 +ff98 +3043 3044 +304d 304e +3057 3058 +3061 3062 +306b +3072 3074 +307f +308a +3090 END diff --git a/lib/unicode/Is/SylII.pl b/lib/unicode/Is/SylII.pl new file mode 100644 index 0000000000..4516d7a32a --- /dev/null +++ b/lib/unicode/Is/SylII.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1404 +1432 +144f +146e +148c +14a6 +14c3 +14d6 +14f0 +1512 +1529 +1547 +1556 +1562 1563 +1576 +1580 +1590 +15a1 +15a9 +1672 +END diff --git a/lib/unicode/Is/SylN.pl b/lib/unicode/Is/SylN.pl new file mode 100644 index 0000000000..215463fb7f --- /dev/null +++ b/lib/unicode/Is/SylN.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +3093 +END diff --git a/lib/unicode/Is/SylO.pl b/lib/unicode/Is/SylO.pl index ec287c456a..a0a6f7dd01 100644 --- a/lib/unicode/Is/SylO.pl +++ b/lib/unicode/Is/SylO.pl @@ -2,4 +2,156 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1206 +120e +1216 +121e +1226 +122e +1236 +123e +1246 +1256 +1266 +126e +1276 +127e +1286 +1296 +129e +12a6 +12ae +12be +12ce +12d6 +12de +12e6 +12ee +12f6 +12fe +1306 +130e +131e +1326 +132e +1336 +133e +1346 +134e +1356 +13a3 +13aa +13b0 +13b6 +13bc +13c3 +13c9 +13d0 +13d9 +13e0 +13e6 +13ec +13f2 +1405 +1433 +1450 +1469 +146f +148d +14a7 +14c4 +14d7 +14f1 +1513 +152a +1548 +154a +1557 +1564 +156d +1572 +1577 +1581 +1588 +158c +1591 +1599 +159d +15a2 +15aa +15b2 +15b6 +15ba +15be +15c2 +15c5 +15cb +15d1 +15dd +15e3 +15e9 +15f0 +15f6 +15fc +1603 +1609 +160f +1616 +161d +1623 +1629 +162f +1635 +163b +1641 +1649 +164f +1655 +165c +1662 +1668 +1673 +30a9 30aa +30b3 30b4 +30bd 30be +30c8 30c9 +30ce +30db 30dd +30e2 +30e7 30e8 +30ed +30f2 +30fa +32d4 +32d9 +32de +32e3 +32e8 +32ed +32f2 +32f5 +32fa +32fe +ff66 +ff6b +ff6e +ff75 +ff7a +ff7f +ff84 +ff89 +ff8e +ff93 +ff96 +ff9b +3049 304a +3053 3054 +305d 305e +3068 3069 +306e +307b 307d +3082 +3087 3088 +308d +3092 END diff --git a/lib/unicode/Is/SylOO.pl b/lib/unicode/Is/SylOO.pl new file mode 100644 index 0000000000..12280534b1 --- /dev/null +++ b/lib/unicode/Is/SylOO.pl @@ -0,0 +1,25 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1406 1407 +1434 1435 +1451 1452 +1470 1471 +148e 148f +14a8 14a9 +14c5 14c6 +14d8 14d9 +14f2 14f3 +1514 +152b 152c +1549 +1558 +1565 +1578 +1582 +1592 +15a3 +15ab +1674 +END diff --git a/lib/unicode/Is/SylU.pl b/lib/unicode/Is/SylU.pl index ec287c456a..c458382f25 100644 --- a/lib/unicode/Is/SylU.pl +++ b/lib/unicode/Is/SylU.pl @@ -2,4 +2,121 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1201 +1209 +1211 +1219 +1221 +1229 +1231 +1239 +1241 +1251 +1261 +1269 +1271 +1279 +1281 +1291 +1299 +12a1 +12a9 +12b9 +12c9 +12d1 +12d9 +12e1 +12e9 +12f1 +12f9 +1301 +1309 +1319 +1321 +1329 +1331 +1339 +1341 +1349 +1351 +13a4 +13ab +13b1 +13b7 +13bd +13c4 +13ca +13d1 +13da +13e1 +13e7 +13ed +13f3 +15c4 +15ca +15d0 +15dc +15e2 +15e8 +15ef +15f5 +15fb +1602 +1608 +160e +1614 1615 +161c +1622 +1628 +162e +1634 +163a +1640 +1648 +164e +1654 +165b +1661 +1667 +30a5 30a6 +30af 30b0 +30b9 30ba +30c3 30c5 +30cc +30d5 30d7 +30e0 +30e5 30e6 +30eb +30f4 +32d2 +32d7 +32dc +32e1 +32e6 +32eb +32f0 +32f4 +32f8 +ff69 +ff6d +ff6f +ff73 +ff78 +ff7d +ff82 +ff87 +ff8c +ff91 +ff95 +ff99 +3045 3046 +304f 3050 +3059 305a +3063 3065 +306c +3075 3077 +3080 +3085 3086 +308b +3094 END diff --git a/lib/unicode/Is/SylV.pl b/lib/unicode/Is/SylV.pl index ec287c456a..b6e76f81b9 100644 --- a/lib/unicode/Is/SylV.pl +++ b/lib/unicode/Is/SylV.pl @@ -2,4 +2,53 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1200 +1208 +1210 +1218 +1220 +1228 +1230 +1238 +1240 +1250 +1260 +1268 +1270 +1278 +1280 +1290 +1298 +12a0 +12a8 +12b8 +12c8 +12d0 +12d8 +12e0 +12e8 +12f0 +12f8 +1300 +1308 +1318 +1320 +1328 +1330 +1338 +1340 +1348 +1350 +13a5 +13ac +13b2 +13b8 +13c5 +13cb +13d2 +13db +13e2 +13e8 +13ee +13f4 END diff --git a/lib/unicode/Is/SylWA.pl b/lib/unicode/Is/SylWA.pl index ec287c456a..9bb529ed01 100644 --- a/lib/unicode/Is/SylWA.pl +++ b/lib/unicode/Is/SylWA.pl @@ -2,4 +2,48 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +120f +1217 +121f +1227 +122f +1237 +123f +124b +125b +1267 +126f +1277 +127f +128b +1297 +129f +12a7 +12b3 +12c3 +12df +12e7 +12f7 +12ff +1307 +1313 +1327 +132f +1337 +133f +134f +1357 +1417 1418 +1444 1445 +1461 1462 +147e 147f +149c 149d +14b6 14b7 +14cb 14cc +14e6 14e7 +1500 1501 +150c 150f +1521 1522 +1539 153a +15db END diff --git a/lib/unicode/Is/SylWAA.pl b/lib/unicode/Is/SylWAA.pl new file mode 100644 index 0000000000..5f3b784d0c --- /dev/null +++ b/lib/unicode/Is/SylWAA.pl @@ -0,0 +1,19 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1419 141b +1446 1448 +1463 1465 +1480 1482 +149e 14a0 +14b8 14ba +14cd 14cf +14e8 14e9 +1502 1504 +1523 1524 +153b 153d +154e 154f +155b 155c +1568 1569 +END diff --git a/lib/unicode/Is/SylWC.pl b/lib/unicode/Is/SylWC.pl index ec287c456a..3ad968c505 100644 --- a/lib/unicode/Is/SylWC.pl +++ b/lib/unicode/Is/SylWC.pl @@ -2,4 +2,12 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +124d +125d +128d +12b5 +12c5 +1315 +1484 +1507 END diff --git a/lib/unicode/Is/SylWE.pl b/lib/unicode/Is/SylWE.pl index ec287c456a..9e32c0e602 100644 --- a/lib/unicode/Is/SylWE.pl +++ b/lib/unicode/Is/SylWE.pl @@ -2,4 +2,22 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +124c +125c +128c +12b4 +12c4 +1314 +140c 140d +143a 143b +1457 1458 +1474 1475 +1492 1493 +14ac 14ad +14c9 14ca +14dc 14dd +14f6 14f7 +1517 1518 +152f 1530 +15d8 END diff --git a/lib/unicode/Is/SylWEE.pl b/lib/unicode/Is/SylWEE.pl new file mode 100644 index 0000000000..c4bccb5240 --- /dev/null +++ b/lib/unicode/Is/SylWEE.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +15d9 +END diff --git a/lib/unicode/Is/SylWI.pl b/lib/unicode/Is/SylWI.pl index ec287c456a..4cd6c6789c 100644 --- a/lib/unicode/Is/SylWI.pl +++ b/lib/unicode/Is/SylWI.pl @@ -2,4 +2,21 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +124a +125a +128a +12b2 +12c2 +1312 +140e 140f +143c 143d +1459 145a +1476 1477 +1494 1495 +14ae 14af +14de 14df +14f8 14f9 +1519 151a +1531 1532 +15da END diff --git a/lib/unicode/Is/SylWII.pl b/lib/unicode/Is/SylWII.pl new file mode 100644 index 0000000000..bd68aeadf5 --- /dev/null +++ b/lib/unicode/Is/SylWII.pl @@ -0,0 +1,15 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1410 1411 +143e 143f +145b 145c +1478 1479 +1496 1497 +14b0 14b1 +14e0 14e1 +14fa 14fb +151b 151c +1533 1534 +END diff --git a/lib/unicode/Is/SylWO.pl b/lib/unicode/Is/SylWO.pl new file mode 100644 index 0000000000..7676564130 --- /dev/null +++ b/lib/unicode/Is/SylWO.pl @@ -0,0 +1,16 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1412 1413 +1440 1441 +145d 145e +147a 147b +1498 1499 +14b2 14b3 +14e2 14e3 +14fc 14fd +151d 151e +1535 1536 +15d7 +END diff --git a/lib/unicode/Is/SylWOO.pl b/lib/unicode/Is/SylWOO.pl new file mode 100644 index 0000000000..0ab766a553 --- /dev/null +++ b/lib/unicode/Is/SylWOO.pl @@ -0,0 +1,15 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1414 1416 +1442 1443 +145f 1460 +147c 147d +149a 149b +14b4 14b5 +14e4 14e5 +14fe 14ff +151f 1520 +1537 1538 +END diff --git a/lib/unicode/Is/SylWU.pl b/lib/unicode/Is/SylWU.pl new file mode 100644 index 0000000000..76af7aefad --- /dev/null +++ b/lib/unicode/Is/SylWU.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +15d6 +END diff --git a/lib/unicode/Is/SylWV.pl b/lib/unicode/Is/SylWV.pl index ec287c456a..8bd8849042 100644 --- a/lib/unicode/Is/SylWV.pl +++ b/lib/unicode/Is/SylWV.pl @@ -2,4 +2,10 @@ # This file is built by mktables.PL from e.g. Unicode.300. # Any changes made here will be lost! return <<'END'; +1248 +1258 +1288 +12b0 +12c0 +1310 END diff --git a/lib/unicode/Is/Upper.pl b/lib/unicode/Is/Upper.pl index 8dde2742d0..4fda655dc4 100644 --- a/lib/unicode/Is/Upper.pl +++ b/lib/unicode/Is/Upper.pl @@ -86,9 +86,9 @@ return <<'END'; 01b5 01b7 01b8 01bc -01c4 -01c7 -01ca +01c4 01c5 +01c7 01c8 +01ca 01cb 01cd 01cf 01d1 @@ -106,7 +106,7 @@ return <<'END'; 01ea 01ec 01ee -01f1 +01f1 01f2 01f4 01f6 01f8 01fa @@ -355,11 +355,14 @@ return <<'END'; 1f5d 1f5f 1f68 1f6f -1fb8 1fbb -1fc8 1fcb +1f88 1f8f +1f98 1f9f +1fa8 1faf +1fb8 1fbc +1fc8 1fcc 1fd8 1fdb 1fe8 1fec -1ff8 1ffb +1ff8 1ffc 2102 2107 210b 210d diff --git a/lib/unicode/Makefile b/lib/unicode/Makefile index c68fa3af00..af5e77b47b 100644 --- a/lib/unicode/Makefile +++ b/lib/unicode/Makefile @@ -1,6 +1,5 @@ all: - ./mktables.PL - ./MakeEthiopicSyllables.PL + ../../miniperl -I../../lib ./mktables.PL clean: rm -f *.pl */*.pl diff --git a/lib/unicode/mktables.PL b/lib/unicode/mktables.PL index 4f705a4016..241d2e6bb3 100755 --- a/lib/unicode/mktables.PL +++ b/lib/unicode/mktables.PL @@ -1,6 +1,11 @@ #!../../miniperl +use bytes; + $UnicodeData = "Unicode.300"; +$SyllableData = "syllables.txt"; +$PropData = "Props.txt"; + # Note: we try to keep filenames unique within first 8 chars. Using # subdirectories for the following helps. @@ -14,16 +19,15 @@ mkdir "To", 0777; ['IsWord', '$cat =~ /^L[ulot]|^Nd/ or $code eq "005F"', ''], ['IsAlnum', '$cat =~ /^L[ulot]|^Nd/', ''], ['IsAlpha', '$cat =~ /^L[ulot]/', ''], - # XXX broken: recursive definition (/\s/ will look up IsSpace in future) - ['IsSpace', '$cat =~ /^Z/ or $code lt "0020" and chr(hex $code) =~ /^\s/', ''], + ['IsSpace', 'White space', $PropData], ['IsDigit', '$cat =~ /^Nd$/', ''], - ['IsUpper', '$cat =~ /^Lu$/', ''], + ['IsUpper', '$cat =~ /^L[ut]$/', ''], ['IsLower', '$cat =~ /^Ll$/', ''], ['IsASCII', 'hex $code <= 127', ''], ['IsCntrl', '$cat =~ /^C/', ''], - ['IsGraph', '$cat =~ /^[^C]/ and $code ne "0020"', ''], + ['IsGraph', '$cat =~ /^[^C]/ and ($cat !~ /^Z/ and $code ne "0020" or chr(hex $code) !~ /^\s/)', ''], ['IsPrint', '$cat =~ /^[^C]/', ''], - ['IsPunct', '$cat =~ /^P/', ''], + ['IsPunct', 'Punctuation', $PropData], ['IsXDigit', '$code =~ /^00(3[0-9]|[46][1-6])$/', ''], ['ToUpper', '$up', '$up'], ['ToLower', '$down', '$down'], @@ -43,12 +47,14 @@ mkdir "To", 0777; ['IsM', '$cat =~ /^M/', ''], # Mark ['IsMn', '$cat eq "Mn"', ''], # Mark, Non-Spacing ['IsMc', '$cat eq "Mc"', ''], # Mark, Combining + ['IsMe', '$cat eq "Me"', ''], # Mark, Enclosing ['IsN', '$cat =~ /^N/', ''], # Number ['IsNd', '$cat eq "Nd"', ''], # Number, Decimal Digit ['IsNo', '$cat eq "No"', ''], # Number, Other + ['IsNl', '$cat eq "Nl"', ''], # Number, Letter - ['IsZ', '$cat =~ /^Z/', ''], # Zeparator + ['IsZ', '$cat =~ /^Z/', ''], # Separator ['IsZs', '$cat eq "Zs"', ''], # Separator, Space ['IsZl', '$cat eq "Zl"', ''], # Separator, Line ['IsZp', '$cat eq "Zp"', ''], # Separator, Paragraph @@ -57,6 +63,9 @@ mkdir "To", 0777; ['IsCc', '$cat eq "Cc"', ''], # Other, Control or Format ['IsCo', '$cat eq "Co"', ''], # Other, Private Use ['IsCn', '$cat eq "Cn"', ''], # Other, Not Assigned + ['IsCf', '$cat eq "Cf"', ''], # Other, Format + ['IsCs', '$cat eq "Cs"', ''], # Other, Surrogate + ['IsCn', 'Unassigned Code Value',$PropData], # Other, Not Assigned # Informative @@ -72,9 +81,13 @@ mkdir "To", 0777; ['IsPs', '$cat eq "Ps"', ''], # Punctuation, Open ['IsPe', '$cat eq "Pe"', ''], # Punctuation, Close ['IsPo', '$cat eq "Po"', ''], # Punctuation, Other + ['IsPc', '$cat eq "Pc"', ''], # Punctuation, Connector + ['IsPi', '$cat eq "Pi"', ''], # Punctuation, Initial quote + ['IsPf', '$cat eq "Pf"', ''], # Punctuation, Final quote ['IsS', '$cat =~ /^S/', ''], # Symbol ['IsSm', '$cat eq "Sm"', ''], # Symbol, Math + ['IsSk', '$cat eq "Sk"', ''], # Symbol, Modifier ['IsSc', '$cat eq "Sc"', ''], # Symbol, Currency ['IsSo', '$cat eq "So"', ''], # Symbol, Other @@ -95,6 +108,15 @@ mkdir "To", 0777; # and punctuation specific to # those scripts + ['IsBidiLRE', '$bid eq "LRE"', ''], # Left-to-Right Embedding + ['IsBidiLRO', '$bid eq "LRO"', ''], # Left-to-Right Override + ['IsBidiAL', '$bid eq "AL"', ''], # Right-to-Left Arabic + ['IsBidiRLE', '$bid eq "RLE"', ''], # Right-to-Left Embedding + ['IsBidiRLO', '$bid eq "RLO"', ''], # Right-to-Left Override + ['IsBidiPDF', '$bid eq "PDF"', ''], # Pop Directional Format + ['IsBidiNSM', '$bid eq "NSM"', ''], # Non-Spacing Mark + ['IsBidiBN', '$bid eq "BN"', ''], # Boundary Neutral + # Weak types: ['IsBidiEN','$bid eq "EN"', ''], # European Number @@ -134,6 +156,7 @@ mkdir "To", 0777; ['IsDCnarrow', '$decomp =~ /^<narrow>/', ''], ['IsDCsmall', '$decomp =~ /^<small>/', ''], ['IsDCsquare', '$decomp =~ /^<square>/', ''], + ['IsDCfraction', '$decomp =~ /^<fraction>/', ''], ['IsDCcompat', '$decomp =~ /^<compat>/', ''], # Number @@ -155,19 +178,8 @@ mkdir "To", 0777; # Syllables - ['IsSylV', '$syl eq "V"', ''], - ['IsSylU', '$syl eq "U"', ''], - ['IsSylI', '$syl eq "I"', ''], - ['IsSylA', '$syl eq "A"', ''], - ['IsSylE', '$syl eq "E"', ''], - ['IsSylC', '$syl eq "C"', ''], - ['IsSylO', '$syl eq "O"', ''], - ['IsSylWV', '$syl eq "V"', ''], - ['IsSylWI', '$syl eq "I"', ''], - ['IsSylWA', '$syl eq "A"', ''], - ['IsSylWE', '$syl eq "E"', ''], - ['IsSylWC', '$syl eq "C"', ''], - + syllable_defs(), + # Line break properties - Normative ['IsLbrkBK','$brk eq "BK"', ''], # Mandatory Break @@ -232,8 +244,8 @@ END exit if @ARGV and not grep { $_ eq Block } @ARGV; print "Block\n"; -open(UD, 'Blocks.txt') or die "Can't open blocks.txt: $!\n"; -open(OUT, ">Block.pl") or die "Can't create $table.pl: $!\n"; +open(UD, 'Blocks.txt') or die "Can't open Blocks.txt: $!\n"; +open(OUT, ">Block.pl") or die "Can't create Block.pl: $!\n"; print OUT <<EOH; # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file is built by $0 from e.g. $UnicodeData. @@ -277,6 +289,8 @@ sub proplist { my $out; my $split; + return listFromPropFile($wanted) if $val eq $PropData; + if ($table =~ /^Arab/) { open(UD, "ArabShap.txt") or warn "Can't open $table: $!"; @@ -288,7 +302,7 @@ sub proplist { $split = '($code, $short, $name) = split(/; */); $code =~ s/^U\+//;'; } elsif ($table =~ /^IsSyl/) { - open(UD, "syllables.txt") or warn "Can't open $table: $!"; + open(UD, $SyllableData) or warn "Can't open $table: $!"; $split = '($code, $short, $syl) = split(/; */); $code =~ s/^U\+//;'; } @@ -308,8 +322,8 @@ sub proplist { eval <<"END"; while (<UD>) { next if /^#/; - next if /^\s/; - chop; + next if /^\\s/; + s/\\s+\$//; $split if ($wanted) { push(\@wanted, [hex \$code, hex $val, \$name =~ /, First>\$/]); @@ -343,7 +357,7 @@ END eval <<"END"; while (<UD>) { next if /^#/; - next if /^\s*\$/; + next if /^\\s*\$/; chop; $split if ($wanted) { @@ -376,4 +390,44 @@ END $out; } +sub listFromPropFile { + my ($wanted) = @_; + my $out; + + open (UD, $PropData) or die "Can't open $PropData: $!\n"; + local($/) = "\n" . '*' x 43 . "\n\nProperty dump for:"; # not 42? + + <UD>; + while (<UD>) { + chomp; + if (s/0x[\d\w]+\s+\((.*?)\)// and $wanted eq $1) { + s/\(\d+ chars\)//g; + s/^\s+//mg; + s/\s+$//mg; + s/\.\./\t/g; + $out = lc $_; + last; + } + } + close (UD); + "$out\n"; +} + +sub syllable_defs { + my @defs; + my %seen; + + open (SD, $SyllableData) or die "Can't open $SyllableData: $!\n"; + while (<SD>) { + next if /^\s*(#|$)/; + s/\s+$//; + ($code, $name, $syl) = split /; */; + next unless $syl; + push (@defs, ["IsSyl$syl", qq{\$syl eq "$syl"}, '']) + unless $seen{$syl}++; + } + close (SD); + return (@defs); +} + # eof @@ -162,6 +162,7 @@ Perl_pad_allocmy(pTHX_ char *name) do { if ((sv = svp[off]) && sv != &PL_sv_undef + && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash) && strEQ(name, SvPVX(sv))) { @@ -1570,18 +1570,7 @@ Perl_call_method(pTHX_ const char *methname, I32 flags) /* name of the subroutine */ /* See G_* flags in cop.h */ { - dSP; - OP myop; - if (!PL_op) { - Zero(&myop, 1, OP); - PL_op = &myop; - } - XPUSHs(sv_2mortal(newSVpv(methname,0))); - PUTBACK; - pp_method(); - if (PL_op == &myop) - PL_op = Nullop; - return call_sv(*PL_stack_sp--, flags); + return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD); } /* May be called with any of a CV, a GV, or an SV containing the name. */ @@ -1601,6 +1590,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) { dSP; LOGOP myop; /* fake syntax tree node */ + UNOP method_op; I32 oldmark; I32 retval; I32 oldscope; @@ -1638,6 +1628,14 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) && !(flags & G_NODEBUG)) PL_op->op_private |= OPpENTERSUB_DB; + if (flags & G_METHOD) { + Zero(&method_op, 1, UNOP); + method_op.op_next = PL_op; + method_op.op_ppaddr = PL_ppaddr[OP_METHOD]; + myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB]; + PL_op = &method_op; + } + if (!(flags & G_EVAL)) { CATCH_SET(TRUE); call_body((OP*)&myop, FALSE); @@ -1655,7 +1653,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) ENTER; SAVETMPS; - push_return(PL_op->op_next); + push_return(Nullop); PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp); PUSHEVAL(cx, 0, 0); PL_eval_root = PL_op; /* Only needed so that goto works right. */ diff --git a/pod/perl56delta.pod b/pod/perl56delta.pod index 27cdc224ff..5a824ac8e5 100644 --- a/pod/perl56delta.pod +++ b/pod/perl56delta.pod @@ -10,7 +10,7 @@ This document describes differences between the 5.005 release and this one. =head2 Interpreter cloning, threads, and concurrency -Perl 5.005_63 introduces the beginnings of support for running multiple +Perl 5.6.0 introduces the beginnings of support for running multiple interpreters concurrently in different threads. In conjunction with the perl_clone() API call, which can be used to selectively duplicate the state of any given interpreter, it is possible to compile a @@ -375,7 +375,7 @@ problems associated with it. NOTE: This is currently an experimental feature. Interfaces and implementation are subject to change. -=item Support for CHECK blocks +=head2 Support for CHECK blocks In addition to C<BEGIN>, C<INIT>, C<END>, C<DESTROY> and C<AUTOLOAD>, subroutines named C<CHECK> are now special. These are queued up during @@ -388,7 +388,7 @@ be called directly. For example to match alphabetic characters use /[[:alpha:]]/. See L<perlre> for details. -=item Better pseudo-random number generator +=head2 Better pseudo-random number generator In 5.005_0x and earlier, perl's rand() function used the C library rand(3) function. As of 5.005_52, Configure tests for drand48(), @@ -409,7 +409,7 @@ Thus: now correctly prints "3|a", instead of "2|a". -=item Better worst-case behavior of hashes +=head2 Better worst-case behavior of hashes Small changes in the hashing algorithm have been implemented in order to improve the distribution of lower order bits in the @@ -632,7 +632,7 @@ Diagnostic output now goes to whichever file the C<STDERR> handle is pointing at, instead of always going to the underlying C runtime library's C<stderr>. -=item More consistent close-on-exec behavior +=head2 More consistent close-on-exec behavior On systems that support a close-on-exec flag on filehandles, the flag is now set for any handles created by pipe(), socketpair(), @@ -693,7 +693,7 @@ The variable modified by shmread(), and messages returned by msgrcv() because other untrusted processes can modify messages and shared memory segments for their own nefarious purposes. -=item More functional bareword prototype (*) +=head2 More functional bareword prototype (*) Bareword prototypes have been rationalized to enable them to be used to override builtins that accept barewords and interpret them in @@ -760,6 +760,38 @@ with another number. This behavior must be specifically enabled when running Configure. See F<INSTALL> and F<README.Y2K>. +=head2 Arrays now always interpolate into double-quoted strings + +In double-quoted strings, arrays now interpolate, no matter what. The +behavior in earlier versions of perl 5 was that arrays would interpolate +into strings if the array had been mentioned before the string was +compiled, and otherwise Perl would raise a fatal compile-time error. +In versions 5.000 through 5.003, the error was + + Literal @example now requires backslash + +In versions 5.004_01 through 5.6.0, the error was + + In string, @example now must be written as \@example + +The idea here was to get people into the habit of writing +C<"fred\@example.com"> when they wanted a literal C<@> sign, just as +they have always written C<"Give me back my \$5"> when they wanted a +literal C<$> sign. + +Starting with 5.6.1, when Perl now sees an C<@> sign in a +double-quoted string, it I<always> attempts to interpolate an array, +regardless of whether or not the array has been used or declared +already. The fatal error has been downgraded to an optional warning: + + Possible unintended interpolation of @example in string + +This warns you that C<"fred@example.com"> is going to turn into +C<fred.com> if you don't backslash the C<@>. + +See L<http://www.plover.com/~mjd/perl/at-error.html> for more details +about the history here. + =head1 Modules and Pragmata =head2 Modules @@ -1409,7 +1441,7 @@ eliminating redundant copying overheads. Minor changes in how subroutine calls are handled internally provide marginal improvements in performance. -=item delete(), each(), values() and hash iteration are faster +=head2 delete(), each(), values() and hash iteration are faster The hash values returned by delete(), each(), values() and hashes in a list context are the actual values in the hash, instead of copies. @@ -2298,6 +2330,20 @@ when you meant Remember that "my", "our", and "local" bind tighter than comma. +=item Possible unintended interpolation of %s in string + +(W ambiguous) It used to be that Perl would try to guess whether you +wanted an array interpolated or a literal @. It no longer does this; +arrays are now I<always> interpolated into strings. This means that +if you try something like: + + print "fred@example.com"; + +and the array C<@example> doesn't exist, Perl is going to print +C<fred.com>, which is probably not what you wanted. To get a literal +C<@> sign in a string, put a backslash before it, just as you would +to get a literal C<$> sign. + =item Possible Y2K bug: %s (W y2k) You are concatenating the number 19 with another number, which @@ -2522,7 +2568,7 @@ There is a potential incompatibility in the behavior of list slices that are comprised entirely of undefined values. See L</"Behavior of list slices is more consistent">. -=head2 Format of $English::PERL_VERSION is different +=item Format of $English::PERL_VERSION is different The English module now sets $PERL_VERSION to $^V (a string value) rather than C<$]> (a numeric value). This is a potential incompatibility. @@ -2647,7 +2693,7 @@ a simple scalar or as a reference to a typeglob. See L</"More functional bareword prototype (*)">. -=head2 Semantics of bit operators may have changed on 64-bit platforms +=item Semantics of bit operators may have changed on 64-bit platforms If your platform is either natively 64-bit or if Perl has been configured to used 64-bit integers, i.e., $Config{ivsize} is 8, @@ -2661,7 +2707,7 @@ the excess bits in the result of unary C<~>, e.g., C<~$x & 0xffffffff>. See L</"Bit operators support full native integer width">. -=head2 More builtins taint their results +=item More builtins taint their results As described in L</"Improved security features">, there may be more sources of taint in a Perl program. @@ -2891,6 +2937,18 @@ appear in %ENV. This may be a benign occurrence, as some software packages might directly modify logical name tables and introduce nonstandard names, or it may indicate that a logical name table has been corrupted. +=item In string, @%s now must be written as \@%s + +The description of this error used to say: + + (Someday it will simply assume that an unbackslashed @ + interpolates an array.) + +That day has come, and this fatal error has been removed. It has been +replaced by a non-fatal warning instead. +See L</Arrays now always interpolate into double-quoted strings> for +details. + =item Probable precedence problem on %s (W) The compiler found a bareword where it expected a conditional, diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 58e29515c4..cd467ba8ed 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -165,9 +165,16 @@ the type. May fail on overlapping copies. See also C<Move>. =item croak -This is the XSUB-writer's interface to Perl's C<die> function. Use this -function the same way you use the C C<printf> function. See -C<warn>. +This is the XSUB-writer's interface to Perl's C<die> function. +Normally use this function the same way you use the C C<printf> +function. See C<warn>. + +If you want to throw an exception object, assign the object to +C<$@> and then pass C<Nullch> to croak(): + + errsv = get_sv("@", TRUE); + sv_setsv(errsv, exception_object); + croak(Nullch); void croak(const char* pat, ...) @@ -1597,17 +1604,17 @@ false, defined or undefined. Does not handle 'get' magic. bool SvTRUE(SV* sv) -=item svtype - -An enum of flags for Perl types. These are found in the file B<sv.h> -in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. - =item SvTYPE Returns the type of the SV. See C<svtype>. svtype SvTYPE(SV* sv) +=item svtype + +An enum of flags for Perl types. These are found in the file B<sv.h> +in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. + =item SVt_IV Integer type flag for scalars. See C<svtype>. diff --git a/pod/perldebguts.pod b/pod/perldebguts.pod index 45c33c7ec4..5812a40fcb 100644 --- a/pod/perldebguts.pod +++ b/pod/perldebguts.pod @@ -639,7 +639,7 @@ than 32 bytes (all these examples assume 32-bit architectures, the result are quite a bit worse on 64-bit architectures). If a variable is accessed in two of three different ways (which require an integer, a float, or a string), the memory footprint may increase yet another -20 bytes. A sloppy malloc(3) implementation can make inflate these +20 bytes. A sloppy malloc(3) implementation can inflate these numbers dramatically. On the opposite end of the scale, a declaration like @@ -686,7 +686,7 @@ the following example: Total sbrk(): 215040/47:145. Odd ends: pad+heads+chain+tail: 0+2192+0+6144. It is possible to ask for such a statistic at arbitrary points in -your execution using the mstats() function out of the standard +your execution using the mstat() function out of the standard Devel::Peek module. Here is some explanation of that format: diff --git a/pod/perldebug.pod b/pod/perldebug.pod index c8ef60fa45..bccdcf4f51 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -767,6 +767,11 @@ Breakable lines are marked with C<:>. Lines with breakpoints are marked by C<b> and those with actions by C<a>. The line that's about to be executed is marked by C<< ==> >>. +Please be aware that code in debugger listings may not look the same +as your original source code. Line directives and external source +filters can alter the code before Perl sees it, causing code to move +from its original positions or take on entirely different forms. + =item Frame listing When the C<frame> option is set, the debugger would print entered (and diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 4e67506e26..f24c1d2ad3 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3426,7 +3426,7 @@ Generalized quotes. See L<perlop/"Regexp Quote-Like Operators">. =item quotemeta -Returns the value of EXPR with all non-alphanumeric +Returns the value of EXPR with all non-"word" characters backslashed. (That is, all characters not matching C</[A-Za-z_0-9]/> will be preceded by a backslash in the returned string, regardless of any locale settings.) diff --git a/pod/perlintern.pod b/pod/perlintern.pod index b0aab33e2b..6d8d67dae0 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -12,6 +12,18 @@ B<they are not for use in extensions>! =over 8 +=item is_gv_magical + +Returns C<TRUE> if given the name of a magical GV. + +Currently only useful internally when determining if a GV should be +created even in rvalue contexts. + +C<flags> is not used at present but available for future extension to +allow selecting particular classes of magical variable. + + bool is_gv_magical(char *name, STRLEN len, U32 flags) + =back =head1 AUTHORS diff --git a/pod/perlre.pod b/pod/perlre.pod index 2db4139c30..a82ab32b73 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -169,7 +169,7 @@ You'll need to write something like C<m/\Quser\E\@\Qhost/>. In addition, Perl defines the following: \w Match a "word" character (alphanumeric plus "_") - \W Match a non-word character + \W Match a non-"word" character \s Match a whitespace character \S Match a non-whitespace character \d Match a digit character @@ -180,7 +180,7 @@ In addition, Perl defines the following: equivalent to C<(?:\PM\pM*)> \C Match a single C char (octet) even under utf8. -A C<\w> matches a single alphanumeric character, not a whole word. +A C<\w> matches a single alphanumeric character or C<_>, not a whole word. Use C<\w+> to match a string of Perl-identifier characters (which isn't the same as matching an English word). If C<use locale> is in effect, the list of alphabetic characters generated by C<\w> is taken from the @@ -377,7 +377,7 @@ that looks like \\, \(, \), \<, \>, \{, or \} is always interpreted as a literal character, not a metacharacter. This was once used in a common idiom to disable or quote the special meanings of regular expression metacharacters in a string that you want to -use for a pattern. Simply quote all non-alphanumeric characters: +use for a pattern. Simply quote all non-"word" characters: $pattern =~ s/(\W)/\\$1/g; diff --git a/pod/perlretut.pod b/pod/perlretut.pod index 5ff4298012..66f8179ab6 100644 --- a/pod/perlretut.pod +++ b/pod/perlretut.pod @@ -344,7 +344,7 @@ become the svelte C<[0-9]> and C<[a-z]>. Some examples are /[0-9bx-z]aa/; # matches '0aa', ..., '9aa', # 'baa', 'xaa', 'yaa', or 'zaa' /[0-9a-fA-F]/; # matches a hexadecimal digit - /[0-9a-zA-Z_]/; # matches an alphanumeric character, + /[0-9a-zA-Z_]/; # matches a "word" character, # like those in a perl variable name If C<'-'> is the first or last character in a character class, it is diff --git a/pod/perlsub.pod b/pod/perlsub.pod index f1b87923ef..f45f5494f6 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -357,7 +357,7 @@ A compilation error results otherwise. An inner block may countermand this with C<no strict 'vars'>. A C<my> has both a compile-time and a run-time effect. At compile -time, the compiler takes notice of it. The principle usefulness +time, the compiler takes notice of it. The principal usefulness of this is to quiet C<use strict 'vars'>, but it is also essential for generation of closures as detailed in L<perlref>. Actual initialization is delayed until run time, though, so it gets executed diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index dfded2ecde..a65b4cd263 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -598,6 +598,11 @@ C</^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/> with C<$1> being the line number for the next line, and C<$2> being the optional filename (specified within quotes). +There is a fairly obvious gotcha included with the line directive: +Debuggers and profilers will only show the last source line to appear +at a particular line number in a given file. Care should be taken not +to cause line number collisions in code you'd like to debug later. + Here are some examples that you should be able to type into your command shell: diff --git a/pod/perltie.pod b/pod/perltie.pod index 95de3bb928..49bf98999c 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -260,6 +260,10 @@ index whose value we're trying to fetch. return $self->{ARRAY}[$idx]; } +If a negative array index is used to read from an array, the index +will be translated to a positive one internally by calling FETCHSIZE +before being passed to FETCH. + As you may have noticed, the name of the FETCH method (et al.) is the same for all accesses, even though the constructors differ in names (TIESCALAR vs TIEARRAY). While in theory you could have the same class servicing @@ -281,6 +285,8 @@ there. For example: } return $self->{ARRAY}[$idx] = $value; } + +Negative indexes are treated the same as with FETCH. =item DESTROY this diff --git a/pod/perltrap.pod b/pod/perltrap.pod index c477272abe..3f54edef2b 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -1296,7 +1296,8 @@ within certain expressions, statements, contexts, or whatever. print "To: someone@somewhere.com\n"; # perl4 prints: To:someone@somewhere.com - # perl5 errors : In string, @somewhere now must be written as \@somewhere + # perl < 5.6.1, error : In string, @somewhere now must be written as \@somewhere + # perl >= 5.6.1, warning : Possible unintended interpolation of @somewhere in string =item * Interpolation diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 4756a9edbb..347b46e4f5 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -5,8 +5,8 @@ perlXStut - Tutorial for writing XSUBs =head1 DESCRIPTION This tutorial will educate the reader on the steps involved in creating -a Perl extension. The reader is assumed to have access to L<perlguts> and -L<perlxs>. +a Perl extension. The reader is assumed to have access to L<perlguts>, +L<perlapi> and L<perlxs>. This tutorial starts with very simple examples and becomes more complex, with each new example adding new features. Certain concepts may not be @@ -187,7 +187,8 @@ been deleted): Manifying ./blib/man3/Mytest.3 % -You can safely ignore the line about "prototyping behavior". +You can safely ignore the line about "prototyping behavior" - it is +explained in the section "The PROTOTYPES: Keyword" in L<perlxs>. If you are on a Win32 system, and the build process fails with linker errors for functions in the C library, check if your Perl is configured @@ -1056,9 +1057,143 @@ the stack is I<always> large enough to take one return value. =back -=head2 EXAMPLE 6 (Coming Soon) +=head2 EXAMPLE 6 -Passing in and returning references to arrays and/or hashes +In this example, we will accept a reference to an array as an input +parameter, and return a reference to an array of hashes. This will +demonstrate manipulation of complex Perl data types from an XSUB. + +This extension is somewhat contrived. It is based on the code in +the previous example. It calls the statfs function multiple times, +accepting a reference to an array of filenames as input, and returning +a reference to an array of hashes containing the data for each of the +filesystems. + +Return to the Mytest directory and add the following code to the end of +Mytest.xs: + + SV * + multi_statfs(paths) + SV * paths + INIT: + AV * results; + I32 numpaths = 0; + int i, n; + struct statfs buf; + + if ((!SvROK(paths)) + || (SvTYPE(SvRV(paths)) != SVt_PVAV) + || ((numpaths = av_len((AV *)SvRV(paths))) < 0)) + { + XSRETURN_UNDEF; + } + results = (AV *)sv_2mortal((SV *)newAV()); + CODE: + for (n = 0; n <= numpaths; n++) { + HV * rh; + STRLEN l; + char * fn = SvPV(*av_fetch((AV *)SvRV(paths), n, 0), l); + + i = statfs(fn, &buf); + if (i != 0) { + av_push(results, newSVnv(errno)); + continue; + } + + rh = (HV *)sv_2mortal((SV *)newHV()); + + hv_store(rh, "f_bavail", 8, newSVnv(buf.f_bavail), 0); + hv_store(rh, "f_bfree", 7, newSVnv(buf.f_bfree), 0); + hv_store(rh, "f_blocks", 8, newSVnv(buf.f_blocks), 0); + hv_store(rh, "f_bsize", 7, newSVnv(buf.f_bsize), 0); + hv_store(rh, "f_ffree", 7, newSVnv(buf.f_ffree), 0); + hv_store(rh, "f_files", 7, newSVnv(buf.f_files), 0); + hv_store(rh, "f_type", 6, newSVnv(buf.f_type), 0); + + av_push(results, newRV((SV *)rh)); + } + RETVAL = newRV((SV *)results); + OUTPUT: + RETVAL + +And add the following code to test.pl, while incrementing the "1..11" +string in the BEGIN block to "1..13": + + $results = Mytest::multi_statfs([ '/', '/blech' ]); + print ((ref $results->[0]) ? "ok 12\n" : "not ok 12\n"); + print ((! ref $results->[1]) ? "ok 13\n" : "not ok 13\n"); + +=head2 New Things in this Example + +There are a number of new concepts introduced here, described below: + +=over 4 + +=item * + +This function does not use a typemap. Instead, we declare it as accepting +one SV* (scalar) parameter, and returning an SV* value, and we take care of +populating these scalars within the code. Because we are only returning +one value, we don't need a C<PPCODE:> directive - instead, we use C<CODE:> +and C<OUTPUT:> directives. + +=item * + +When dealing with references, it is important to handle them with caution. +The C<INIT:> block first checks that +C<SvROK> returns true, which indicates that paths is a valid reference. It +then verifies that the object referenced by paths is an array, using C<SvRV> +to dereference paths, and C<SvTYPE> to discover its type. As an added test, +it checks that the array referenced by paths is non-empty, using the C<av_len> +function (which returns -1 if the array is empty). The XSRETURN_UNDEF macro +is used to abort the XSUB and return the undefined value whenever all three of +these conditions are not met. + +=item * + +We manipulate several arrays in this XSUB. Note that an array is represented +internally by an AV* pointer. The functions and macros for manipulating +arrays are similar to the functions in Perl: C<av_len> returns the highest +index in an AV*, much like $#array; C<av_fetch> fetches a single scalar value +from an array, given its index; C<av_push> pushes a scalar value onto the +end of the array, automatically extending the array as necessary. + +Specifically, we read pathnames one at a time from the input array, and +store the results in an output array (results) in the same order. If +statfs fails, the element pushed onto the return array is the value of +errno after the failure. If statfs succeeds, though, the value pushed +onto the return array is a reference to a hash containing some of the +information in the statfs structure. + +As with the return stack, it would be possible (and a small performance win) +to pre-extend the return array before pushing data into it, since we know +how many elements we will return: + + av_extend(results, numpaths); + +=item * + +We are performing only one hash operation in this function, which is storing +a new scalar under a key using C<hv_store>. A hash is represented by an HV* +pointer. Like arrays, the functions for manipulating hashes from an XSUB +mirror the functionality available from Perl. See L<perlguts> and L<perlapi> +for details. + +=item * + +To create a reference, we use the C<newRV> function. Note that you can +cast an AV* or an HV* to type SV* in this case (and many others). This +allows you to take references to arrays, hashes and scalars with the same +function. Conversely, the C<SvRV> function always returns an SV*, which may +need to be be cast to the appropriate type if it is something other than a +scalar (check with C<SvTYPE>). + +=item * + +At this point, xsubpp is doing very little work - the differences between +Mytest.xs and Mytest.c are minimal. + +=back =head2 EXAMPLE 7 (Coming Soon) @@ -1112,7 +1247,7 @@ Some systems may have installed Perl version 5 as "perl5". =head1 See also -For more information, consult L<perlguts>, L<perlxs>, L<perlmod>, +For more information, consult L<perlguts>, L<perlapi>, L<perlxs>, L<perlmod>, and L<perlpod>. =head1 Author @@ -198,7 +198,7 @@ PP(pp_rv2gv) else { if (SvTYPE(sv) != SVt_PVGV) { char *sym; - STRLEN n_a; + STRLEN len; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -236,13 +236,17 @@ PP(pp_rv2gv) report_uninit(); RETSETUNDEF; } - sym = SvPV(sv, n_a); + sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV); - if (!sv) + if (!sv + && (!is_gv_magical(sym,len,0) + || !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -276,7 +280,7 @@ PP(pp_rv2sv) else { GV *gv = (GV*)sv; char *sym; - STRLEN n_a; + STRLEN len; if (SvTYPE(gv) != SVt_PVGV) { if (SvGMAGICAL(sv)) { @@ -292,13 +296,17 @@ PP(pp_rv2sv) report_uninit(); RETSETUNDEF; } - sym = SvPV(sv, n_a); + sym = SvPV(sv, len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV); - if (!gv) + if (!gv + && (!is_gv_magical(sym,len,0) + || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -1571,9 +1571,12 @@ PP(pp_caller) { SV * mask ; SV * old_warnings = cx->blk_oldcop->cop_warnings ; - if (old_warnings == pWARN_NONE || old_warnings == pWARN_STD) + + if (old_warnings == pWARN_NONE || + (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0)) mask = newSVpvn(WARN_NONEstring, WARNsize) ; - else if (old_warnings == pWARN_ALL) + else if (old_warnings == pWARN_ALL || + (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) mask = newSVpvn(WARN_ALLstring, WARNsize) ; else mask = newSVsv(old_warnings); @@ -462,7 +462,7 @@ PP(pp_rv2av) if (SvTYPE(sv) != SVt_PVGV) { char *sym; - STRLEN n_a; + STRLEN len; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -481,13 +481,17 @@ PP(pp_rv2av) } RETSETUNDEF; } - sym = SvPV(sv,n_a); + sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV); - if (!gv) + if (!gv + && (!is_gv_magical(sym,len,0) + || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -562,7 +566,7 @@ PP(pp_rv2hv) if (SvTYPE(sv) != SVt_PVGV) { char *sym; - STRLEN n_a; + STRLEN len; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -581,13 +585,17 @@ PP(pp_rv2hv) } RETSETUNDEF; } - sym = SvPV(sv,n_a); + sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV); - if (!gv) + if (!gv + && (!is_gv_magical(sym,len,0) + || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV)))) + { RETSETUNDEF; + } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -331,6 +331,7 @@ PERL_CALLCONV U32 Perl_intro_my(pTHX); PERL_CALLCONV char* Perl_instr(pTHX_ const char* big, const char* little); PERL_CALLCONV bool Perl_io_close(pTHX_ IO* io, bool not_implicit); PERL_CALLCONV OP* Perl_invert(pTHX_ OP* cmd); +PERL_CALLCONV bool Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags); PERL_CALLCONV bool Perl_is_uni_alnum(pTHX_ U32 c); PERL_CALLCONV bool Perl_is_uni_alnumc(pTHX_ U32 c); PERL_CALLCONV bool Perl_is_uni_idfirst(pTHX_ U32 c); diff --git a/t/base/lex.t b/t/base/lex.t index d90d404cac..c7fb0e4cf3 100755 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -1,6 +1,6 @@ #!./perl -print "1..46\n"; +print "1..51\n"; $x = 'x'; @@ -206,3 +206,42 @@ EOT print "# $@\nnot ok $test\n" if $@; T '^main:plink:53$', $test++; } + +# tests 47--51 start here +# tests for new array interpolation semantics: +# arrays now *always* interpolate into "..." strings. +# 20000522 MJD (mjd@plover.com) +{ + my $test = 47; + eval(q(">@nosuch<" eq "><")) || print "# $@", "not "; + print "ok $test\n"; + ++$test; + + # Look at this! This is going to be a common error in the future: + eval(q("fred@example.com" eq "fred.com")) || print "# $@", "not "; + print "ok $test\n"; + ++$test; + + # Let's make sure that normal array interpolation still works right + # For some reason, this appears not to be tested anywhere else. + my @a = (1,2,3); + print +((">@a<" eq ">1 2 3<") ? '' : 'not '), "ok $test\n"; + ++$test; + + # Ditto. + eval(q{@nosuch = ('a', 'b', 'c'); ">@nosuch<" eq ">a b c<"}) + || print "# $@", "not "; + print "ok $test\n"; + ++$test; + + # This isn't actually a lex test, but it's testing the same feature + sub makearray { + my @array = ('fish', 'dog', 'carrot'); + *R::crackers = \@array; + } + + eval(q{makearray(); ">@R::crackers<" eq ">fish dog carrot<"}) + || print "# $@", "not "; + print "ok $test\n"; + ++$test; +} @@ -11,7 +11,7 @@ BEGIN { use warnings; -print "1..30\n"; +print "1..40\n"; # type coersion on assignment $foo = 'foo'; @@ -128,6 +128,42 @@ print {*x{FILEHANDLE}} "ok 23\n"; ++$test; &{$a}; } +# although it *should* if you're talking about magicals + +{ + my $test = 29; + + my $a = "]"; + print "not " unless defined ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; + + $a = "1"; + "o" =~ /(o)/; + print "not " unless ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; + $a = "2"; + print "not " if ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; + $a = "1x"; + print "not " if defined ${$a}; + ++$test; print "ok $test\n"; + print "not " if defined *{$a}; + ++$test; print "ok $test\n"; + $a = "11"; + "o" =~ /(((((((((((o)))))))))))/; + print "not " unless ${$a}; + ++$test; print "ok $test\n"; + print "not " unless defined *{$a}; + ++$test; print "ok $test\n"; +} + + # does pp_readline() handle glob-ness correctly? { @@ -137,4 +173,4 @@ print {*x{FILEHANDLE}} "ok 23\n"; } __END__ -ok 30 +ok 40 diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index 836cdba4cc..f3f205e746 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -173,7 +173,7 @@ EOE __END__ ref $xref # ref ref $cstr # ref nonref -`$runme -e "print qq[1\n]"` # backtick skip(MSWin32) +`$runme -e "print qq[1\\n]"` # backtick skip(MSWin32) `$undefed` # backtick undef skip(MSWin32) <*> # glob <OP> # readline diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars index 2ccfef7105..5ba579d969 100644 --- a/t/pragma/strict-vars +++ b/t/pragma/strict-vars @@ -387,6 +387,8 @@ EXPECT # multiple our declarations in same scope, same package, warning use strict 'vars'; use warnings; +{ our $x = 1 } +{ our $x = 0 } our $foo; { our $foo; @@ -394,6 +396,17 @@ our $foo; our $foo; } EXPECT -"our" variable $foo redeclared at - line 7. +"our" variable $foo redeclared at - line 9. (Did you mean "local" instead of "our"?) -Name "Foo::foo" used only once: possible typo at - line 9. +Name "Foo::foo" used only once: possible typo at - line 11. +######## + +# Make sure the strict vars failure still occurs +# now that the `@i should be written as \@i' failure does not occur +# 20000522 mjd@plover.com (MJD) +use strict 'vars'; +no warnings; +"@i_like_crackers"; +EXPECT +Global symbol "@i_like_crackers" requires explicit package name at - line 7. +Execution of - aborted due to compilation errors. diff --git a/t/pragma/strict.t b/t/pragma/strict.t index c4d64164e6..167b3604f5 100755 --- a/t/pragma/strict.t +++ b/t/pragma/strict.t @@ -19,7 +19,7 @@ my @prgs = () ; foreach (sort glob("pragma/strict-*")) { - next if /(~|\.orig)$/; + next if /(~|\.orig|,v)$/; open F, "<$_" or die "Cannot open $_: $!\n" ; while (<F>) { diff --git a/t/pragma/warn/9enabled b/t/pragma/warn/9enabled index 55642ffadf..96f319e55d 100755 --- a/t/pragma/warn/9enabled +++ b/t/pragma/warn/9enabled @@ -817,3 +817,87 @@ abc all not enabled def self enabled def abc not enabled def all not enabled +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if warnings::enabled("io") ; + print "ok3\n" if warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +BEGIN { $^W = 1 ; } +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +$^W = 1 ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke index 8db8027767..64f5368588 100644 --- a/t/pragma/warn/toke +++ b/t/pragma/warn/toke @@ -585,3 +585,11 @@ EXPECT Integer overflow in binary number at - line 5. Integer overflow in hexadecimal number at - line 8. Integer overflow in octal number at - line 11. +######## +# toke.c +use warnings 'ambiguous'; +"@mjd_previously_unused_array"; +no warnings 'ambiguous'; +"@mjd_previously_unused_array"; +EXPECT +Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3. diff --git a/t/pragma/warnings.t b/t/pragma/warnings.t index 71fb0df972..a551740b17 100644 --- a/t/pragma/warnings.t +++ b/t/pragma/warnings.t @@ -26,9 +26,7 @@ else foreach (@w_files) { - next if /\.orig$/ ; - - next if /(~|\.orig)$/; + next if /(~|\.orig|,v)$/; open F, "<$_" or die "Cannot open $_: $!\n" ; while (<F>) { @@ -2149,9 +2149,14 @@ Perl_yylex(pTHX) */ if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) { GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV); - if (!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) - yyerror(Perl_form(aTHX_ "In string, %s now must be written as \\%s", - PL_tokenbuf, PL_tokenbuf)); + if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) + && ckWARN(WARN_AMBIGUOUS)) + { + /* Downgraded from fatal to warning 20000522 mjd */ + Perl_warner(aTHX_ WARN_AMBIGUOUS, + "Possible unintended interpolation of %s in string", + PL_tokenbuf); + } } /* build ops for a bareword */ @@ -1580,14 +1580,20 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) SV *msv; STRLEN msglen; - msv = vmess(pat, args); - if (PL_errors && SvCUR(PL_errors)) { - sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, msglen); - SvCUR_set(PL_errors, 0); + if (pat) { + msv = vmess(pat, args); + if (PL_errors && SvCUR(PL_errors)) { + sv_catsv(PL_errors, msv); + message = SvPV(PL_errors, msglen); + SvCUR_set(PL_errors, 0); + } + else + message = SvPV(msv,msglen); + } + else { + message = Nullch; + msglen = 0; } - else - message = SvPV(msv,msglen); DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message)); @@ -1606,9 +1612,14 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) ENTER; save_re_context(); - msg = newSVpvn(message, msglen); - SvREADONLY_on(msg); - SAVEFREESV(msg); + if (message) { + msg = newSVpvn(message, msglen); + SvREADONLY_on(msg); + SAVEFREESV(msg); + } + else { + msg = ERRSV; + } PUSHSTACKi(PERLSI_DIEHOOK); PUSHMARK(SP); @@ -1655,9 +1666,16 @@ Perl_croak_nocontext(const char *pat, ...) /* =for apidoc croak -This is the XSUB-writer's interface to Perl's C<die> function. Use this -function the same way you use the C C<printf> function. See -C<warn>. +This is the XSUB-writer's interface to Perl's C<die> function. +Normally use this function the same way you use the C C<printf> +function. See C<warn>. + +If you want to throw an exception object, assign the object to +C<$@> and then pass C<Nullch> to croak(): + + errsv = get_sv("@", TRUE); + sv_setsv(errsv, exception_object); + croak(Nullch); =cut */ diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm index 2fc48530c0..c51863a4f3 100644 --- a/vms/ext/vmsish.pm +++ b/vms/ext/vmsish.pm @@ -44,12 +44,12 @@ default of Universal Time (a.k.a Greenwich Mean Time, or GMT). =item C<vmsish hushed> -This supresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR +This suppresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR if Perl terminates with an error status. This primarily effects error -exits from things like compiler errors or "standard Perl" runtime errors, +exits from things like Perl compiler errors or "standard Perl" runtime errors, where text error messages are also generated by Perl. -The error exits from inside VMS.C are generally more serious, and are +The error exits from inside the core are generally more serious, and are not supressed. =back diff --git a/vms/ext/vmsish.t b/vms/ext/vmsish.t index 2a5b580bda..d63da57235 100644 --- a/vms/ext/vmsish.t +++ b/vms/ext/vmsish.t @@ -136,6 +136,7 @@ sub do_a_perl { local *P; open(P,'>vmsish_test.com') || die('not ok ?? : unable to open "vmsish_test.com" for writing'); print P "\$ set message/facil/sever/ident/text\n"; + print P "\$ define/nolog/user sys\$error _nla0:\n"; print P "\$ $Invoke_Perl @_\n"; close P; my $x = `\@vmsish_test.com`; diff --git a/vms/test.com b/vms/test.com index bda5f7d07e..4f345cec0e 100644 --- a/vms/test.com +++ b/vms/test.com @@ -41,7 +41,7 @@ $ if p2.nes."" then dbg = "dbg" $ if p2.nes."" then ndbg = "ndbg" $! $! Pick up a copy of perl to use for the tests -$ Delete/Log/NoConfirm Perl.;* +$ If F$Search("Perl.").nes."" Then Delete/Log/NoConfirm Perl.;* $ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl. $ $! Make the environment look a little friendlier to tests which assume Unix @@ -93,7 +93,7 @@ $ $! And do it $ Show Process/Accounting $ testdir = "Directory/NoHead/NoTrail/Column=1" -$ Define/User 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe' +$ Define 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe' $ MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'" $ Deck/Dollar=$$END-OF-TEST$$ # $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $ @@ -240,6 +240,7 @@ print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n", $user,$sys,$cuser,$csys,$files,$totmax); $$END-OF-TEST$$ $ wrapup: +$ deassign 'dbg'Perlshr $ Show Process/Accounting $ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;* $ Set Default &olddef @@ -732,8 +732,7 @@ my_crypt(const char *textpasswd, const char *usrname) usrdsc.dsc$a_pointer = usrname; if (!((sts = sys$getuai(0, 0, &usrdsc, uailst, 0, 0, 0)) & 1)) { switch (sts) { - case SS$_NOGRPPRV: - case SS$_NOSYSPRV: + case SS$_NOGRPPRV: case SS$_NOSYSPRV: set_errno(EACCES); break; case RMS$_RNF: @@ -832,15 +831,13 @@ kill_file(char *name) newace.myace$l_ident = oldace.myace$l_ident; if (!((aclsts = sys$change_acl(0,&type,&fildsc,lcklst,0,0,0)) & 1)) { switch (aclsts) { - case RMS$_FNF: - case RMS$_DNF: - case RMS$_DIR: - case SS$_NOSUCHOBJECT: + case RMS$_FNF: case RMS$_DNF: case SS$_NOSUCHOBJECT: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; - case RMS$_SYN: - case SS$_INVFILFOROP: + case RMS$_SYN: case SS$_INVFILFOROP: set_errno(EINVAL); break; case RMS$_PRV: set_errno(EACCES); break; @@ -897,6 +894,9 @@ my_mkdir(char *dir, Mode_t mode) STRLEN dirlen = strlen(dir); dTHX; + /* zero length string sometimes gives ACCVIO */ + if (dirlen == 0) return -1; + /* CRTL mkdir() doesn't tolerate trailing /, since that implies * null file name/type. However, it's commonplace under Unix, * so we'll allow it for a gain in portability. @@ -1340,8 +1340,7 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) retsts = sys$parse(&myfab,0,0); if (!(retsts & 1)) { mynam.nam$b_nop |= NAM$M_SYNCHK; - if (retsts == RMS$_DNF || retsts == RMS$_DIR || - retsts == RMS$_DEV || retsts == RMS$_DEV) { + if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV) { retsts = sys$parse(&myfab,0,0); if (retsts & 1) goto expanded; } @@ -1484,7 +1483,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL; } dirlen = strlen(dir); - while (dir[dirlen-1] == '/') --dirlen; + while (dirlen && dir[dirlen-1] == '/') --dirlen; if (!dirlen) { /* We had Unixish '/' -- substitute top of current tree */ strcpy(trndir,"/sys$disk/000000"); dir = trndir; @@ -1510,7 +1509,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) * ... do_fileify_dirspec("myroot",buf,1) ... * does something useful. */ - if (!strcmp(dir+dirlen-2,".]")) { + if (dirlen >= 2 && !strcmp(dir+dirlen-2,".]")) { dir[--dirlen] = '\0'; dir[dirlen-1] = ']'; } @@ -1540,7 +1539,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) (dir[2] == '\0' || (dir[2] == '/' && dir[3] == '\0'))) return do_fileify_dirspec("[-]",buf,ts); } - if (dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */ + if (dirlen && dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */ dirlen -= 1; /* to last element */ lastdir = strrchr(dir,'/'); } @@ -1567,7 +1566,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } while ((cp1 = strstr(cp1,"/.")) != NULL); lastdir = strrchr(dir,'/'); } - else if (!strcmp(&dir[dirlen-7],"/000000")) { + else if (dirlen >= 7 && !strcmp(&dir[dirlen-7],"/000000")) { /* Ditto for specs that end in an MFD -- let the VMS code * figure out whether it's a real device or a rooted logical. */ dir[dirlen] = '/'; dir[dirlen+1] = '\0'; @@ -2687,14 +2686,13 @@ unsigned long int zero = 0, sts; set_vaxc_errno(sts); switch (sts) { - case RMS$_FNF: - case RMS$_DNF: - case RMS$_DIR: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; - case RMS$_FNM: - case RMS$_SYN: + case RMS$_FNM: case RMS$_SYN: set_errno(EINVAL); break; case RMS$_PRV: set_errno(EACCES); break; @@ -3264,7 +3262,8 @@ readdir(DIR *dd) case RMS$_DEV: set_errno(ENODEV); break; case RMS$_DIR: - case RMS$_FNF: + set_errno(ENOTDIR); break; + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; default: set_errno(EVMSERR); @@ -3604,10 +3603,12 @@ vms_do_exec(char *cmd) retsts = lib$do_command(&VMScmd); switch (retsts) { - case RMS$_FNF: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; - case RMS$_DNF: case RMS$_DIR: case RMS$_DEV: + case RMS$_DIR: set_errno(ENOTDIR); break; + case RMS$_DEV: + set_errno(ENODEV); break; case RMS$_PRV: set_errno(EACCES); break; case RMS$_SYN: @@ -3664,10 +3665,12 @@ do_spawn(char *cmd) if (!(sts & 1)) { switch (sts) { - case RMS$_FNF: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; - case RMS$_DNF: case RMS$_DIR: case RMS$_DEV: + case RMS$_DIR: set_errno(ENOTDIR); break; + case RMS$_DEV: + set_errno(ENODEV); break; case RMS$_PRV: set_errno(EACCES); break; case RMS$_SYN: @@ -4645,26 +4648,14 @@ cando_by_name(I32 bit, Uid_t effective, char *fname) } switch (bit) { - case S_IXUSR: - case S_IXGRP: - case S_IXOTH: - access = ARM$M_EXECUTE; - break; - case S_IRUSR: - case S_IRGRP: - case S_IROTH: - access = ARM$M_READ; - break; - case S_IWUSR: - case S_IWGRP: - case S_IWOTH: - access = ARM$M_WRITE; - break; - case S_IDUSR: - case S_IDGRP: - case S_IDOTH: - access = ARM$M_DELETE; - break; + case S_IXUSR: case S_IXGRP: case S_IXOTH: + access = ARM$M_EXECUTE; break; + case S_IRUSR: case S_IRGRP: case S_IROTH: + access = ARM$M_READ; break; + case S_IWUSR: case S_IWGRP: case S_IWOTH: + access = ARM$M_WRITE; break; + case S_IDUSR: case S_IDGRP: case S_IDOTH: + access = ARM$M_DELETE; break; default: return FALSE; } @@ -4695,6 +4686,12 @@ cando_by_name(I32 bit, Uid_t effective, char *fname) if (retsts == SS$_ACCONFLICT) { return TRUE; } + +#if defined(__ALPHA) && defined(__VMS_VER) && __VMS_VER == 70100022 && defined(__DECC_VER) && __DECC_VER == 6009001 + /* XXX Hideous kluge to accomodate error in specific version of RTL; + we hope it'll be buried soon */ + if (retsts == 114762) return TRUE; +#endif _ckvmssts(retsts); return FALSE; /* Should never get here */ @@ -4885,9 +4882,10 @@ rmscopy(char *spec_in, char *spec_out, int preserve_dates) if (!((sts = sys$open(&fab_in)) & 1)) { set_vaxc_errno(sts); switch (sts) { - case RMS$_FNF: - case RMS$_DIR: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; case RMS$_SYN: @@ -4929,8 +4927,10 @@ rmscopy(char *spec_in, char *spec_out, int preserve_dates) if (!((sts = sys$create(&fab_out)) & 1)) { set_vaxc_errno(sts); switch (sts) { - case RMS$_DIR: + case RMS$_DNF: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; case RMS$_SYN: diff --git a/vms/vmsish.h b/vms/vmsish.h index c21f8f329e..a181e7c3d9 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -254,6 +254,8 @@ #ifdef VMS_DO_SOCKETS #include "sockadapt.h" +#define PERL_SOCK_SYSREAD_IS_RECV +#define PERL_SOCK_SYSWRITE_IS_SEND #endif #define BIT_BUCKET "_NLA0:" |