This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
authorNick Ing-Simmons <nik@tiuk.ti.com>
Thu, 14 Feb 2002 16:30:56 +0000 (16:30 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Thu, 14 Feb 2002 16:30:56 +0000 (16:30 +0000)
p4raw-id: //depot/perlio@14690
p4raw-branched: from //depot/perl@14685 'branch in' ext/threads/t/end.t
lib/Tie/Memoize.pm lib/Tie/Memoize.t
p4raw-integrated: from //depot/perl@14685 'copy in' lib/Tie/Hash.pm
(@11169..) t/op/groups.t (@13598..) pod/perltie.pod (@13837..)
ext/threads/threads.pm (@14416..) Makefile.SH (@14641..)
Changes patchlevel.h (@14647..) lib/ExtUtils/Installed.pm
(@14655..) lib/File/Spec/t/rel2abs2rel.t (@14656..) utf8.c
(@14669..) MANIFEST (@14675..) ext/threads/threads.xs
(@14678..) lib/ExtUtils/t/Installed.t (@14680..)

15 files changed:
Changes
MANIFEST
Makefile.SH
ext/threads/t/end.t [new file with mode: 0644]
ext/threads/threads.xs
lib/ExtUtils/Installed.pm
lib/ExtUtils/t/Installed.t
lib/File/Spec/t/rel2abs2rel.t
lib/Tie/Hash.pm
lib/Tie/Memoize.pm [new file with mode: 0644]
lib/Tie/Memoize.t [new file with mode: 0644]
patchlevel.h
pod/perltie.pod
t/op/groups.t
utf8.c

diff --git a/Changes b/Changes
index 0d52fe6..83f0a07 100644 (file)
--- a/Changes
+++ b/Changes
@@ -31,6 +31,187 @@ or any other branch.
 Version v5.7.2         Development release working toward v5.8
 --------------
 ____________________________________________________________________________
+[ 14680] By: jhi                                   on 2002/02/13  13:41:50
+        Log: Integrate perlio;
+             
+             Do not lc() the file names before doing dirname() or they don't match.
+     Branch: perl
+         !> lib/ExtUtils/t/Installed.t
+____________________________________________________________________________
+[ 14679] By: sky                                   on 2002/02/13  12:56:13
+        Log: rename mutex to make a bit more sense
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 14678] By: sky                                   on 2002/02/13  12:46:11
+        Log: Track active threads....
+     Branch: perl
+          ! ext/threads/threads.pm ext/threads/threads.xs
+____________________________________________________________________________
+[ 14676] By: sky                                   on 2002/02/13  09:03:37
+        Log: Subject: [PATCH] Re: File/Spec/t/rel2abs2rel2whatever broken again
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: ons feb 13, 2002  11:00:17  Europe/Stockholm
+             Message-Id: <20020213100017.GA6288@blackrider>
+     Branch: perl
+          ! lib/File/Spec/t/rel2abs2rel.t
+____________________________________________________________________________
+[ 14675] By: sky                                   on 2002/02/13  09:00:24
+        Log: Do not propagate END blocks to child threads, test.
+     Branch: perl
+          + ext/threads/t/end.t
+          ! MANIFEST ext/threads/threads.xs
+____________________________________________________________________________
+[ 14672] By: jhi                                   on 2002/02/13  05:17:07
+        Log: $ln is supposed to be already set to $ln + executable suffix
+             on platforms that need it, from Paul Green.
+     Branch: perl
+          ! Configure
+____________________________________________________________________________
+[ 14671] By: jhi                                   on 2002/02/13  05:12:28
+        Log: Subject: New command syntax for 'x' command
+             From: Mark-Jason Dominus <mjd@plover.com>
+             Date: Tue, 12 Feb 2002 20:54:01 -0500
+             Message-ID: <20020213015401.25685.qmail@plover.com>
+     Branch: perl
+          ! lib/perl5db.pl pod/perldebug.pod
+____________________________________________________________________________
+[ 14670] By: jhi                                   on 2002/02/13  05:11:12
+        Log: Subject: New debugger option 'dumpDepth' controls recursion depth of 'x' command
+             From: Mark-Jason Dominus <mjd@plover.com>
+             Date: Tue, 12 Feb 2002 20:20:42 -0500
+             Message-ID: <20020213012042.25245.qmail@plover.com>
+     Branch: perl
+          ! lib/dumpvar.pl lib/perl5db.pl pod/perldebug.pod
+____________________________________________________________________________
+[ 14669] By: jhi                                   on 2002/02/13  04:43:43
+        Log: Iteration continues.
+     Branch: perl
+          ! utf8.c
+____________________________________________________________________________
+[ 14668] By: jhi                                   on 2002/02/13  02:37:31
+        Log: Duh.
+     Branch: perl
+          ! pp_pack.c t/op/length.t
+____________________________________________________________________________
+[ 14667] By: jhi                                   on 2002/02/13  01:33:01
+        Log: Retract #14666.
+     Branch: perl
+          ! t/op/lc.t
+____________________________________________________________________________
+[ 14666] By: jhi                                   on 2002/02/13  01:22:13
+        Log: (retracted by #14667)
+     Branch: perl
+          ! t/op/lc.t
+____________________________________________________________________________
+[ 14665] By: jhi                                   on 2002/02/13  00:45:02
+        Log: Tiny test script tweaks.
+     Branch: perl
+          ! t/uni/fold.t
+____________________________________________________________________________
+[ 14664] By: jhi                                   on 2002/02/13  00:24:37
+        Log: Rewrite the "special mapping" part of to_utf8_case(),
+             this time with fewer bugs.  (See: The Law of Cybernetic
+             Entymology.)
+     Branch: perl
+          ! utf8.c
+____________________________________________________________________________
+[ 14663] By: sky                                   on 2002/02/12  18:26:16
+        Log: Stop failures if you pass an object, sv_dup might not be the right 
+             thing to use since I have a feeling we end up cloning far too much. 
+             (Like the stash for example).... Maybe we need a lightweight sv_dup 
+             that searches the target for things....
+             Real fix is another option to perl_clone which controls if you should 
+             save stashes.
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 14662] By: jhi                                   on 2002/02/12  17:19:49
+        Log: Retract #14661.
+     Branch: perl
+          ! hints/solaris_2.sh
+____________________________________________________________________________
+[ 14661] By: jhi                                   on 2002/02/12  17:16:20
+        Log: (retracted by #14662)
+     Branch: perl
+          ! hints/solaris_2.sh
+____________________________________________________________________________
+[ 14660] By: jhi                                   on 2002/02/12  15:03:58
+        Log: EBCDIC: another "can't happen".
+     Branch: perl
+          ! utf8.c
+____________________________________________________________________________
+[ 14659] By: sky                                   on 2002/02/12  14:38:21
+        Log: Join support, however something wierd seems to happen with filehandles that are passed along threads...
+     Branch: perl
+          + ext/threads/t/join.t
+          ! MANIFEST ext/threads/threads.xs
+____________________________________________________________________________
+[ 14657] By: jhi                                   on 2002/02/12  13:44:34
+        Log: Subject: Re: [PATCH 5.6.1] Win32: Give user control over window creation behavior of system() function 
+             From: Jan Dubois <JanD@ActiveState.com> 
+             Date: Tue, 12 Feb 2002 00:56:31 -0800
+             Message-ID: <4llh6uc4gnqtk3csmfoqed3t6q85436bb1@4ax.com>
+     Branch: perl
+          ! lib/Win32.pod win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 14656] By: jhi                                   on 2002/02/12  13:39:18
+        Log: Subject: [PATCH] Re: 14654 introduced a bug 
+             From: Michael G Schwern <schwern@pobox.com> 
+             Date: Tue, 12 Feb 2002 05:37:36 -0500
+             Message-ID: <20020212103736.GC14327@blackrider>
+     Branch: perl
+          ! lib/File/Spec/t/rel2abs2rel.t
+____________________________________________________________________________
+[ 14655] By: jhi                                   on 2002/02/12  04:50:58
+        Log: More unset installman[13]dir tweaks from chromatic.
+     Branch: perl
+          ! lib/ExtUtils/Installed.pm
+____________________________________________________________________________
+[ 14654] By: jhi                                   on 2002/02/12  04:31:44
+        Log: Subject: Re: [PATCH] Re: Change 14566: Re: File::Spec::rel2abs2rel (?)
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Mon, 11 Feb 2002 12:23:02 -0500
+             Message-ID: <20020211172302.GD9556@blackrider>
+     Branch: perl
+          ! lib/File/Spec/t/rel2abs2rel.t
+____________________________________________________________________________
+[ 14653] By: jhi                                   on 2002/02/12  04:29:10
+        Log: Use `` instead of -| to be a little bit more portable,
+             from Michael Schwern.
+     Branch: perl
+          ! lib/ExtUtils/t/Embed.t
+____________________________________________________________________________
+[ 14652] By: jhi                                   on 2002/02/12  03:17:44
+        Log: EBCDIC: this change for \N{} in particular is now
+             unnecessary because of the recent more general
+             pack U change.
+     Branch: perl
+          ! toke.c
+____________________________________________________________________________
+[ 14651] By: jhi                                   on 2002/02/12  02:15:05
+        Log: Subject: [PATCH @14647] t/test.pl fix for VMS
+             From: "Craig A. Berry" <craigberry@mac.com>
+             Date: Mon, 11 Feb 2002 17:13:47 -0600
+             Message-Id: <5.1.0.14.2.20020211170332.01b94e88@exchi01>
+     Branch: perl
+          ! t/test.pl
+____________________________________________________________________________
+[ 14650] By: jhi                                   on 2002/02/11  23:44:09
+        Log: EBCDIC: pack U bytes change.
+     Branch: perl
+          ! t/op/length.t
+____________________________________________________________________________
+[ 14649] By: jhi                                   on 2002/02/11  23:38:28
+        Log: EBCDIC: pack U is no more equal to concat of \xHHs.
+     Branch: perl
+          ! t/op/each.t
+____________________________________________________________________________
+[ 14647] By: jhi                                   on 2002/02/11  15:11:14
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
 [ 14646] By: jhi                                   on 2002/02/11  15:07:28
         Log: Regen toc.
      Branch: perl
index eac56da..e464ac6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -632,6 +632,7 @@ ext/threads/shared/t/sv_refs.t      thread shared variables
 ext/threads/shared/t/sv_simple.t       thread shared variables
 ext/threads/shared/typemap     thread::shared types
 ext/threads/t/basic.t          ithreads
+ext/threads/t/end.t            Test end functions
 ext/threads/t/libc.t            testing libc functions for threadsafetyness
 ext/threads/t/join.t           Testing the join function
 ext/threads/t/stress_cv.t      Test with multiple threads, coderef cv argument.
@@ -1385,6 +1386,8 @@ lib/Tie/Array/stdpush.t           Test for Tie::StdArray
 lib/Tie/Handle.pm              Base class for tied handles
 lib/Tie/Handle/stdhandle.t     Test for Tie::StdHandle
 lib/Tie/Hash.pm                        Base class for tied hashes
+lib/Tie/Memoize.pm             Base class for memoized tied hashes
+lib/Tie/Memoize.t              Test for Memoize.t
 lib/Tie/RefHash.pm             Base class for tied hashes with references as keys
 lib/Tie/RefHash.t              Test for Tie::RefHash and Tie::RefHash::Nestable
 lib/Tie/Scalar.pm              Base class for tied scalars
index 8ae5c5f..526c2e3 100644 (file)
@@ -1051,10 +1051,14 @@ test_notty.deparse:     test_prep
 # Can't depend on lib/Config.pm because that might be where miniperl
 # is crashing.
 minitest: miniperl$(EXE_EXT) lib/re.pm
+       -@test -f lib/lib.pm && test -f lib/Config.pm || \
+         $(MAKE) lib/Config.pm lib/lib.pm
+       @echo " "
        @echo "You may see some irrelevant test failures if you have been unable"
-       @echo "to build lib/Config.pm."
+       @echo "to build lib/Config.pm or lib/lib.pm."
+       @echo " "
        - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \
-               && $(LDLIBPTH) ./perl TEST base/*.t comp/*.t cmd/*.t run/*.t io/*.t op/*.t </dev/tty
+               && $(LDLIBPTH) ./perl TEST base/*.t comp/*.t cmd/*.t run/*.t io/*.t op/*.t uni/*.t </dev/tty
 
 # Test via harness
 
diff --git a/ext/threads/t/end.t b/ext/threads/t/end.t
new file mode 100644 (file)
index 0000000..199ca47
--- /dev/null
@@ -0,0 +1,41 @@
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'useithreads'}) {
+        print "1..0 # Skip: no useithreads\n";
+        exit 0;
+    }
+}
+
+use ExtUtils::testlib;
+use strict;
+BEGIN { print "1..6\n" };
+use threads;
+use threads::shared;
+
+my $test_id = 1;
+share($test_id);
+use Devel::Peek qw(Dump);
+
+sub ok {
+    my ($ok, $name) = @_;
+
+    # You have to do it this way or VMS will get confused.
+    print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+    $test_id++;
+    return $ok;
+}
+ok(1);
+END { ok(1,"End block run once") }
+threads->create(sub { eval "END { ok(1,'') }"})->join();
+threads->create(sub { eval "END { ok(1,'') }"})->join();
+threads->create(\&thread)->join();
+
+sub thread {
+       eval "END { ok(1,'') }";
+       threads->create(sub { eval "END { ok(1,'') }"})->join();
+}
index 83dca93..006e552 100755 (executable)
@@ -69,10 +69,10 @@ ithread *threads;
 #define ithread_detach(thread)         Perl_ithread_detach(aTHX_ thread)
 #define ithread_tid(thread)            ((thread)->tid)
 
-static perl_mutex create_mutex;  /* protects the creation of threads ??? */
+static perl_mutex create_destruct_mutex;  /* protects the creation and destruction of threads*/
 
 I32 tid_counter = 0;
-
+I32 active_threads = 0;
 perl_key self_key;
 
 /*
@@ -86,7 +86,7 @@ Perl_ithread_destruct (pTHX_ ithread* thread)
                MUTEX_UNLOCK(&thread->mutex);
                return;
        }
-       MUTEX_LOCK(&create_mutex);
+       MUTEX_LOCK(&create_destruct_mutex);
        /* Remove from circular list of threads */
        if (thread->next == thread) {
            /* last one should never get here ? */
@@ -99,7 +99,8 @@ Perl_ithread_destruct (pTHX_ ithread* thread)
                threads = thread->next;
            }
        }
-       MUTEX_UNLOCK(&create_mutex);
+       active_threads--;
+       MUTEX_UNLOCK(&create_destruct_mutex);
        /* Thread is now disowned */
 #if 0
         Perl_warn(aTHX_ "destruct %d @ %p by %p",
@@ -282,7 +283,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
        ithread*        thread;
        CLONE_PARAMS    clone_param;
 
-       MUTEX_LOCK(&create_mutex);
+       MUTEX_LOCK(&create_destruct_mutex);
        thread = PerlMemShared_malloc(sizeof(ithread));
        Zero(thread,1,ithread);
        thread->next = threads;
@@ -315,7 +316,11 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
         */
        {
            dTHXa(thread->interp);
-
+            /* Here we remove END blocks since they should only run
+              in the thread they are created 
+            */
+            SvREFCNT_dec(PL_endav);
+            PL_endav = newAV();
             clone_param.flags = 0;
            thread->init_function = sv_dup(init_function, &clone_param);
            if (SvREFCNT(thread->init_function) == 0) {
@@ -363,7 +368,8 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 #endif
        }
 #endif
-       MUTEX_UNLOCK(&create_mutex);
+       active_threads++;
+       MUTEX_UNLOCK(&create_destruct_mutex);
        return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
 }
 
@@ -526,8 +532,8 @@ BOOT:
        ithread* thread;
        PL_perl_destruct_level = 2;
        PERL_THREAD_ALLOC_SPECIFIC(self_key);
-       MUTEX_INIT(&create_mutex);
-       MUTEX_LOCK(&create_mutex);
+       MUTEX_INIT(&create_destruct_mutex);
+       MUTEX_LOCK(&create_destruct_mutex);
        thread  = PerlMemShared_malloc(sizeof(ithread));
        Zero(thread,1,ithread);
        PL_perl_destruct_level = 2;
@@ -538,6 +544,7 @@ BOOT:
        thread->interp = aTHX;
        thread->count  = 1;  /* imortal */
        thread->tid = tid_counter++;
+       active_threads++;
        thread->detached = 1;
 #ifdef WIN32
        thread->thr = GetCurrentThreadId();
@@ -545,6 +552,6 @@ BOOT:
        thread->thr = pthread_self();
 #endif
        PERL_THREAD_SETSPECIFIC(self_key,thread);
-       MUTEX_UNLOCK(&create_mutex);
+       MUTEX_UNLOCK(&create_destruct_mutex);
 }
 
index c9a6bfc..5b7f663 100644 (file)
@@ -32,26 +32,31 @@ if ($DOSISH)
 return(0);
 }
 
+sub _is_doc($$)
+{ 
+my ($self, $path) = @_;
+my $man1dir = $Config{man1direxp};
+my $man3dir = $Config{man3direxp};
+return(($man1dir && $self->_is_prefix($path, $man1dir))
+      ||
+      ($man3dir && $self->_is_prefix($path, $man3dir))
+      ? 1 : 0)
+}
 sub _is_type($$$)
 {
 my ($self, $path, $type) = @_;
 return(1) if ($type eq "all");
+
 if ($type eq "doc")
    {
-   return($self->_is_prefix($path, $Config{installman1dir})
-          ||
-          $self->_is_prefix($path, $Config{installman3dir})
-          ? 1 : 0)
+   return($self->_is_doc($path))
    }
 if ($type eq "prog")
    {
-   return($self->_is_prefix($path, $Config{prefix})
-          &&
-          !($Config{installman1dir} && 
-                       $self->_is_prefix($path, $Config{installman1dir}))
+   return($self->_is_prefix($path, $Config{prefixexp})
           &&
-          !($Config{installman3dir} && 
-                       $self->_is_prefix($path, $Config{installman3dir}))
+          !($self->_is_doc($path))
           ? 1 : 0);
    }
 return(0);
@@ -74,27 +79,25 @@ my ($class) = @_;
 $class = ref($class) || $class;
 my $self = {};
 
-my $installarchlib = $Config{installarchlib};
-my $archlib = $Config{archlib};
-my $sitearch = $Config{sitearch};
+my $archlib = $Config{archlibexp};
+my $sitearch = $Config{sitearchexp};
 
 if ($DOSISH)
    {
-   $installarchlib =~ s|\\|/|g;
    $archlib =~ s|\\|/|g;
    $sitearch =~ s|\\|/|g;
    }
 
 # Read the core packlist
 $self->{Perl}{packlist} =
-   ExtUtils::Packlist->new( File::Spec->catfile($installarchlib, '.packlist') );
+   ExtUtils::Packlist->new( File::Spec->catfile($archlib, '.packlist') );
 $self->{Perl}{version} = $Config{version};
 
 # Read the module packlists
 my $sub = sub
    {
    # Only process module .packlists
-   return if ($_) ne ".packlist" || $File::Find::dir eq $installarchlib;
+   return if ($_) ne ".packlist" || $File::Find::dir eq $archlib;
 
    # Hack of the leading bits of the paths & convert to a module name
    my $module = $File::Find::name;
@@ -256,7 +259,7 @@ is given the special name 'Perl'.
 This takes one mandatory parameter, the name of a module.  It returns a list of
 all the filenames from the package.  To obtain a list of core perl files, use
 the module name 'Perl'.  Additional parameters are allowed.  The first is one
-of the strings "prog", "man" or "all", to select either just program files,
+of the strings "prog", "doc" or "all", to select either just program files,
 just manual files or all files.  The remaining parameters are a list of
 directories. The filenames returned will be restricted to those under the
 specified directories.
@@ -265,7 +268,7 @@ specified directories.
 
 This takes one mandatory parameter, the name of a module.  It returns a list of
 all the directories from the package.  Additional parameters are allowed.  The
-first is one of the strings "prog", "man" or "all", to select either just
+first is one of the strings "prog", "doc" or "all", to select either just
 program directories, just manual directories or all directories.  The remaining
 parameters are a list of directories. The directories returned will be
 restricted to those under the specified directories.  This method returns only
@@ -273,7 +276,7 @@ the leaf directories that contain files from the specified module.
 
 =item directory_tree()
 
-This is identical in operation to directory(), except that it includes all the
+This is identical in operation to directories(), except that it includes all the
 intermediate directories back up to the specified directories.
 
 =item validate()
index 8bd7fe6..70287f8 100644 (file)
@@ -26,7 +26,7 @@ use Test::More tests => 43;
 
 BEGIN { use_ok( 'ExtUtils::Installed' ) }
 
-my $noman = ! ($Config{installman1dir} && $Config{installman3dir});
+my $mandirs =  !!$Config{man1direxp} + !!$Config{man3direxp};
 
 # saves having to qualify package name for class methods
 my $ei = bless( {}, 'ExtUtils::Installed' );
@@ -40,17 +40,22 @@ is( $ei->_is_prefix('\foo\bar', '\bar'), 0,
 # _is_type
 is( $ei->_is_type(0, 'all'), 1, '_is_type() should be true for type of "all"' );
 
-foreach my $path (qw( installman1dir installman3dir )) {
-       my $file = $Config{$path} . '/foo';
+foreach my $path (qw( man1dir man3dir )) {
+SKIP: {
+       my $dir = $Config{$path.'exp'};
+        skip("no man directory $path on this system", 2 ) unless $dir;
+
+       my $file = $dir . '/foo';
        is( $ei->_is_type($file, 'doc'), 1, "... should find doc file in $path" );
        is( $ei->_is_type($file, 'prog'), 0, "... but not prog file in $path" );
+    }
 }
 
-is( $ei->_is_type($Config{prefix} . '/bar', 'prog'), 1, 
-       "... should find prog file under $Config{prefix}" );
+is( $ei->_is_type($Config{prefixexp} . '/bar', 'prog'), 1, 
+       "... should find prog file under $Config{prefixexp}" );
 
 SKIP: {
-       skip('no man directories on this system', 1) if $noman;
+       skip('no man directories on this system', 1) unless $mandirs;
        is( $ei->_is_type('bar', 'doc'), 0, 
                '... should not find doc file outside path' );
 }
@@ -103,15 +108,14 @@ FAKE
 
 
 SKIP: {
-       skip( "could not write packlist: $!", 3 ) unless $wrotelist;
+       skip("could not write packlist: $!", 3 ) unless $wrotelist;
 
        # avoid warning and death by localizing glob
        local *ExtUtils::Installed::Config;
-    my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
+       my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
        %ExtUtils::Installed::Config = (
-               archlib            => cwd(),
-        installarchlib => cwd(),
-               sitearch           => $fake_mod_dir,
+               archlibexp         => cwd(),
+               sitearchexp        => $fake_mod_dir,
        );
 
        # necessary to fool new()
@@ -132,9 +136,13 @@ is( join(' ', $ei->modules()), 'abc def ghi',
 # files
 $ei->{goodmod} = { 
        packlist => { 
-               File::Spec->catdir($Config{installman1dir}, 'foo') => 1,
-               File::Spec->catdir($Config{installman3dir}, 'bar') => 1,
-               File::Spec->catdir($Config{prefix}, 'foobar') => 1,
+                ($Config{man1direxp} ? 
+                    (File::Spec->catdir($Config{man1direxp}, 'foo') => 1) : 
+                        ()),
+                ($Config{man3direxp} ? 
+                    (File::Spec->catdir($Config{man3direxp}, 'bar') => 1) : 
+                        ()),
+                File::Spec->catdir($Config{prefixexp}, 'foobar') => 1,
                foobaz  => 1,
        },
 };
@@ -146,13 +154,15 @@ like( $@, qr/type must be/,'files() should croak given bad type' );
 
 my @files;
 SKIP: {
-       skip('no man directories on this system', 3) if $noman;
-       
-       @files = $ei->files('goodmod', 'doc', $Config{installman1dir});
-       is( scalar @files, 1, '... should find doc file under given dir' );
-       is( grep({ /foo$/ } @files), 1, '... checking file name' );
-       @files = $ei->files('goodmod', 'doc');
-       is( scalar @files, 2, '... should find all doc files with no dir' );
+    skip('no man directory man1dir on this system', 2) unless $Config{man1direxp}; 
+    @files = $ei->files('goodmod', 'doc', $Config{man1direxp});
+    is( scalar @files, 1, '... should find doc file under given dir' );
+    is( grep({ /foo$/ } @files), 1, '... checking file name' );
+}
+SKIP: {
+    skip('no man directories on this system', 1) unless $mandirs;
+    @files = $ei->files('goodmod', 'doc');
+    is( scalar @files, $mandirs, '... should find all doc files with no dir' );
 }
 
 @files = $ei->files('goodmod', 'prog', 'fake', 'fake2');
@@ -161,7 +171,7 @@ is( scalar @files, 0, '... should find no doc files given wrong dirs' );
 is( scalar @files, 1, '... should find doc file in correct dir' );
 like( $files[0], qr/foobar$/, '... checking file name' );
 @files = $ei->files('goodmod');
-is( scalar @files, 4, '... should find all files with no type specified' );
+is( scalar @files, 2 + $mandirs, '... should find all files with no type specified' );
 my %dirnames = map { lc($_) => dirname($_) } @files;
 
 # directories
@@ -169,24 +179,27 @@ my @dirs = $ei->directories('goodmod', 'prog', 'fake');
 is( scalar @dirs, 0, 'directories() should return no dirs if no files found' );
 
 SKIP: {
-       skip('no man directories on this system', 4) if $noman;
-
-       @dirs = $ei->directories('goodmod', 'doc');
-       is( scalar @dirs, 2, '... should find all files files() would' );
-       @dirs = $ei->directories('goodmod');
-       is( scalar @dirs, 4, '... should find all files files() would, again' );
-       @files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } 
-               @files;
-       is( join(' ', @files), join(' ', @dirs), '... should sort output' );
-
-       # directory_tree
-       my $expectdirs = dirname($Config{installman1dir}) eq 
-               dirname($Config{installman3dir}) ? 3 :2;
-
-       @dirs = $ei->directory_tree('goodmod', 'doc', 
-               dirname($Config{installman1dir}));
-       is( scalar @dirs, $expectdirs, 
-               'directory_tree() should report intermediate dirs to those requested' );
+    skip('no man directories on this system', 1) unless $mandirs;
+    @dirs = $ei->directories('goodmod', 'doc');
+    is( scalar @dirs, $mandirs, '... should find all files files() would' );
+}
+@dirs = $ei->directories('goodmod');
+is( scalar @dirs, 2 + $mandirs, '... should find all files files() would, again' );
+@files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } @files;
+is( join(' ', @files), join(' ', @dirs), '... should sort output' );
+
+# directory_tree
+my $expectdirs = 
+       ($mandirs == 2) && 
+       (dirname($Config{man1direxp}) eq dirname($Config{man3direxp}))
+       ? 3 : 2;
+SKIP: {
+    skip('no man directories on this system', 1) unless $mandirs;
+    @dirs = $ei->directory_tree('goodmod', 'doc', $Config{man1direxp} ?
+       dirname($Config{man1direxp}) : dirname($Config{man3direxp}));
+    is( scalar @dirs, $expectdirs, 
+        'directory_tree() should report intermediate dirs to those requested' );
 }
 
 my $fakepak = Fakepak->new(102);
index 9d2ce2c..fff3a1b 100644 (file)
@@ -15,13 +15,19 @@ use File::Spec;
 
 # Change 'perl' to './perl' so the shell doesn't go looking through PATH.
 sub safe_rel {
-    return File::Spec->catfile(File::Spec->curdir, $_[0]);
+    my($perl) = shift;
+    $perl = File::Spec->catfile(File::Spec->curdir, $perl) unless
+      File::Spec->file_name_is_absolute($perl);
+
+    return $perl;
 }
 
 # Here we make sure File::Spec can properly deal with executables.
 # VMS has some trouble with these.
-my $perl = File::Spec->rel2abs($^X);
-is( `$^X   -le "print 'ok'"`, "ok\n",   '`` works' );
+my $perl = safe_rel($^X);
+is( `$perl   -le "print 'ok'"`, "ok\n",   '`` works' );
+
+$perl = File::Spec->rel2abs($^X);
 is( `$perl -le "print 'ok'"`, "ok\n",   'rel2abs($^X)' );
 
 $perl = File::Spec->canonpath($perl);
@@ -30,5 +36,5 @@ is( `$perl -le "print 'ok'"`, "ok\n",   'canonpath on abs executable' );
 $perl = safe_rel(File::Spec->abs2rel($perl));
 is( `$perl -le "print 'ok'"`, "ok\n",   'abs2rel()' );
 
-$perl = File::Spec->canonpath($^X);
+$perl = safe_rel(File::Spec->canonpath($^X));
 is( `$perl -le "print 'ok'"`, "ok\n",   'canonpath on rel executable' );
index 91ccbee..c97e9d0 100644 (file)
@@ -4,7 +4,7 @@ our $VERSION = '1.00';
 
 =head1 NAME
 
-Tie::Hash, Tie::StdHash - base class definitions for tied hashes
+Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for tied hashes
 
 =head1 SYNOPSIS
 
@@ -23,24 +23,43 @@ Tie::Hash, Tie::StdHash - base class definitions for tied hashes
     @ISA = (Tie::StdHash);
 
     # All methods provided by default, define only those needing overrides
+    # Accessors access the storage in %{$_[0]};
+    # TIEHANDLE should return a reference to the actual storage
     sub DELETE { ... }
 
+    package NewExtraHash;
+    require Tie::Hash;
+
+    @ISA = (Tie::ExtraHash);
+
+    # All methods provided by default, define only those needing overrides
+    # Accessors access the storage in %{$_[0][0]};
+    # TIEHANDLE should return an array reference with the first element being
+    # the reference to the actual storage 
+    sub DELETE { 
+      $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer
+      delete $_[0][0]->{$_[1]};                  #  $_[0]->SUPER::DELETE($_[1]) }
+
 
     package main;
 
     tie %new_hash, 'NewHash';
     tie %new_std_hash, 'NewStdHash';
+    tie %new_extra_hash, 'NewExtraHash',
+       sub {warn "Doing \U$_[1]\E of $_[2].\n"};
 
 =head1 DESCRIPTION
 
 This module provides some skeletal methods for hash-tying classes. See
 L<perltie> for a list of the functions required in order to tie a hash
 to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
-as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> package
-provides most methods required for hashes in L<perltie>. It inherits from
-B<Tie::Hash>, and causes tied hashes to behave exactly like standard hashes,
-allowing for selective overloading of methods. The C<new> method is provided
-as grandfathering in the case a class forgets to include a C<TIEHASH> method.
+as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> and
+B<Tie::ExtraHash> packages
+provide most methods for hashes described in L<perltie> (the exceptions
+are C<UNTIE> and C<DESTROY>).  They cause tied hashes to behave exactly like standard hashes,
+and allow for selective overwriting of methods.  B<Tie::Hash> grandfathers the
+C<new> method: it is used if C<TIEHASH> is not defined
+in the case a class forgets to include a C<TIEHASH> method.
 
 For developers wishing to write their own tied hashes, the required methods
 are briefly defined below. See the L<perltie> section for more detailed
@@ -87,12 +106,63 @@ Clear all values from the tied hash I<this>.
 
 =back
 
-=head1 CAVEATS
+=head1 Inheriting from B<Tie::StdHash>
+
+The accessor methods assume that the actual storage for the data in the tied
+hash is in the hash referenced by C<tied(%tiedhash)>.  Thus overwritten
+C<TIEHANDLE> method should return a hash reference, and the remaining methods
+should operate on the hash referenced by the first argument:
+
+  package ReportHash;
+  our @ISA = 'Tie::StdHash';
+
+  sub TIEHASH  {
+    my $storage = bless {}, shift;
+    warn "New ReportHash created, stored in $storage.\n";
+    $storage
+  }
+  sub STORE    {
+    warn "Storing data with key $_[1] at $_[0].\n";
+    $_[0]{$_[1]} = $_[2]
+  }
+
 
-The L<perltie> documentation includes a method called C<DESTROY> as
-a necessary method for tied hashes. Neither B<Tie::Hash> nor B<Tie::StdHash>
-define a default for this method. This is a standard for class packages,
-but may be omitted in favor of a simple default.
+=head1 Inheriting from B<Tie::ExtraHash>
+
+The accessor methods assume that the actual storage for the data in the tied
+hash is in the hash referenced by C<(tied(%tiedhash))[0]>.  Thus overwritten
+C<TIEHANDLE> method should return an array reference with the first
+element being a hash reference, and the remaining methods should operate on the
+hash C<< %{ $_[0]->[0] }>>:
+
+  package ReportHash;
+  our @ISA = 'Tie::StdHash';
+
+  sub TIEHASH  {
+    my $storage = bless {}, shift;
+    warn "New ReportHash created, stored in $storage.\n";
+    [$storage, @_]
+  }
+  sub STORE    {
+    warn "Storing data with key $_[1] at $_[0].\n";
+    $_[0][0]{$_[1]} = $_[2]
+  }
+
+The default C<TIEHANDLE> method stores "extra" arguments to tie() starting
+from offset 1 in the array referenced by C<tied(%tiedhash)>; this is the
+same storage algorithm as in TIEHASH subroutine above.  Hence, a typical
+package inheriting from B<Tie::ExtraHash> does not need to overwrite this
+method.
+
+=head1 C<UNTIE> and C<DESTROY>
+
+The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>,
+B<Tie::StdHash>, or B<Tie::ExtraHash>.  Tied hashes do not require
+presense of these methods, but if defined, the methods will be called in
+proper time, see L<perltie>.
+
+If needed, these methods should be defined by the package inheriting from
+B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>.
 
 =head1 MORE INFORMATION
 
@@ -148,7 +218,7 @@ sub CLEAR {
 # alter some parts of their behaviour.
 
 package Tie::StdHash;
-@ISA = qw(Tie::Hash);
+# @ISA = qw(Tie::Hash);                # would inherit new() only
 
 sub TIEHASH  { bless {}, $_[0] }
 sub STORE    { $_[0]->{$_[1]} = $_[2] }
@@ -159,4 +229,15 @@ sub EXISTS   { exists $_[0]->{$_[1]} }
 sub DELETE   { delete $_[0]->{$_[1]} }
 sub CLEAR    { %{$_[0]} = () }
 
+package Tie::ExtraHash;
+
+sub TIEHASH  { my $p = shift; bless [{}, @_], $p }
+sub STORE    { $_[0][0]{$_[1]} = $_[2] }
+sub FETCH    { $_[0][0]{$_[1]} }
+sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
+sub NEXTKEY  { each %{$_[0][0]} }
+sub EXISTS   { exists $_[0][0]->{$_[1]} }
+sub DELETE   { delete $_[0][0]->{$_[1]} }
+sub CLEAR    { %{$_[0][0]} = () }
+
 1;
diff --git a/lib/Tie/Memoize.pm b/lib/Tie/Memoize.pm
new file mode 100644 (file)
index 0000000..0b3d320
--- /dev/null
@@ -0,0 +1,127 @@
+use strict;
+package Tie::Memoize;
+use Tie::Hash;
+our @ISA = 'Tie::ExtraHash';
+
+our $exists_token = \undef;
+
+sub croak {require Carp; goto &Carp::croak}
+
+# Format: [0: STORAGE, 1: EXISTS-CACHE, 2: FETCH_function;
+#         3: EXISTS_function, 4: DATA, 5: EXISTS_different ]
+
+sub FETCH {
+  my ($h,$key) = ($_[0][0], $_[1]);
+  my $res = $h->{$key};
+  return $res if defined $res; # Shortcut if accessible
+  return $res if exists $h->{$key}; # Accessible, but undef
+  my $cache = $_[0][1]{$key};
+  return if defined $cache and not $cache; # Known to not exist
+  my @res = $_[0][2]->($key, $_[0][4]);        # Autoload
+  $_[0][1]{$key} = 0, return unless @res; # Cache non-existence
+  delete $_[0][1]{$key};       # Clear existence cache, not needed any more
+  $_[0][0]{$key} = $res[0];    # Store data and return
+}
+
+sub EXISTS   {
+  my ($a,$key) = (shift, shift);
+  return 1 if exists $a->[0]{$key}; # Have data
+  my $cache = $a->[1]{$key};
+  return $cache if defined $cache; # Existence cache
+  my @res = $a->[3]($key,$a->[4]);
+  $_[0][1]{$key} = 0, return unless @res; # Cache non-existence
+  # Now we know it exists
+  return ($_[0][1]{$key} = 1) if $a->[5]; # Only existence reported
+  # Now know the value
+  $_[0][0]{$key} = $res[0];    # Store data
+  return 1
+}
+
+sub TIEHASH  {
+  croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr' if @_ < 2;
+  croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr, $data, \&exists_subr, \%data_cache, \%existence_cache' if @_ > 6;
+  push @_, undef if @_ < 3;    # Data
+  push @_, $_[1] if @_ < 4;    # exists
+  push @_, {} while @_ < 6;    # initial value and caches
+  bless [ @_[4,5,1,3,2], $_[1] ne $_[3]], $_[0]
+}
+
+1;
+
+=head1 NAME
+
+Tiel::Memoize - add data to hash when needed
+
+=head1 SYNOPSIS
+
+  require Tie::Memoize;
+  tie %hash, 'Tie::Memoize',
+      \&fetch,                 # The rest is optional
+      $DATA, \&exists,
+      {%ini_value}, {%ini_existence};
+
+=head1 DESCRIPTION
+
+This package allows a tied hash to autoload its values on the first access,
+and to use the cached value on the following accesses.
+
+Only read-accesses (via fetching the value or C<exists>) result in calls to
+the functions; the modify-accesses are performed as on a normal hash.
+
+The required arguments during C<tie> are the hash, the package, and
+the reference to the C<FETCH>ing function.  The optional arguments are
+an arbitrary scalar $data, the reference to the C<EXISTS> function,
+and initial values of the hash and of the existence cache.
+
+Both the C<FETCH>ing function and the C<EXISTS> functions have the
+same signature: the arguments are C<$key, $data>; $data is the same
+value as given as argument during tie()ing.  Both functions should
+return an empty list if the value does not exist.  If C<EXISTS>
+function is different from the C<FETCH>ing function, it should return
+a TRUE value on success.  The C<FETCH>ing function should return the
+intended value if the key is valid.
+
+=head1 Inheriting from B<Tie::Memoize>
+
+The structure of the tied() data is an array reference with elements
+
+  0:  cache of known values
+  1:  cache of known existence of keys
+  2:  FETCH  function
+  3:  EXISTS function
+  4:  $data
+
+The rest is for internal usage of this package.  In particular, if
+TIEHASH is overwritten, it should call SUPER::TIEHASH.
+
+=head1 EXAMPLE
+
+  sub slurp {
+    my ($key, $dir) = shift;
+    open my $h, '<', "$dir/$key" or return;
+    local $/; <$h>                     # slurp it all
+  }
+  sub exists { my ($key, $dir) = shift; return -f "$dir/$key" }
+
+  tie %hash, 'Tie::Memoize', \&slurp, $directory, \&exists,
+      { fake_file1 => $content1, fake_file2 => $content2 },
+      { pretend_does_not_exists => 0, known_to_exist => 1 };
+
+This example treats the slightly modified contents of $directory as a
+hash.  The modifications are that the keys F<fake_file1> and
+F<fake_file2> fetch values $content1 and $content2, and
+F<pretend_does_not_exists> will never be accessed.  Additionally, the
+existence of F<known_to_exist> is never checked (so if it does not
+exists when its content is needed, the user of %hash may be confused).
+
+=head1 BUGS
+
+FIRSTKEY and NEXTKEY methods go through the keys which were already read,
+not all the possible keys of the hash.
+
+=head1 AUTHOR
+
+Ilya Zakharevich L<mailto:perl-module-hash-memoize@ilyaz.org>.
+
+=cut
+
diff --git a/lib/Tie/Memoize.t b/lib/Tie/Memoize.t
new file mode 100644 (file)
index 0000000..defb437
--- /dev/null
@@ -0,0 +1,61 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+use Tie::Memoize;
+use Test::More tests => 28;
+use File::Spec;
+
+sub slurp {
+  my ($key, $dir) = @_;
+  open my $h, '<', File::Spec->catfile($dir, $key) or return;
+  local $/;
+  <$h>                 # slurp it all
+}
+sub exists { my ($key, $dir) = @_; return -f File::Spec->catfile($dir, $key) }
+
+my $directory = File::Spec->catdir(File::Spec->updir, 'lib');
+
+tie my %hash, 'Tie::Memoize', \&slurp, $directory, \&exists,
+    { fake_file1 => 123, fake_file2 => 45678 },
+    { 'strict.pm' => 0, known_to_exist => 1 };
+
+ok(not exists $hash{'strict.pm'});
+ok(exists $hash{known_to_exist});
+ok($hash{fake_file2} eq 45678);
+ok($hash{fake_file1} eq 123);
+ok(exists $hash{known_to_exist});
+ok(not exists $hash{'strict.pm'});
+ok(not defined $hash{fake_file3});
+ok(not defined $hash{known_to_exist});
+ok(not exists $hash{known_to_exist});
+ok(not exists $hash{'strict.pm'});
+my $c = slurp('constant.pm', $directory);
+ok($c);
+ok($hash{'constant.pm'} eq $c);
+ok($hash{'constant.pm'} eq $c);
+ok(not exists $hash{'strict.pm'});
+ok(exists $hash{'blib.pm'});
+
+untie %hash;
+
+tie %hash, 'Tie::Memoize', \&slurp, $directory;
+
+ok(exists $hash{'strict.pm'}, 'existing file');
+ok(not exists $hash{fake_file2});
+ok(not exists $hash{fake_file1});
+ok(not exists $hash{known_to_exist});
+ok(exists $hash{'strict.pm'}, 'existing file again');
+ok(not defined $hash{fake_file3});
+ok(not defined $hash{known_to_exist});
+ok(not exists $hash{known_to_exist});
+ok(exists $hash{'strict.pm'}, 'existing file again');
+ok($hash{'constant.pm'} eq $c);
+ok($hash{'constant.pm'} eq $c);
+ok(exists $hash{'strict.pm'}, 'existing file again');
+ok(exists $hash{'blib.pm'}, 'another existing file');
+
index 2ece08f..437471b 100644 (file)
@@ -79,7 +79,7 @@
 #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
 static char    *local_patches[] = {
         NULL
-       ,"DEVEL14646"
+       ,"DEVEL14680"
        ,NULL
 };
 
index f959367..adc557d 100644 (file)
@@ -161,7 +161,7 @@ argument--the new value the user is trying to assign.
 
 This method will be triggered when the C<untie> occurs. This can be useful
 if the class needs to know when no further calls will be made. (Except DESTROY
-of course.) See below for more details.
+of course.) See L<The C<untie> Gotcha> below for more details.
 
 =item DESTROY this
 
@@ -452,7 +452,7 @@ In our example, we'll use a little shortcut if there is a I<LIST>:
 
 =item UNTIE this
 
-Will be called when C<untie> happens. (See below.)
+Will be called when C<untie> happens. (See L<The C<untie> Gotcha> below.)
 
 =item DESTROY this
 
@@ -475,7 +475,7 @@ the keys.  UNTIE is called when C<untie> happens, and DESTROY is called when
 the tied variable is garbage collected.
 
 If this seems like a lot, then feel free to inherit from merely the
-standard Tie::Hash module for most of your methods, redefining only the
+standard Tie::StdHash module for most of your methods, redefining only the
 interesting ones.  See L<Tie::Hash> for details.
 
 Remember that Perl distinguishes between a key not existing in the hash,
@@ -756,7 +756,7 @@ thing, but we'll have to go through the LIST field indirectly.
 
 =item UNTIE this
 
-This is called when C<untie> occurs.
+This is called when C<untie> occurs.  See L<The C<untie> Gotcha> below.
 
 =item DESTROY this
 
@@ -880,7 +880,8 @@ function.
 =item UNTIE this
 
 As with the other types of ties, this method will be called when C<untie> happens.
-It may be appropriate to "auto CLOSE" when this occurs.
+It may be appropriate to "auto CLOSE" when this occurs.  See
+L<The C<untie> Gotcha> below.
 
 =item DESTROY this
 
@@ -903,7 +904,7 @@ Here's how to use our little example:
 =head2 UNTIE this
 
 You can define for all tie types an UNTIE method that will be called
-at untie().
+at untie().  See L<The C<untie> Gotcha> below.
 
 =head2 The C<untie> Gotcha
 
index 4d3dcaf..77dbb2b 100755 (executable)
@@ -116,11 +116,6 @@ print "1..2\n";
 
 $pwgid = $( + 0;
 ($pwgnam) = getgrgid($pwgid);
-if ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.
-    @basegroup{$pwgid,$pwgnam} = (0,0);
-} else {
-    @basegroup{$pwgid,$pwgnam} = (1,1);
-}
 $seen{$pwgid}++;
 
 print "# pwgid = $pwgid, pwgnam = $pwgnam\n";
@@ -145,12 +140,28 @@ if ($^O =~ /^(?:uwin|solaris)$/) {
        $gr1 = join(' ', sort @gr);
 }
 
+if ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.
+    @basegroup{$pwgid,$pwgnam} = (0,0);
+} else {
+    @basegroup{$pwgid,$pwgnam} = (1,1);
+}
 $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
 
+my $ok1 = 0;
 if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) {
     print "ok 1\n";
+    $ok1++;
 }
-else {
+elsif ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.
+    # Retry in default unix mode
+    %basegroup = ( $pwgid => 1, $pwgnam => 1 );
+    $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
+    if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) {
+       print "ok 1 # This Cygwin behaves like Unix (Win2k?)\n";
+       $ok1++;
+    }
+}
+unless ($ok1) {
     print "#gr1 is <$gr1>\n";
     print "#gr2 is <$gr2>\n";
     print "not ok 1\n";
diff --git a/utf8.c b/utf8.c
index 0f84d36..71aaf8a 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1315,11 +1315,6 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, char *norma
                         * (usually, but not always multicharacter)
                         * mapping, since any characters in the low 256
                         * are in Unicode code points, not EBCDIC.
-                        * If we either had a bit in the "special"
-                        * mappings indicating "contains lower 256",
-                        * or if we on EBCDIC platforms regenerate the
-                        * lib/unicore/To/Foo.pl, we could do without
-                        * this, but for now, let's do it this way.
                         * --jhi */
 
                        U8 tmpbuf[UTF8_MAXLEN_FOLD+1];