Integrate with Sarathy.

p4raw-id: //depot/cfgperl@6305

12 files changed, 87 insertions, 56 deletions

diff --git a/embed.h b/embed.h
index fe28352aba..6fc37214e0 100644
--- a/embed.h
+++ b/embed.h
@@ -829,15 +829,17 @@
 #define mg_dup			Perl_mg_dup
 #define sv_dup			Perl_sv_dup
 #if defined(HAVE_INTERP_INTERN)
-#define sys_intern_clear	Perl_sys_intern_clear
 #define sys_intern_dup		Perl_sys_intern_dup
-#define sys_intern_init		Perl_sys_intern_init
 #endif
 #define ptr_table_new		Perl_ptr_table_new
 #define ptr_table_fetch		Perl_ptr_table_fetch
 #define ptr_table_store		Perl_ptr_table_store
 #define ptr_table_split		Perl_ptr_table_split
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_clear	Perl_sys_intern_clear
+#define sys_intern_init		Perl_sys_intern_init
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif
@@ -2273,15 +2275,17 @@
 #define mg_dup(a)		Perl_mg_dup(aTHX_ a)
 #define sv_dup(a)		Perl_sv_dup(aTHX_ a)
 #if defined(HAVE_INTERP_INTERN)
-#define sys_intern_clear()	Perl_sys_intern_clear(aTHX)
 #define sys_intern_dup(a,b)	Perl_sys_intern_dup(aTHX_ a,b)
-#define sys_intern_init()	Perl_sys_intern_init(aTHX)
 #endif
 #define ptr_table_new()		Perl_ptr_table_new(aTHX)
 #define ptr_table_fetch(a,b)	Perl_ptr_table_fetch(aTHX_ a,b)
 #define ptr_table_store(a,b,c)	Perl_ptr_table_store(aTHX_ a,b,c)
 #define ptr_table_split(a)	Perl_ptr_table_split(aTHX_ a)
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_clear()	Perl_sys_intern_clear(aTHX)
+#define sys_intern_init()	Perl_sys_intern_init(aTHX)
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif
@@ -4457,12 +4461,8 @@
 #define Perl_sv_dup		CPerlObj::Perl_sv_dup
 #define sv_dup			Perl_sv_dup
 #if defined(HAVE_INTERP_INTERN)
-#define Perl_sys_intern_clear	CPerlObj::Perl_sys_intern_clear
-#define sys_intern_clear	Perl_sys_intern_clear
 #define Perl_sys_intern_dup	CPerlObj::Perl_sys_intern_dup
 #define sys_intern_dup		Perl_sys_intern_dup
-#define Perl_sys_intern_init	CPerlObj::Perl_sys_intern_init
-#define sys_intern_init		Perl_sys_intern_init
 #endif
 #define Perl_ptr_table_new	CPerlObj::Perl_ptr_table_new
 #define ptr_table_new		Perl_ptr_table_new
@@ -4473,6 +4473,12 @@
 #define Perl_ptr_table_split	CPerlObj::Perl_ptr_table_split
 #define ptr_table_split		Perl_ptr_table_split
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#define Perl_sys_intern_clear	CPerlObj::Perl_sys_intern_clear
+#define sys_intern_clear	Perl_sys_intern_clear
+#define Perl_sys_intern_init	CPerlObj::Perl_sys_intern_init
+#define sys_intern_init		Perl_sys_intern_init
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif
diff --git a/embed.pl b/embed.pl
index 55b24212ca..7e94a09146 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2176,16 +2176,18 @@ Ap	|GP*	|gp_dup		|GP* gp
 Ap	|MAGIC*	|mg_dup		|MAGIC* mg
 Ap	|SV*	|sv_dup		|SV* sstr
 #if defined(HAVE_INTERP_INTERN)
-Ap	|void	|sys_intern_clear
 Ap	|void	|sys_intern_dup	|struct interp_intern* src \
 				|struct interp_intern* dst
-Ap	|void	|sys_intern_init
 #endif
 Ap	|PTR_TBL_t*|ptr_table_new
 Ap	|void*	|ptr_table_fetch|PTR_TBL_t *tbl|void *sv
 Ap	|void	|ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv
 Ap	|void	|ptr_table_split|PTR_TBL_t *tbl
 #endif
+#if defined(HAVE_INTERP_INTERN)
+Ap	|void	|sys_intern_clear
+Ap	|void	|sys_intern_init
+#endif
 
 #if defined(PERL_OBJECT)
 protected:
diff --git a/global.sym b/global.sym
index 15afc0c2b6..9053446da2 100644
--- a/global.sym
+++ b/global.sym
@@ -536,10 +536,10 @@ Perl_dirp_dup
 Perl_gp_dup
 Perl_mg_dup
 Perl_sv_dup
-Perl_sys_intern_clear
 Perl_sys_intern_dup
-Perl_sys_intern_init
 Perl_ptr_table_new
 Perl_ptr_table_fetch
 Perl_ptr_table_store
 Perl_ptr_table_split
+Perl_sys_intern_clear
+Perl_sys_intern_init
diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm
index e1a462eee9..9ef55ec84a 100644
--- a/lib/File/Spec/Mac.pm
+++ b/lib/File/Spec/Mac.pm
@@ -362,7 +362,7 @@ L</file_name_is_absolute> for details.
 
 =cut
 
-sub rel2abs($$;$;) {
+sub rel2abs {
     my ($self,$path,$base ) = @_;
 
     if ( ! $self->file_name_is_absolute( $path ) ) {
diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm
index 5d943289ff..a81c533235 100644
--- a/lib/File/Spec/Unix.pm
+++ b/lib/File/Spec/Unix.pm
@@ -423,7 +423,7 @@ Based on code written by Shigio Yamaguchi.
 
 =cut
 
-sub rel2abs($$;$;) {
+sub rel2abs {
     my ($self,$path,$base ) = @_;
 
     # Clean up $path
diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index ec20289180..c19695d7e5 100644
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -3,9 +3,10 @@ package File::Spec::VMS;
 use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
-@ISA = qw(File::Spec::Unix);
 
-$VERSION = 1.0;
+$VERSION = '1.1';
+
+@ISA = qw(File::Spec::Unix);
 
 use Cwd;
 use File::Basename;
@@ -39,6 +40,11 @@ sub eliminate_macros {
     my($self,$path) = @_;
     return '' unless $path;
     $self = {} unless ref $self;
+
+    if ($path =~ /\s/) {
+      return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+    }
+
     my($npath) = unixify($path);
     my($complex) = 0;
     my($head,$macro,$tail);
@@ -88,6 +94,12 @@ sub fixpath {
     $self = bless {} unless ref $self;
     my($fixedpath,$prefix,$name);
 
+    if ($path =~ /\s/) {
+      return join ' ',
+             map { $self->fixpath($_,$force_path) }
+	     split /\s+/, $path;
+    }
+
     if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
         if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
             $fixedpath = vmspath($self->eliminate_macros($path));
@@ -439,7 +451,7 @@ Use VMS syntax when converting filespecs.
 
 =cut
 
-sub rel2abs($$;$;) {
+sub rel2abs {
     my $self = shift ;
     return vmspath(File::Spec::Unix::rel2abs( $self, @_ ))
         if ( join( '', @_ ) =~ m{/} ) ;
diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index b863dc4919..f5d6cda2bc 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -43,7 +43,6 @@ from the following list:
     $ENV{TMPDIR}
     $ENV{TEMP}
     $ENV{TMP}
-    C:/temp
     /tmp
     /
 
@@ -53,7 +52,7 @@ my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
     my $self = shift;
-    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /)) {
+    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
 	next unless defined && -d;
 	$tmpdir = $_;
 	last;
@@ -313,7 +312,7 @@ sub abs2rel {
 }
 
 
-sub rel2abs($$;$;) {
+sub rel2abs {
     my ($self,$path,$base ) = @_;
 
     if ( ! $self->file_name_is_absolute( $path ) ) {
diff --git a/objXSUB.h b/objXSUB.h
index 97fdeef4dd..4f51cb81ec 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -2182,18 +2182,10 @@
 #undef  sv_dup
 #define sv_dup			Perl_sv_dup
 #if defined(HAVE_INTERP_INTERN)
-#undef  Perl_sys_intern_clear
-#define Perl_sys_intern_clear	pPerl->Perl_sys_intern_clear
-#undef  sys_intern_clear
-#define sys_intern_clear	Perl_sys_intern_clear
 #undef  Perl_sys_intern_dup
 #define Perl_sys_intern_dup	pPerl->Perl_sys_intern_dup
 #undef  sys_intern_dup
 #define sys_intern_dup		Perl_sys_intern_dup
-#undef  Perl_sys_intern_init
-#define Perl_sys_intern_init	pPerl->Perl_sys_intern_init
-#undef  sys_intern_init
-#define sys_intern_init		Perl_sys_intern_init
 #endif
 #undef  Perl_ptr_table_new
 #define Perl_ptr_table_new	pPerl->Perl_ptr_table_new
@@ -2212,6 +2204,16 @@
 #undef  ptr_table_split
 #define ptr_table_split		Perl_ptr_table_split
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#undef  Perl_sys_intern_clear
+#define Perl_sys_intern_clear	pPerl->Perl_sys_intern_clear
+#undef  sys_intern_clear
+#define sys_intern_clear	Perl_sys_intern_clear
+#undef  Perl_sys_intern_init
+#define Perl_sys_intern_init	pPerl->Perl_sys_intern_init
+#undef  sys_intern_init
+#define sys_intern_init		Perl_sys_intern_init
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif
diff --git a/perlapi.c b/perlapi.c
index 470a8ecbd0..26d559a0fd 100755
--- a/perlapi.c
+++ b/perlapi.c
@@ -3945,26 +3945,12 @@ Perl_sv_dup(pTHXo_ SV* sstr)
 }
 #if defined(HAVE_INTERP_INTERN)
 
-#undef  Perl_sys_intern_clear
-void
-Perl_sys_intern_clear(pTHXo)
-{
-    ((CPerlObj*)pPerl)->Perl_sys_intern_clear();
-}
-
 #undef  Perl_sys_intern_dup
 void
 Perl_sys_intern_dup(pTHXo_ struct interp_intern* src, struct interp_intern* dst)
 {
     ((CPerlObj*)pPerl)->Perl_sys_intern_dup(src, dst);
 }
-
-#undef  Perl_sys_intern_init
-void
-Perl_sys_intern_init(pTHXo)
-{
-    ((CPerlObj*)pPerl)->Perl_sys_intern_init();
-}
 #endif
 
 #undef  Perl_ptr_table_new
@@ -3995,6 +3981,22 @@ Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl)
     ((CPerlObj*)pPerl)->Perl_ptr_table_split(tbl);
 }
 #endif
+#if defined(HAVE_INTERP_INTERN)
+
+#undef  Perl_sys_intern_clear
+void
+Perl_sys_intern_clear(pTHXo)
+{
+    ((CPerlObj*)pPerl)->Perl_sys_intern_clear();
+}
+
+#undef  Perl_sys_intern_init
+void
+Perl_sys_intern_init(pTHXo)
+{
+    ((CPerlObj*)pPerl)->Perl_sys_intern_init();
+}
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index a754daa476..5baacc8cdf 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3425,6 +3425,12 @@ an attribute list, but the matching closing (right) parenthesis
 character was not found.  You may need to add (or remove) a backslash
 character to get your parentheses to balance.  See L<attributes>.
 
+=item Unterminated compressed integer
+
+(F) An argument to unpack("w",...) was incompatible with the BER
+compressed integer format and could not be converted to an integer.
+See L<perlfunc/pack>.
+
 =item Unterminated <> operator
 
 (F) The lexer saw a left angle bracket in a place where it was expecting
diff --git a/proto.h b/proto.h
index 893545a842..e7a21c360f 100644
--- a/proto.h
+++ b/proto.h
@@ -941,15 +941,17 @@ PERL_CALLCONV GP*	Perl_gp_dup(pTHX_ GP* gp);
 PERL_CALLCONV MAGIC*	Perl_mg_dup(pTHX_ MAGIC* mg);
 PERL_CALLCONV SV*	Perl_sv_dup(pTHX_ SV* sstr);
 #if defined(HAVE_INTERP_INTERN)
-PERL_CALLCONV void	Perl_sys_intern_clear(pTHX);
 PERL_CALLCONV void	Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst);
-PERL_CALLCONV void	Perl_sys_intern_init(pTHX);
 #endif
 PERL_CALLCONV PTR_TBL_t*	Perl_ptr_table_new(pTHX);
 PERL_CALLCONV void*	Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv);
 PERL_CALLCONV void	Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv);
 PERL_CALLCONV void	Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl);
 #endif
+#if defined(HAVE_INTERP_INTERN)
+PERL_CALLCONV void	Perl_sys_intern_clear(pTHX);
+PERL_CALLCONV void	Perl_sys_intern_init(pTHX);
+#endif
 
 #if defined(PERL_OBJECT)
 protected:
diff --git a/win32/win32.c b/win32/win32.c
index b4ad80cf48..a05a3fe8a6 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -4055,6 +4055,18 @@ Perl_sys_intern_init(pTHX)
     w32_init_socktype		= 0;
 }
 
+void
+Perl_sys_intern_clear(pTHX)
+{
+    Safefree(w32_perlshell_tokens);
+    Safefree(w32_perlshell_vec);
+    /* NOTE: w32_fdpid is freed by sv_clean_all() */
+    Safefree(w32_children);
+#  ifdef USE_ITHREADS
+    Safefree(w32_pseudo_children);
+#  endif
+}
+
 #  ifdef USE_ITHREADS
 
 void
@@ -4069,18 +4081,6 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype;
 }
-
-void
-Perl_sys_intern_clear(pTHX)
-{
-    Safefree(w32_perlshell_tokens);
-    Safefree(w32_perlshell_vec);
-    /* NOTE: w32_fdpid is freed by sv_clean_all() */
-    Safefree(w32_children);
-#  ifdef USE_ITHREADS
-    Safefree(w32_pseudo_children);
-#  endif
-}
 #  endif /* USE_ITHREADS */
 #endif /* HAVE_INTERP_INTERN */