[inseparable changes from patch from perl5.003_26 to perl5.003_27]

 BUILD PROCESS

Subject: Fix eval "" in Configure
Date: Fri, 14 Feb 1997 13:09:53 -0500
From: John L. Allen <allen@gateway.grumman.com>
Files: Configure

    Subject: Re: Configure problem on IRIX - me dumb
    
    p5p-msgid: <9702141809.AA17001@gateway.grumman.com>

Subject: Don't link with -lsfio if sfio is not requested
From: Chip Salzenberg <chip@perl.com>
Files: Configure

Subject: perl5.003_26 Configure change "win" for AIX 4
Date: Fri, 14 Feb 1997 13:59:02 -0600 (CST)
From: Tim Mooney <mooney@dogbert.cc.ndsu.NoDak.edu>
Files: Configure

    p5p-msgid: <Pine.OSF.3.95.970214135751.32654A-100000@dogbert.cc.ndsu.NoDak.edu>
    private-msgid: <Pine.OSF.3.95.970214135751.32654A-100000@dogbert.cc.ndsu.NoD

 CORE LANGUAGE CHANGES

Subject: Better looks_like_number() function [sv.c]
Date: Fri, 14 Feb 1997 18:08:52 +0100
From: Gisle Aas <aas@bergen.sn.no>
Files: sv.c
Msg-ID: <199702141708.SAA17546@bergen.sn.no>

    (applied based on p5p patch as commit 8dbaa58ee2aba7cc22d84199a674c58bbf108b46)

Subject: Remove redundant functions UNIVERSAL::{class,is_instance}
Date: 14 Feb 1997 15:52:21 +0000
From: Gisle Aas <aas@bergen.sn.no>
Files: pod/perldelta.pod pod/perlobj.pod t/op/universal.t universal.c
Msg-ID: <hwwsbpeq2.fsf@bergen.sn.no>

    (applied based on p5p patch as commit 77bb9b23081b62119e8fbe9f5655b8802e4537ae)

Subject: Allow C<setpgrp $$>
Date: 16 Feb 1997 23:19:12 -0500
From: Roderick Schertler <roderick@gate.net>
Files: pp_sys.c
Msg-ID: <pzraigyshr.fsf@eeyore.ibcinc.com>

    (applied based on p5p patch as commit 3d2573a84a1aa655d5da58c57b3fc20e04d40f9f)

Subject: Fix syntax error on C<&$1>
From: Chip Salzenberg <chip@perl.com>
Files: toke.c

Subject: Fix grep() with refs in array context
From: Chip Salzenberg <chip@perl.com>
Files: pp.c

 CORE PORTABILITY

Subject: Eliminate $^S; add C<use vmsish qw(status exit time)>
Date: Mon, 17 Feb 1997 02:45:26 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: MANIFEST gv.c lib/English.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp mg.c op.c perl.c perl.h pod/perldelta.pod pod/perlmod.pod pod/perlvar.pod pp_ctl.c pp_sys.c utils/perldoc.PL vms/Makefile vms/config.vms vms/descrip.mms vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs vms/ext/XSSymSet.pm vms/ext/vmsish.pm vms/vms.c vms/vmsish.h win32/makedef.pl

    private-msgid: <01IFI9CFKL0S004R2V@hmivax.humgen.upenn.edu>

 LIBRARY AND EXTENSIONS

Subject: Remove Fatal.pm
From: Chip Salzenberg <chip@perl.com>
Files: MANIFEST lib/Fatal.pm pod/perldelta.pod pod/perlmod.pod pod/roffitall t/lib/fatal.t

Subject: Refresh MakeMaker to 5.40
From: Andy Dougherty <doughera@lafcol.lafayette.edu>
Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm

 OTHER CORE CHANGES

Subject: Fix core dump when embedding
From: Chip Salzenberg <chip@perl.com>
Files: perl.c

Subject: Re: Fragile signals
Date: Thu, 13 Feb 1997 01:44:39 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: mg.c
Msg-ID: <199702130644.BAA07572@monk.mps.ohio-state.edu>

    (applied based on p5p patch as commit 09df8c7df7dfc9853902f1fdd8a6d95f53be66fc)

Subject: Make format strings correspond exactly to parameters
Date: 13 Feb 1997 17:24:31 -0500
From: Roderick Schertler <roderick@gate.net>
Files: doio.c ext/DB_File/DB_File.xs ext/Opcode/Opcode.xs gv.c op.c perl.c pp_ctl.c pp_sys.c regcomp.c toke.c
Msg-ID: <pz7mkc1h0g.fsf@eeyore.ibcinc.com>

    (applied based on p5p patch as commit bf81aadd817bdea29720b072eef945df2da8463b)

Subject: Don't try to attach 'o' magic to read-only values
From: Chip Salzenberg <chip@perl.com>
Files: sv.c

Subject: Fix carriage-return message
From: Chip Salzenberg <chip@perl.com>
Files: toke.c

Subject: In <=>, test for equality first
From: Chip Salzenberg <chip@perl.com>
Files: pp.c

Subject: Don't mark sv_{true,false} PADTMP
From: Chip Salzenberg <chip@perl.com>
Files: op.c

4 files changed, 324 insertions, 7 deletions

diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm
index ad16af366f..516e678e2c 100644
--- a/vms/ext/Stdio/Stdio.pm
+++ b/vms/ext/Stdio/Stdio.pm
@@ -1,8 +1,8 @@
 #   VMS::Stdio - VMS extensions to Perl's stdio calls
 #
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
-#   Version: 2.01
-#   Revised: 10-Dec-1996
+#   Version: 2.02
+#   Revised: 15-Feb-1997
 
 package VMS::Stdio;
 
@@ -12,7 +12,7 @@ use Carp '&croak';
 use DynaLoader ();
 use Exporter ();
  
-$VERSION = '2.01';
+$VERSION = '2.02';
 @ISA = qw( Exporter DynaLoader IO::File );
 @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY &O_NOWAIT
               &O_RDONLY &O_RDWR  &O_TRUNC &O_WRONLY );
diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs
index 200268c7f1..b10fec0d48 100644
--- a/vms/ext/Stdio/Stdio.xs
+++ b/vms/ext/Stdio/Stdio.xs
@@ -1,8 +1,8 @@
 /* VMS::Stdio - VMS extensions to stdio routines 
  *
- * Version:  2.0
+ * Version:  2.02
  * Author:   Charles Bailey  bailey@genetics.upenn.edu
- * Revised:  28-Feb-1996
+ * Revised:  15-Feb-1997
  *
  */
 
@@ -127,7 +127,8 @@ flush(sv)
 	CODE:
 	    FILE *fp = Nullfp;
 	    if (SvOK(sv)) fp = IoIFP(sv_2io(sv));
-	    ST(0) = fflush(fp) ? &sv_undef : &sv_yes;
+	    if (fflush(fp)) { ST(0) = &sv_undef; }
+	    else            { clearerr(fp); ST(0) = &sv_yes; }
 
 char *
 getname(fp)
@@ -157,7 +158,8 @@ sync(fp)
 	FILE *	fp
 	PROTOTYPE: $
 	CODE:
-	    ST(0) = fsync(fileno(fp)) ? &sv_undef : &sv_yes;
+	    if (fsync(fileno(fp))) { ST(0) = &sv_undef; }
+	    else                   { clearerr(fp); ST(0) = &sv_yes; }
 
 char *
 tmpnam()
diff --git a/vms/ext/XSSymSet.pm b/vms/ext/XSSymSet.pm
new file mode 100644
index 0000000000..868a303c01
--- /dev/null
+++ b/vms/ext/XSSymSet.pm
@@ -0,0 +1,239 @@
+package ExtUtils::XSSymSet;
+
+use Carp qw( &carp );
+use strict;
+use vars qw( $VERSION );
+$VERSION = '1.0';
+
+
+sub new { 
+  my($pkg,$maxlen,$silent) = @_;
+  $maxlen ||= 31;
+  $silent ||= 0;
+  my($obj) = { '__M@xLen' => $maxlen, '__S!lent' => $silent };
+  bless $obj, $pkg;
+}
+
+
+sub trimsym {
+  my($self,$name,$maxlen,$silent) = @_;
+
+  unless (defined $maxlen) {
+    if (ref $self) { $maxlen ||= $self->{'__M@xLen'}; }
+    $maxlen ||= 31;
+  }
+  unless (defined $silent) {
+    if (ref $self) { $silent ||= $self->{'__S!lent'}; }
+    $silent ||= 0;
+  }
+  return $name if (length $name <= $maxlen);
+
+  my $trimmed = $name;
+  # First, just try to remove duplicated delimiters
+  $trimmed =~ s/__/_/g;
+  if (length $trimmed > $maxlen) {
+    # Next, all duplicated chars
+    $trimmed =~ s/(.)\1+/$1/g;
+    if (length $trimmed > $maxlen) {
+      my $squeezed = $trimmed;
+      my($xs,$prefix,$func) = $trimmed =~ /^(XS_)?(.*)_([^_]*)$/;
+      if (length $func <= 12) {  # Try to preserve short function names
+        my $frac = int(length $prefix / (length $trimmed - $maxlen) + 0.5);
+        my $pat = '([^_])';
+        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
+        $prefix =~ s/$pat/$1/g;
+        $squeezed = "$xs$prefix" . "_$func";
+        if (length $squeezed > $maxlen) {
+          $pat =~ s/A-Z//;
+          $prefix =~ s/$pat/$1/g;
+          $squeezed = "$xs$prefix" . "_$func";
+        }
+      }
+      else { 
+        my $frac = int(length $trimmed / (length $trimmed - $maxlen) + 0.5);
+        my $pat = '([^_])';
+        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
+        $squeezed = "$prefix$func";
+        $squeezed =~ s/$pat/$1/g;
+        if (length "$xs$squeezed" > $maxlen) {
+          $pat =~ s/A-Z//;
+          $squeezed =~ s/$pat/$1/g;
+        }
+        $squeezed = "$xs$squeezed";
+      }
+      if (length $squeezed <= $maxlen) { $trimmed = $squeezed; }
+      else {
+        my $frac = int((length $trimmed - $maxlen) / length $trimmed + 0.5);
+        my $pat = '(.).{$frac}';
+        $trimmed =~ s/$pat/$1/g;
+      }
+    }
+  }
+  carp "Warning: long symbol $name\n\ttrimmed to $trimmed\n\t" unless $silent;
+  return $trimmed;
+}
+
+
+sub addsym {
+  my($self,$sym,$maxlen,$silent) = @_;
+  my $trimmed = $self->get_trimmed($sym);
+
+  return $trimmed if defined $trimmed;
+
+  $maxlen ||= $self->{'__M@xLen'} || 31;
+  $silent ||= $self->{'__S!lent'} || 0;    
+  $trimmed = $self->trimsym($sym,$maxlen,1);
+  if (exists $self->{$trimmed}) {
+    my($i) = "00";
+    $trimmed = $self->trimsym($sym,$maxlen-3,$silent);
+    while (exists $self->{"${trimmed}_$i"}) { $i++; }
+    carp "Warning: duplicate symbol $trimmed\n\tchanged to ${trimmed}_$i\n\t(original was $sym)\n\t"
+      unless $silent;
+    $trimmed .= "_$i";
+  }
+  elsif (not $silent and $trimmed ne $sym) {
+    carp "Warning: long symbol $sym\n\ttrimmed to $trimmed\n\t";
+  }
+  $self->{$trimmed} = $sym;
+  $self->{'__N+Map'}->{$sym} = $trimmed;
+  $trimmed;
+}
+
+
+sub delsym {
+  my($self,$sym) = @_;
+  my $trimmed = $self->{'__N+Map'}->{$sym};
+  if (defined $trimmed) {
+    delete $self->{'__N+Map'}->{$sym};
+    delete $self->{$trimmed};
+  }
+  $trimmed;
+}
+
+
+sub get_trimmed {
+  my($self,$sym) = @_;
+  $self->{'__N+Map'}->{$sym};
+}
+
+
+sub get_orig {
+  my($self,$trimmed) = @_;
+  $self->{$trimmed};
+}
+
+
+sub all_orig { (keys %{$_[0]->{'__N+Map'}}); }
+sub all_trimmed { (grep { /^\w+$/ } keys %{$_[0]}); }
+
+__END__
+
+=head1 NAME
+
+VMS::XSSymSet - keep sets of symbol names palatable to the VMS linker
+
+=head1 SYNOPSIS
+
+  use VMS::XSSymSet;
+
+  $set = new VMS::XSSymSet;
+  while ($sym = make_symbol()) { $set->addsym($sym); }
+  foreach $safesym ($set->all_trimmed) {
+    print "Processing $safesym (derived from ",$self->get_orig($safesym),")\n";
+    do_stuff($safesym);
+  }
+
+  $safesym = VMS::XSSymSet->trimsym($onesym);
+
+=head1 DESCRIPTION
+
+Since the VMS linker distinguishes symbols based only on the first 31
+characters of their names, it is occasionally necessary to shorten
+symbol names in order to avoid collisions.  (This is especially true of
+names generated by xsubpp, since prefixes generated by nested package
+names can become quite long.)  C<VMS::XSSymSet> provides functions to
+shorten names in a consistent fashion, and to track a set of names to
+insure that each is unique.  While designed with F<xsubpp> in mind, it
+may be used with any set of strings.  
+
+This package supplies the following functions, all of which should be
+called as methods.
+
+=over 4
+
+=item new([$maxlen[,$silent]])
+
+Creates an empty C<VMS::XSSymset> set of symbols.  This function may be
+called as a static method or via an existing object.  If C<$maxlen> or
+C<$silent> are specified, they are used as the defaults for maximum
+name length and warning behavior in future calls to addsym() or
+trimsym() via this object.
+
+=item addsym($name[,$maxlen[,$silent]])
+
+Creates a symbol name from C<$name>, using the methods described
+under trimsym(), which is unique in this set of symbols, and returns
+the new name.  C<$name> and its resultant are added to the set, and
+any future calls to addsym() specifying the same C<$name> will return
+the same result, regardless of the value of C<$maxlen> specified.
+Unless C<$silent> is true, warnings are output if C<$name> had to be
+trimmed or changed in order to avoid collision with an existing symbol
+name.  C<$maxlen> and C<$silent> default to the values specified when
+this set of symbols was created.  This method must be called via an
+existing object.
+
+=item trimsym($name[,$maxlen[,$silent]])
+
+Creates a symbol name C<$maxlen> or fewer characters long from
+C<$name> and returns it. If C<$name> is too long, it first tries to
+shorten it by removing duplicate characters, then by periodically
+removing non-underscore characters, and finally, if necessary, by
+periodically removing characters of any type.  C<$maxlen> defaults
+to 31.  Unless C<$silent> is true, a warning is output if C<$name>
+is altered in any way.  This function may be called either as a
+static method or via an existing object, but in the latter case no
+check is made to insure that the resulting name is unique in the
+set of symbols.
+
+=item delsym($name)
+
+Removes C<$name> from the set of symbols, where C<$name> is the
+original symbol name passed previously to addsym().  If C<$name>
+existed in the set of symbols, returns its "trimmed" equivalent,
+otherwise returns C<undef>.  This method must be called via an
+existing object.
+
+=item get_orig($trimmed)
+
+Returns the original name which was trimmed to C<$trimmed> by a
+previous call to addsym(), or C<undef> if C<$trimmed> does not
+correspond to a member of this set of symbols.  This method must be
+called via an existing object.
+
+=item get_trimmed($name)
+
+Returns the trimmed name which was generated from C<$name> by a
+previous call to addsym(), or C<undef> if C<$name> is not a member
+of this set of symbols.  This method must be called via an
+existing object.
+
+=item all_orig()
+
+Returns a list containing all of the original symbol names
+from this set.
+
+=item all_trimmed()
+
+Returns a list containing all of the trimmed symbol names
+from this set.
+
+=back
+
+=head1 AUTHOR
+
+Charles Bailey  E<lt>I<bailey@genetics.upenn.edu>E<gt>
+
+=head1 REVISION
+
+Last revised 14-Feb-1997, for Perl 5.004.
+
diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm
new file mode 100644
index 0000000000..851d576e79
--- /dev/null
+++ b/vms/ext/vmsish.pm
@@ -0,0 +1,76 @@
+package vmsish;
+
+=head1 NAME
+
+vmsish - Perl pragma to control VMS-specific language features
+
+=head1 SYNOPSIS
+
+    use vmsish;
+
+    use vmsish 'status';	# or '$?'
+    use vmsish 'exit';
+    use vmsish 'time';
+
+    use vmsish;
+    no vmsish 'time';
+
+=head1 DESCRIPTION
+
+If no import list is supplied, all possible VMS-specific features are
+assumed.  Currently, there are three VMS-specific features available:
+'status' (a.k.a '$?'), 'exit', and 'time'.
+
+=over 6
+
+=item C<vmsish status>
+
+This makes C<$?> and C<system> return the native VMS exit status
+instead of emulating the POSIX exit status.
+
+=item C<vmsish exit>
+
+This makes C<exit 1> produce a successful exit (with status SS$_NORMAL),
+instead of emulating UNIX exit(), which considers C<exit 1> to indicate
+an error.  As with the CRTL's exit() function, C<exit 0> is also mapped
+to an exit status of SS$_NORMAL, and any other argument to exit() is
+used directly as Perl's exit status.
+
+=item C<vmsish time>
+
+This makes all times relative to the local time zone, instead of the
+default of Universal Time (a.k.a Greenwich Mean Time, or GMT).
+
+=back
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+
+if ($^O ne 'VMS') {
+    require Carp;
+    Carp::croak("This isn't VMS");
+}
+
+sub bits {
+    my $bits = 0;
+    my $sememe;
+    foreach $sememe (@_) {
+	$bits |= 0x01000000, next if $sememe eq 'status' || $sememe eq '$?';
+	$bits |= 0x02000000, next if $sememe eq 'exit';
+	$bits |= 0x04000000, next if $sememe eq 'time';
+    }
+    $bits;
+}
+
+sub import {
+    shift;
+    $^H |= bits(@_ ? @_ : qw(status exit time));
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ bits(@_ ? @_ : qw(status exit time));
+}
+
+1;