From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Thu, 14 Feb 2002 16:30:56 +0000 (+0000)
Subject: Integrate mainline
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=58c2ef1935bc22d76403b75989b56de9eecb6730;p=p5sagit%2Fp5-mst-13.2.git

Integrate mainline

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..)
---

diff --git a/Changes b/Changes
index 0d52fe6..83f0a07 100644
--- 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
diff --git a/MANIFEST b/MANIFEST
index eac56da..e464ac6 100644
--- 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
diff --git a/Makefile.SH b/Makefile.SH
index 8ae5c5f..526c2e3 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -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
index 0000000..199ca47
--- /dev/null
+++ b/ext/threads/t/end.t
@@ -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();
+}
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 83dca93..006e552 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -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);
 }
 
diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm
index c9a6bfc..5b7f663 100644
--- a/lib/ExtUtils/Installed.pm
+++ b/lib/ExtUtils/Installed.pm
@@ -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()
diff --git a/lib/ExtUtils/t/Installed.t b/lib/ExtUtils/t/Installed.t
index 8bd7fe6..70287f8 100644
--- a/lib/ExtUtils/t/Installed.t
+++ b/lib/ExtUtils/t/Installed.t
@@ -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);
diff --git a/lib/File/Spec/t/rel2abs2rel.t b/lib/File/Spec/t/rel2abs2rel.t
index 9d2ce2c..fff3a1b 100644
--- a/lib/File/Spec/t/rel2abs2rel.t
+++ b/lib/File/Spec/t/rel2abs2rel.t
@@ -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' );
diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 91ccbee..c97e9d0 100644
--- a/lib/Tie/Hash.pm
+++ b/lib/Tie/Hash.pm
@@ -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
index 0000000..0b3d320
--- /dev/null
+++ b/lib/Tie/Memoize.pm
@@ -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
index 0000000..defb437
--- /dev/null
+++ b/lib/Tie/Memoize.t
@@ -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');
+
diff --git a/patchlevel.h b/patchlevel.h
index 2ece08f..437471b 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -79,7 +79,7 @@
 #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
 static	char	*local_patches[] = {
         NULL
-	,"DEVEL14646"
+	,"DEVEL14680"
 	,NULL
 };
 
diff --git a/pod/perltie.pod b/pod/perltie.pod
index f959367..adc557d 100644
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -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
 
diff --git a/t/op/groups.t b/t/op/groups.t
index 4d3dcaf..77dbb2b 100755
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -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
--- 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];