[inseparable changes from patch from perl5.003_07 to perl5.003_08]

 CORE LANGUAGE CHANGES

Subject: Bitwise op sign rationalization
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h pp_hot.c proto.h sv.c t/op/bop.t

    Make bitwise ops result in unsigned values, unless C<use
    integer> is in effect.  Includes initial support for UVs.

Subject: Defined scoping for C<my> in control structures
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c

    Finally defines semantics of "my" in control expressions,
    like the condition of "if" and "while".  In all cases, scope
    of a "my" var extends to the end of the entire control
    structure.  Also adds new construct "for my", which
    automatically declares the control variable "my" and limits
    its scope to the loop.

Subject: Fix ++/-- after int conversion (e.g. 'printf "%d"')
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c pp_hot.c sv.c

    This patch makes Perl correctly ignore SvIVX() if either
    NOK or POK is true, since SvIVX() may be a truncated or
    overflowed version of the real value.

Subject: Make code match Camel II re: functions that use $_
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: opcode.pl

Subject: Provide scalar context on left side of "->"
From: Chip Salzenberg <chip@atlantic.net>
Files: perly.c perly.y

Subject: Quote bearword package/handle FOO in "funcname FOO => 'bar'"
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c

 OTHER CORE CHANGES

Subject: Warn on overflow of octal and hex integers
From: Chip Salzenberg <chip@atlantic.net>
Files: proto.h toke.c util.c

Subject: If -w active, warn for commas and hashes ('#') in qw()
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c

Subject: Fixes for pack('w')
From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
Files: pp.c t/op/pack.t

Subject: More complete output from sv_dump()
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: sv.c

Subject: Major '..' and debugger patches
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: lib/perl5db.pl op.c pp_ctl.c scope.c scope.h

Subject: Fix for formline()
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c t/op/write.t

Subject: Fix stack botch in untie and binmode
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pp_sys.c

Subject: Complete EMBED, including symbols from interp.sym
From: Chip Salzenberg <chip@atlantic.net>
Files: MANIFEST embed.pl ext/DynaLoader/dlutils.c ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c perl.h pp_sys.c proto.h regexec.c toke.c util.c x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h

    New define EMBEDMYMALLOC makes embedding total by
    avoiding "Mymalloc" etc.

Subject: Support old embedding for people who want it
From: Chip Salzenberg <chip@atlantic.net>
Files: MANIFEST Makefile.SH old_embed.pl old_global.sym

 PORTABILITY

Subject: Miscellaneous VMS fixes
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl perl.h perl_exp.SH proto.h t/TEST t/io/read.t t/lib/findbin.t t/lib/getopt.t util.c utils/h2xs.PL vms/Makefile vms/config.vms vms/descrip.mms vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs vms/perlvms.pod vms/test.com vms/vms.c

Subject: DJGPP patches (MS-DOS)
From: "Douglas E. Wegscheid" <wegscd@whirlpool.com>
Files: doio.c dosish.h ext/SDBM_File/sdbm/sdbm.c handy.h lib/AutoSplit.pm lib/Cwd.pm lib/File/Find.pm malloc.c perl.c perl.h pp_sys.c proto.h sv.c util.c

Subject: Patch to make Perl work under AmigaOS
From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
Files: MANIFEST hints/amigaos.sh installman lib/File/Basename.pm lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c

12 files changed, 149 insertions, 61 deletions

diff --git a/t/README b/t/README
index d714295dd2..00bf561c23 100644
--- a/t/README
+++ b/t/README
@@ -8,4 +8,4 @@ If you put out extra lines with a '#' character on the front, you don't
 have to worry about removing the extra print statements later since TEST
 ignores lines beginning with '#'.
 
-If you come up with new tests, send them to lwall@sems.com.
+If you come up with new tests, send them to larry@wall.org.
diff --git a/t/TEST b/t/TEST
index 160e316754..4ef50ea478 100755
--- a/t/TEST
+++ b/t/TEST
@@ -41,7 +41,7 @@ while ($test = shift) {
     }
     $te = $test;
     chop($te);
-    print "$te" . '.' x (15 - length($te));
+    print "$te" . '.' x (18 - length($te));
     if ($sharpbang) {
 	open(results,"./$test |") || (print "can't run.\n");
     } else {
@@ -50,6 +50,10 @@ while ($test = shift) {
 	close(script);
 	if (/#!..perl(.*)/) {
 	    $switch = $1;
+	    if ($^O eq 'VMS') {
+		# Must protect uppercase switches with "" on command line
+		$switch =~ s/-([A-Z]\S*)/"-$1"/g;
+	    }
 	} else {
 	    $switch = '';
 	}
diff --git a/t/io/read.t b/t/io/read.t
index 16d32b189c..b27fde17c7 100755
--- a/t/io/read.t
+++ b/t/io/read.t
@@ -15,8 +15,12 @@ read(A,$b,1,4);
 
 close(A);
 
+unlink("a");
+
 if ($b eq "\000\000\000\000_") {
 	print "ok 1\n";
 } else { # Probably "\000bcd_"
 	print "not ok 1\n";
 }
+
+unlink 'a';
diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t
index 81d32c415b..e20cfaba06 100755
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -1,7 +1,7 @@
 #!./perl -w
 
 BEGIN {
-    @INC = '../lib';
+    @INC = '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
 	print "1..0\n";
@@ -23,6 +23,21 @@ sub ok
     print "ok $no\n" ;
 }
 
+sub lexical
+{
+    my(@a) = unpack ("C*", $a) ;
+    my(@b) = unpack ("C*", $b) ;
+
+    my $len = (@a > @b ? @b : @a) ;
+    my $i = 0 ;
+
+    foreach $i ( 0 .. $len -1) {
+        return $a[$i] - $b[$i] if $a[$i] != $b[$i] ;
+    }
+
+    return @a - @b ;
+}
+
 $Dfile = "dbbtree.tmp";
 unlink $Dfile;
 
@@ -31,13 +46,13 @@ umask(0);
 # Check the interface to BTREEINFO
 
 my $dbh = new DB_File::BTREEINFO ;
+ok(1, $dbh->{flags} == 0) ;
+ok(2, $dbh->{cachesize} == 0) ;
+ok(3, $dbh->{psize} == 0) ;
+ok(4, $dbh->{lorder} == 0) ;
+ok(5, $dbh->{minkeypage} == 0) ;
+ok(6, $dbh->{maxkeypage} == 0) ;
 $^W = 0 ;
-ok(1, $dbh->{flags} == undef) ;
-ok(2, $dbh->{cachesize} == undef) ;
-ok(3, $dbh->{psize} == undef) ;
-ok(4, $dbh->{lorder} == undef) ;
-ok(5, $dbh->{minkeypage} == undef) ;
-ok(6, $dbh->{maxkeypage} == undef) ;
 ok(7, $dbh->{compare} == undef) ;
 ok(8, $dbh->{prefix} == undef) ;
 $^W = 1 ;
@@ -170,13 +185,9 @@ ok(28, $i == 30) ;
 ok(29, $#keys == 31) ;
 
 #Check that the keys can be retrieved in order
-$ok = 1 ;
-foreach (keys %h)
-{
-    ($ok = 0), last if defined $previous && $previous gt $_ ;
-    $previous = $_ ;
-}
-ok(30, $ok ) ;
+my @b = keys %h ;
+my @c = sort lexical @b ;
+ok(30, ArrayCompare(\@b, \@c)) ;
 
 $h{'foo'} = '';
 ok(31, $h{'foo'} eq '' ) ;
@@ -440,7 +451,9 @@ $^W = 1 ;
 @srt_3 = sort { length $a <=> length $b } @Keys ;
  
 foreach (@Keys) {
-    $^W = 0 ; $h{$_} = 1 ; $^W = 1 ;
+    $^W = 0 ; 
+    $h{$_} = 1 ; 
+    $^W = 1 ;
     $g{$_} = 1 ;
     $k{$_} = 1 ;
 }
diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
index 999ca6021a..9427a43838 100755
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -1,7 +1,7 @@
 #!./perl -w
 
 BEGIN {
-    @INC = '../lib';
+    @INC = '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
 	print "1..0\n";
@@ -33,15 +33,13 @@ umask(0);
 # Check the interface to RECNOINFO
 
 my $dbh = new DB_File::RECNOINFO ;
-$^W = 0 ;
-ok(1, $dbh->{bval} == undef ) ;
-ok(2, $dbh->{cachesize} == undef) ;
-ok(3, $dbh->{psize} == undef) ;
-ok(4, $dbh->{flags} == undef) ;
-ok(5, $dbh->{lorder} == undef);
-ok(6, $dbh->{reclen} == undef);
-ok(7, $dbh->{bfname} eq undef);
-$^W = 0 ;
+ok(1, $dbh->{bval} == 0 ) ;
+ok(2, $dbh->{cachesize} == 0) ;
+ok(3, $dbh->{psize} == 0) ;
+ok(4, $dbh->{flags} == 0) ;
+ok(5, $dbh->{lorder} == 0);
+ok(6, $dbh->{reclen} == 0);
+ok(7, $dbh->{bfname} eq "");
 
 $dbh->{bval} = 3000 ;
 ok(8, $dbh->{bval} == 3000 );
diff --git a/t/lib/findbin.t b/t/lib/findbin.t
index 8d5347cdb7..3e742f9a4f 100755
--- a/t/lib/findbin.t
+++ b/t/lib/findbin.t
@@ -9,5 +9,5 @@ print "1..1\n";
 
 use FindBin qw($Bin);
 
-print "not " unless $Bin =~ m,t/lib$,;
+print "not " unless $Bin =~ m,t[/.]lib\]?$,;
 print "ok 1\n";
diff --git a/t/lib/getopt.t b/t/lib/getopt.t
index ec2ea49059..fb70f10aae 100755
--- a/t/lib/getopt.t
+++ b/t/lib/getopt.t
@@ -41,7 +41,6 @@ print "ok 7\n";
 # Try illegal options, but avoid printing of the error message
 
 open(STDERR, ">stderr") || die;
-unlink "stderr";
 
 @ARGV = qw(-h help);
 
@@ -69,3 +68,6 @@ print "ok 10\n";
 
 print "not " unless "@ARGV" eq "file";
 print "ok 11\n";
+
+close STDERR;
+unlink "stderr";
diff --git a/t/lib/searchdict.t b/t/lib/searchdict.t
index 69329d65c1..447c425b27 100755
--- a/t/lib/searchdict.t
+++ b/t/lib/searchdict.t
@@ -41,7 +41,7 @@ EOT
 use Search::Dict;
 
 open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
-unlink "dict-$$";
+binmode DICT;			# To make length expected one.
 print DICT $DICT;
 
 my $pos = look *DICT, "abash";
@@ -60,3 +60,6 @@ chomp($word = <DICT>);
 
 print "not " if $pos < 0 || $word ne "Aarhus";
 print "ok 3\n";
+
+close DICT or die "cannot close";
+unlink "dict-$$";
diff --git a/t/op/bop.t b/t/op/bop.t
index 8ebf8d3eeb..7cf200ff25 100755
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -1,24 +1,44 @@
 #!./perl
 
 #
-# test the bit operators '&', '|' and '^'
+# test the bit operators '&', '|', '^', '~', '<<', and '>>'
 #
 
-print "1..9\n";
+print "1..18\n";
 
 # numerics
 print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n");
 print ((0xdead | 0xbeef) == 0xfeef ? "ok 2\n" : "not ok 2\n");
 print ((0xdead ^ 0xbeef) == 0x6042 ? "ok 3\n" : "not ok 3\n");
+print ((~0xdead & 0xbeef) == 0x2042 ? "ok 4\n" : "not ok 4\n");
+
+# shifts
+print ((257 << 7) == 32896 ? "ok 5\n" : "not ok 5\n");
+print ((33023 >> 7) == 257 ? "ok 6\n" : "not ok 6\n");
+
+# signed vs. unsigned
+print ((~0 > 0 && do { use integer; ~0 } == -1)
+       ? "ok 7\n" : "not ok 7\n");
+print (((2147483648 & -1) > 0 && do { use integer; 2147483648 & -1 } < 0)
+       ? "ok 8\n" : "not ok 8\n");
+print (((2147483648 | 1) > 0 && do { use integer; 2147483648 | 1 } < 0)
+       ? "ok 9\n" : "not ok 9\n");
+print (((2147483648 ^ 1) > 0 && do { use integer; 2147483648 ^ 1 } < 0)
+       ? "ok 10\n" : "not ok 10\n");
+print (((1 << 31) == 2147483648 && do { use integer; 1 << 31 } == -2147483648)
+       ? "ok 11\n" : "not ok 11\n");
+print (((2147483648 >> 1) == 1073741824 &&
+       do { use integer; 2147483648 >> 1 } == -1073741824)
+       ? "ok 12\n" : "not ok 12\n");
 
 # short strings
-print (("AAAAA" & "zzzzz") eq '@@@@@' ? "ok 4\n" : "not ok 4\n");
-print (("AAAAA" | "zzzzz") eq '{{{{{' ? "ok 5\n" : "not ok 5\n");
-print (("AAAAA" ^ "zzzzz") eq ';;;;;' ? "ok 6\n" : "not ok 6\n");
+print (("AAAAA" & "zzzzz") eq '@@@@@' ? "ok 13\n" : "not ok 13\n");
+print (("AAAAA" | "zzzzz") eq '{{{{{' ? "ok 14\n" : "not ok 14\n");
+print (("AAAAA" ^ "zzzzz") eq ';;;;;' ? "ok 15\n" : "not ok 15\n");
 
 # long strings
 $foo = "A" x 150;
 $bar = "z" x 75;
-print (($foo & $bar) eq ('@'x75 ) ? "ok 7\n" : "not ok 7\n");
-print (($foo | $bar) eq ('{'x75 . 'A'x75) ? "ok 8\n" : "not ok 8\n");
-print (($foo ^ $bar) eq (';'x75 . 'A'x75) ? "ok 9\n" : "not ok 9\n");
+print (($foo & $bar) eq ('@'x75 ) ? "ok 16\n" : "not ok 16\n");
+print (($foo | $bar) eq ('{'x75 . 'A'x75) ? "ok 17\n" : "not ok 17\n");
+print (($foo ^ $bar) eq (';'x75 . 'A'x75) ? "ok 18\n" : "not ok 18\n");
diff --git a/t/op/pack.t b/t/op/pack.t
index f15a7033ab..b11fe234e7 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
 
-print "1..16\n";
+print "1..25\n";
 
 $format = "c2x5CCxsdila6";
 # Need the expression in here to force ary[5] to be numeric.  This avoids
@@ -47,25 +47,26 @@ print +($x = unpack("I",pack("I", 0xFFFFFFFF))) == 0xFFFFFFFF
 
 # check 'w'
 my $test=10;
-my @x = (5,130,256,560,32000,3097152,268435455,2**30+20, 2**56+4711);
+my @x = (5,130,256,560,32000,3097152,268435455,1073741844,
+         '4503599627365785','23728385234614992549757750638446');
 my $x = pack('w*', @x);
-my $y = pack 'C*', 5,129,2,130,0,132,48,129,250,0,129,189,132,64,255,255,255,
-                   127,132,128,128,128,20,129,128,128,128,128,128,128,164,96;
+my $y = pack 'H*', '0581028200843081fa0081bd8440ffffff7f848080801487ffffffffffdb19caefe8e1eeeea0c2e1e3e8ede1ee6e';
 
 print $x eq $y ? "ok $test\n" : "not ok $test\n"; $test++;
 
 @y = unpack('w*', $y);
-my $a = join ':', @x;
-my $b = join ':', @y;
-
-print $a eq $b ? "ok $test\n" : "not ok $test\n"; $test++;
+my $a;
+while ($a = pop @x) {
+  my $b = pop @y;
+  print $a eq $b ? "ok $test\n" : "not ok $test\n$a\n$b\n"; $test++;
+}
 
 @y = unpack('w2', $x);
 
 print scalar(@y) == 2 ? "ok $test\n" : "not ok $test\n"; $test++;
 print $y[1] == 130 ? "ok $test\n" : "not ok $test\n"; $test++;
 
-# test exections
+# test exeptions
 eval { $x = unpack 'w', pack 'C*', 0xff, 0xff};
 print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++;
 
diff --git a/t/op/tie.t b/t/op/tie.t
index cf116519e6..77e74db4e2 100755
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -3,7 +3,7 @@
 # This test harness will (eventually) test the "tie" functionality
 # without the need for a *DBM* implementation.
 
-# Currently it only tests use strict "untie".
+# Currently it only tests the untie warning 
 
 chdir 't' if -d 't';
 @INC = "../lib";
@@ -11,6 +11,9 @@ $ENV{PERL5LIB} = "../lib";
 
 $|=1;
 
+# catch warnings into fatal errors
+$SIG{__WARN__} = sub { die "WARNING: @_" } ;
+
 undef $/;
 @prgs = split "\n########\n", <DATA>;
 print "1..", scalar @prgs, "\n";
@@ -22,7 +25,7 @@ for (@prgs){
     $results = $@ ;
     $results =~ s/\n+$//;
     $expected =~ s/\n+$//;
-    if ( $status or $results !~ /^$expected/){
+    if ( $status or $results and $results !~ /^WARNING: $expected/){
 	print STDERR "STATUS: $status\n";
 	print STDERR "PROG: $prog\n";
 	print STDERR "EXPECTED:\n$expected\n";
@@ -74,7 +77,8 @@ EXPECT
 ########
 
 # strict behaviour, without any extra references
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 untie %h;
@@ -82,26 +86,29 @@ EXPECT
 ########
 
 # strict behaviour, with 1 extra references generating an error
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 untie %h;
 EXPECT
-Can't untie: 1 inner references still exist at
+untie attempted while 1 inner references still exist
 ########
 
 # strict behaviour, with 1 extra references via tied generating an error
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 $a = tied %h;
 untie %h;
 EXPECT
-Can't untie: 1 inner references still exist at
+untie attempted while 1 inner references still exist
 ########
 
 # strict behaviour, with 1 extra references which are destroyed
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 $a = 0 ;
@@ -110,7 +117,8 @@ EXPECT
 ########
 
 # strict behaviour, with extra 1 references via tied which are destroyed
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 $a = tied %h;
@@ -120,22 +128,25 @@ EXPECT
 ########
 
 # strict error behaviour, with 2 extra references 
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 $b = tied %h ;
 untie %h;
 EXPECT
-Can't untie: 2 inner references still exist at
+untie attempted while 2 inner references still exist
 ########
 
 # strict behaviour, check scope of strictness.
-no strict 'untie';
+#no warning 'untie';
+local $^W = 0 ;
 use Tie::Hash ;
 $A = tie %H, Tie::StdHash;
 $C = $B = tied %H ;
 {
-    use strict 'untie';
+    #use warning 'untie';
+    local $^W = 1 ;
     use Tie::Hash ;
     tie %h, Tie::StdHash;
     untie %h;
diff --git a/t/op/write.t b/t/op/write.t
index d14cef3cd6..46ec8130b9 100755
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
 
-print "1..3\n";
+print "1..5\n";
 
 format OUT =
 the quick brown @<<
@@ -133,3 +133,35 @@ if (`cat Op_write.tmp` eq $right)
 else
     { print "not ok 3\n"; }
 
+# formline tests
+
+$mustbe = <<EOT;
+@ a
+@> ab
+@>> abc
+@>>>  abc
+@>>>>   abc
+@>>>>>    abc
+@>>>>>>     abc
+@>>>>>>>      abc
+@>>>>>>>>       abc
+@>>>>>>>>>        abc
+@>>>>>>>>>>         abc
+EOT
+
+$was1 = $was2 = '';
+for (0..10) {           
+  # lexical picture
+  $^A = '';
+  my $format1 = '@' . '>' x $_;
+  formline $format1, 'abc';
+  $was1 .= "$format1 $^A\n";
+  # global
+  $^A = '';
+  local $format2 = '@' . '>' x $_;
+  formline $format2, 'abc';
+  $was2 .= "$format2 $^A\n";
+}
+print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
+print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
+