diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/Encode/Encode.pm | 6 | ||||
| -rw-r--r-- | ext/Encode/Encode.xs | 11 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Scalar.xs | 1 | ||||
| -rw-r--r-- | perl.c | 8 | ||||
| -rw-r--r-- | perlio.c | 58 | ||||
| -rw-r--r-- | perlio.h | 2 | ||||
| -rw-r--r-- | perliol.h | 1 | ||||
| -rw-r--r-- | pod/perlmodlib.pod | 61 | ||||
| -rw-r--r--[-rwxr-xr-x] | t/lib/mimeqp.t | 0 | ||||
| -rw-r--r-- | t/lib/tie-refhash.t | 42 |
11 files changed, 110 insertions, 81 deletions
@@ -1205,7 +1205,6 @@ os2/dl_os2.c Addon for dl_open os2/dlfcn.h Addon for dl_open os2/os2.c Additional code for OS/2 os2/os2.sym Additional symbols to export -os2/os2add.sym Overriding symbols to export os2/os2ish.h Header for OS/2 os2/os2thread.h pthread-like typedefs os2/perl2cmd.pl Corrects installed binaries under OS/2 diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index fd85520311..650180647b 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -273,7 +273,7 @@ use base 'Encode::Encoding'; # Encoding is 16-bit network order Unicode (no surogates) # Used for X font encodings -__PACKAGE__->Define(qw(UCS-2 iso10646-1)); +__PACKAGE__->Define(qw(UCS-2 iso-10646-1)); sub decode { @@ -285,7 +285,7 @@ sub decode $uni .= chr($code); } $_[1] = $str if $chk; - Encode::utf8_upgrade($uni); + utf8::upgrade($uni); return $uni; } @@ -586,7 +586,7 @@ UTF-16 is similar to UCS-2, 16 bit or 2-byte chunks. UCS-2 can only represent 0..0xFFFF, while UTF-16 has a "surogate pair" scheme which allows it to cover the whole Unicode range. -Encode implements big-endian UCS-2 aliased to "iso10646-1" as that +Encode implements big-endian UCS-2 aliased to "iso-10646-1" as that happens to be the name used by that representation when used with X11 fonts. UTF-32 or UCS-4 is 32-bit or 4-byte chunks. Perl's logical characters diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index 74303c9389..13ba7045c4 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -219,9 +219,11 @@ PerlIOEncode_flush(PerlIO *f) { PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode); IV code = 0; - dTHX; - if (e->bufsv && (PerlIOBase(f)->flags & (PERLIO_F_RDBUF|PERLIO_F_WRBUF))) + if (e->bufsv && (PerlIOBase(f)->flags & (PERLIO_F_RDBUF|PERLIO_F_WRBUF)) + &&(e->base.ptr > e->base.buf) + ) { + dTHX; dSP; SV *str; char *s; @@ -452,6 +454,11 @@ encode_method(pTHX_ encode_t *enc, encpage_t *dir, SV *src, int check) SvCUR_set(src,SvCUR(src)-slen); } } + else + { + SvCUR_set(dst,slen); + SvPOK_on(dst); + } return dst; } diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index 650cc5a67a..7a01ec696c 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -124,6 +124,7 @@ PerlIOScalar_get_base(PerlIO *f) dTHX; return (STDCHAR *)SvPV_nolen(s->var); } + return (STDCHAR *) Nullch; } STDCHAR * @@ -395,6 +395,7 @@ perl_destruct(pTHXx) LEAVE; FREETMPS; + /* We must account for everything. */ /* Destroy the main CV and syntax tree */ @@ -409,6 +410,13 @@ perl_destruct(pTHXx) PL_main_cv = Nullcv; PL_dirty = TRUE; + /* Tell PerlIO we are about to tear things apart in case + we have layers which are using resources that should + be cleaned up now. + */ + + PerlIO_destruct(aTHX); + if (PL_sv_objcount) { /* * Try to destruct global references. We do this first so that the @@ -93,6 +93,11 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) return -1; } +void +PerlIO_destruct(pTHX) +{ +} + int PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names) { @@ -313,6 +318,37 @@ PerlIO_cleanup() } void +PerlIO_destruct(pTHX) +{ + PerlIO **table = &_perlio; + PerlIO *f; + while ((f = *table)) + { + int i; + table = (PerlIO **)(f++); + for (i=1; i < PERLIO_TABLE_SIZE; i++) + { + PerlIO *x = f; + PerlIOl *l; + while ((l = *x)) + { + if (l->tab->kind & PERLIO_K_DESTRUCT) + { + PerlIO_debug("Destruct popping %s\n",l->tab->name); + PerlIO_flush(x); + PerlIO_pop(aTHX_ x); + } + else + { + x = PerlIONext(x); + } + } + f++; + } + } +} + +void PerlIO_pop(pTHX_ PerlIO *f) { PerlIOl *l = *f; @@ -888,11 +924,11 @@ PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **a PerlIO_stdstreams(aTHX); if (narg) { - if (SvROK(*args)) + if (SvROK(*args) && !sv_isobject(*args)) { - if (sv_isobject(*args)) + if (SvTYPE(SvRV(*args)) < SVt_PVAV) { - SV *handler = PerlIO_find_layer(aTHX_ "object",6); + SV *handler = PerlIO_find_layer(aTHX_ "Scalar",6); if (handler) { def = newAV(); @@ -903,21 +939,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **a } else { - if (SvTYPE(SvRV(*args)) < SVt_PVAV) - { - SV *handler = PerlIO_find_layer(aTHX_ "Scalar",6); - if (handler) - { - def = newAV(); - av_push(def,handler); - av_push(def,&PL_sv_undef); - incdef = 0; - } - } - else - { - Perl_croak(aTHX_ "Unsupported reference arg to open()"); - } + Perl_croak(aTHX_ "Unsupported reference arg to open()"); } } } @@ -327,6 +327,8 @@ extern int PerlIO_apply_layers (pTHX_ PerlIO *f, const char *mode, const char *n extern int PerlIO_binmode (pTHX_ PerlIO *f, int iotype, int omode, const char *names); #endif +extern void PerlIO_destruct(pTHX); + #ifndef PERLIO_IS_STDIO extern void PerlIO_cleanup(void); @@ -46,6 +46,7 @@ struct _PerlIO_funcs #define PERLIO_K_FASTGETS 0x00000008 #define PERLIO_K_DUMMY 0x00000010 #define PERLIO_K_UTF8 0x00008000 +#define PERLIO_K_DESTRUCT 0x00010000 /*--------------------------------------------------------------------------------------*/ struct _PerlIO diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod index 62d249a150..15be6f27a2 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -134,6 +134,10 @@ Restrict unsafe constructs Predeclare sub names +=item unicode::distinct + +Strictly distinguish UTF8 data and non-UTF data. + =item utf8 Enable/disable UTF-8 in source code @@ -200,6 +204,10 @@ Perl compiler's C backend Perl compiler's optimized C translation backend +=item B::Concise + +Walk Perl syntax tree, printing concise info about ops + =item B::Debug Walk Perl syntax tree, printing debug info about ops @@ -292,6 +300,10 @@ Wrapper around CPAN.pm without using any XS module Warn of errors (from perspective of caller) +=item Carp::Heavy + +No user serviceable parts inside + =item Class::Struct Declare struct-like datatypes as Perl classes @@ -496,6 +508,10 @@ Simplified source filtering Locate directory of original perl script +=item GDBM_File + +Perl5 access to the gdbm library. + =item Getopt::Long Extended processing of command line options @@ -620,6 +636,10 @@ Convert POD data to formatted ASCII text Convert POD data to formatted color ASCII text +=item Pod::Text::Overstrike + +Convert POD data to formatted overstrike text + =item Pod::Text::Termcap Convert POD data to ASCII text with format escapes @@ -802,87 +822,66 @@ modules are: =over 4 =item * - Language Extensions and Documentation Tools =item * - Development Support =item * - Operating System Interfaces =item * - Networking, Device Control (modems) and InterProcess Communication =item * - Data Types and Data Type Utilities =item * - Database Interfaces =item * - User Interfaces =item * - Interfaces to / Emulations of Other Programming Languages =item * - File Names, File Systems and File Locking (see also File Handles) =item * - String Processing, Language Text Processing, Parsing, and Searching =item * - Option, Argument, Parameter, and Configuration File Processing =item * - Internationalization and Locale =item * - Authentication, Security, and Encryption =item * - World Wide Web, HTML, HTTP, CGI, MIME =item * - Server and Daemon Utilities =item * - Archiving and Compression =item * - Images, Pixmap and Bitmap Manipulation, Drawing, and Graphing =item * - Mail and Usenet News =item * - Control Flow Utilities (callbacks and exceptions etc) =item * - File Handle and Input/Output Stream Utilities =item * - Miscellaneous Modules =back @@ -1451,28 +1450,18 @@ Don't delete the original .pl file till the new .pm one works! =over 4 -=item * - -Complete applications rarely belong in the Perl Module Library. +=item Complete applications rarely belong in the Perl Module Library. -=item * - -Many applications contain some Perl code that could be reused. +=item Many applications contain some Perl code that could be reused. Help save the world! Share your code in a form that makes it easy to reuse. -=item * - -Break-out the reusable code into one or more separate module files. - -=item * +=item Break-out the reusable code into one or more separate module files. -Take the opportunity to reconsider and redesign the interfaces. - -=item * +=item Take the opportunity to reconsider and redesign the interfaces. -In some cases the 'application' can then be reduced to a small +=item In some cases the 'application' can then be reduced to a small fragment of code built on top of the reusable modules. In these cases the application could invoked as: diff --git a/t/lib/mimeqp.t b/t/lib/mimeqp.t index f7e127fd4a..f7e127fd4a 100755..100644 --- a/t/lib/mimeqp.t +++ b/t/lib/mimeqp.t diff --git a/t/lib/tie-refhash.t b/t/lib/tie-refhash.t index d80b2e10fc..a82c19c743 100644 --- a/t/lib/tie-refhash.t +++ b/t/lib/tie-refhash.t @@ -1,19 +1,19 @@ #!/usr/bin/perl -w -# +# # Basic test suite for Tie::RefHash and Tie::RefHash::Nestable. -# +# # The testing is in two parts: first, run lots of tests on both a tied # hash and an ordinary un-tied hash, and check they give the same # answer. Then there are tests for those cases where the tied hashes # should behave differently to normal hashes, that is, when using # references as keys. -# +# BEGIN { chdir 't' if -d 't'; - @INC = '.'; + @INC = '.'; push @INC, '../lib'; -} +} use strict; use Tie::RefHash; @@ -28,7 +28,7 @@ my $ref = []; my $ref1 = []; # on a tied hash and on a normal hash, and checking that the results # are the same. This does of course assume that Perl hashes are not # buggy :-) -# +# my @tests = standard_hash_tests(); my @ordinary_results = runtests(\@tests, undef); @@ -40,13 +40,13 @@ foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') { foreach my $i (0 .. $#ordinary_results) { my ($or, $ow, $oe) = @{$ordinary_results[$i]}; my ($tr, $tw, $te) = @{$tied_results[$i]}; - + my $ok = 1; local $^W = 0; $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr); $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw); $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te); - + if (not $ok) { print STDERR "failed for $class: $tests[$i]\n", @@ -127,7 +127,7 @@ exit(); # Print 'ok X' if true, 'not ok X' if false # Uses global $currtest. -# +# sub test { my $t = shift; print 'not ' if not $t; @@ -135,7 +135,7 @@ sub test { } -# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. +# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. sub dumped { my $s = shift; my $d = Dumper($s); @@ -148,7 +148,7 @@ sub dumped { # Crudely dump a hash into a canonical string representation (because # hash keys can appear in any order, Data::Dumper may give different # strings for the same hash). -# +# sub dumph { my $h = shift; my $r = ''; @@ -159,17 +159,17 @@ sub dumph { } # Run the tests and give results. -# +# # Parameters: reference to list of tests to run # name of class to use for tied hash, or undef if not tied -# +# # Returns: list of [R, W, E] tuples, one for each test. # R is the return value from running the test, W any warnings it gave, # and E any exception raised with 'die'. E and W will be tidied up a # little to remove irrelevant details like line numbers :-) -# +# # Will also run a few of its own 'ok N' tests. -# +# sub runtests { my ($tests, $class) = @_; my @r; @@ -215,14 +215,14 @@ sub runtests { # Things that should work just the same for an ordinary hash and a # Tie::RefHash. -# +# # Each test is a code string to be eval'd, it should do something with # %h and give a scalar return value. The global $ref and $ref1 may # also be used. -# +# # One thing we don't test is that the ordering from 'keys', 'values' # and 'each' is the same. You can't reasonably expect that. -# +# sub standard_hash_tests { my @r; @@ -234,12 +234,12 @@ sub standard_hash_tests { { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) } END ; - + # Tests on the existence of the element 'foo' my $FOO_TESTS = <<'END' defined $h{foo}; exists $h{foo}; - $h{foo}; + $h{foo}; END ; @@ -278,7 +278,7 @@ END ; } } - + # Test hash slices my @slicetests; @slicetests = split /\n/, <<'END' |