# See README.warning for information of what the patch does.
#
# Apply with patch -p0 <warn.patch

exit 0

-----------------------------------------------------------------------

*** MANIFEST.orig	Wed Jul 29 07:19:14 1998
--- MANIFEST	Wed Jul 29 07:20:45 1998
***************
*** 750,755 ****
--- 750,756 ----
  lib/utf8_heavy.pl				Support routines for utf8 pragma
  lib/validate.pl		Perl library supporting wholesale file mode validation
  lib/vars.pm		Declare pseudo-imported global variables
+ lib/warning.pm		For "use warning"
  makeaperl.SH		perl script that produces a new perl binary
  makedepend.SH		Precursor to makedepend
  makedir.SH		Precursor to makedir
***************
*** 1123,1128 ****
--- 1124,1147 ----
  t/pragma/strict.t	See if strictures work
  t/pragma/subs.t		See if subroutine pseudo-importation works
  t/pragma/warn-1global	Tests of global warnings for warning.t
+ t/pragma/warn-2use	Tests for "use warning" for warning.t
+ t/pragma/warn-doio	Tests for doio.c for warning.t
+ t/pragma/warn-gv	Tests for gv.c for warning.t
+ t/pragma/warn-mg	Tests for mg.c for warning.t
+ t/pragma/warn-op	Tests for op.c for warning.t
+ t/pragma/warn-perl	Tests for perl.c for warning.t
+ t/pragma/warn-perly	Tests for perly.y for warning.t
+ t/pragma/warn-pp	Tests for pp.c for warning.t
+ t/pragma/warn-pp_ctl	Tests for pp_ctl.c for warning.t
+ t/pragma/warn-pp_hot	Tests for pp_hot.c for warning.t
+ t/pragma/warn-pp_sys	Tests for pp_sys.c for warning.t
+ t/pragma/warn-regcomp	Tests for regcomp.c for warning.t
+ t/pragma/warn-regexec	Tests for regexec.c for warning.t
+ t/pragma/warn-sv	Tests for sv.c for warning.t
+ t/pragma/warn-taint	Tests for taint.c for warning.t
+ t/pragma/warn-toke	Tests for toke.c for warning.t
+ t/pragma/warn-universal	Tests for universal.c for warning.t
+ t/pragma/warn-util	Tests for util.c for warning.t
  t/pragma/warning.t	See if warning controls work
  taint.c			Tainting code
  thrdvar.h		Per-thread variables
***************
*** 1178,1183 ****
--- 1197,1204 ----
  vms/vms_yfix.pl		convert Unix perly.[ch] to VMS perly_[ch].vms
  vms/vmsish.h		VMS-specific C header for Perl core
  vms/writemain.pl	Generate perlmain.c from miniperlmain.c+extensions
+ warning.h		The warning numbers
+ warning.pl		Program to write warning.h and lib/warning.pm
  win32/GenCAPI.pl	Win32 port for C API with PERL_OBJECT
  win32/Makefile		Win32 makefile for NMAKE (Visual C++ build)
  win32/TEST		Win32 port
*** Makefile.SH.orig	Wed Jul 29 07:19:14 1998
--- Makefile.SH	Wed Jul 29 07:20:45 1998
***************
*** 210,216 ****
  h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
  h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h
  h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
! h5 = bytecode.h byterun.h utf8.h
  h = $(h1) $(h2) $(h3) $(h4) $(h5)
  
  c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c byterun.c
--- 210,216 ----
  h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
  h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h
  h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
! h5 = bytecode.h byterun.h utf8.h warning.h
  h = $(h1) $(h2) $(h3) $(h4) $(h5)
  
  c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c byterun.c
***************
*** 462,467 ****
--- 462,468 ----
  #	byterun.c:	bytecode.pl
  #	lib/B/Asmdata.pm:	bytecode.pl
  #	regnodes.h:	regcomp.pl
+ #	warning.h lib/warning.pm:	warning.pl
  # The correct versions should be already supplied with the perl kit,
  # in case you don't have perl available.
  # To force them to run, type
***************
*** 472,477 ****
--- 473,479 ----
  	perl embed.pl
  	perl bytecode.pl
  	perl regcomp.pl
+ 	perl warning.pl
  
  # Extensions:
  # Names added to $(dynamic_ext) or $(static_ext) or $(nonxs_ext) will
*** /dev/null	Wed Jul 29 09:03:56 1998
--- README.warning	Wed Jul 29 07:22:25 1998
***************
*** 0 ****
--- 1,244 ----
+ Date: 29th July 1998
+ 
+ This patch adds lexical warnings to Perl. It should apply over
+ 5.005_50
+ 
+ NOTE: This is a prototype. Do not assume that lexical warnings will
+       necessarily be anything like this implementation.
+ 
+ Changes 
+ =======
+ 
+   Date: 8th April 1998
+ 
+     * patch now applies cleanly over 5.004_64
+ 
+     * added the -X switch (the inverse "lint" command)
+ 
+   Date: 26th Feb 1997
+ 
+     * By popular demand, the warnings bitmask can now be of arbitrary
+       length. The code uses an SV* to store the bitmask.
+ 
+     * Rationalised the warning categories a bit. This area still needs
+       a lot of work.
+ 
+     * Added -W switch (the "lint" command).
+ 
+     * Added an experimental feature to allow warnings to be excalated
+       to fatal errors.
+ 
+ 
+ The "use warning" pragma
+ ========================
+ 
+     The "use warning" pragma is intended to replace both the use of the
+     command line flag "-w" and its equivalent variable $^W with a pragma
+     that works like the existing "strict" pragma.
+ 
+     This means that the scope of the pragma is limited to the enclosing
+     block. It also means that that a pragma setting will not leak across
+     files (via use/require/do). This will allow authors to define the
+     degree of warning checks that will be applied to their module.
+ 
+     By default warnings are disabled.
+ 
+     All warnings are enabled in a block by either of these:
+ 
+ 	use warning ;
+ 	use warning 'all' ;
+ 
+     Similarly all warnings are disabled in a block by either of these:
+ 
+ 	no warning ;
+ 	no warning 'all' ;
+ 
+     A hierarchy of "categories" have been defined to allow groups of
+     warnings to be enabled/disabled in isolation.  The current
+     hierarchy is:
+ 
+ 	all - +--- unsafe -------+--- taint
+ 	      |			 |
+ 	      |			 +--- substr
+ 	      |			 |
+ 	      |			 +--- signal
+ 	      |			 |
+ 	      |			 +--- closure
+ 	      |			 |
+ 	      |			 +--- untie
+ 	      |			 
+ 	      +--- io	---------+--- pipe
+ 	      |			 |
+ 	      |			 +--- unopened
+ 	      |			 |
+ 	      |			 +--- closed
+ 	      |			 |
+ 	      |			 +--- newline
+ 	      |			 |
+ 	      |			 +--- exec
+ 	      |
+ 	      +--- syntax    ----+--- ambiguous
+ 	      |			 |
+ 	      |			 +--- semicolon
+ 	      |			 |
+ 	      |			 +--- precedence
+ 	      |			 |
+ 	      |			 +--- reserved
+ 	      |			 |
+ 	      |			 +--- octal
+ 	      |			 |
+ 	      |			 +--- parenthesis
+ 	      |			 |
+ 	      |			 +--- deprecated
+ 	      |
+ 	      |--- uninitialized
+ 	      |
+ 	      +--- void
+ 	      |
+ 	      +--- recursion
+ 	      |
+ 	      +--- redefine
+ 	      |
+ 	      +--- numeric
+ 	      |
+ 	      +--- once
+ 	      |
+ 	      +--- misc
+ 
+     This hierarchy is very tentative. Feedback is needed.
+ 
+     Just like the "strict" pragma any of these categories can be
+     combined
+ 
+ 	use warning qw(void redefine) ;
+ 	no warning qw(io syntax untie) ;
+ 
+ The "lint" flag, -W
+ ===================
+ 
+ If the -W flag is used on the command line, it will enable all warnings
+ throughout the program regardless of whether warnings were disabled
+ locally using "no warning" or $^W =0. This includes any file that gets
+ included during compilation via use/require.
+ 
+ The inverse "lint" flag, -X
+ ===========================
+ Does exactly the same as the -W flag, except it disables all warnings.
+ 
+ 
+ Backward Compatability
+ ======================
+ 
+     How Lexical Warnings interact with -w/$^W
+ 
+     1. The -w flag just sets the global $^W variable as in 5.004
+        This means that any legacy code that currently relies on
+        manipulating $^W to control warning behaviour will still work.
+ 
+     2. Apart from now being a boolean, the $^W variable operates in
+        exactly the same horrible uncontrolled global way as in 5.004,
+        except...
+ 
+     3. If a piece of code is under the control of a lexical warning
+        pragma, the $^W variable will be ignored.
+  
+        The combined effect of 2 & 3 is that it will will allow new code
+        which will use the lexical warning pragma to control old
+        $^W-type code (using a local $^W=0) if it really wants to, but
+        not vice-versa.
+  
+     4. The only way to override a lexical warnings setting is with the
+        new -W or -X command line flags.
+ 
+ 
+ Fatal Warnings
+ ==============
+ 
+ This feature is very experimental.
+ 
+ The presence of the word "FATAL" in the category list will escalate any
+ warnings from the category specified that are detected in the lexical
+ scope into fatal errors. In the code below, there are 3 places where a
+ deprecated warning will be detected, the middle one will produce a
+ fatal error.
+ 
+ 
+     use warning ;
+ 
+     $a = 1 if $a EQ $b ;
+ 
+     {
+ 	use warning qw(FATAL deprecated) ;
+         $a = 1 if $a EQ $b ;
+     }
+ 
+     $a = 1 if $a EQ $b ;
+ 
+ 
+ TODO
+ ====
+ 
+ test harness for -X (assuming it is a permanent fixture).
+ win32, os2 & vms all have warnings. These need to be included.
+ 
+ Unresolved Issues
+ =================
+ 
+   The pragma name?
+     A few possibilities:
+ 	warning
+ 	warnings
+ 	warn
+ 
+   Hierarchy of Warnings
+     The current patch has a fairly arbitrary hierarchy.
+     Ideas for a useful hierarchy would be most welcome.
+ 
+   A command line option to turn off all warnings?
+      -X or -q, perhaps.
+ 
+   Current mandatory warnings.
+     May be useful to bring them under the control of this pragma.
+ 
+   Severity
+     Do we want/need a severity classification?
+         pedantic
+         high/strict/precise
+         medium/default
+         low/common
+     
+   Versions
+     This is a thorhy issue. Say someone writes a script using Perl
+     5.004 and places this at the top:
+ 
+ 	use warning ;
+ 
+     Time passes and 5.005 comes out. It has added a few extra warnings.
+     The script prints warning messages.
+ 
+     A possibility is to allow the warnings that are checked to be
+     limited to those available in a given version of Perl. A possible
+     syntax could be:
+ 
+ 	use warning 5.004 ;
+ 
+     or
+ 
+ 	use warning 5.004 qw(void uninitialized) ;
+ 
+     Do we really need this amount of control?
+ 
+   Documentation
+     There isn't any yet.
+ 
+ 
+   perl5db.pl
+     The debugger saves and restores $^W at runtime. I haven't checked
+     whether the debugger will still work with the lexical warnings
+     patch applied.
+ 
+   diagnostics.pm
+     I *think* I've got diagnostics to work with the lexiacal warnings
+     patch, but there were design decisions made in diagnostics to work
+     around the limitations of $^W. Now that those limitations are gone,
+     the module should be revisited.
*** cop.h.orig	Mon Jul 20 02:08:39 1998
--- cop.h	Wed Jul 29 07:20:46 1998
***************
*** 15,20 ****
--- 15,21 ----
      U32		cop_seq;	/* parse sequence number */
      I32		cop_arybase;	/* array base this line was compiled with */
      line_t      cop_line;       /* line # of this command */
+     SV *	cop_warnings;	/* lexical warnings bitmask */
  };
  
  #define Nullcop Null(COP*)
*** doio.c.orig	Wed Jul 22 09:02:21 1998
--- doio.c	Wed Jul 29 07:20:46 1998
***************
*** 173,180 ****
  	    TAINT_PROPER("piped open");
  	    if (name[strlen(name)-1] == '|') {
  		name[strlen(name)-1] = '\0' ;
! 		if (PL_dowarn)
! 		    warn("Can't do bidirectional pipe");
  	    }
  	    fp = PerlProc_popen(name,"w");
  	    writing = 1;
--- 173,180 ----
  	    TAINT_PROPER("piped open");
  	    if (name[strlen(name)-1] == '|') {
  		name[strlen(name)-1] = '\0' ;
! 		if (ckWARN(WARN_PIPE))
! 		    warner(WARN_PIPE, "Can't do bidirectional pipe");
  	    }
  	    fp = PerlProc_popen(name,"w");
  	    writing = 1;
***************
*** 283,290 ****
  	}
      }
      if (!fp) {
! 	if (PL_dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
! 	    warn(warn_nl, "open");
  	goto say_false;
      }
      if (IoTYPE(io) &&
--- 283,290 ----
  	}
      }
      if (!fp) {
! 	if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == '<' && strchr(name, '\n'))
! 	    warner(WARN_NEWLINE, warn_nl, "open");
  	goto say_false;
      }
      if (IoTYPE(io) &&
***************
*** 601,608 ****
      io = GvIO(gv);
      if (!io) {		/* never opened */
  	if (not_implicit) {
! 	    if (PL_dowarn)
! 		warn("Close on unopened file <%s>",GvENAME(gv));
  	    SETERRNO(EBADF,SS$_IVCHAN);
  	}
  	return FALSE;
--- 601,609 ----
      io = GvIO(gv);
      if (!io) {		/* never opened */
  	if (not_implicit) {
! 	    if (ckWARN(WARN_UNOPENED))
! 		warner(WARN_UNOPENED, 
! 		       "Close on unopened file <%s>",GvENAME(gv));
  	    SETERRNO(EBADF,SS$_IVCHAN);
  	}
  	return FALSE;
***************
*** 699,706 ****
  #endif
  	return PerlIO_tell(fp);
      }
!     if (PL_dowarn)
! 	warn("tell() on unopened file");
      SETERRNO(EBADF,RMS$_IFI);
      return -1L;
  }
--- 700,707 ----
  #endif
  	return PerlIO_tell(fp);
      }
!     if (ckWARN(WARN_UNOPENED))
! 	warner(WARN_UNOPENED, "tell() on unopened file");
      SETERRNO(EBADF,RMS$_IFI);
      return -1L;
  }
***************
*** 718,725 ****
  #endif
  	return PerlIO_seek(fp, pos, whence) >= 0;
      }
!     if (PL_dowarn)
! 	warn("seek() on unopened file");
      SETERRNO(EBADF,RMS$_IFI);
      return FALSE;
  }
--- 719,726 ----
  #endif
  	return PerlIO_seek(fp, pos, whence) >= 0;
      }
!     if (ckWARN(WARN_UNOPENED))
! 	warner(WARN_UNOPENED, "seek() on unopened file");
      SETERRNO(EBADF,RMS$_IFI);
      return FALSE;
  }
***************
*** 732,739 ****
  
      if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
  	return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
!     if (PL_dowarn)
! 	warn("sysseek() on unopened file");
      SETERRNO(EBADF,RMS$_IFI);
      return -1L;
  }
--- 733,740 ----
  
      if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
  	return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
!     if (ckWARN(WARN_UNOPENED))
! 	warner(WARN_UNOPENED, "sysseek() on unopened file");
      SETERRNO(EBADF,RMS$_IFI);
      return -1L;
  }
***************
*** 853,860 ****
      }
      switch (SvTYPE(sv)) {
      case SVt_NULL:
! 	if (PL_dowarn)
! 	    warn(warn_uninit);
  	return TRUE;
      case SVt_IV:
  	if (SvIOK(sv)) {
--- 854,861 ----
      }
      switch (SvTYPE(sv)) {
      case SVt_NULL:
! 	if (ckWARN(WARN_UNINITIALIZED))
! 	    warner(WARN_UNINITIALIZED, warn_uninit);
  	return TRUE;
      case SVt_IV:
  	if (SvIOK(sv)) {
***************
*** 894,901 ****
  	else {
  	    if (tmpgv == PL_defgv)
  		return PL_laststatval;
! 	    if (PL_dowarn)
! 		warn("Stat on unopened file <%s>",
  		  GvENAME(tmpgv));
  	    PL_statgv = Nullgv;
  	    sv_setpv(PL_statname,"");
--- 895,902 ----
  	else {
  	    if (tmpgv == PL_defgv)
  		return PL_laststatval;
! 	    if (ckWARN(WARN_UNOPENED))
! 		warner(WARN_UNOPENED, "Stat on unopened file <%s>",
  		  GvENAME(tmpgv));
  	    PL_statgv = Nullgv;
  	    sv_setpv(PL_statname,"");
***************
*** 920,927 ****
  	sv_setpv(PL_statname, s);
  	PL_laststype = OP_STAT;
  	PL_laststatval = PerlLIO_stat(s, &PL_statcache);
! 	if (PL_laststatval < 0 && PL_dowarn && strchr(s, '\n'))
! 	    warn(warn_nl, "stat");
  	return PL_laststatval;
      }
  }
--- 921,928 ----
  	sv_setpv(PL_statname, s);
  	PL_laststype = OP_STAT;
  	PL_laststatval = PerlLIO_stat(s, &PL_statcache);
! 	if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
! 	    warner(WARN_NEWLINE, warn_nl, "stat");
  	return PL_laststatval;
      }
  }
***************
*** 951,958 ****
  #else
      PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
  #endif
!     if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
! 	warn(warn_nl, "lstat");
      return PL_laststatval;
  }
  
--- 952,959 ----
  #else
      PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
  #endif
!     if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
! 	warner(WARN_NEWLINE, warn_nl, "lstat");
      return PL_laststatval;
  }
  
***************
*** 979,986 ****
  	    PerlProc_execvp(tmps,PL_Argv);
  	else
  	    PerlProc_execvp(PL_Argv[0],PL_Argv);
! 	if (PL_dowarn)
! 	    warn("Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno));
      }
      do_execfree();
      return FALSE;
--- 980,988 ----
  	    PerlProc_execvp(tmps,PL_Argv);
  	else
  	    PerlProc_execvp(PL_Argv[0],PL_Argv);
! 	if (ckWARN(WARN_EXEC))
! 	    warner(WARN_EXEC, "Can't exec \"%s\": %s", 
! 		PL_Argv[0], Strerror(errno));
      }
      do_execfree();
      return FALSE;
***************
*** 1082,1089 ****
  	    do_execfree();
  	    goto doshell;
  	}
! 	if (PL_dowarn)
! 	    warn("Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno));
      }
      do_execfree();
      return FALSE;
--- 1084,1092 ----
  	    do_execfree();
  	    goto doshell;
  	}
! 	if (ckWARN(WARN_EXEC))
! 	    warner(WARN_EXEC, "Can't exec \"%s\": %s", 
! 		PL_Argv[0], Strerror(errno));
      }
      do_execfree();
      return FALSE;
*** global.sym.orig	Wed Jul 29 07:19:16 1998
--- global.sym	Wed Jul 29 07:20:46 1998
***************
*** 1107,1112 ****
--- 1107,1113 ----
  uv_to_utf8
  wait4pid
  warn
+ warner
  watch
  whichsig
  yydestruct
*** gv.c.orig	Mon Jul 20 09:20:08 1998
--- gv.c	Wed Jul 29 07:20:47 1998
***************
*** 223,230 ****
  	    SV* sv = *svp++;
  	    HV* basestash = gv_stashsv(sv, FALSE);
  	    if (!basestash) {
! 		if (PL_dowarn)
! 		    warn("Can't locate package %s for @%s::ISA",
  			SvPVX(sv), HvNAME(stash));
  		continue;
  	    }
--- 223,230 ----
  	    SV* sv = *svp++;
  	    HV* basestash = gv_stashsv(sv, FALSE);
  	    if (!basestash) {
! 		if (ckWARN(WARN_MISC))
! 		    warner(WARN_MISC, "Can't locate package %s for @%s::ISA",
  			SvPVX(sv), HvNAME(stash));
  		continue;
  	    }
***************
*** 358,365 ****
      /*
       * Inheriting AUTOLOAD for non-methods works ... for now.
       */
!     if (PL_dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash))
! 	warn(
  	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
  	     HvNAME(stash), (int)len, name);
  
--- 358,366 ----
      /*
       * Inheriting AUTOLOAD for non-methods works ... for now.
       */
!     if (ckWARN(WARN_DEPRECATED) && !method && 
! 	(GvCVGEN(gv) || GvSTASH(gv) != stash))
! 	warner(WARN_DEPRECATED,
  	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
  	     HvNAME(stash), (int)len, name);
  
***************
*** 736,743 ****
  	goto magicalize;
      case '#':
      case '*':
! 	if (PL_dowarn && len == 1 && sv_type == SVt_PV)
! 	    warn("Use of $%s is deprecated", name);
  	/* FALL THROUGH */
      case '[':
      case '^':
--- 737,744 ----
  	goto magicalize;
      case '#':
      case '*':
! 	if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV)
! 	    warner(WARN_DEPRECATED, "Use of $%s is deprecated", name);
  	/* FALL THROUGH */
      case '[':
      case '^':
***************
*** 755,760 ****
--- 756,762 ----
      case '/':
      case '|':
      case '\001':
+     case '\002':
      case '\004':
      case '\005':
      case '\006':
***************
*** 893,899 ****
  		PL_curcop->cop_filegv = filegv;
  		if (filegv && GvMULTI(filegv))	/* Filename began with slash */
  		    continue;
! 		warn("Name \"%s::%s\" used only once: possible typo",
  			HvNAME(stash), GvNAME(gv));
  	    }
  	}
--- 895,902 ----
  		PL_curcop->cop_filegv = filegv;
  		if (filegv && GvMULTI(filegv))	/* Filename began with slash */
  		    continue;
! 		warner(WARN_ONCE,
! 			"Name \"%s::%s\" used only once: possible typo",
  			HvNAME(stash), GvNAME(gv));
  	    }
  	}
*** lib/diagnostics.pm.orig	Mon Jul 20 02:14:13 1998
--- lib/diagnostics.pm	Wed Jul 29 07:20:47 1998
***************
*** 274,280 ****
  
  $transmo = <<EOFUNC;
  sub transmo {
!     local \$^W = 0;  # recursive warnings we do NOT need!
      study;
  EOFUNC
  
--- 274,280 ----
  
  $transmo = <<EOFUNC;
  sub transmo {
!     #local \$^W = 0;  # recursive warnings we do NOT need!
      study;
  EOFUNC
  
***************
*** 371,377 ****
  
  sub import {
      shift;
!     $old_w = $^W;
      $^W = 1; # yup, clobbered the global variable; tough, if you
  	     # want diags, you want diags.
      return if $SIG{__WARN__} eq \&warn_trap;
--- 371,377 ----
  
  sub import {
      shift;
!     #$old_w = $^W;
      $^W = 1; # yup, clobbered the global variable; tough, if you
  	     # want diags, you want diags.
      return if $SIG{__WARN__} eq \&warn_trap;
***************
*** 407,413 ****
  
  sub disable {
      shift;
!     $^W = $old_w;
      return unless $SIG{__WARN__} eq \&warn_trap;
      $SIG{__WARN__} = $oldwarn;
      $SIG{__DIE__} = $olddie;
--- 407,413 ----
  
  sub disable {
      shift;
!     #$^W = $old_w;
      return unless $SIG{__WARN__} eq \&warn_trap;
      $SIG{__WARN__} = $oldwarn;
      $SIG{__DIE__} = $olddie;
*** /dev/null	Wed Jul 29 09:03:56 1998
--- lib/warning.pm	Wed Jul 29 07:20:47 1998
***************
*** 0 ****
--- 1,171 ----
+ 
+ # This file was created by warning.pl
+ # Any changes made here will be lost.
+ #
+ 
+ package warning;
+ 
+ =head1 NAME
+ 
+ warning - Perl pragma to control 
+ 
+ =head1 SYNOPSIS
+ 
+     use warning;
+ 
+     use warning "all";
+     use warning "deprecated";
+ 
+     use warning;
+     no warning "unsafe";
+ 
+ =head1 DESCRIPTION
+ 
+ If no import list is supplied, all possible restrictions are assumed.
+ (This is the safest mode to operate in, but is sometimes too strict for
+ casual programming.)  Currently, there are three possible things to be
+ strict about:  
+ 
+ =over 6
+ 
+ =item C<warning deprecated>
+ 
+ This generates a runtime error if you use deprecated 
+ 
+     use warning 'deprecated';
+ 
+ =back
+ 
+ See L<perlmod/Pragmatic Modules>.
+ 
+ 
+ =cut
+ 
+ use Carp ;
+ 
+ %Bits = (
+     'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55", # [0..31]
+     'ambiguous'		=> "\x00\x00\x00\x00\x10\x00\x00\x00", # [18]
+     'closed'		=> "\x00\x00\x00\x00\x00\x40\x00\x00", # [23]
+     'closure'		=> "\x00\x04\x00\x00\x00\x00\x00\x00", # [5]
+     'default'		=> "\x00\x00\x10\x00\x00\x00\x00\x00", # [10]
+     'deprecated'	=> "\x00\x00\x00\x10\x00\x00\x00\x00", # [14]
+     'exec'		=> "\x00\x00\x00\x00\x00\x00\x01\x00", # [24]
+     'io'		=> "\x00\x00\x00\x00\x00\x54\x15\x00", # [21..26]
+     'misc'		=> "\x00\x00\x00\x00\x00\x00\x00\x04", # [29]
+     'newline'		=> "\x00\x00\x00\x00\x00\x10\x00\x00", # [22]
+     'numeric'		=> "\x00\x00\x04\x00\x00\x00\x00\x00", # [9]
+     'octal'		=> "\x00\x00\x00\x00\x04\x00\x00\x00", # [17]
+     'once'		=> "\x00\x00\x40\x00\x00\x00\x00\x00", # [11]
+     'parenthesis'	=> "\x00\x00\x00\x00\x40\x00\x00\x00", # [19]
+     'pipe'		=> "\x00\x00\x00\x00\x00\x00\x10\x00", # [26]
+     'precedence'	=> "\x00\x00\x00\x00\x00\x01\x00\x00", # [20]
+     'printf'		=> "\x00\x00\x00\x00\x01\x00\x00\x00", # [16]
+     'recursion'		=> "\x00\x00\x00\x00\x00\x00\x00\x01", # [28]
+     'redefine'		=> "\x01\x00\x00\x00\x00\x00\x00\x00", # [0]
+     'reserved'		=> "\x00\x00\x00\x04\x00\x00\x00\x00", # [13]
+     'semicolon'		=> "\x00\x00\x00\x40\x00\x00\x00\x00", # [15]
+     'signal'		=> "\x00\x40\x00\x00\x00\x00\x00\x00", # [7]
+     'substr'		=> "\x00\x01\x00\x00\x00\x00\x00\x00", # [4]
+     'syntax'		=> "\x00\x00\x00\x55\x55\x01\x00\x00", # [12..20]
+     'taint'		=> "\x40\x00\x00\x00\x00\x00\x00\x00", # [3]
+     'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x40\x00", # [27]
+     'unopened'		=> "\x00\x00\x00\x00\x00\x00\x04\x00", # [25]
+     'unsafe'		=> "\x50\x55\x01\x00\x00\x00\x00\x00", # [2..8]
+     'untie'		=> "\x00\x10\x00\x00\x00\x00\x00\x00", # [6]
+     'utf8'		=> "\x00\x00\x01\x00\x00\x00\x00\x00", # [8]
+     'void'		=> "\x04\x00\x00\x00\x00\x00\x00\x00", # [1]
+   );
+ 
+ %DeadBits = (
+     'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..31]
+     'ambiguous'		=> "\x00\x00\x00\x00\x20\x00\x00\x00", # [18]
+     'closed'		=> "\x00\x00\x00\x00\x00\x80\x00\x00", # [23]
+     'closure'		=> "\x00\x08\x00\x00\x00\x00\x00\x00", # [5]
+     'default'		=> "\x00\x00\x20\x00\x00\x00\x00\x00", # [10]
+     'deprecated'	=> "\x00\x00\x00\x20\x00\x00\x00\x00", # [14]
+     'exec'		=> "\x00\x00\x00\x00\x00\x00\x02\x00", # [24]
+     'io'		=> "\x00\x00\x00\x00\x00\xa8\x2a\x00", # [21..26]
+     'misc'		=> "\x00\x00\x00\x00\x00\x00\x00\x08", # [29]
+     'newline'		=> "\x00\x00\x00\x00\x00\x20\x00\x00", # [22]
+     'numeric'		=> "\x00\x00\x08\x00\x00\x00\x00\x00", # [9]
+     'octal'		=> "\x00\x00\x00\x00\x08\x00\x00\x00", # [17]
+     'once'		=> "\x00\x00\x80\x00\x00\x00\x00\x00", # [11]
+     'parenthesis'	=> "\x00\x00\x00\x00\x80\x00\x00\x00", # [19]
+     'pipe'		=> "\x00\x00\x00\x00\x00\x00\x20\x00", # [26]
+     'precedence'	=> "\x00\x00\x00\x00\x00\x02\x00\x00", # [20]
+     'printf'		=> "\x00\x00\x00\x00\x02\x00\x00\x00", # [16]
+     'recursion'		=> "\x00\x00\x00\x00\x00\x00\x00\x02", # [28]
+     'redefine'		=> "\x02\x00\x00\x00\x00\x00\x00\x00", # [0]
+     'reserved'		=> "\x00\x00\x00\x08\x00\x00\x00\x00", # [13]
+     'semicolon'		=> "\x00\x00\x00\x80\x00\x00\x00\x00", # [15]
+     'signal'		=> "\x00\x80\x00\x00\x00\x00\x00\x00", # [7]
+     'substr'		=> "\x00\x02\x00\x00\x00\x00\x00\x00", # [4]
+     'syntax'		=> "\x00\x00\x00\xaa\xaa\x02\x00\x00", # [12..20]
+     'taint'		=> "\x80\x00\x00\x00\x00\x00\x00\x00", # [3]
+     'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x80\x00", # [27]
+     'unopened'		=> "\x00\x00\x00\x00\x00\x00\x08\x00", # [25]
+     'unsafe'		=> "\xa0\xaa\x02\x00\x00\x00\x00\x00", # [2..8]
+     'untie'		=> "\x00\x20\x00\x00\x00\x00\x00\x00", # [6]
+     'utf8'		=> "\x00\x00\x02\x00\x00\x00\x00\x00", # [8]
+     'void'		=> "\x08\x00\x00\x00\x00\x00\x00\x00", # [1]
+   );
+ 
+ 
+ sub bits {
+     my $mask ;
+     my $catmask ;
+     my $fatal = 0 ;
+     foreach my $word (@_) {
+ 	if  ($word eq 'FATAL')
+ 	  { $fatal = 1 }
+ 	elsif ($catmask = $Bits{$word}) {
+ 	  $mask |= $catmask ;
+ 	  $mask |= $DeadBits{$word} if $fatal ;
+ 	}
+ 	else
+ 	  { croak "unknown warning category '$word'" }
+     }
+ 
+     return $mask ;
+ }
+ 
+ sub import {
+     shift;
+     $^B |= bits(@_ ? @_ : 'all') ;
+ }
+ 
+ sub unimport {
+     shift;
+     $^B &= ~ bits(@_ ? @_ : 'all') ;
+ }
+ 
+ 
+ sub make_fatal
+ {
+     my $self = shift ;
+     my $bitmask = $self->bits(@_) ;
+     $SIG{__WARN__} =
+         sub
+         {
+             die @_ if $^B & $bitmask ;
+             warn @_
+         } ;
+ }
+ 
+ sub bitmask
+ {
+     return $^B ;
+ }
+ 
+ sub enabled
+ {
+     my $string = shift ;
+ 
+     return 1
+ 	if $bits{$string} && $^B & $bits{$string} ;
+    
+     return 0 ; 
+ }
+ 
+ 1;
*** mg.c.orig	Wed Jul 29 07:19:49 1998
--- mg.c	Wed Jul 29 07:20:47 1998
***************
*** 346,351 ****
--- 346,379 ----
      return 0;
  }
  
+ #if 0
+ static char * 
+ printW(sv)
+ SV * sv ;
+ {
+ #if 1
+     return "" ;
+ 
+ #else
+     int i ;
+     static char buffer[50] ;
+     char buf1[20] ;
+     char * p ;
+ 
+ 
+     sprintf(buffer, "Buffer %d, Length = %d - ", sv, SvCUR(sv)) ;
+     p = SvPVX(sv) ;
+     for (i = 0; i < SvCUR(sv) ; ++ i) {
+         sprintf (buf1, " %x [%x]", (p+i), *(p+i)) ;
+ 	strcat(buffer, buf1) ;
+     } 
+ 
+     return buffer ;
+ 
+ #endif
+ }
+ #endif
+ 
  int
  magic_get(SV *sv, MAGIC *mg)
  {
***************
*** 360,365 ****
--- 388,405 ----
      case '\001':		/* ^A */
  	sv_setsv(sv, PL_bodytarget);
  	break;
+     case '\002':		/* ^B */
+ 	/* printf("magic_get $^B: ") ; */
+ 	if (curcop->cop_warnings == WARN_NONE)
+ 	    /* printf("WARN_NONE\n"), */
+ 	    sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
+         else if (curcop->cop_warnings == WARN_ALL)
+ 	    /* printf("WARN_ALL\n"), */
+ 	    sv_setpvn(sv, WARN_ALLstring, WARNsize) ;
+         else 
+ 	    /* printf("some %s\n", printW(curcop->cop_warnings)), */
+ 	    sv_setsv(sv, curcop->cop_warnings);
+ 	break;
      case '\004':		/* ^D */
  	sv_setiv(sv, (IV)(PL_debug & 32767));
  	break;
***************
*** 453,459 ****
  #endif
  	break;
      case '\027':		/* ^W */
! 	sv_setiv(sv, (IV)PL_dowarn);
  	break;
      case '1': case '2': case '3': case '4':
      case '5': case '6': case '7': case '8': case '9': case '&':
--- 493,499 ----
  #endif
  	break;
      case '\027':		/* ^W */
! 	sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) == G_WARN_ON));
  	break;
      case '1': case '2': case '3': case '4':
      case '5': case '6': case '7': case '8': case '9': case '&':
***************
*** 848,855 ****
      else {
  	i = whichsig(s);	/* ...no, a brick */
  	if (!i) {
! 	    if (PL_dowarn || strEQ(s,"ALARM"))
! 		warn("No such signal: SIG%s", s);
  	    return 0;
  	}
  	SvREFCNT_dec(psig_name[i]);
--- 888,895 ----
      else {
  	i = whichsig(s);	/* ...no, a brick */
  	if (!i) {
! 	    if (ckWARN(WARN_SIGNAL) || strEQ(s,"ALARM"))
! 		warner(WARN_SIGNAL, "No such signal: SIG%s", s);
  	    return 0;
  	}
  	SvREFCNT_dec(psig_name[i]);
***************
*** 1519,1524 ****
--- 1559,1579 ----
      case '\001':	/* ^A */
  	sv_setsv(PL_bodytarget, sv);
  	break;
+     case '\002':	/* ^B */
+ 	if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
+             if (memEQ(SvPVX(sv), WARN_ALLstring, WARNsize))
+ 	        compiling.cop_warnings = WARN_ALL;
+ 	    else if (memEQ(SvPVX(sv), WARN_NONEstring, WARNsize))
+ 	        compiling.cop_warnings = WARN_NONE;
+             else {
+ 	        if (compiling.cop_warnings != WARN_NONE && 
+ 		    compiling.cop_warnings != WARN_ALL)
+ 	            sv_setsv(compiling.cop_warnings, sv);
+ 	        else
+ 		    compiling.cop_warnings = newSVsv(sv) ;
+ 	    }
+ 	}
+ 	break;
      case '\004':	/* ^D */
  	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
  	DEBUG_x(dump_all());
***************
*** 1568,1574 ****
  #endif
  	break;
      case '\027':	/* ^W */
! 	PL_dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  	break;
      case '.':
  	if (PL_localizing) {
--- 1623,1632 ----
  #endif
  	break;
      case '\027':	/* ^W */
! 	if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
! 	    i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
! 	    PL_dowarn = (i ? G_WARN_ON : G_WARN_OFF) ;
! 	}
  	break;
      case '.':
  	if (PL_localizing) {
***************
*** 1958,1965 ****
  	cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
  
      if (!cv || !CvROOT(cv)) {
! 	if (PL_dowarn)
! 	    warn("SIG%s handler \"%s\" not defined.\n",
  		sig_name[sig], (gv ? GvENAME(gv)
  				: ((cv && CvGV(cv))
  				   ? GvENAME(CvGV(cv))
--- 2016,2023 ----
  	cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
  
      if (!cv || !CvROOT(cv)) {
! 	if (ckWARN(WARN_SIGNAL))
! 	    warner(WARN_SIGNAL, "SIG%s handler \"%s\" not defined.\n",
  		sig_name[sig], (gv ? GvENAME(gv)
  				: ((cv && CvGV(cv))
  				   ? GvENAME(CvGV(cv))
*** op.c.orig	Wed Jul 29 07:19:50 1998
--- op.c	Wed Jul 29 07:20:48 1998
***************
*** 126,132 ****
  	}
  	croak("Can't use global %s in \"my\"",name);
      }
!     if (PL_dowarn && AvFILLp(PL_comppad_name) >= 0) {
  	SV **svp = AvARRAY(PL_comppad_name);
  	for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
  	    if ((sv = svp[off])
--- 126,132 ----
  	}
  	croak("Can't use global %s in \"my\"",name);
      }
!     if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
  	SV **svp = AvARRAY(PL_comppad_name);
  	for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
  	    if ((sv = svp[off])
***************
*** 134,140 ****
  		&& SvIVX(sv) == 999999999       /* var is in open scope */
  		&& strEQ(name, SvPVX(sv)))
  	    {
! 		warn("\"my\" variable %s masks earlier declaration in same scope", name);
  		break;
  	    }
  	}
--- 134,142 ----
  		&& SvIVX(sv) == 999999999       /* var is in open scope */
  		&& strEQ(name, SvPVX(sv)))
  	    {
! 		warner(WARN_UNSAFE,
! 			"\"my\" variable %s masks earlier declaration in same scope", 
! 			name);
  		break;
  	    }
  	}
***************
*** 231,238 ****
  				if (CvANON(bcv))
  				    CvCLONE_on(bcv);
  				else {
! 				    if (PL_dowarn && !CvUNIQUE(cv))
! 					warn(
  					  "Variable \"%s\" may be unavailable",
  					     name);
  				    break;
--- 233,240 ----
  				if (CvANON(bcv))
  				    CvCLONE_on(bcv);
  				else {
! 				    if (ckWARN(WARN_CLOSURE) && !CvUNIQUE(cv))
! 					warner(WARN_CLOSURE,
  					  "Variable \"%s\" may be unavailable",
  					     name);
  				    break;
***************
*** 241,248 ****
  			}
  		    }
  		    else if (!CvUNIQUE(PL_compcv)) {
! 			if (PL_dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
! 			    warn("Variable \"%s\" will not stay shared", name);
  		    }
  		}
  		av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
--- 243,251 ----
  			}
  		    }
  		    else if (!CvUNIQUE(PL_compcv)) {
! 			if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv))
! 			    warner(WARN_CLOSURE,
! 				"Variable \"%s\" will not stay shared", name);
  		    }
  		}
  		av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
***************
*** 600,605 ****
--- 603,610 ----
      case OP_DBSTATE:
  	Safefree(cCOPo->cop_label);
  	SvREFCNT_dec(cCOPo->cop_filegv);
+ 	if (cCOPo->cop_warnings != WARN_NONE && cCOPo->cop_warnings != WARN_ALL)
+ 	    SvREFCNT_dec(cCOPo->cop_warnings);
  	break;
      case OP_CONST:
  	SvREFCNT_dec(cSVOPo->op_sv);
***************
*** 685,698 ****
  STATIC OP *
  scalarboolean(OP *o)
  {
!     if (PL_dowarn &&
  	o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
  	dTHR;
  	line_t oldline = PL_curcop->cop_line;
  
  	if (PL_copline != NOLINE)
  	    PL_curcop->cop_line = PL_copline;
! 	warn("Found = in conditional, should be ==");
  	PL_curcop->cop_line = oldline;
      }
      return scalar(o);
--- 690,703 ----
  STATIC OP *
  scalarboolean(OP *o)
  {
!     if (ckWARN(WARN_SYNTAX) &&
  	o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
  	dTHR;
  	line_t oldline = PL_curcop->cop_line;
  
  	if (PL_copline != NOLINE)
  	    PL_curcop->cop_line = PL_copline;
! 	warner(WARN_SYNTAX, "Found = in conditional, should be ==");
  	PL_curcop->cop_line = oldline;
      }
      return scalar(o);
***************
*** 880,886 ****
  
      case OP_CONST:
  	sv = cSVOPo->op_sv;
! 	if (PL_dowarn) {
  	    useless = "a constant";
  	    if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
  		useless = 0;
--- 885,891 ----
  
      case OP_CONST:
  	sv = cSVOPo->op_sv;
! 	if (ckWARN(WARN_VOID)) {
  	    useless = "a constant";
  	    if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
  		useless = 0;
***************
*** 947,954 ****
  	}
  	break;
      }
!     if (useless && PL_dowarn)
! 	warn("Useless use of %s in void context", useless);
      return o;
  }
  
--- 952,959 ----
  	}
  	break;
      }
!     if (useless && ckWARN(WARN_VOID))
! 	warner(WARN_VOID, "Useless use of %s in void context", useless);
      return o;
  }
  
***************
*** 1458,1475 ****
  {
      OP *o;
  
!     if (PL_dowarn &&
! 	(left->op_type == OP_RV2AV ||
! 	 left->op_type == OP_RV2HV ||
! 	 left->op_type == OP_PADAV ||
! 	 left->op_type == OP_PADHV)) {
! 	char *desc = op_desc[(right->op_type == OP_SUBST ||
! 			      right->op_type == OP_TRANS)
! 			     ? right->op_type : OP_MATCH];
! 	char *sample = ((left->op_type == OP_RV2AV ||
! 			 left->op_type == OP_PADAV)
! 			? "@array" : "%hash");
! 	warn("Applying %s to %s will act on scalar(%s)", desc, sample, sample);
      }
  
      if (right->op_type == OP_MATCH ||
--- 1463,1482 ----
  {
      OP *o;
  
!     if (ckWARN(WARN_UNSAFE) &&
!       (left->op_type == OP_RV2AV ||
!        left->op_type == OP_RV2HV ||
!        left->op_type == OP_PADAV ||
!        left->op_type == OP_PADHV)) {
!       char *desc = op_desc[(right->op_type == OP_SUBST ||
!                             right->op_type == OP_TRANS)
!                            ? right->op_type : OP_MATCH];
!       char *sample = ((left->op_type == OP_RV2AV ||
!                        left->op_type == OP_PADAV)
!                       ? "@array" : "%hash");
!       warner(WARN_UNSAFE,
!              "Applying %s to %s will act on scalar(%s)", 
!              desc, sample, sample);
      }
  
      if (right->op_type == OP_MATCH ||
***************
*** 1558,1563 ****
--- 1565,1578 ----
      PL_pad_reset_pending = FALSE;
      SAVEHINTS();
      PL_hints &= ~HINT_BLOCK_SCOPE;
+     SAVEPPTR(compiling.cop_warnings); 
+     if (PL_compiling.cop_warnings != WARN_ALL && 
+        PL_compiling.cop_warnings != WARN_NONE) {
+         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
+         SAVEFREESV(PL_compiling.cop_warnings) ;
+     }
+ 
+ 
      return retval;
  }
  
***************
*** 1629,1639 ****
      if (o->op_flags & OPf_PARENS)
  	list(o);
      else {
! 	if (PL_dowarn && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
  	    char *s;
  	    for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
  	    if (*s == ';' || *s == '=')
! 		warn("Parens missing around \"%s\" list", lex ? "my" : "local");
  	}
      }
      PL_in_my = FALSE;
--- 1644,1655 ----
      if (o->op_flags & OPf_PARENS)
  	list(o);
      else {
! 	if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
  	    char *s;
  	    for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
  	    if (*s == ';' || *s == '=')
! 		warner(WARN_PARENTHESIS, "Parens missing around \"%s\" list",
! 				lex ? "my" : "local");
  	}
      }
      PL_in_my = FALSE;
***************
*** 2816,2821 ****
--- 2832,2843 ----
      }
      cop->cop_seq = seq;
      cop->cop_arybase = PL_curcop->cop_arybase;
+     if (PL_curcop->cop_warnings == WARN_NONE 
+ 	|| PL_curcop->cop_warnings == WARN_ALL)
+         cop->cop_warnings = PL_curcop->cop_warnings ;
+     else 
+         cop->cop_warnings = newSVsv(PL_curcop->cop_warnings) ;
+ 
  
      if (PL_copline == NOLINE)
          cop->cop_line = PL_curcop->cop_line;
***************
*** 2896,2903 ****
  	}
      }
      if (first->op_type == OP_CONST) {
! 	if (PL_dowarn && (first->op_private & OPpCONST_BARE))
! 	    warn("Probable precedence problem on %s", op_desc[type]);
  	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
  	    op_free(first);
  	    *firstp = Nullop;
--- 2918,2926 ----
  	}
      }
      if (first->op_type == OP_CONST) {
! 	if (ckWARN(WARN_PRECEDENCE) && (first->op_private & OPpCONST_BARE))
! 	    warner(WARN_PRECEDENCE, "Probable precedence problem on %s", 
! 			op_desc[type]);
  	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
  	    op_free(first);
  	    *firstp = Nullop;
***************
*** 2915,2921 ****
  	else
  	    scalar(other);
      }
!     else if (PL_dowarn && (first->op_flags & OPf_KIDS)) {
  	OP *k1 = ((UNOP*)first)->op_first;
  	OP *k2 = k1->op_sibling;
  	OPCODE warnop = 0;
--- 2938,2944 ----
  	else
  	    scalar(other);
      }
!     else if (ckWARN(WARN_UNSAFE) && (first->op_flags & OPf_KIDS)) {
  	OP *k1 = ((UNOP*)first)->op_first;
  	OP *k2 = k1->op_sibling;
  	OPCODE warnop = 0;
***************
*** 2938,2944 ****
  	if (warnop) {
  	    line_t oldline = PL_curcop->cop_line;
  	    PL_curcop->cop_line = PL_copline;
! 	    warn("Value of %s%s can be \"0\"; test with defined()",
  		 op_desc[warnop],
  		 ((warnop == OP_READLINE || warnop == OP_GLOB)
  		  ? " construct" : "() operator"));
--- 2961,2968 ----
  	if (warnop) {
  	    line_t oldline = PL_curcop->cop_line;
  	    PL_curcop->cop_line = PL_copline;
! 	    warner(WARN_UNSAFE,
! 		 "Value of %s%s can be \"0\"; test with defined()",
  		 op_desc[warnop],
  		 ((warnop == OP_READLINE || warnop == OP_GLOB)
  		  ? " construct" : "() operator"));
***************
*** 3687,3700 ****
  		croak("Can't redefine active sort subroutine %s", name);
  	    if(const_sv = cv_const_sv(cv))
  		const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
! 	    if ((const_sv && const_changed) || PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
  					&& HvNAME(GvSTASH(CvGV(cv)))
  					&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
  						 "autouse"))) {
  		line_t oldline = PL_curcop->cop_line;
  		PL_curcop->cop_line = PL_copline;
! 		warn(const_sv ? "Constant subroutine %s redefined"
! 		     : "Subroutine %s redefined", name);
  		PL_curcop->cop_line = oldline;
  	    }
  	    SvREFCNT_dec(cv);
--- 3711,3726 ----
  		croak("Can't redefine active sort subroutine %s", name);
  	    if(const_sv = cv_const_sv(cv))
  		const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
! 	    if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE) 
! 					&& !(CvGV(cv) && GvSTASH(CvGV(cv))
  					&& HvNAME(GvSTASH(CvGV(cv)))
  					&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
  						 "autouse"))) {
  		line_t oldline = PL_curcop->cop_line;
  		PL_curcop->cop_line = PL_copline;
! 		warner(WARN_REDEFINE,
! 			const_sv ? "Constant subroutine %s redefined"
! 		                 : "Subroutine %s redefined", name);
  		PL_curcop->cop_line = oldline;
  	    }
  	    SvREFCNT_dec(cv);
***************
*** 3915,3926 ****
  	}
  	else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
  	    /* already defined (or promised) */
! 	    if (PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
  			    && HvNAME(GvSTASH(CvGV(cv)))
  			    && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
  		line_t oldline = PL_curcop->cop_line;
  		PL_curcop->cop_line = PL_copline;
! 		warn("Subroutine %s redefined",name);
  		PL_curcop->cop_line = oldline;
  	    }
  	    SvREFCNT_dec(cv);
--- 3941,3952 ----
  	}
  	else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
  	    /* already defined (or promised) */
! 	    if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
  			    && HvNAME(GvSTASH(CvGV(cv)))
  			    && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
  		line_t oldline = PL_curcop->cop_line;
  		PL_curcop->cop_line = PL_copline;
! 		warner(WARN_REDEFINE, "Subroutine %s redefined",name);
  		PL_curcop->cop_line = oldline;
  	    }
  	    SvREFCNT_dec(cv);
***************
*** 3995,4005 ****
      gv = gv_fetchpv(name,TRUE, SVt_PVFM);
      GvMULTI_on(gv);
      if (cv = GvFORM(gv)) {
! 	if (PL_dowarn) {
  	    line_t oldline = PL_curcop->cop_line;
  
  	    PL_curcop->cop_line = PL_copline;
! 	    warn("Format %s redefined",name);
  	    PL_curcop->cop_line = oldline;
  	}
  	SvREFCNT_dec(cv);
--- 4021,4031 ----
      gv = gv_fetchpv(name,TRUE, SVt_PVFM);
      GvMULTI_on(gv);
      if (cv = GvFORM(gv)) {
! 	if (ckWARN(WARN_REDEFINE)) {
  	    line_t oldline = PL_curcop->cop_line;
  
  	    PL_curcop->cop_line = PL_copline;
! 	    warner(WARN_REDEFINE, "Format %s redefined",name);
  	    PL_curcop->cop_line = oldline;
  	}
  	SvREFCNT_dec(cv);
***************
*** 4467,4474 ****
  		    char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
  		    OP *newop = newAVREF(newGVOP(OP_GV, 0,
  			gv_fetchpv(name, TRUE, SVt_PVAV) ));
! 		    if (PL_dowarn)
! 			warn("Array @%s missing the @ in argument %ld of %s()",
  			    name, (long)numargs, op_desc[type]);
  		    op_free(kid);
  		    kid = newop;
--- 4493,4501 ----
  		    char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
  		    OP *newop = newAVREF(newGVOP(OP_GV, 0,
  			gv_fetchpv(name, TRUE, SVt_PVAV) ));
! 		    if (ckWARN(WARN_SYNTAX))
! 			warner(WARN_SYNTAX,
! 			    "Array @%s missing the @ in argument %ld of %s()",
  			    name, (long)numargs, op_desc[type]);
  		    op_free(kid);
  		    kid = newop;
***************
*** 4485,4492 ****
  		    char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
  		    OP *newop = newHVREF(newGVOP(OP_GV, 0,
  			gv_fetchpv(name, TRUE, SVt_PVHV) ));
! 		    if (PL_dowarn)
! 			warn("Hash %%%s missing the %% in argument %ld of %s()",
  			    name, (long)numargs, op_desc[type]);
  		    op_free(kid);
  		    kid = newop;
--- 4512,4520 ----
  		    char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
  		    OP *newop = newHVREF(newGVOP(OP_GV, 0,
  			gv_fetchpv(name, TRUE, SVt_PVHV) ));
! 		    if (ckWARN(WARN_SYNTAX))
! 			warner(WARN_SYNTAX,
! 			    "Hash %%%s missing the %% in argument %ld of %s()",
  			    name, (long)numargs, op_desc[type]);
  		    op_free(kid);
  		    kid = newop;
***************
*** 5237,5243 ****
  
  	case OP_EXEC:
  	    o->op_seq = PL_op_seqmax++;
! 	    if (PL_dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
  		if (o->op_next->op_sibling &&
  			o->op_next->op_sibling->op_type != OP_EXIT &&
  			o->op_next->op_sibling->op_type != OP_WARN &&
--- 5265,5272 ----
  
  	case OP_EXEC:
  	    o->op_seq = PL_op_seqmax++;
! 	    if (ckWARN(WARN_SYNTAX) && o->op_next 
! 		&& o->op_next->op_type == OP_NEXTSTATE) {
  		if (o->op_next->op_sibling &&
  			o->op_next->op_sibling->op_type != OP_EXIT &&
  			o->op_next->op_sibling->op_type != OP_WARN &&
***************
*** 5245,5252 ****
  		    line_t oldline = PL_curcop->cop_line;
  
  		    PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
! 		    warn("Statement unlikely to be reached");
! 		    warn("(Maybe you meant system() when you said exec()?)\n");
  		    PL_curcop->cop_line = oldline;
  		}
  	    }
--- 5274,5281 ----
  		    line_t oldline = PL_curcop->cop_line;
  
  		    PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
! 		    warner(WARN_SYNTAX, "Statement unlikely to be reached");
! 		    warner(WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
  		    PL_curcop->cop_line = oldline;
  		}
  	    }
*** op.h.orig	Wed Jul 29 07:19:50 1998
--- op.h	Wed Jul 29 07:20:48 1998
***************
*** 130,135 ****
--- 130,136 ----
  #define OPpCONST_ENTERED	16	/* Has been entered as symbol. */
  #define OPpCONST_ARYBASE	32	/* Was a $[ translated to constant. */
  #define OPpCONST_BARE		64	/* Was a bare word (filehandle?). */
+ #define OPpCONST_WARNING	128	/* Was a $^W translated to constant. */
  
  /* Private for OP_FLIP/FLOP */
  #define OPpFLIP_LINENUM		64	/* Range arg potentially a line num. */
*** perl.c.orig	Wed Jul 22 08:42:03 1998
--- perl.c	Wed Jul 29 07:20:48 1998
***************
*** 405,411 ****
      PL_minus_a      = FALSE;
      PL_minus_F      = FALSE;
      PL_doswitches   = FALSE;
!     PL_dowarn       = FALSE;
      PL_doextract    = FALSE;
      PL_sawampersand = FALSE;	/* must save all match strings */
      PL_sawstudy     = FALSE;	/* do fbm_instr on all strings */
--- 405,411 ----
      PL_minus_a      = FALSE;
      PL_minus_F      = FALSE;
      PL_doswitches   = FALSE;
!     PL_dowarn       = G_WARN_OFF;
      PL_doextract    = FALSE;
      PL_sawampersand = FALSE;	/* must save all match strings */
      PL_sawstudy     = FALSE;	/* do fbm_instr on all strings */
***************
*** 682,687 ****
--- 682,688 ----
  
      time(&PL_basetime);
      oldscope = PL_scopestack_ix;
+     PL_dowarn = G_WARN_OFF;
  
      JMPENV_PUSH(ret);
      switch (ret) {
***************
*** 739,744 ****
--- 740,747 ----
  	case 'u':
  	case 'U':
  	case 'v':
+ 	case 'W':
+ 	case 'X':
  	case 'w':
  	    if (s = moreswitches(s))
  		goto reswitch;
***************
*** 992,998 ****
      if (PL_do_undump)
  	my_unexec();
  
!     if (PL_dowarn)
  	gv_check(PL_defstash);
  
      LEAVE;
--- 995,1001 ----
      if (PL_do_undump)
  	my_unexec();
  
!     if (ckWARN(WARN_ONCE))
  	gv_check(PL_defstash);
  
      LEAVE;
***************
*** 1749,1755 ****
  Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
  	PerlProc_exit(0);
      case 'w':
! 	PL_dowarn = TRUE;
  	s++;
  	return s;
      case '*':
--- 1752,1769 ----
  Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
  	PerlProc_exit(0);
      case 'w':
! 	if (! (PL_dowarn & G_WARN_ALL_MASK))
! 	    PL_dowarn |= G_WARN_ON; 
! 	s++;
! 	return s;
!     case 'W':
! 	PL_dowarn = G_WARN_ALL_ON|G_WARN_ON; 
! 	compiling.cop_warnings = WARN_ALL ;
! 	s++;
! 	return s;
!     case 'X':
! 	PL_dowarn = G_WARN_ALL_OFF; 
! 	compiling.cop_warnings = WARN_NONE ;
  	s++;
  	return s;
      case '*':
*** perl.h.orig	Wed Jul 29 07:19:51 1998
--- perl.h	Wed Jul 29 07:20:49 1998
***************
*** 1257,1262 ****
--- 1257,1263 ----
  #include "hv.h"
  #include "mg.h"
  #include "scope.h"
+ #include "warning.h"
  #include "bytecode.h"
  #include "byterun.h"
  #include "utf8.h"
*** pp.c.orig	Wed Jul 29 07:19:54 1998
--- pp.c	Wed Jul 29 07:20:49 1998
***************
*** 234,241 ****
  		if (PL_op->op_flags & OPf_REF ||
  		    PL_op->op_private & HINT_STRICT_REFS)
  		    DIE(no_usym, "a symbol");
! 		if (PL_dowarn)
! 		    warn(warn_uninit);
  		RETSETUNDEF;
  	    }
  	    sym = SvPV(sv, PL_na);
--- 234,241 ----
  		if (PL_op->op_flags & OPf_REF ||
  		    PL_op->op_private & HINT_STRICT_REFS)
  		    DIE(no_usym, "a symbol");
! 		if (ckWARN(WARN_UNINITIALIZED))
! 		    warner(WARN_UNINITIALIZED, warn_uninit);
  		RETSETUNDEF;
  	    }
  	    sym = SvPV(sv, PL_na);
***************
*** 278,285 ****
  		if (PL_op->op_flags & OPf_REF ||
  		    PL_op->op_private & HINT_STRICT_REFS)
  		    DIE(no_usym, "a SCALAR");
! 		if (PL_dowarn)
! 		    warn(warn_uninit);
  		RETSETUNDEF;
  	    }
  	    sym = SvPV(sv, PL_na);
--- 278,285 ----
  		if (PL_op->op_flags & OPf_REF ||
  		    PL_op->op_private & HINT_STRICT_REFS)
  		    DIE(no_usym, "a SCALAR");
! 		if (ckWARN(WARN_UNINITIALIZED))
! 		    warner(WARN_UNINITIALIZED, warn_uninit);
  		RETSETUNDEF;
  	    }
  	    sym = SvPV(sv, PL_na);
***************
*** 520,527 ****
  	SV *ssv = POPs;
  	STRLEN len;
  	char *ptr = SvPV(ssv,len);
! 	if (PL_dowarn && len == 0)
! 	    warn("Explicit blessing to '' (assuming package main)");
  	stash = gv_stashpvn(ptr, len, TRUE);
      }
  
--- 520,528 ----
  	SV *ssv = POPs;
  	STRLEN len;
  	char *ptr = SvPV(ssv,len);
! 	if (ckWARN(WARN_UNSAFE) && len == 0)
! 	    warner(WARN_UNSAFE, 
! 		   "Explicit blessing to '' (assuming package main)");
  	stash = gv_stashpvn(ptr, len, TRUE);
      }
  
***************
*** 770,777 ****
  	hv_undef((HV*)sv);
  	break;
      case SVt_PVCV:
! 	if (PL_dowarn && cv_const_sv((CV*)sv))
! 	    warn("Constant subroutine %s undefined",
  		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
  	/* FALL THROUGH */
      case SVt_PVFM:
--- 771,778 ----
  	hv_undef((HV*)sv);
  	break;
      case SVt_PVCV:
! 	if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
! 	    warner(WARN_UNSAFE, "Constant subroutine %s undefined",
  		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
  	/* FALL THROUGH */
      case SVt_PVFM:
***************
*** 1874,1881 ****
  	rem -= pos;
      }
      if (fail < 0) {
! 	if (PL_dowarn || lvalue || repl)
! 	    warn("substr outside of string");
  	RETPUSHUNDEF;
      }
      else {
--- 1875,1882 ----
  	rem -= pos;
      }
      if (fail < 0) {
! 	if (ckWARN(WARN_SUBSTR) || lvalue || repl)
! 	    warner(WARN_SUBSTR, "substr outside of string");
  	RETPUSHUNDEF;
      }
      else {
***************
*** 1887,1894 ****
  	    if (!SvGMAGICAL(sv)) {
  		if (SvROK(sv)) {
  		    SvPV_force(sv,PL_na);
! 		    if (PL_dowarn)
! 			warn("Attempt to use reference as lvalue in substr");
  		}
  		if (SvOK(sv))		/* is it defined ? */
  		    (void)SvPOK_only(sv);
--- 1888,1896 ----
  	    if (!SvGMAGICAL(sv)) {
  		if (SvROK(sv)) {
  		    SvPV_force(sv,PL_na);
! 		    if (ckWARN(WARN_SUBSTR))
! 			warner(WARN_SUBSTR,
! 				"Attempt to use reference as lvalue in substr");
  		}
  		if (SvOK(sv))		/* is it defined ? */
  		    (void)SvPOK_only(sv);
***************
*** 2704,2711 ****
  	SV *val = NEWSV(46, 0);
  	if (MARK < SP)
  	    sv_setsv(val, *++MARK);
! 	else if (PL_dowarn)
! 	    warn("Odd number of elements in hash assignment");
  	(void)hv_store_ent(hv,key,val,0);
      }
      SP = ORIGMARK;
--- 2706,2713 ----
  	SV *val = NEWSV(46, 0);
  	if (MARK < SP)
  	    sv_setsv(val, *++MARK);
! 	else if (ckWARN(WARN_UNSAFE))
! 	    warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
  	(void)hv_store_ent(hv,key,val,0);
      }
      SP = ORIGMARK;
***************
*** 3173,3180 ****
  	default:
  	    croak("Invalid type in unpack: '%c'", (int)datumtype);
  	case ',': /* grandfather in commas but with a warning */
! 	    if (commas++ == 0 && PL_dowarn)
! 		warn("Invalid type in unpack: '%c'", (int)datumtype);
  	    break;
  	case '%':
  	    if (len == 1 && pat[-1] != '1')
--- 3175,3182 ----
  	default:
  	    croak("Invalid type in unpack: '%c'", (int)datumtype);
  	case ',': /* grandfather in commas but with a warning */
! 	    if (commas++ == 0 && ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
  	    break;
  	case '%':
  	    if (len == 1 && pat[-1] != '1')
***************
*** 3983,3990 ****
  	default:
  	    croak("Invalid type in pack: '%c'", (int)datumtype);
  	case ',': /* grandfather in commas but with a warning */
! 	    if (commas++ == 0 && PL_dowarn)
! 		warn("Invalid type in pack: '%c'", (int)datumtype);
  	    break;
  	case '%':
  	    DIE("%% may only be used in unpack");
--- 3985,3992 ----
  	default:
  	    croak("Invalid type in pack: '%c'", (int)datumtype);
  	case ',': /* grandfather in commas but with a warning */
! 	    if (commas++ == 0 && ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype);
  	    break;
  	case '%':
  	    DIE("%% may only be used in unpack");
***************
*** 4365,4372 ****
  		     * of pack() (and all copies of the result) are
  		     * gone.
  		     */
! 		    if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
! 			warn("Attempt to pack pointer to temporary value");
  		    if (SvPOK(fromstr) || SvNIOK(fromstr))
  			aptr = SvPV(fromstr,PL_na);
  		    else
--- 4367,4375 ----
  		     * of pack() (and all copies of the result) are
  		     * gone.
  		     */
! 		    if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
! 			warner(WARN_UNSAFE,
! 				"Attempt to pack pointer to temporary value");
  		    if (SvPOK(fromstr) || SvNIOK(fromstr))
  			aptr = SvPV(fromstr,PL_na);
  		    else
*** pp_ctl.c.orig	Wed Jul 29 07:19:55 1998
--- pp_ctl.c	Wed Jul 29 07:20:50 1998
***************
*** 357,364 ****
  		sv = *++MARK;
  	    else {
  		sv = &PL_sv_no;
! 		if (PL_dowarn)
! 		    warn("Not enough format arguments");
  	    }
  	    break;
  
--- 357,364 ----
  		sv = *++MARK;
  	    else {
  		sv = &PL_sv_no;
! 		if (ckWARN(WARN_SYNTAX))
! 		    warner(WARN_SYNTAX, "Not enough format arguments");
  	    }
  	    break;
  
***************
*** 981,1000 ****
  	cx = &cxstack[i];
  	switch (cx->cx_type) {
  	case CXt_SUBST:
! 	    if (PL_dowarn)
! 		warn("Exiting substitution via %s", op_name[PL_op->op_type]);
  	    break;
  	case CXt_SUB:
! 	    if (PL_dowarn)
! 		warn("Exiting subroutine via %s", op_name[PL_op->op_type]);
  	    break;
  	case CXt_EVAL:
! 	    if (PL_dowarn)
! 		warn("Exiting eval via %s", op_name[PL_op->op_type]);
  	    break;
  	case CXt_NULL:
! 	    if (PL_dowarn)
! 		warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]);
  	    return -1;
  	case CXt_LOOP:
  	    if (!cx->blk_loop.label ||
--- 981,1004 ----
  	cx = &cxstack[i];
  	switch (cx->cx_type) {
  	case CXt_SUBST:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting substitution via %s", 
! 			op_name[PL_op->op_type]);
  	    break;
  	case CXt_SUB:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting subroutine via %s", 
! 			op_name[PL_op->op_type]);
  	    break;
  	case CXt_EVAL:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting eval via %s", 
! 			op_name[PL_op->op_type]);
  	    break;
  	case CXt_NULL:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting pseudo-block via %s", 
! 			op_name[PL_op->op_type]);
  	    return -1;
  	case CXt_LOOP:
  	    if (!cx->blk_loop.label ||
***************
*** 1097,1116 ****
  	cx = &cxstack[i];
  	switch (cx->cx_type) {
  	case CXt_SUBST:
! 	    if (PL_dowarn)
! 		warn("Exiting substitution via %s", op_name[PL_op->op_type]);
  	    break;
  	case CXt_SUB:
! 	    if (PL_dowarn)
! 		warn("Exiting subroutine via %s", op_name[PL_op->op_type]);
  	    break;
  	case CXt_EVAL:
! 	    if (PL_dowarn)
! 		warn("Exiting eval via %s", op_name[PL_op->op_type]);
  	    break;
  	case CXt_NULL:
! 	    if (PL_dowarn)
! 		warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]);
  	    return -1;
  	case CXt_LOOP:
  	    DEBUG_l( deb("(Found loop #%ld)\n", (long)i));
--- 1101,1124 ----
  	cx = &cxstack[i];
  	switch (cx->cx_type) {
  	case CXt_SUBST:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting substitution via %s", 
! 			op_name[PL_op->op_type]);
  	    break;
  	case CXt_SUB:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting subroutine via %s", 
! 			op_name[PL_op->op_type]);
  	    break;
  	case CXt_EVAL:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting eval via %s", 
! 			op_name[PL_op->op_type]);
  	    break;
  	case CXt_NULL:
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Exiting pseudo-block via %s", 
! 			op_name[PL_op->op_type]);
  	    return -1;
  	case CXt_LOOP:
  	    DEBUG_l( deb("(Found loop #%ld)\n", (long)i));
***************
*** 1968,1974 ****
  		if (CvDEPTH(cv) < 2)
  		    (void)SvREFCNT_inc(cv);
  		else {	/* save temporaries on recursion? */
! 		    if (CvDEPTH(cv) == 100 && PL_dowarn)
  			sub_crush_depth(cv);
  		    if (CvDEPTH(cv) > AvFILLp(padlist)) {
  			AV *newpad = newAV();
--- 1976,1982 ----
  		if (CvDEPTH(cv) < 2)
  		    (void)SvREFCNT_inc(cv);
  		else {	/* save temporaries on recursion? */
! 		    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
  			sub_crush_depth(cv);
  		    if (CvDEPTH(cv) > AvFILLp(padlist)) {
  			AV *newpad = newAV();
***************
*** 2686,2691 ****
--- 2694,2702 ----
      SAVEFREEPV(name);
      SAVEHINTS();
      PL_hints = 0;
+     SAVEPPTR(PL_compiling.cop_warnings);
+     PL_compiling.cop_warnings = ((PL_dowarn & G_WARN_ALL_ON) ? WARN_ALL 
+ 							     : WARN_NONE);
   
      /* switch to eval mode */
  
***************
*** 2746,2751 ****
--- 2757,2768 ----
      SAVEDELETE(PL_defstash, safestr, strlen(safestr));
      SAVEHINTS();
      PL_hints = PL_op->op_targ;
+     SAVEPPTR(compiling.cop_warnings);
+     if (PL_compiling.cop_warnings != WARN_ALL 
+ 	&& PL_compiling.cop_warnings != WARN_NONE){
+         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
+         SAVEFREESV(PL_compiling.cop_warnings) ;
+     }
  
      push_return(PL_op->op_next);
      PUSHBLOCK(cx, CXt_EVAL, SP);
*** pp_hot.c.orig	Wed Jul 29 07:19:55 1998
--- pp_hot.c	Wed Jul 29 07:20:50 1998
***************
*** 328,350 ****
  	RETURN;
      }
      if (!(io = GvIO(gv))) {
! 	if (PL_dowarn) {
  	    SV* sv = sv_newmortal();
              gv_fullname3(sv, gv, Nullch);
!             warn("Filehandle %s never opened", SvPV(sv,PL_na));
          }
  
  	SETERRNO(EBADF,RMS$_IFI);
  	goto just_say_no;
      }
      else if (!(fp = IoOFP(io))) {
! 	if (PL_dowarn)  {
  	    SV* sv = sv_newmortal();
              gv_fullname3(sv, gv, Nullch);
  	    if (IoIFP(io))
! 		warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
! 	    else
! 		warn("print on closed filehandle %s", SvPV(sv,PL_na));
  	}
  	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  	goto just_say_no;
--- 328,352 ----
  	RETURN;
      }
      if (!(io = GvIO(gv))) {
! 	if (ckWARN(WARN_UNOPENED)) {
  	    SV* sv = sv_newmortal();
              gv_fullname3(sv, gv, Nullch);
!             warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na));
          }
  
  	SETERRNO(EBADF,RMS$_IFI);
  	goto just_say_no;
      }
      else if (!(fp = IoOFP(io))) {
! 	if (ckWARN2(WARN_CLOSED, WARN_IO))  {
  	    SV* sv = sv_newmortal();
              gv_fullname3(sv, gv, Nullch);
  	    if (IoIFP(io))
! 		warner(WARN_IO, "Filehandle %s opened only for input", 
! 				SvPV(sv,PL_na));
! 	    else if (ckWARN(WARN_CLOSED))
! 		warner(WARN_CLOSED, "print on closed filehandle %s", 
! 				SvPV(sv,PL_na));
  	}
  	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  	goto just_say_no;
***************
*** 431,438 ****
  		    if (PL_op->op_flags & OPf_REF ||
  		      PL_op->op_private & HINT_STRICT_REFS)
  			DIE(no_usym, "an ARRAY");
! 		    if (PL_dowarn)
! 			warn(warn_uninit);
  		    if (GIMME == G_ARRAY)
  			RETURN;
  		    RETPUSHUNDEF;
--- 433,440 ----
  		    if (PL_op->op_flags & OPf_REF ||
  		      PL_op->op_private & HINT_STRICT_REFS)
  			DIE(no_usym, "an ARRAY");
! 		    if (ckWARN(WARN_UNINITIALIZED))
! 			warner(WARN_UNINITIALIZED, warn_uninit);
  		    if (GIMME == G_ARRAY)
  			RETURN;
  		    RETPUSHUNDEF;
***************
*** 515,522 ****
  		    if (PL_op->op_flags & OPf_REF ||
  		      PL_op->op_private & HINT_STRICT_REFS)
  			DIE(no_usym, "a HASH");
! 		    if (PL_dowarn)
! 			warn(warn_uninit);
  		    if (GIMME == G_ARRAY) {
  			SP--;
  			RETURN;
--- 517,524 ----
  		    if (PL_op->op_flags & OPf_REF ||
  		      PL_op->op_private & HINT_STRICT_REFS)
  			DIE(no_usym, "a HASH");
! 		    if (ckWARN(WARN_UNINITIALIZED))
! 			warner(WARN_UNINITIALIZED, warn_uninit);
  		    if (GIMME == G_ARRAY) {
  			SP--;
  			RETURN;
***************
*** 654,667 ****
  		if (relem == lastrelem) {
  		    if (*relem) {
  			HE *didstore;
! 			if (PL_dowarn) {
  			    if (relem == firstrelem &&
  				SvROK(*relem) &&
  				( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
  				  SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
! 				warn("Reference found where even-sized list expected");
  			    else
! 				warn("Odd number of elements in hash assignment");
  			}
  			tmpstr = NEWSV(29,0);
  			didstore = hv_store_ent(hash,*relem,tmpstr,0);
--- 656,669 ----
  		if (relem == lastrelem) {
  		    if (*relem) {
  			HE *didstore;
! 			if (ckWARN(WARN_UNSAFE)) {
  			    if (relem == firstrelem &&
  				SvROK(*relem) &&
  				( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
  				  SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
! 				warner(WARN_UNSAFE, "Reference found where even-sized list expected");
  			    else
! 				warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
  			}
  			tmpstr = NEWSV(29,0);
  			didstore = hv_store_ent(hash,*relem,tmpstr,0);
***************
*** 1212,1219 ****
  	    SP--;
      }
      if (!fp) {
! 	if (PL_dowarn && io && !(IoFLAGS(io) & IOf_START))
! 	    warn("Read on closed filehandle <%s>", GvENAME(PL_last_in_gv));
  	if (gimme == G_SCALAR) {
  	    (void)SvOK_off(TARG);
  	    PUSHTARG;
--- 1214,1222 ----
  	    SP--;
      }
      if (!fp) {
! 	if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START))
! 	    warner(WARN_CLOSED,
! 		   "Read on closed filehandle <%s>", GvENAME(PL_last_in_gv));
  	if (gimme == G_SCALAR) {
  	    (void)SvOK_off(TARG);
  	    PUSHTARG;
***************
*** 2258,2264 ****
  	if (CvDEPTH(cv) < 2)
  	    (void)SvREFCNT_inc(cv);
  	else {	/* save temporaries on recursion? */
! 	    if (CvDEPTH(cv) == 100 && PL_dowarn 
  		  && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
  		sub_crush_depth(cv);
  	    if (CvDEPTH(cv) > AvFILLp(padlist)) {
--- 2261,2267 ----
  	if (CvDEPTH(cv) < 2)
  	    (void)SvREFCNT_inc(cv);
  	else {	/* save temporaries on recursion? */
! 	    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
  		  && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
  		sub_crush_depth(cv);
  	    if (CvDEPTH(cv) > AvFILLp(padlist)) {
***************
*** 2372,2382 ****
  sub_crush_depth(CV *cv)
  {
      if (CvANON(cv))
! 	warn("Deep recursion on anonymous subroutine");
      else {
  	SV* tmpstr = sv_newmortal();
  	gv_efullname3(tmpstr, CvGV(cv), Nullch);
! 	warn("Deep recursion on subroutine \"%s\"", SvPVX(tmpstr));
      }
  }
  
--- 2375,2386 ----
  sub_crush_depth(CV *cv)
  {
      if (CvANON(cv))
! 	warner(WARN_RECURSION, "Deep recursion on anonymous subroutine");
      else {
  	SV* tmpstr = sv_newmortal();
  	gv_efullname3(tmpstr, CvGV(cv), Nullch);
! 	warner(WARN_RECURSION, "Deep recursion on subroutine \"%s\"", 
! 		SvPVX(tmpstr));
      }
  }
  
*** pp_sys.c.orig	Wed Jul 29 07:19:57 1998
--- pp_sys.c	Wed Jul 29 07:20:50 1998
***************
*** 612,618 ****
  
      sv = POPs;
  
!     if (PL_dowarn) {
          MAGIC * mg ;
          if (SvMAGICAL(sv)) {
              if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
--- 612,618 ----
  
      sv = POPs;
  
!     if (ckWARN(WARN_UNTIE)) {
          MAGIC * mg ;
          if (SvMAGICAL(sv)) {
              if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
***************
*** 621,628 ****
                  mg = mg_find(sv, 'q') ;
      
              if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
! 		warn("untie attempted while %lu inner references still exist",
! 			(unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
          }
      }
   
--- 621,629 ----
                  mg = mg_find(sv, 'q') ;
      
              if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
! 		warner(WARN_UNTIE,
! 		    "untie attempted while %lu inner references still exist",
! 		    (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
          }
      }
   
***************
*** 1083,1100 ****
  
      fp = IoOFP(io);
      if (!fp) {
! 	if (PL_dowarn) {
  	    if (IoIFP(io))
! 		warn("Filehandle only opened for input");
! 	    else
! 		warn("Write on closed filehandle");
  	}
  	PUSHs(&PL_sv_no);
      }
      else {
  	if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
! 	    if (PL_dowarn)
! 		warn("page overflow");
  	}
  	if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) ||
  		PerlIO_error(fp))
--- 1084,1101 ----
  
      fp = IoOFP(io);
      if (!fp) {
! 	if (ckWARN2(WARN_CLOSED,WARN_IO)) {
  	    if (IoIFP(io))
! 		warner(WARN_IO, "Filehandle only opened for input");
! 	    else if (ckWARN(WARN_CLOSED))
! 		warner(WARN_CLOSED, "Write on closed filehandle");
  	}
  	PUSHs(&PL_sv_no);
      }
      else {
  	if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
! 	    if (ckWARN(WARN_IO))
! 		warner(WARN_IO, "page overflow");
  	}
  	if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) ||
  		PerlIO_error(fp))
***************
*** 1149,1168 ****
  
      sv = NEWSV(0,0);
      if (!(io = GvIO(gv))) {
! 	if (PL_dowarn) {
  	    gv_fullname3(sv, gv, Nullch);
! 	    warn("Filehandle %s never opened", SvPV(sv,PL_na));
  	}
  	SETERRNO(EBADF,RMS$_IFI);
  	goto just_say_no;
      }
      else if (!(fp = IoOFP(io))) {
! 	if (PL_dowarn)  {
  	    gv_fullname3(sv, gv, Nullch);
  	    if (IoIFP(io))
! 		warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
! 	    else
! 		warn("printf on closed filehandle %s", SvPV(sv,PL_na));
  	}
  	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  	goto just_say_no;
--- 1150,1171 ----
  
      sv = NEWSV(0,0);
      if (!(io = GvIO(gv))) {
! 	if (ckWARN(WARN_UNOPENED)) {
  	    gv_fullname3(sv, gv, Nullch);
! 	    warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na));
  	}
  	SETERRNO(EBADF,RMS$_IFI);
  	goto just_say_no;
      }
      else if (!(fp = IoOFP(io))) {
! 	if (ckWARN2(WARN_CLOSED,WARN_IO))  {
  	    gv_fullname3(sv, gv, Nullch);
  	    if (IoIFP(io))
! 		warner(WARN_IO, "Filehandle %s opened only for input",
! 			SvPV(sv,PL_na));
! 	    else if (ckWARN(WARN_CLOSED))
! 		warner(WARN_CLOSED, "printf on closed filehandle %s",
! 			SvPV(sv,PL_na));
  	}
  	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  	goto just_say_no;
***************
*** 1396,1406 ****
      io = GvIO(gv);
      if (!io || !IoIFP(io)) {
  	length = -1;
! 	if (PL_dowarn) {
  	    if (PL_op->op_type == OP_SYSWRITE)
! 		warn("Syswrite on closed filehandle");
  	    else
! 		warn("Send on closed socket");
  	}
      }
      else if (PL_op->op_type == OP_SYSWRITE) {
--- 1399,1409 ----
      io = GvIO(gv);
      if (!io || !IoIFP(io)) {
  	length = -1;
! 	if (ckWARN(WARN_CLOSED)) {
  	    if (PL_op->op_type == OP_SYSWRITE)
! 		warner(WARN_CLOSED, "Syswrite on closed filehandle");
  	    else
! 		warner(WARN_CLOSED, "Send on closed socket");
  	}
      }
      else if (PL_op->op_type == OP_SYSWRITE) {
***************
*** 1813,1820 ****
  	RETPUSHUNDEF;
  
  nuts:
!     if (PL_dowarn)
! 	warn("bind() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
--- 1816,1823 ----
  	RETPUSHUNDEF;
  
  nuts:
!     if (ckWARN(WARN_CLOSED))
! 	warner(WARN_CLOSED, "bind() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
***************
*** 1843,1850 ****
  	RETPUSHUNDEF;
  
  nuts:
!     if (PL_dowarn)
! 	warn("connect() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
--- 1846,1853 ----
  	RETPUSHUNDEF;
  
  nuts:
!     if (ckWARN(WARN_CLOSED))
! 	warner(WARN_CLOSED, "connect() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
***************
*** 1869,1876 ****
  	RETPUSHUNDEF;
  
  nuts:
!     if (PL_dowarn)
! 	warn("listen() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
--- 1872,1879 ----
  	RETPUSHUNDEF;
  
  nuts:
!     if (ckWARN(WARN_CLOSED))
! 	warner(WARN_CLOSED, "listen() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
***************
*** 1923,1930 ****
      RETURN;
  
  nuts:
!     if (PL_dowarn)
! 	warn("accept() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
  
  badexit:
--- 1926,1933 ----
      RETURN;
  
  nuts:
!     if (ckWARN(WARN_CLOSED))
! 	warner(WARN_CLOSED, "accept() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
  
  badexit:
***************
*** 1950,1957 ****
      RETURN;
  
  nuts:
!     if (PL_dowarn)
! 	warn("shutdown() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
--- 1953,1960 ----
      RETURN;
  
  nuts:
!     if (ckWARN(WARN_CLOSED))
! 	warner(WARN_CLOSED, "shutdown() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
      RETPUSHUNDEF;
  #else
***************
*** 2028,2035 ****
      RETURN;
  
  nuts:
!     if (PL_dowarn)
! 	warn("[gs]etsockopt() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
  nuts2:
      RETPUSHUNDEF;
--- 2031,2038 ----
      RETURN;
  
  nuts:
!     if (ckWARN(WARN_CLOSED))
! 	warner(WARN_CLOSED, "[gs]etsockopt() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
  nuts2:
      RETPUSHUNDEF;
***************
*** 2101,2108 ****
      RETURN;
  
  nuts:
!     if (PL_dowarn)
! 	warn("get{sock, peer}name() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
  nuts2:
      RETPUSHUNDEF;
--- 2104,2111 ----
      RETURN;
  
  nuts:
!     if (ckWARN(WARN_CLOSED))
! 	warner(WARN_CLOSED, "get{sock, peer}name() on closed fd");
      SETERRNO(EBADF,SS$_IVCHAN);
  nuts2:
      RETPUSHUNDEF;
***************
*** 2159,2166 ****
  #endif
  	    PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
  	if (PL_laststatval < 0) {
! 	    if (PL_dowarn && strchr(SvPV(PL_statname, PL_na), '\n'))
! 		warn(warn_nl, "stat");
  	    max = 0;
  	}
      }
--- 2162,2169 ----
  #endif
  	    PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
  	if (PL_laststatval < 0) {
! 	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, PL_na), '\n'))
! 		warner(WARN_NEWLINE, warn_nl, "stat");
  	    max = 0;
  	}
      }
***************
*** 2564,2571 ****
  		len = 512;
  	}
  	else {
! 	    if (PL_dowarn)
! 		warn("Test on unopened file <%s>",
  		  GvENAME(cGVOP->op_gv));
  	    SETERRNO(EBADF,RMS$_IFI);
  	    RETPUSHUNDEF;
--- 2567,2574 ----
  		len = 512;
  	}
  	else {
! 	    if (ckWARN(WARN_UNOPENED))
! 		warner(WARN_UNOPENED, "Test on unopened file <%s>",
  		  GvENAME(cGVOP->op_gv));
  	    SETERRNO(EBADF,RMS$_IFI);
  	    RETPUSHUNDEF;
***************
*** 2583,2590 ****
  	i = PerlLIO_open(SvPV(sv, PL_na), 0);
  #endif
  	if (i < 0) {
! 	    if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
! 		warn(warn_nl, "open");
  	    RETPUSHUNDEF;
  	}
  	PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
--- 2586,2593 ----
  	i = PerlLIO_open(SvPV(sv, PL_na), 0);
  #endif
  	if (i < 0) {
! 	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
! 		warner(WARN_NEWLINE, warn_nl, "open");
  	    RETPUSHUNDEF;
  	}
  	PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
*** proto.h.orig	Wed Jul 29 07:19:57 1998
--- proto.h	Wed Jul 29 07:20:51 1998
***************
*** 666,671 ****
--- 666,672 ----
  VIRTUAL void	vivify_ref _((SV* sv, U32 to_what));
  VIRTUAL I32	wait4pid _((int pid, int* statusp, int flags));
  VIRTUAL void	warn _((const char* pat,...));
+ VIRTUAL void	warner _((U32 err, const char* pat,...));
  VIRTUAL void	watch _((char** addr));
  VIRTUAL I32	whichsig _((char* sig));
  VIRTUAL int	yyerror _((char* s));
*** regcomp.c.orig	Wed Jul 29 07:19:58 1998
--- regcomp.c	Wed Jul 29 07:20:51 1998
***************
*** 485,494 ****
  					? (flags & ~SCF_DO_SUBSTR) : flags);
  		if (!scan) 		/* It was not CURLYX, but CURLY. */
  		    scan = next;
! 		if (PL_dowarn && (minnext + deltanext == 0) 
  		    && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
  		    && maxcount <= 10000) /* Complement check for big count */
! 		    warn("Strange *+?{} on zero-length expression");
  		min += minnext * mincount;
  		is_inf |= (maxcount == REG_INFTY && (minnext + deltanext) > 0
  			   || deltanext == I32_MAX);
--- 485,494 ----
  					? (flags & ~SCF_DO_SUBSTR) : flags);
  		if (!scan) 		/* It was not CURLYX, but CURLY. */
  		    scan = next;
! 		if (ckWARN(WARN_UNSAFE) && (minnext + deltanext == 0) 
  		    && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
  		    && maxcount <= 10000) /* Complement check for big count */
! 		    warner(WARN_UNSAFE, "Strange *+?{} on zero-length expression");
  		min += minnext * mincount;
  		is_inf |= (maxcount == REG_INFTY && (minnext + deltanext) > 0
  			   || deltanext == I32_MAX);
***************
*** 1553,1560 ****
  	goto do_curly;
      }
    nest_check:
!     if (PL_dowarn && !SIZE_ONLY && !(flags&HASWIDTH) && max > 10000) {
! 	warn("%.*s matches null string many times",
  	    PL_regcomp_parse - origparse, origparse);
      }
  
--- 1553,1560 ----
  	goto do_curly;
      }
    nest_check:
!     if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY && !(flags&HASWIDTH) && max > 10000) {
! 	warner(WARN_UNSAFE, "%.*s matches null string many times",
  	    PL_regcomp_parse - origparse, origparse);
      }
  
***************
*** 2082,2089 ****
  		     * (POSIX Extended Character Classes, that is)
  		     * The text between e.g. [: and :] would start
  		     * at posixccs + 1 and stop at regcomp_parse - 2. */
! 		    if (dowarn && !SIZE_ONLY)
! 			warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
  		    PL_regcomp_parse++; /* skip over the ending ] */
  		}
  	    }
--- 2082,2090 ----
  		     * (POSIX Extended Character Classes, that is)
  		     * The text between e.g. [: and :] would start
  		     * at posixccs + 1 and stop at regcomp_parse - 2. */
! 		    if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY)
! 			warner(WARN_UNSAFE,
!                           "Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
  		    PL_regcomp_parse++; /* skip over the ending ] */
  		}
  	    }
***************
*** 2286,2293 ****
  		     * (POSIX Extended Character Classes, that is)
  		     * The text between e.g. [: and :] would start
  		     * at posixccs + 1 and stop at regcomp_parse - 2. */
! 		    if (dowarn && !SIZE_ONLY)
! 			warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
  		    PL_regcomp_parse++; /* skip over the ending ] */
  		}
  	    }
--- 2287,2295 ----
  		     * (POSIX Extended Character Classes, that is)
  		     * The text between e.g. [: and :] would start
  		     * at posixccs + 1 and stop at regcomp_parse - 2. */
! 		    if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY)
! 			warner(WARN_UNSAFE,
!                             "Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
  		    PL_regcomp_parse++; /* skip over the ending ] */
  		}
  	    }
*** regexec.c.orig	Wed Jul 29 07:19:59 1998
--- regexec.c	Wed Jul 29 07:20:51 1998
***************
*** 1669,1678 ****
  		    PL_regcc = cc;
  
  		    if (n >= cc->max) {	/* Maximum greed exceeded? */
! 			if (PL_dowarn && n >= REG_INFTY 
  			    && !(PL_reg_flags & RF_warned)) {
  			    PL_reg_flags |= RF_warned;
! 			    warn("%s limit (%d) exceeded",
  				 "Complex regular subexpression recursion",
  				 REG_INFTY - 1);
  			}
--- 1669,1678 ----
  		    PL_regcc = cc;
  
  		    if (n >= cc->max) {	/* Maximum greed exceeded? */
! 			if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY 
  			    && !(PL_reg_flags & RF_warned)) {
  			    PL_reg_flags |= RF_warned;
! 			    warner(WARN_UNSAFE, "%s limit (%d) exceeded",
  				 "Complex regular subexpression recursion",
  				 REG_INFTY - 1);
  			}
***************
*** 1726,1734 ****
  				      REPORT_CODE_OFF+PL_regindent*2, "")
  			);
  		}
! 		if (PL_dowarn && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) {
  		    PL_reg_flags |= RF_warned;
! 		    warn("count exceeded %d", REG_INFTY - 1);
  		}
  
  		/* Failed deeper matches of scan, so see if this one works. */
--- 1726,1735 ----
  				      REPORT_CODE_OFF+PL_regindent*2, "")
  			);
  		}
! 		if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY 
! 			&& !(PL_reg_flags & RF_warned)) {
  		    PL_reg_flags |= RF_warned;
! 		    warner(WARN_UNSAFE, "count exceeded %d", REG_INFTY - 1);
  		}
  
  		/* Failed deeper matches of scan, so see if this one works. */
*** sv.c.orig	Wed Jul 29 07:20:00 1998
--- sv.c	Wed Jul 29 07:20:52 1998
***************
*** 1289,1298 ****
      *d = '\0';
  
      if (PL_op)
! 	warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
  		op_name[PL_op->op_type]);
      else
! 	warn("Argument \"%s\" isn't numeric", tmpbuf);
  }
  
  IV
--- 1289,1298 ----
      *d = '\0';
  
      if (PL_op)
! 	warner(WARN_NUMERIC, "Argument \"%s\" isn't numeric in %s", tmpbuf,
  		op_name[PL_op->op_type]);
      else
! 	warner(WARN_NUMERIC, "Argument \"%s\" isn't numeric", tmpbuf);
  }
  
  IV
***************
*** 1313,1322 ****
  	if (SvPOKp(sv) && SvLEN(sv))
  	    return asIV(sv);
  	if (!SvROK(sv)) {
! 	    if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warn(warn_uninit);
  	    }
  	    return 0;
  	}
--- 1313,1322 ----
  	if (SvPOKp(sv) && SvLEN(sv))
  	    return asIV(sv);
  	if (!SvROK(sv)) {
! 	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warner(WARN_UNINITIALIZED, warn_uninit);
  	    }
  	    return 0;
  	}
***************
*** 1339,1346 ****
  	    }
  	    if (SvPOKp(sv) && SvLEN(sv))
  		return asIV(sv);
! 	    if (PL_dowarn)
! 		warn(warn_uninit);
  	    return 0;
  	}
      }
--- 1339,1346 ----
  	    }
  	    if (SvPOKp(sv) && SvLEN(sv))
  		return asIV(sv);
! 	    if (ckWARN(WARN_UNINITIALIZED))
! 		warner(WARN_UNINITIALIZED, warn_uninit);
  	    return 0;
  	}
      }
***************
*** 1368,1375 ****
      }
      else  {
  	dTHR;
! 	if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
! 	    warn(warn_uninit);
  	return 0;
      }
      DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n",
--- 1368,1375 ----
      }
      else  {
  	dTHR;
! 	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
! 	    warner(WARN_UNINITIALIZED, warn_uninit);
  	return 0;
      }
      DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n",
***************
*** 1391,1400 ****
  	if (SvPOKp(sv) && SvLEN(sv))
  	    return asUV(sv);
  	if (!SvROK(sv)) {
! 	    if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warn(warn_uninit);
  	    }
  	    return 0;
  	}
--- 1391,1400 ----
  	if (SvPOKp(sv) && SvLEN(sv))
  	    return asUV(sv);
  	if (!SvROK(sv)) {
! 	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warner(WARN_UNINITIALIZED, warn_uninit);
  	    }
  	    return 0;
  	}
***************
*** 1414,1421 ****
  	    }
  	    if (SvPOKp(sv) && SvLEN(sv))
  		return asUV(sv);
! 	    if (PL_dowarn)
! 		warn(warn_uninit);
  	    return 0;
  	}
      }
--- 1414,1421 ----
  	    }
  	    if (SvPOKp(sv) && SvLEN(sv))
  		return asUV(sv);
! 	    if (ckWARN(WARN_UNINITIALIZED))
! 		warner(WARN_UNINITIALIZED, warn_uninit);
  	    return 0;
  	}
      }
***************
*** 1439,1448 ****
  	SvUVX(sv) = asUV(sv);
      }
      else  {
! 	if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
  	    dTHR;
  	    if (!PL_localizing)
! 		warn(warn_uninit);
  	}
  	return 0;
      }
--- 1439,1448 ----
  	SvUVX(sv) = asUV(sv);
      }
      else  {
! 	if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
  	    dTHR;
  	    if (!PL_localizing)
! 		warner(WARN_UNINITIALIZED, warn_uninit);
  	}
  	return 0;
      }
***************
*** 1461,1467 ****
  	if (SvNOKp(sv))
  	    return SvNVX(sv);
  	if (SvPOKp(sv) && SvLEN(sv)) {
! 	    if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  		not_a_number(sv);
  	    SET_NUMERIC_STANDARD();
  	    return atof(SvPVX(sv));
--- 1461,1467 ----
  	if (SvNOKp(sv))
  	    return SvNVX(sv);
  	if (SvPOKp(sv) && SvLEN(sv)) {
! 	    if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
  		not_a_number(sv);
  	    SET_NUMERIC_STANDARD();
  	    return atof(SvPVX(sv));
***************
*** 1469,1478 ****
  	if (SvIOKp(sv))
  	    return (double)SvIVX(sv);
          if (!SvROK(sv)) {
! 	    if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warn(warn_uninit);
  	    }
              return 0;
          }
--- 1469,1478 ----
  	if (SvIOKp(sv))
  	    return (double)SvIVX(sv);
          if (!SvROK(sv)) {
! 	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warner(WARN_UNINITIALIZED, warn_uninit);
  	    }
              return 0;
          }
***************
*** 1488,1502 ****
  	}
  	if (SvREADONLY(sv)) {
  	    if (SvPOKp(sv) && SvLEN(sv)) {
! 		if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  		    not_a_number(sv);
  		SET_NUMERIC_STANDARD();
  		return atof(SvPVX(sv));
  	    }
  	    if (SvIOKp(sv))
  		return (double)SvIVX(sv);
! 	    if (PL_dowarn)
! 		warn(warn_uninit);
  	    return 0.0;
  	}
      }
--- 1488,1502 ----
  	}
  	if (SvREADONLY(sv)) {
  	    if (SvPOKp(sv) && SvLEN(sv)) {
! 		if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
  		    not_a_number(sv);
  		SET_NUMERIC_STANDARD();
  		return atof(SvPVX(sv));
  	    }
  	    if (SvIOKp(sv))
  		return (double)SvIVX(sv);
! 	    if (ckWARN(WARN_UNINITIALIZED))
! 		warner(WARN_UNINITIALIZED, warn_uninit);
  	    return 0.0;
  	}
      }
***************
*** 1517,1531 ****
  	SvNVX(sv) = (double)SvIVX(sv);
      }
      else if (SvPOKp(sv) && SvLEN(sv)) {
! 	if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  	    not_a_number(sv);
  	SET_NUMERIC_STANDARD();
  	SvNVX(sv) = atof(SvPVX(sv));
      }
      else  {
  	dTHR;
! 	if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
! 	    warn(warn_uninit);
  	return 0.0;
      }
      SvNOK_on(sv);
--- 1517,1531 ----
  	SvNVX(sv) = (double)SvIVX(sv);
      }
      else if (SvPOKp(sv) && SvLEN(sv)) {
! 	if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
  	    not_a_number(sv);
  	SET_NUMERIC_STANDARD();
  	SvNVX(sv) = atof(SvPVX(sv));
      }
      else  {
  	dTHR;
! 	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
! 	    warner(WARN_UNINITIALIZED, warn_uninit);
  	return 0.0;
      }
      SvNOK_on(sv);
***************
*** 1543,1549 ****
  
      if (numtype == 1)
  	return atol(SvPVX(sv));
!     if (!numtype && PL_dowarn)
  	not_a_number(sv);
      SET_NUMERIC_STANDARD();
      d = atof(SvPVX(sv));
--- 1543,1549 ----
  
      if (numtype == 1)
  	return atol(SvPVX(sv));
!     if (!numtype && ckWARN(WARN_NUMERIC))
  	not_a_number(sv);
      SET_NUMERIC_STANDARD();
      d = atof(SvPVX(sv));
***************
*** 1562,1568 ****
      if (numtype == 1)
  	return strtoul(SvPVX(sv), Null(char**), 10);
  #endif
!     if (!numtype && PL_dowarn)
  	not_a_number(sv);
      SET_NUMERIC_STANDARD();
      return U_V(atof(SvPVX(sv)));
--- 1562,1568 ----
      if (numtype == 1)
  	return strtoul(SvPVX(sv), Null(char**), 10);
  #endif
!     if (!numtype && ckWARN(WARN_NUMERIC))
  	not_a_number(sv);
      SET_NUMERIC_STANDARD();
      return U_V(atof(SvPVX(sv)));
***************
*** 1677,1686 ****
  	    goto tokensave;
  	}
          if (!SvROK(sv)) {
! 	    if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warn(warn_uninit);
  	    }
              *lp = 0;
              return "";
--- 1677,1686 ----
  	    goto tokensave;
  	}
          if (!SvROK(sv)) {
! 	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
  		dTHR;
  		if (!PL_localizing)
! 		    warner(WARN_UNINITIALIZED, warn_uninit);
  	    }
              *lp = 0;
              return "";
***************
*** 1785,1792 ****
  		tsv = Nullsv;
  		goto tokensave;
  	    }
! 	    if (PL_dowarn)
! 		warn(warn_uninit);
  	    *lp = 0;
  	    return "";
  	}
--- 1785,1792 ----
  		tsv = Nullsv;
  		goto tokensave;
  	    }
! 	    if (ckWARN(WARN_UNINITIALIZED))
! 		warner(WARN_UNINITIALIZED, warn_uninit);
  	    *lp = 0;
  	    return "";
  	}
***************
*** 1833,1840 ****
      }
      else {
  	dTHR;
! 	if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
! 	    warn(warn_uninit);
  	*lp = 0;
  	return "";
      }
--- 1833,1840 ----
      }
      else {
  	dTHR;
! 	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
! 	    warner(WARN_UNINITIALIZED, warn_uninit);
  	*lp = 0;
  	return "";
      }
***************
*** 2163,2174 ****
  				    croak(
  				    "Can't redefine active sort subroutine %s",
  					  GvENAME((GV*)dstr));
! 				if (PL_dowarn || (const_changed && const_sv)) {
  				    if (!(CvGV(cv) && GvSTASH(CvGV(cv))
  					  && HvNAME(GvSTASH(CvGV(cv)))
  					  && strEQ(HvNAME(GvSTASH(CvGV(cv))),
  						   "autouse")))
! 					warn(const_sv ? 
  					     "Constant subroutine %s redefined"
  					     : "Subroutine %s redefined", 
  					     GvENAME((GV*)dstr));
--- 2163,2174 ----
  				    croak(
  				    "Can't redefine active sort subroutine %s",
  					  GvENAME((GV*)dstr));
! 				if (ckWARN(WARN_REDEFINE) || (const_changed && const_sv)) {
  				    if (!(CvGV(cv) && GvSTASH(CvGV(cv))
  					  && HvNAME(GvSTASH(CvGV(cv)))
  					  && strEQ(HvNAME(GvSTASH(CvGV(cv))),
  						   "autouse")))
! 					warner(WARN_REDEFINE, const_sv ? 
  					     "Constant subroutine %s redefined"
  					     : "Subroutine %s redefined", 
  					     GvENAME((GV*)dstr));
***************
*** 2297,2304 ****
      }
      else {
  	if (dtype == SVt_PVGV) {
! 	    if (PL_dowarn)
! 		warn("Undefined value assigned to typeglob");
  	}
  	else
  	    (void)SvOK_off(dstr);
--- 2297,2304 ----
      }
      else {
  	if (dtype == SVt_PVGV) {
! 	    if (ckWARN(WARN_UNSAFE))
! 		warner(WARN_UNSAFE, "Undefined value assigned to typeglob");
  	}
  	else
  	    (void)SvOK_off(dstr);
***************
*** 4901,4907 ****
  
  	default:
        unknown:
! 	    if (!args && PL_dowarn &&
  		  (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
  		SV *msg = sv_newmortal();
  		sv_setpvf(msg, "Invalid conversion in %s: ",
--- 4901,4907 ----
  
  	default:
        unknown:
! 	    if (!args && ckWARN(WARN_PRINTF) &&
  		  (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
  		SV *msg = sv_newmortal();
  		sv_setpvf(msg, "Invalid conversion in %s: ",
***************
*** 4911,4917 ****
  			      c & 0xFF);
  		else
  		    sv_catpv(msg, "end of string");
! 		warn("%_", msg); /* yes, this is reentrant */
  	    }
  
  	    /* output mangled stuff ... */
--- 4911,4917 ----
  			      c & 0xFF);
  		else
  		    sv_catpv(msg, "end of string");
! 		warner(WARN_PRINTF, "%_", msg); /* yes, this is reentrant */
  	    }
  
  	    /* output mangled stuff ... */
*** t/op/tie.t.orig	Mon Jul 20 02:19:12 1998
--- t/op/tie.t	Wed Jul 29 07:20:52 1998
***************
*** 77,84 ****
  ########
  
  # strict behaviour, without any extra references
! #use warning 'untie';
! local $^W = 1 ;
  use Tie::Hash ;
  tie %h, Tie::StdHash;
  untie %h;
--- 77,84 ----
  ########
  
  # strict behaviour, without any extra references
! use warning 'untie';
! #local $^W = 1 ;
  use Tie::Hash ;
  tie %h, Tie::StdHash;
  untie %h;
***************
*** 86,93 ****
  ########
  
  # strict behaviour, with 1 extra references generating an error
! #use warning 'untie';
! local $^W = 1 ;
  use Tie::Hash ;
  $a = tie %h, Tie::StdHash;
  untie %h;
--- 86,93 ----
  ########
  
  # strict behaviour, with 1 extra references generating an error
! use warning 'untie';
! #local $^W = 1 ;
  use Tie::Hash ;
  $a = tie %h, Tie::StdHash;
  untie %h;
***************
*** 96,103 ****
  ########
  
  # strict behaviour, with 1 extra references via tied generating an error
! #use warning 'untie';
! local $^W = 1 ;
  use Tie::Hash ;
  tie %h, Tie::StdHash;
  $a = tied %h;
--- 96,103 ----
  ########
  
  # strict behaviour, with 1 extra references via tied generating an error
! use warning 'untie';
! #local $^W = 1 ;
  use Tie::Hash ;
  tie %h, Tie::StdHash;
  $a = tied %h;
***************
*** 107,114 ****
  ########
  
  # strict behaviour, with 1 extra references which are destroyed
! #use warning 'untie';
! local $^W = 1 ;
  use Tie::Hash ;
  $a = tie %h, Tie::StdHash;
  $a = 0 ;
--- 107,114 ----
  ########
  
  # strict behaviour, with 1 extra references which are destroyed
! use warning 'untie';
! #local $^W = 1 ;
  use Tie::Hash ;
  $a = tie %h, Tie::StdHash;
  $a = 0 ;
***************
*** 117,124 ****
  ########
  
  # strict behaviour, with extra 1 references via tied which are destroyed
! #use warning 'untie';
! local $^W = 1 ;
  use Tie::Hash ;
  tie %h, Tie::StdHash;
  $a = tied %h;
--- 117,124 ----
  ########
  
  # strict behaviour, with extra 1 references via tied which are destroyed
! use warning 'untie';
! #local $^W = 1 ;
  use Tie::Hash ;
  tie %h, Tie::StdHash;
  $a = tied %h;
***************
*** 128,135 ****
  ########
  
  # strict error behaviour, with 2 extra references 
! #use warning 'untie';
! local $^W = 1 ;
  use Tie::Hash ;
  $a = tie %h, Tie::StdHash;
  $b = tied %h ;
--- 128,135 ----
  ########
  
  # strict error behaviour, with 2 extra references 
! use warning 'untie';
! #local $^W = 1 ;
  use Tie::Hash ;
  $a = tie %h, Tie::StdHash;
  $b = tied %h ;
***************
*** 139,152 ****
  ########
  
  # strict behaviour, check scope of strictness.
! #no warning 'untie';
! local $^W = 0 ;
  use Tie::Hash ;
  $A = tie %H, Tie::StdHash;
  $C = $B = tied %H ;
  {
!     #use warning 'untie';
!     local $^W = 1 ;
      use Tie::Hash ;
      tie %h, Tie::StdHash;
      untie %h;
--- 139,152 ----
  ########
  
  # strict behaviour, check scope of strictness.
! no warning 'untie';
! #local $^W = 0 ;
  use Tie::Hash ;
  $A = tie %H, Tie::StdHash;
  $C = $B = tied %H ;
  {
!     use warning 'untie';
!     #local $^W = 1 ;
      use Tie::Hash ;
      tie %h, Tie::StdHash;
      untie %h;
*** t/pragma/warn-1global.orig	Thu Mar  5 19:44:23 1998
--- t/pragma/warn-1global	Wed Jul 29 07:20:52 1998
***************
*** 1,5 ****
--- 1,6 ----
  Check existing $^W functionality
  
+ 
  __END__
  
  # warnable code, warnings disabled
***************
*** 110,131 ****
  ########
  
  $^W = 1;
! eval "my $b ; chop $b ;" ;
  EXPECT
! Use of uninitialized value at - line 3.
! Use of uninitialized value at - line 3.
  ########
  
! eval "$^W = 1;" ;
  my $b ; chop $b ;
  EXPECT
! 
  ########
  
  eval {$^W = 1;} ;
  my $b ; chop $b ;
  EXPECT
! Use of uninitialized value at - line 3.
  ########
  
  {
--- 111,134 ----
  ########
  
  $^W = 1;
! eval 'my $b ; chop $b ;' ;
! print $@ ;
  EXPECT
! Use of uninitialized value at (eval 1) line 1.
  ########
  
! eval '$^W = 1;' ;
! print $@ ;
  my $b ; chop $b ;
  EXPECT
! Use of uninitialized value at - line 4.
  ########
  
  eval {$^W = 1;} ;
+ print $@ ;
  my $b ; chop $b ;
  EXPECT
! Use of uninitialized value at - line 4.
  ########
  
  {
***************
*** 147,151 ****
--- 150,186 ----
  ########
  -w
  -e undef
+ EXPECT
+ Use of uninitialized value at - line 2.
+ ########
+ 
+ $^W = 1 + 2 ;
+ EXPECT
+ 
+ ########
+ 
+ $^W = $a ;
+ EXPECT
+ 
+ ########
+ 
+ sub fred {}
+ $^W = fred() ;
+ EXPECT
+ 
+ ########
+ 
+ sub fred { my $b ; chop $b ;}
+ { local $^W = 0 ;
+   fred() ;
+ }
+ EXPECT
+ 
+ ########
+ 
+ sub fred { my $b ; chop $b ;}
+ { local $^W = 1 ;
+   fred() ;
+ }
  EXPECT
  Use of uninitialized value at - line 2.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-2use	Wed Jul 29 07:20:52 1998
***************
*** 0 ****
--- 1,291 ----
+ Check lexical warning functionality
+ 
+ TODO
+   check that the warning hierarchy works.
+ 
+ __END__
+ 
+ # check illegal category is caught
+ use warning 'blah' ;
+ EXPECT
+ unknown warning category 'blah' at - line 3
+ BEGIN failed--compilation aborted at - line 3.
+ ########
+ 
+ # Check compile time scope of pragma
+ use warning 'deprecated' ;
+ {
+     no warning ;
+     1 if $a EQ $b ;
+ }
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 8.
+ ########
+ 
+ # Check compile time scope of pragma
+ no warning;
+ {
+     use warning 'deprecated' ;
+     1 if $a EQ $b ;
+ }
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 6.
+ ########
+ 
+ # Check runtime scope of pragma
+ use warning 'uninitialized' ;
+ {
+     no warning ;
+     my $b ; chop $b ;
+ }
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 8.
+ ########
+ 
+ # Check runtime scope of pragma
+ no warning ;
+ {
+     use warning 'uninitialized' ;
+     my $b ; chop $b ;
+ }
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ # Check runtime scope of pragma
+ no warning ;
+ {
+     use warning 'uninitialized' ;
+     $a = sub { my $b ; chop $b ; }
+ }
+ &$a ;
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ use warning 'deprecated' ;
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 3.
+ ########
+ 
+ --FILE-- abc
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ use warning 'deprecated' ;
+ require "./abc";
+ EXPECT
+ 
+ ########
+ 
+ --FILE-- abc
+ use warning 'deprecated' ;
+ 1;
+ --FILE-- 
+ require "./abc";
+ 1 if $a EQ $b ;
+ EXPECT
+ 
+ ########
+ 
+ --FILE-- abc
+ use warning 'deprecated' ;
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ use warning 'uninitialized' ;
+ require "./abc";
+ my $a ; chop $a ;
+ EXPECT
+ Use of EQ is deprecated at ./abc line 2.
+ Use of uninitialized value at - line 3.
+ ########
+ 
+ --FILE-- abc.pm
+ use warning 'deprecated' ;
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ use warning 'uninitialized' ;
+ use abc;
+ my $a ; chop $a ;
+ EXPECT
+ Use of EQ is deprecated at abc.pm line 2.
+ Use of uninitialized value at - line 3.
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval {
+     my $b ; chop $b ;
+ }; print STDERR $@ ;
+ my $b ; chop $b ;
+ EXPECT
+ 
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval {
+     use warning 'uninitialized' ;
+     my $b ; chop $b ;
+ }; print STDERR $@ ;
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'uninitialized' ;
+ eval {
+     my $b ; chop $b ;
+ }; print STDERR $@ ;
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 5.
+ Use of uninitialized value at - line 7.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'uninitialized' ;
+ eval {
+     no warning ;
+     my $b ; chop $b ;
+ }; print STDERR $@ ;
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 8.
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval {
+     1 if $a EQ $b ;
+ }; print STDERR $@ ;
+ 1 if $a EQ $b ;
+ EXPECT
+ 
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval {
+     use warning 'deprecated' ;
+     1 if $a EQ $b ;
+ }; print STDERR $@ ;
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 6.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'deprecated' ;
+ eval {
+     1 if $a EQ $b ;
+ }; print STDERR $@ ;
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 5.
+ Use of EQ is deprecated at - line 7.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'deprecated' ;
+ eval {
+     no warning ;
+     1 if $a EQ $b ;
+ }; print STDERR $@ ;
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 8.
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval '
+     my $b ; chop $b ;
+ '; print STDERR $@ ;
+ my $b ; chop $b ;
+ EXPECT
+ 
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval q[ 
+     use warning 'uninitialized' ;
+     my $b ; chop $b ;
+ ]; print STDERR $@;
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at (eval 1) line 3.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'uninitialized' ;
+ eval '
+     my $b ; chop $b ;
+ '; print STDERR $@ ;
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at (eval 1) line 2.
+ Use of uninitialized value at - line 7.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'uninitialized' ;
+ eval '
+     no warning ;
+     my $b ; chop $b ;
+ '; print STDERR $@ ;
+ my $b ; chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 8.
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval '
+     1 if $a EQ $b ;
+ '; print STDERR $@ ;
+ 1 if $a EQ $b ;
+ EXPECT
+ 
+ ########
+ 
+ # Check scope of pragma with eval
+ no warning ;
+ eval q[ 
+     use warning 'deprecated' ;
+     1 if $a EQ $b ;
+ ]; print STDERR $@;
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at (eval 1) line 3.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'deprecated' ;
+ eval '
+     1 if $a EQ $b ;
+ '; print STDERR $@;
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 7.
+ Use of EQ is deprecated at (eval 1) line 2.
+ ########
+ 
+ # Check scope of pragma with eval
+ use warning 'deprecated' ;
+ eval '
+     no warning ;
+     1 if $a EQ $b ;
+ '; print STDERR $@;
+ 1 if $a EQ $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 8.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-3both	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,66 ----
+ Check interaction of $^W and lexical
+ 
+ __END__
+ 
+ # Check interaction of $^W and use warning
+ sub fred { 
+     use warning ;
+     my $b ; 
+     chop $b ;
+ }
+ { local $^W = 0 ;
+   fred() ;
+ }
+ 
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ # Check interaction of $^W and use warning
+ sub fred { 
+     no warning ;
+     my $b ; 
+     chop $b ;
+ }
+ { local $^W = 1 ;
+   fred() ;
+ }
+ 
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ # Check interaction of $^W and use warning
+ use warning ;
+ $^W = 1 ;
+ my $b ; 
+ chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ # Check interaction of $^W and use warning
+ $^W = 1 ;
+ use warning ;
+ my $b ; 
+ chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ # Check interaction of $^W and use warning
+ $^W = 1 ;
+ no warning ;
+ my $b ; 
+ chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 6.
+ ########
+ 
+ # Check interaction of $^W and use warning
+ no warning ;
+ $^W = 1 ;
+ my $b ; 
+ chop $b ;
+ EXPECT
+ Use of uninitialized value at - line 6.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-4lint	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,112 ----
+ Check lint
+ 
+ __END__
+ -W
+ # lint: check compile time $^W is zapped
+ BEGIN { $^W = 0 ;}
+ $a = $b = 1 ;
+ $a = 1 if $a EQ $b ;
+ close STDIN ; print STDIN "abc" ;
+ EXPECT
+ Use of EQ is deprecated at - line 5.
+ print on closed filehandle main::STDIN at - line 6.
+ ########
+ -W
+ # lint: check runtime $^W is zapped
+ $^W = 0 ;
+ close STDIN ; print STDIN "abc" ;
+ EXPECT
+ print on closed filehandle main::STDIN at - line 4.
+ ########
+ -W
+ # lint: check runtime $^W is zapped
+ {
+   $^W = 0 ;
+   close STDIN ; print STDIN "abc" ;
+ }
+ EXPECT
+ print on closed filehandle main::STDIN at - line 5.
+ ########
+ -W
+ # lint: check "no warning" is zapped
+ no warning ;
+ $a = $b = 1 ;
+ $a = 1 if $a EQ $b ;
+ close STDIN ; print STDIN "abc" ;
+ EXPECT
+ Use of EQ is deprecated at - line 5.
+ print on closed filehandle main::STDIN at - line 6.
+ ########
+ -W
+ # lint: check "no warning" is zapped
+ {
+   no warning ;
+   close STDIN ; print STDIN "abc" ;
+ }
+ EXPECT
+ print on closed filehandle main::STDIN at - line 5.
+ ########
+ -Ww
+ # lint: check combination of -w and -W
+ {
+   $^W = 0 ;
+   close STDIN ; print STDIN "abc" ;
+ }
+ EXPECT
+ print on closed filehandle main::STDIN at - line 5.
+ ########
+ -W
+ --FILE-- abc.pm
+ no warning 'deprecated' ;
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ no warning 'uninitialized' ;
+ use abc;
+ my $a ; chop $a ;
+ EXPECT
+ Use of EQ is deprecated at abc.pm line 3.
+ Use of uninitialized value at - line 3.
+ ########
+ -W
+ --FILE-- abc
+ no warning 'deprecated' ;
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ no warning 'uninitialized' ;
+ require "./abc";
+ my $a ; chop $a ;
+ EXPECT
+ Use of EQ is deprecated at ./abc line 3.
+ Use of uninitialized value at - line 3.
+ ########
+ -W
+ --FILE-- abc.pm
+ BEGIN {$^W = 0}
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ $^W = 0 ;
+ use abc;
+ my $a ; chop $a ;
+ EXPECT
+ Use of EQ is deprecated at abc.pm line 3.
+ Use of uninitialized value at - line 3.
+ ########
+ -W
+ --FILE-- abc
+ BEGIN {$^W = 0}
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ $^W = 0 ;
+ require "./abc";
+ my $a ; chop $a ;
+ EXPECT
+ Use of EQ is deprecated at ./abc line 3.
+ Use of uninitialized value at - line 3.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-5nolint	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,96 ----
+ Check anti-lint
+ 
+ __END__
+ -X
+ # nolint: check compile time $^W is zapped
+ BEGIN { $^W = 1 ;}
+ $a = $b = 1 ;
+ $a = 1 if $a EQ $b ;
+ close STDIN ; print STDIN "abc" ;
+ EXPECT
+ ########
+ -X
+ # nolint: check runtime $^W is zapped
+ $^W = 1 ;
+ close STDIN ; print STDIN "abc" ;
+ EXPECT
+ ########
+ -X
+ # nolint: check runtime $^W is zapped
+ {
+   $^W = 1 ;
+   close STDIN ; print STDIN "abc" ;
+ }
+ EXPECT
+ ########
+ -X
+ # nolint: check "no warning" is zapped
+ use warning ;
+ $a = $b = 1 ;
+ $a = 1 if $a EQ $b ;
+ close STDIN ; print STDIN "abc" ;
+ EXPECT
+ ########
+ -X
+ # nolint: check "no warning" is zapped
+ {
+   use warning ;
+   close STDIN ; print STDIN "abc" ;
+ }
+ EXPECT
+ ########
+ -Xw
+ # nolint: check combination of -w and -X
+ {
+   $^W = 1 ;
+   close STDIN ; print STDIN "abc" ;
+ }
+ EXPECT
+ ########
+ -X
+ --FILE-- abc.pm
+ use warning 'deprecated' ;
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ use warning 'uninitialized' ;
+ use abc;
+ my $a ; chop $a ;
+ EXPECT
+ ########
+ -X
+ --FILE-- abc
+ use warning 'deprecated' ;
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ use warning 'uninitialized' ;
+ require "./abc";
+ my $a ; chop $a ;
+ EXPECT
+ ########
+ -X
+ --FILE-- abc.pm
+ BEGIN {$^W = 1}
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ $^W = 1 ;
+ use abc;
+ my $a ; chop $a ;
+ EXPECT
+ ########
+ -X
+ --FILE-- abc
+ BEGIN {$^W = 1}
+ my ($a, $b) = (0,0);
+ 1 if $a EQ $b ;
+ 1;
+ --FILE-- 
+ $^W = 1 ;
+ require "./abc";
+ my $a ; chop $a ;
+ EXPECT
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-doio	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,94 ----
+   doio.c	AOK
+ 
+   Can't do bidirectional pipe
+     open(F, "| true |");
+ 
+   warn(warn_nl, "open");
+     open(F, "true\ncd")
+ 
+   Close on unopened file <%s>
+     $a = "fred";close($a)
+ 
+   tell() on unopened file
+     $a = "fred";$a = tell($a)
+ 
+   seek() on unopened file
+     $a = "fred";$a = seek($a,1,1)
+ 
+   sysseek() on unopened file
+     $a = "fred";$a = seek($a,1,1)
+ 
+   warn(warn_uninit);
+     print $a ;
+ 
+   Stat on unopened file <%s> 
+     close STDIN ; -x STDIN ;
+ 
+   warn(warn_nl, "stat");
+     stat "ab\ncd"
+ 
+   warn(warn_nl, "lstat");
+     lstat "ab\ncd"
+ 
+   Can't exec \"%s\": %s 
+ 
+   Can't exec \"%s\": %s 
+ 
+ 
+ __END__
+ # doio.c
+ use warning 'io' ;
+ open(F, "|true|")
+ EXPECT
+ Can't do bidirectional pipe at - line 3.
+ ########
+ # doio.c
+ use warning 'io' ;
+ open(F, "<true\ncd")
+ EXPECT
+ Unsuccessful open on filename containing newline at - line 3.
+ ########
+ # doio.c
+ use warning 'io' ;
+ close STDIN ;
+ tell(STDIN);
+ $a = seek(STDIN,1,1);
+ $a = sysseek(STDIN,1,1);
+ -x STDIN ;
+ EXPECT
+ tell() on unopened file at - line 4.
+ seek() on unopened file at - line 5.
+ sysseek() on unopened file at - line 6.
+ Stat on unopened file <STDIN> at - line 7.
+ ########
+ # doio.c
+ use warning 'uninitialized' ;
+ print $a ;
+ EXPECT
+ Use of uninitialized value at - line 3.
+ ########
+ # doio.c
+ use warning 'io' ;
+ 
+ EXPECT
+ 
+ ########
+ # doio.c
+ use warning 'io' ;
+ stat "ab\ncd";
+ lstat "ab\ncd";
+ EXPECT
+ Unsuccessful stat on filename containing newline at - line 3.
+ Unsuccessful stat on filename containing newline at - line 4.
+ ########
+ # doio.c
+ use warning 'io' ;
+ exec "lskdjfalksdjfdjfkls" ;
+ EXPECT
+ Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3.
+ ########
+ # doio.c
+ use warning 'io' ;
+ exec "lskdjfalksdjfdjfkls", "abc" ;
+ EXPECT
+ Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-gv	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,40 ----
+   gv.c AOK
+ 
+      Can't locate package %s for @%s::ISA
+ 	@ISA = qw(Fred); joe()
+ 
+      Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated
+ 	sub Other::AUTOLOAD { 1 } sub Other::fred {}
+ 	@ISA = qw(Other) ;
+ 	fred() ;
+ 
+      Use of $# is deprecated
+      Use of $* is deprecated
+ 
+ 	$a = ${"#"} ;
+  	$a = ${"*"} ;
+ 
+ 
+ __END__
+ # gv.c
+ use warning 'misc' ;
+ @ISA = qw(Fred); joe()
+ EXPECT
+ Can't locate package Fred for @main::ISA at - line 3.
+ Undefined subroutine &main::joe called at - line 3.
+ ########
+ # gv.c
+ sub Other::AUTOLOAD { 1 } sub Other::fred {}
+ @ISA = qw(Other) ;
+ use warning 'deprecated' ;
+ fred() ;
+ EXPECT
+ Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
+ ########
+ # gv.c
+ use warning 'deprecated' ;
+ $a = ${"#"};
+ $a = ${"*"};
+ EXPECT
+ Use of $# is deprecated at - line 3.
+ Use of $* is deprecated at - line 4.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-mg	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,21 ----
+   mg.c	AOK
+ 
+   No such signal: SIG%s
+     $SIG{FRED} = sub {}
+ 
+   SIG%s handler \"%s\" not defined.
+     $SIG{"INT"} = "ok3"; kill "INT",$$;
+ 
+ 
+ __END__
+ # mg.c
+ use warning 'signal' ;
+ $SIG{FRED} = sub {};
+ EXPECT
+ No such signal: SIGFRED at - line 3.
+ ########
+ # mg.c
+ use warning 'signal' ;
+ $SIG{"INT"} = "fred"; kill "INT",$$;
+ EXPECT
+ SIGINT handler "fred" not defined.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-op	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,535 ----
+   op.c		AOK
+ 
+      "my" variable %s masks earlier declaration in same scope
+ 	my $x;
+ 	my $x ;
+ 
+      Variable "%s" may be unavailable 
+ 	sub x {
+       	    my $x;
+       	    sub y {
+          	$x
+       	    }
+    	}
+ 
+      Variable "%s" will not stay shared 
+ 	sub x {
+       	    my $x;
+       	    sub y {
+          	sub { $x }
+       	    }
+    	}
+ 
+      Found = in conditional, should be ==
+ 	1 if $a = 1 ;
+ 
+      Use of implicit split to @_ is deprecated
+ 	split ;
+ 
+      Use of implicit split to @_ is deprecated
+ 	$a = split ;
+ 
+      Useless use of time in void context
+      Useless use of a variable in void context
+      Useless use of a constant in void context
+ 	time ;
+ 	$a ;
+ 	"abc"
+ 
+      Applying %s to %s will act on scalar(%s)
+ 	my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+ 	@a =~ /abc/ ;
+ 	@a =~ s/a/b/ ;
+ 	@a =~ tr/a/b/ ;
+ 	@$b =~ /abc/ ;
+ 	@$b =~ s/a/b/ ;
+ 	@$b =~ tr/a/b/ ;
+ 	%a =~ /abc/ ;
+ 	%a =~ s/a/b/ ;
+ 	%a =~ tr/a/b/ ;
+ 	%$c =~ /abc/ ;
+ 	%$c =~ s/a/b/ ;
+ 	%$c =~ tr/a/b/ ;
+ 
+ 
+      Parens missing around "my" list at -e line 1.
+        my $a, $b = (1,2);
+  
+      Parens missing around "local" list at -e line 1.
+        local $a, $b = (1,2);
+  
+      Probable precedence problem on logical or at -e line 1.
+        use warning 'syntax'; my $x = print(ABC || 1);
+  
+      Value of %s may be \"0\"; use \"defined\" 
+ 	$x = 1 if $x = <FH> ;
+ 	$x = 1 while $x = <FH> ;
+ 
+      Subroutine fred redefined at -e line 1.
+        sub fred{1;} sub fred{1;}
+  
+      Constant subroutine %s redefined 
+         sub fred() {1;} sub fred() {1;}
+  
+      Format FRED redefined at /tmp/x line 5.
+        format FRED =
+        .
+        format FRED =
+        .
+  
+      Array @%s missing the @ in argument %d of %s() 
+ 	push fred ;
+  
+      Hash %%%s missing the %% in argument %d of %s() 
+ 	keys joe ;
+  
+      Statement unlikely to be reached
+      (Maybe you meant system() when you said exec()?
+  	exec "true" ; my $a
+ 
+ 
+ __END__
+ # op.c
+ use warning 'unsafe' ;
+ my $x ;
+ my $x ;
+ EXPECT
+ "my" variable $x masks earlier declaration in same scope at - line 4.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ sub x {
+       my $x;
+       sub y {
+          $x
+       }
+    }
+ EXPECT
+ Variable "$x" will not stay shared at - line 7.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ sub x {
+       my $x;
+       sub y {
+          sub { $x }
+       }
+    }
+ EXPECT
+ Variable "$x" may be unavailable at - line 6.
+ ########
+ # op.c
+ use warning 'syntax' ;
+ 1 if $a = 1 ;
+ EXPECT
+ Found = in conditional, should be == at - line 3.
+ ########
+ # op.c
+ use warning 'deprecated' ;
+ split ;
+ EXPECT
+ Use of implicit split to @_ is deprecated at - line 3.
+ ########
+ # op.c
+ use warning 'deprecated' ;
+ $a = split ;
+ EXPECT
+ Use of implicit split to @_ is deprecated at - line 3.
+ ########
+ # op.c
+ use warning 'void' ; close STDIN ;
+ 1 x 3 ;			# OP_REPEAT
+ 			# OP_GVSV
+ wantarray ; 		# OP_WANTARRAY
+ 			# OP_GV
+ 			# OP_PADSV
+ 			# OP_PADAV
+ 			# OP_PADHV
+ 			# OP_PADANY
+ 			# OP_AV2ARYLEN
+ ref ;			# OP_REF
+ \@a ;			# OP_REFGEN
+ \$a ;			# OP_SREFGEN
+ defined $a ;		# OP_DEFINED
+ hex $a ;		# OP_HEX
+ oct $a ;		# OP_OCT
+ length $a ;		# OP_LENGTH
+ substr $a,1 ;		# OP_SUBSTR
+ vec $a,1,2 ;		# OP_VEC
+ index $a,1,2 ;		# OP_INDEX
+ rindex $a,1,2 ;		# OP_RINDEX
+ sprintf $a ;		# OP_SPRINTF
+ $a[0] ;			# OP_AELEM
+ 			# OP_AELEMFAST
+ @a[0] ;			# OP_ASLICE
+ #values %a ;		# OP_VALUES
+ #keys %a ;		# OP_KEYS
+ $a{0} ;			# OP_HELEM
+ @a{0} ;			# OP_HSLICE
+ unpack "a", "a" ;	# OP_UNPACK
+ pack $a,"" ;		# OP_PACK
+ join "" ;		# OP_JOIN
+ (@a)[0,1] ;		# OP_LSLICE
+ 			# OP_ANONLIST
+ 			# OP_ANONHASH
+ sort(1,2) ;		# OP_SORT
+ reverse(1,2) ;		# OP_REVERSE
+ 			# OP_RANGE
+ 			# OP_FLIP
+ (1 ..2) ;		# OP_FLOP
+ caller ;		# OP_CALLER
+ fileno STDIN ;		# OP_FILENO
+ eof STDIN ;		# OP_EOF
+ tell STDIN ;		# OP_TELL
+ readlink 1;		# OP_READLINK
+ time ;			# OP_TIME
+ localtime ;		# OP_LOCALTIME
+ gmtime ;		# OP_GMTIME
+ getgrnam 1;		# OP_GGRNAM
+ getgrgid 1 ;		# OP_GGRGID
+ getpwnam 1;		# OP_GPWNAM
+ getpwuid 1;		# OP_GPWUID
+ EXPECT
+ Useless use of repeat in void context at - line 3.
+ Useless use of wantarray in void context at - line 5.
+ Useless use of reference-type operator in void context at - line 12.
+ Useless use of reference constructor in void context at - line 13.
+ Useless use of scalar ref constructor in void context at - line 14.
+ Useless use of defined operator in void context at - line 15.
+ Useless use of hex in void context at - line 16.
+ Useless use of oct in void context at - line 17.
+ Useless use of length in void context at - line 18.
+ Useless use of substr in void context at - line 19.
+ Useless use of vec in void context at - line 20.
+ Useless use of index in void context at - line 21.
+ Useless use of rindex in void context at - line 22.
+ Useless use of sprintf in void context at - line 23.
+ Useless use of array element in void context at - line 24.
+ Useless use of array slice in void context at - line 26.
+ Useless use of hash elem in void context at - line 29.
+ Useless use of hash slice in void context at - line 30.
+ Useless use of unpack in void context at - line 31.
+ Useless use of pack in void context at - line 32.
+ Useless use of join in void context at - line 33.
+ Useless use of list slice in void context at - line 34.
+ Useless use of sort in void context at - line 37.
+ Useless use of reverse in void context at - line 38.
+ Useless use of range (or flop) in void context at - line 41.
+ Useless use of caller in void context at - line 42.
+ Useless use of fileno in void context at - line 43.
+ Useless use of eof in void context at - line 44.
+ Useless use of tell in void context at - line 45.
+ Useless use of readlink in void context at - line 46.
+ Useless use of time in void context at - line 47.
+ Useless use of localtime in void context at - line 48.
+ Useless use of gmtime in void context at - line 49.
+ Useless use of getgrnam in void context at - line 50.
+ Useless use of getgrgid in void context at - line 51.
+ Useless use of getpwnam in void context at - line 52.
+ Useless use of getpwuid in void context at - line 53.
+ ########
+ # op.c
+ use warning 'void' ;
+ use Config ;
+ BEGIN {
+     if ( ! $Config{d_telldir}) {
+         print <<EOM ;
+ SKIPPED
+ # telldir not present
+ EOM
+         exit 
+     }
+ }
+ telldir 1 ;		# OP_TELLDIR
+ EXPECT
+ Useless use of telldir in void context at - line 13.
+ ########
+ # op.c
+ use warning 'void' ;
+ use Config ;
+ BEGIN {
+     if ( ! $Config{d_getppid}) {
+         print <<EOM ;
+ SKIPPED
+ # getppid not present
+ EOM
+         exit 
+     }
+ }
+ getppid ;		# OP_GETPPID
+ EXPECT
+ Useless use of getppid in void context at - line 13.
+ ########
+ # op.c
+ use warning 'void' ;
+ use Config ;
+ BEGIN {
+     if ( ! $Config{d_getpgrp}) {
+         print <<EOM ;
+ SKIPPED
+ # getpgrp not present
+ EOM
+         exit 
+     }
+ }
+ getpgrp ;		# OP_GETPGRP
+ EXPECT
+ Useless use of getpgrp in void context at - line 13.
+ ########
+ # op.c
+ use warning 'void' ;
+ use Config ;
+ BEGIN {
+     if ( ! $Config{d_times}) {
+         print <<EOM ;
+ SKIPPED
+ # times not present
+ EOM
+         exit 
+     }
+ }
+ times ;			# OP_TMS
+ EXPECT
+ Useless use of times in void context at - line 13.
+ ########
+ # op.c
+ use warning 'void' ;
+ use Config ;
+ BEGIN {
+     if ( ! $Config{d_getprior}) {
+         print <<EOM ;
+ SKIPPED
+ # getpriority not present
+ EOM
+         exit 
+     }
+ }
+ getpriority 1,2;	# OP_GETPRIORITY
+ EXPECT
+ Useless use of getpriority in void context at - line 13.
+ ########
+ # op.c
+ use warning 'void' ;
+ use Config ;
+ BEGIN {
+     if ( ! $Config{d_getlogin}) {
+         print <<EOM ;
+ SKIPPED
+ # getlogin not present
+ EOM
+         exit 
+     }
+ }
+ getlogin ;			# OP_GETLOGIN
+ EXPECT
+ Useless use of getlogin in void context at - line 13.
+ ########
+ # op.c
+ use warning 'void' ;
+ use Config ; BEGIN {
+ if ( ! $Config{d_socket}) {
+     print <<EOM ;
+ SKIPPED
+ # getsockname not present
+ # getpeername not present
+ # gethostbyname not present
+ # gethostbyaddr not present
+ # gethostent not present
+ # getnetbyname not present
+ # getnetbyaddr not present
+ # getnetent not present
+ # getprotobyname not present
+ # getprotobynumber not present
+ # getprotoent not present
+ # getservbyname not present
+ # getservbyport not present
+ # getservent not present
+ EOM
+     exit 
+ } }
+ getsockname STDIN ;	# OP_GETSOCKNAME
+ getpeername STDIN ;	# OP_GETPEERNAME
+ gethostbyname 1 ;	# OP_GHBYNAME
+ gethostbyaddr 1,2;	# OP_GHBYADDR
+ gethostent ;		# OP_GHOSTENT
+ getnetbyname 1 ;	# OP_GNBYNAME
+ getnetbyaddr 1,2 ;	# OP_GNBYADDR
+ getnetent ;		# OP_GNETENT
+ getprotobyname 1;	# OP_GPBYNAME
+ getprotobynumber 1;	# OP_GPBYNUMBER
+ getprotoent ;		# OP_GPROTOENT
+ getservbyname 1,2;	# OP_GSBYNAME
+ getservbyport 1,2;	# OP_GSBYPORT
+ getservent ;		# OP_GSERVENT
+ EXPECT
+ Useless use of getsockname in void context at - line 24.
+ Useless use of getpeername in void context at - line 25.
+ Useless use of gethostbyname in void context at - line 26.
+ Useless use of gethostbyaddr in void context at - line 27.
+ Useless use of gethostent in void context at - line 28.
+ Useless use of getnetbyname in void context at - line 29.
+ Useless use of getnetbyaddr in void context at - line 30.
+ Useless use of getnetent in void context at - line 31.
+ Useless use of getprotobyname in void context at - line 32.
+ Useless use of getprotobynumber in void context at - line 33.
+ Useless use of getprotoent in void context at - line 34.
+ Useless use of getservbyname in void context at - line 35.
+ Useless use of getservbyport in void context at - line 36.
+ Useless use of getservent in void context at - line 37.
+ ########
+ # op.c
+ use warning 'void' ;
+ *a ; # OP_RV2GV
+ $a ; # OP_RV2SV
+ @a ; # OP_RV2AV
+ %a ; # OP_RV2HV
+ EXPECT
+ Useless use of a variable in void context at - line 3.
+ Useless use of a variable in void context at - line 4.
+ Useless use of a variable in void context at - line 5.
+ Useless use of a variable in void context at - line 6.
+ ########
+ # op.c
+ use warning 'void' ;
+ "abc"; # OP_CONST
+ 7 ; # OP_CONST
+ EXPECT
+ Useless use of a constant in void context at - line 3.
+ Useless use of a constant in void context at - line 4.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+ @a =~ /abc/ ;
+ @a =~ s/a/b/ ;
+ @a =~ tr/a/b/ ;
+ @$b =~ /abc/ ;
+ @$b =~ s/a/b/ ;
+ @$b =~ tr/a/b/ ;
+ %a =~ /abc/ ;
+ %a =~ s/a/b/ ;
+ %a =~ tr/a/b/ ;
+ %$c =~ /abc/ ;
+ %$c =~ s/a/b/ ;
+ %$c =~ tr/a/b/ ;
+ EXPECT
+ Applying pattern match to @array will act on scalar(@array) at - line 4.
+ Applying substitution to @array will act on scalar(@array) at - line 5.
+ Can't modify private array in substitution at - line 5, near "s/a/b/ ;"
+ Applying character translation to @array will act on scalar(@array) at - line 6.
+ Applying pattern match to @array will act on scalar(@array) at - line 7.
+ Applying substitution to @array will act on scalar(@array) at - line 8.
+ Applying character translation to @array will act on scalar(@array) at - line 9.
+ Applying pattern match to %hash will act on scalar(%hash) at - line 10.
+ Applying substitution to %hash will act on scalar(%hash) at - line 11.
+ Applying character translation to %hash will act on scalar(%hash) at - line 12.
+ Applying pattern match to %hash will act on scalar(%hash) at - line 13.
+ Applying substitution to %hash will act on scalar(%hash) at - line 14.
+ Applying character translation to %hash will act on scalar(%hash) at - line 15.
+ Execution of - aborted due to compilation errors.
+ ########
+ # op.c
+ use warning 'syntax' ;
+ my $a, $b = (1,2);
+ EXPECT
+ Parens missing around "my" list at - line 3.
+ ########
+ # op.c
+ use warning 'syntax' ;
+ local $a, $b = (1,2);
+ EXPECT
+ Parens missing around "local" list at - line 3.
+ ########
+ # op.c
+ use warning 'syntax' ;
+ print (ABC || 1) ;
+ EXPECT
+ Probable precedence problem on logical or at - line 3.
+ ########
+ --FILE-- abc
+ 
+ --FILE--
+ # op.c
+ use warning 'unsafe' ;
+ open FH, "<abc" ;
+ $x = 1 if $x = <FH> ;
+ EXPECT
+ Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ opendir FH, "." ;
+ $x = 1 if $x = readdir FH ;
+ closedir FH ;
+ EXPECT
+ Value of readdir() operator can be "0"; test with defined() at - line 4.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ $x = 1 if $x = <*> ;
+ EXPECT
+ Value of glob construct can be "0"; test with defined() at - line 3.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ %a = (1,2,3,4) ;
+ $x = 1 if $x = each %a ;
+ EXPECT
+ Value of each() operator can be "0"; test with defined() at - line 4.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ $x = 1 while $x = <*> and 0 ;
+ EXPECT
+ Value of glob construct can be "0"; test with defined() at - line 3.
+ ########
+ # op.c
+ use warning 'unsafe' ;
+ opendir FH, "." ;
+ $x = 1 while $x = readdir FH and 0 ;
+ closedir FH ;
+ EXPECT
+ Value of readdir() operator can be "0"; test with defined() at - line 4.
+ ########
+ # op.c
+ use warning 'redefine' ;
+ sub fred {}
+ sub fred {}
+ EXPECT
+ Subroutine fred redefined at - line 4.
+ ########
+ # op.c
+ use warning 'redefine' ;
+ sub fred () { 1 }
+ sub fred () { 1 }
+ EXPECT
+ Constant subroutine fred redefined at - line 4.
+ ########
+ # op.c
+ use warning 'redefine' ;
+ format FRED =
+ .
+ format FRED =
+ .
+ EXPECT
+ Format FRED redefined at - line 5.
+ ########
+ # op.c
+ use warning 'syntax' ;
+ push FRED;
+ EXPECT
+ Array @FRED missing the @ in argument 1 of push() at - line 3.
+ ########
+ # op.c
+ use warning 'syntax' ;
+ @a = keys FRED ;
+ EXPECT
+ Hash %FRED missing the % in argument 1 of keys() at - line 3.
+ ########
+ # op.c
+ use warning 'syntax' ;
+ exec "true" ; 
+ my $a
+ EXPECT
+ Statement unlikely to be reached at - line 4.
+ (Maybe you meant system() when you said exec()?)
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-perl	Wed Jul 29 07:20:53 1998
***************
*** 0 ****
--- 1,12 ----
+   perl.c	AOK
+ 
+   gv_check(defstash)
+ 	Name \"%s::%s\" used only once: possible typo 
+ 
+ 
+ __END__
+ # perl.c
+ use warning 'once' ;
+ $x = 3 ;
+ EXPECT
+ Name "main::x" used only once: possible typo at - line 3.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-perly	Wed Jul 29 07:20:54 1998
***************
*** 0 ****
--- 1,25 ----
+   perly.y	AOK
+ 
+   dep() => deprecate("\"do\" to call subroutines") 
+   Use of "do" to call subroutines is deprecated
+ 
+ 	sub fred {} do fred()
+ 	sub fred {} do fred(1)
+ 	sub fred {} $a = "fred" ; do $a()
+ 	sub fred {} $a = "fred" ; do $a(1)
+ 
+ 
+ __END__
+ # perly.y
+ use warning 'deprecated' ;
+ sub fred {} 
+ do fred() ;
+ do fred(1) ;
+ $a = "fred" ; 
+ do $a() ;
+ do $a(1) ;
+ EXPECT
+ Use of "do" to call subroutines is deprecated at - line 4.
+ Use of "do" to call subroutines is deprecated at - line 5.
+ Use of "do" to call subroutines is deprecated at - line 7.
+ Use of "do" to call subroutines is deprecated at - line 8.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-pp	Wed Jul 29 07:20:54 1998
***************
*** 0 ****
--- 1,85 ----
+   pp.c	TODO
+ 
+   substr outside of string
+     $a = "ab" ; $a = substr($a, 4,5)
+ 
+   Attempt to use reference as lvalue in substr 
+     $a = "ab" ; $b = \$a ;  substr($b, 1,1) = $b
+ 
+   uninitialized	in pp_rv2gv()
+ 	my *b = *{ undef()}
+ 
+   uninitialized	in pp_rv2sv()
+ 	my $a = undef ; my $b = $$a
+ 
+   Odd number of elements in hash list
+ 	my $a = { 1,2,3 } ;
+ 
+   Invalid type in unpack: '%c
+ 	my $A = pack ("A,A", 1,2) ;
+ 	my @A = unpack ("A,A", "22") ;
+ 
+   Attempt to pack pointer to temporary value
+ 	pack("p", "abc") ;
+ 
+   Explicit blessing to '' (assuming package main)
+ 	bless \[], "";
+ 
+   Constant subroutine %s undefined			<<<
+   Constant subroutine (anonymous) undefined		<<<
+ 
+ __END__
+ # pp.c
+ use warning 'substr' ;
+ $a = "ab" ; 
+ $a = substr($a, 4,5)
+ EXPECT
+ substr outside of string at - line 4.
+ ########
+ # pp.c
+ use warning 'substr' ;
+ $a = "ab" ; 
+ $b = \$a ;  
+ substr($b, 1,1) = "ab" ;
+ EXPECT
+ Attempt to use reference as lvalue in substr at - line 5.
+ ########
+ # pp.c
+ use warning 'uninitialized' ;
+ # TODO
+ EXPECT
+ 
+ ########
+ # pp.c
+ use warning 'unsafe' ;
+ my $a = { 1,2,3};
+ EXPECT
+ Odd number of elements in hash assignment at - line 3.
+ ########
+ # pp.c
+ use warning 'unsafe' ;
+ my @a = unpack ("A,A", "22") ;
+ my $a = pack ("A,A", 1,2) ;
+ EXPECT
+ Invalid type in unpack: ',' at - line 3.
+ Invalid type in pack: ',' at - line 4.
+ ########
+ # pp.c
+ use warning 'uninitialized' ;
+ my $a = undef ; 
+ my $b = $$a
+ EXPECT
+ Use of uninitialized value at - line 4.
+ ########
+ # pp.c
+ use warning 'unsafe' ;
+ sub foo { my $a = "a"; return $a . $a++ . $a++ }
+ my $a = pack("p", &foo) ;
+ EXPECT
+ Attempt to pack pointer to temporary value at - line 4.
+ ########
+ # pp.c
+ use warning 'unsafe' ;
+ bless \[], "" ;
+ EXPECT
+ Explicit blessing to '' (assuming package main) at - line 3.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-pp_ctl	Wed Jul 29 07:20:54 1998
***************
*** 0 ****
--- 1,145 ----
+   pp_ctl.c	AOK
+  
+      Not enough format arguments	
+  	format STDOUT =
+  	@<<< @<<<
+  	$a
+  	.
+  	write;
+      
+ 
+     Exiting substitution via %s
+ 	$_ = "abc" ;
+ 	while ($i ++ == 0)
+ 	{
+     	    s/ab/last/e ;
+ 	}
+ 
+     Exiting subroutine via %s		
+ 	sub fred { last }
+ 	{ fred() }
+ 
+     Exiting eval via %s	
+ 	{ eval "last" }
+ 
+     Exiting pseudo-block via %s 
+ 	@a = (1,2) ; @b = sort { last } @a ;
+ 
+     Exiting substitution via %s
+ 	$_ = "abc" ;
+ 	last fred:
+ 	while ($i ++ == 0)
+ 	{
+     	    s/ab/last fred/e ;
+ 	}
+ 
+ 
+     Exiting subroutine via %s
+ 	sub fred { last joe }
+ 	joe: { fred() }
+ 
+     Exiting eval via %s
+ 	fred: { eval "last fred" }
+ 
+     Exiting pseudo-block via %s 
+ 	@a = (1,2) ; fred: @b = sort { last fred } @a ;
+ 
+ 
+     Deep recursion on subroutine \"%s\"
+ 	sub fred
+ 	{
+     	goto &fred() if $a++ < 200
+ 	}
+ 	 
+ 	goto &fred()
+ 
+ 
+ __END__
+ # pp_ctl.c
+ use warning 'syntax' ;
+ format STDOUT =
+ @<<< @<<<
+ 1
+ .
+ write;
+ EXPECT
+ Not enough format arguments at - line 5.
+ 1
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ $_ = "abc" ;
+  
+ while ($i ++ == 0)
+ {
+     s/ab/last/e ;
+ }
+ EXPECT
+ Exiting substitution via last at - line 7.
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ sub fred { last }
+ { fred() }
+ EXPECT
+ Exiting subroutine via last at - line 3.
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ { eval "last" } 
+ print STDERR $@ ;
+ EXPECT
+ Exiting eval via last at (eval 1) line 1.
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ @a = (1,2) ;
+ @b = sort { last } @a ;
+ EXPECT
+ Exiting pseudo-block via last at - line 4.
+ Can't "last" outside a block at - line 4.
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ $_ = "abc" ;
+ fred: 
+ while ($i ++ == 0)
+ {
+     s/ab/last fred/e ;
+ }
+ EXPECT
+ Exiting substitution via last at - line 7.
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ sub fred { last joe }
+ joe: { fred() }
+ EXPECT
+ Exiting subroutine via last at - line 3.
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ joe: { eval "last joe" }
+ print STDERR $@ ;
+ EXPECT
+ Exiting eval via last at (eval 1) line 2.
+ ########
+ # pp_ctl.c
+ use warning 'unsafe' ;
+ @a = (1,2) ;
+ fred: @b = sort { last fred } @a ;
+ EXPECT
+ Exiting pseudo-block via last at - line 4.
+ Label not found for "last fred" at - line 4.
+ ########
+ # pp_ctl.c
+ use warning 'recursion' ;
+ BEGIN { warn "PREFIX\n" ;}
+ sub fred
+ {
+     goto &fred() if $a++ < 200
+ }
+  
+ goto &fred()
+ EXPECT
+ Deep recursion on subroutine "main::fred" at - line 6.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-pp_hot	Wed Jul 29 07:20:54 1998
***************
*** 0 ****
--- 1,107 ----
+   pp_hot.c	AOK
+ 
+   Filehandle %s never opened
+     $f = $a = "abc" ; print $f $a
+ 
+   Filehandle %s opened only for input
+     print STDIN "abc" ;
+ 
+ 
+   print on closed filehandle %s
+     close STDIN ; print STDIN "abc" ;
+ 
+   uninitialized
+ 	my $a = undef ; my @b = @$a
+ 
+   uninitialized	
+ 	my $a = undef ; my %b = %$a
+ 
+   Odd number of elements in hash list
+ 	%X = (1,2,3) ;
+ 
+   Reference found where even-sized list expected 
+ 	$X = [ 1 ..3 ];
+ 
+   Read on closed filehandle <%s>
+     close STDIN ; $a = <STDIN>;
+ 
+   Deep recursion on subroutine \"%s\"
+      sub fred { fred() if $a++ < 200} fred()
+ 
+   Deep recursion on anonymous subroutine 
+      $a = sub { &$a if $a++ < 200} &$a
+ 
+ __END__
+ # pp_hot.c
+ use warning 'unopened' ;
+ $f = $a = "abc" ; 
+ print $f $a
+ EXPECT
+ Filehandle main::abc never opened at - line 4.
+ ########
+ # pp_hot.c
+ use warning 'io' ;
+ print STDIN "anc";
+ EXPECT
+ Filehandle main::STDIN opened only for input at - line 3.
+ ########
+ # pp_hot.c
+ use warning 'closed' ;
+ close STDIN ;
+ print STDIN "anc";
+ EXPECT
+ print on closed filehandle main::STDIN at - line 4.
+ ########
+ # pp_hot.c
+ use warning 'uninitialized' ;
+ my $a = undef ;
+ my @b = @$a
+ EXPECT
+ Use of uninitialized value at - line 4.
+ ########
+ # pp_hot.c
+ use warning 'uninitialized' ;
+ my $a = undef ;
+ my %b = %$a
+ EXPECT
+ Use of uninitialized value at - line 4.
+ ########
+ # pp_hot.c
+ use warning 'unsafe' ;
+ my %X ; %X = (1,2,3) ;
+ EXPECT
+ Odd number of elements in hash assignment at - line 3.
+ ########
+ # pp_hot.c
+ use warning 'unsafe' ;
+ my %X ; %X = [1 .. 3] ;
+ EXPECT
+ Reference found where even-sized list expected at - line 3.
+ ########
+ # pp_hot.c
+ use warning 'closed' ;
+ close STDIN ; $a = <STDIN> ;
+ EXPECT
+ Read on closed filehandle <STDIN> at - line 3.
+ ########
+ # pp_hot.c
+ use warning 'recursion' ;
+ sub fred 
+ { 
+     fred() if $a++ < 200
+ } 
+ 
+ fred()
+ EXPECT
+ Deep recursion on subroutine "main::fred" at - line 5.
+ ########
+ # pp_hot.c
+ use warning 'recursion' ;
+ $b = sub 
+ { 
+     &$b if $a++ < 200
+ }  ;
+ 
+ &$b ;
+ EXPECT
+ Deep recursion on anonymous subroutine at - line 5.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-pp_sys	Wed Jul 29 07:20:54 1998
***************
*** 0 ****
--- 1,208 ----
+   pp_sys.c 	AOK
+ 
+   untie attempted while %d inner references still exist
+     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
+ 
+   Filehandle only opened for input
+     format STDIN =
+     .
+     write STDIN;
+ 
+   Write on closed filehandle
+     format STDIN =
+     .
+     close STDIN;
+     write STDIN ;
+ 
+   page overflow	
+ 
+   Filehandle %s never opened
+     $a = "abc"; printf $a "fred"
+ 
+   Filehandle %s opened only for input
+     $a = "abc"; 
+     printf $a "fred"
+ 
+   printf on closed filehandle %s
+     close STDIN ;
+     printf STDIN "fred"
+ 
+   Syswrite on closed filehandle
+     close STDIN; 
+     syswrite STDIN, "fred", 1;
+ 
+   Send on closed socket
+     close STDIN; 
+     send STDIN, "fred", 1
+ 
+   bind() on closed fd
+     close STDIN; 
+     bind STDIN, "fred" ;
+ 
+ 
+   connect() on closed fd
+     close STDIN; 
+     connect STDIN, "fred" ;
+ 
+   listen() on closed fd
+     close STDIN; 
+     listen STDIN, 2;
+ 
+   accept() on closed fd
+     close STDIN; 
+     accept STDIN, "fred" ;
+ 
+   shutdown() on closed fd
+     close STDIN; 
+     shutdown STDIN, 0;
+ 
+   [gs]etsockopt() on closed fd
+     close STDIN; 
+     setsockopt STDIN, 1,2,3;
+     getsockopt STDIN, 1,2;
+ 
+   get{sock, peer}name() on closed fd
+     close STDIN; 
+     getsockname STDIN;
+     getpeername STDIN;
+ 
+   warn(warn_nl, "stat");
+ 
+   Test on unopened file <%s>
+ 	close STDIN ; -T STDIN ;
+ 
+   warn(warn_nl, "open");
+     -T "abc\ndef" ;
+ 
+   
+ 
+ __END__
+ # pp_sys.c
+ use warning 'untie' ;
+ sub TIESCALAR { bless [] } ; 
+ $b = tie $a, 'main'; 
+ untie $a ;
+ EXPECT
+ untie attempted while 1 inner references still exist at - line 5.
+ ########
+ # pp_sys.c
+ use warning 'io' ;
+ format STDIN =
+ .
+ write STDIN;
+ EXPECT
+ Filehandle only opened for input at - line 5.
+ ########
+ # pp_sys.c
+ use warning 'closed' ;
+ format STDIN =
+ .
+ close STDIN;
+ write STDIN;
+ EXPECT
+ Write on closed filehandle at - line 6.
+ ########
+ # pp_sys.c
+ use warning 'io' ;
+ format STDOUT_TOP =
+ abc
+ .
+ format STDOUT =
+ def
+ ghi
+ .
+ $= = 1 ;
+ $- =1 ;
+ open STDOUT, ">/dev/null" ;
+ write ;
+ EXPECT
+ page overflow at - line 13.
+ ########
+ # pp_sys.c
+ use warning 'unopened' ;
+ $a = "abc"; 
+ printf $a "fred"
+ EXPECT
+ Filehandle main::abc never opened at - line 4.
+ ########
+ # pp_sys.c
+ use warning 'closed' ;
+ close STDIN ;
+ printf STDIN "fred"
+ EXPECT
+ printf on closed filehandle main::STDIN at - line 4.
+ ########
+ # pp_sys.c
+ use warning 'io' ;
+ printf STDIN "fred"
+ EXPECT
+ Filehandle main::STDIN opened only for input at - line 3.
+ ########
+ # pp_sys.c
+ use warning 'closed' ;
+ close STDIN; 
+ syswrite STDIN, "fred", 1;
+ EXPECT
+ Syswrite on closed filehandle at - line 4.
+ ########
+ # pp_sys.c
+ use warning 'io' ;
+ use Config; 
+ BEGIN { 
+   if ( $^O ne 'VMS' and ! $Config{d_socket}) {
+     print <<EOM ;
+ SKIPPED
+ # send not present
+ # bind not present
+ # connect not present
+ # accept not present
+ # shutdown not present
+ # setsockopt not present
+ # getsockopt not present
+ # getsockname not present
+ # getpeername not present
+ EOM
+     exit ;
+   } 
+ }
+ close STDIN; 
+ send STDIN, "fred", 1;
+ bind STDIN, "fred" ;
+ connect STDIN, "fred" ;
+ listen STDIN, 2;
+ accept STDIN, "fred" ;
+ shutdown STDIN, 0;
+ setsockopt STDIN, 1,2,3;
+ getsockopt STDIN, 1,2;
+ getsockname STDIN;
+ getpeername STDIN;
+ EXPECT
+ Send on closed socket at - line 22.
+ bind() on closed fd at - line 23.
+ connect() on closed fd at - line 24.
+ listen() on closed fd at - line 25.
+ accept() on closed fd at - line 26.
+ shutdown() on closed fd at - line 27.
+ [gs]etsockopt() on closed fd at - line 28.
+ [gs]etsockopt() on closed fd at - line 29.
+ get{sock, peer}name() on closed fd at - line 30.
+ get{sock, peer}name() on closed fd at - line 31.
+ ########
+ # pp_sys.c
+ use warning 'newline' ;
+ stat "abc\ndef";
+ EXPECT
+ Unsuccessful stat on filename containing newline at - line 3.
+ ########
+ # pp_sys.c
+ use warning 'unopened' ;
+ close STDIN ; 
+ -T STDIN ;
+ EXPECT
+ Test on unopened file <STDIN> at - line 4.
+ ########
+ # pp_sys.c
+ use warning 'newline' ;
+ -T "abc\ndef" ;
+ EXPECT
+ Unsuccessful open on filename containing newline at - line 3.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-regcomp	Wed Jul 29 08:58:10 1998
***************
*** 0 ****
--- 1,53 ----
+   regcomp.c	AOK
+ 
+   %.*s matches null string many times   
+ 
+ 	$a = "ABC123" ; $a =~ /(?=a)*/'
+ 
+   Strange *+?{} on zero-length expression
+ 
+ 	/(?=a)?/
+ 
+   Character class syntax [: :] is reserved for future extensions
+ 	/[a[:xyz:]b]/
+ 
+   Character class syntax [. .] is reserved for future extensions
+   Character class syntax [= =] is reserved for future extensions
+ 
+ __END__
+ # regcomp.c
+ use warning 'unsafe' ;
+ my $a = "ABC123" ; 
+ $a =~ /(?=a)*/ ;
+ EXPECT
+ (?=a)* matches null string many times at - line 4.
+ ########
+ # regcomp.c
+ use warning 'unsafe' ;
+ $_ = "" ;
+ /(?=a)?/;
+ EXPECT
+ Strange *+?{} on zero-length expression at - line 4.
+ ########
+ # regcomp.c
+ use warning 'unsafe' ;
+ $_ = "" ;
+ /[a[:xyz:]b]/;
+ /[a[.xyz.]b]/;
+ /[a[=xyz=]b]/;
+ EXPECT
+ Character class syntax [: :] is reserved for future extensions at - line 4.
+ Character class syntax [. .] is reserved for future extensions at - line 5.
+ Character class syntax [= =] is reserved for future extensions at - line 6.
+ ########
+ # regcomp.c
+ use warning 'unsafe' ; 
+ # use utf8 ; # Note this line should be uncommented when utf8 gets fixed.
+ $_ = "" ;
+ /[a[:xyz:]b]/;
+ /[a[.xyz.]b]/;
+ /[a[=xyz=]b]/;
+ EXPECT
+ Character class syntax [: :] is reserved for future extensions at - line 5.
+ Character class syntax [. .] is reserved for future extensions at - line 6.
+ Character class syntax [= =] is reserved for future extensions at - line 7.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-regexec	Wed Jul 29 07:20:55 1998
***************
*** 0 ****
--- 1,23 ----
+   regexec.c	
+ 
+   count exceeded %d
+ 
+         $_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
+   count exceeded %d
+ 
+         $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ;
+ 
+ __END__
+ # regexec.c
+ use warning 'unsafe' ;
+ $_ = 'a' x (2**15+1); 
+ /^()(a\1)*$/ ;
+ EXPECT
+ count exceeded 32766 at - line 4.
+ ########
+ # regexec.c
+ use warning 'unsafe' ;
+ $_ = 'a' x (2**15+1);
+ /^()(a\1)*?$/ ;
+ EXPECT
+ Complex regular subexpression recursion limit (32766) exceeded at - line 4.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-sv	Wed Jul 29 07:20:55 1998
***************
*** 0 ****
--- 1,203 ----
+   sv.c	AOK
+ 
+   warn(warn_uninit);
+ 
+   warn(warn_uninit);
+ 
+   warn(warn_uninit);
+ 
+   warn(warn_uninit);
+ 
+   not_a_number(sv);
+ 
+   not_a_number(sv);
+ 
+   warn(warn_uninit);
+ 
+   not_a_number(sv);
+ 
+   warn(warn_uninit);
+ 
+   not_a_number(sv);
+ 
+   not_a_number(sv);
+ 
+   warn(warn_uninit);
+ 
+   warn(warn_uninit);
+ 
+   Subroutine %s redefined	
+ 
+   Invalid conversion in %s:
+ 
+   Undefined value assigned to typeglob
+ 
+ 
+ __END__
+ # sv.c
+ use integer ;
+ use warning 'uninitialized' ;
+ $x = 1 + $a[0] ; # a
+ EXPECT
+ Use of uninitialized value at - line 4.
+ ########
+ # sv.c (sv_2iv)
+ package fred ;
+ sub TIESCALAR { my $x ; bless \$x}
+ sub FETCH { return undef }
+ sub STORE { return 1 }
+ package main ;
+ tie $A, 'fred' ;
+ use integer ;
+ use warning 'uninitialized' ;
+ $A *= 2 ;
+ EXPECT
+ Use of uninitialized value at - line 10.
+ ########
+ # sv.c
+ use integer ;
+ use warning 'uninitialized' ;
+ my $x *= 2 ; #b 
+ EXPECT
+ Use of uninitialized value at - line 4.
+ ########
+ # sv.c (sv_2uv)
+ package fred ;
+ sub TIESCALAR { my $x ; bless \$x}
+ sub FETCH { return undef }
+ sub STORE { return 1 }
+ package main ;
+ tie $A, 'fred' ;
+ use warning 'uninitialized' ;
+ $B = 0 ;
+ $B |= $A ;
+ EXPECT
+ Use of uninitialized value at - line 10.
+ ########
+ # sv.c
+ use warning 'uninitialized' ;
+ my $Y = 1 ; 
+ my $x = 1 | $a[$Y]
+ EXPECT
+ Use of uninitialized value at - line 4.
+ ########
+ # sv.c
+ use warning 'uninitialized' ;
+ my $x *= 1 ; # d
+ EXPECT
+ Use of uninitialized value at - line 3.
+ ########
+ # sv.c
+ use warning 'uninitialized' ;
+ $x = 1 + $a[0] ; # e
+ EXPECT
+ Use of uninitialized value at - line 3.
+ ########
+ # sv.c (sv_2nv)
+ package fred ;
+ sub TIESCALAR { my $x ; bless \$x}
+ sub FETCH { return undef }
+ sub STORE { return 1 }
+ package main ;
+ tie $A, 'fred' ;
+ use warning 'uninitialized' ;
+ $A *= 2 ;
+ EXPECT
+ Use of uninitialized value at - line 9.
+ ########
+ # sv.c
+ use warning 'uninitialized' ;
+ $x = $y + 1 ; # f
+ EXPECT
+ Use of uninitialized value at - line 3.
+ ########
+ # sv.c
+ use warning 'uninitialized' ;
+ $x = chop undef ; # g
+ EXPECT
+ Use of uninitialized value at - line 3.
+ ########
+ # sv.c
+ use warning 'uninitialized' ;
+ $x = chop $y ; # h
+ EXPECT
+ Use of uninitialized value at - line 3.
+ ########
+ # sv.c (sv_2pv)
+ package fred ;
+ sub TIESCALAR { my $x ; bless \$x}
+ sub FETCH { return undef }
+ sub STORE { return 1 }
+ package main ;
+ tie $A, 'fred' ;
+ use warning 'uninitialized' ;
+ $B = "" ;
+ $B .= $A ;
+ EXPECT
+ Use of uninitialized value at - line 10.
+ ########
+ # sv.c 
+ use warning 'numeric' ;
+ sub TIESCALAR{bless[]} ; 
+ sub FETCH {"def"} ; 
+ tie $a,"main" ; 
+ my $b = 1 + $a
+ EXPECT
+ Argument "def" isn't numeric in add at - line 6.
+ ########
+ # sv.c
+ use warning 'numeric' ;
+ my $x = 1 + "def" ;
+ EXPECT
+ Argument "def" isn't numeric in add at - line 3.
+ ########
+ # sv.c
+ use warning 'numeric' ;
+ my $a = "def" ;
+ my $x = 1 + $a ;
+ EXPECT
+ Argument "def" isn't numeric in add at - line 4.
+ ########
+ # sv.c
+ use warning 'numeric' ; use integer ;
+ my $a = "def" ;
+ my $x = 1 + $a ;
+ EXPECT
+ Argument "def" isn't numeric in i_add at - line 4.
+ ########
+ # sv.c
+ use warning 'numeric' ;
+ my $x = 1 & "def" ;
+ EXPECT
+ Argument "def" isn't numeric in bit_and at - line 3.
+ ########
+ # sv.c
+ use warning 'redefine' ;
+ sub fred {}  
+ sub joe {} 
+ *fred = \&joe ;
+ EXPECT
+ Subroutine fred redefined at - line 5.
+ ########
+ # sv.c
+ use warning 'printf' ;
+ open F, ">/dev/null" ;
+ printf F "%q\n" ;
+ my $a = sprintf "%q" ;
+ printf F "%" ;
+ $a = sprintf "%" ;
+ printf F "%\x02" ;
+ $a = sprintf "%\x02" ;
+ EXPECT
+ Invalid conversion in sprintf: "%q" at - line 5.
+ Invalid conversion in sprintf: end of string at - line 7.
+ Invalid conversion in sprintf: "%\002" at - line 9.
+ Invalid conversion in printf: "%q" at - line 4.
+ Invalid conversion in printf: end of string at - line 6.
+ Invalid conversion in printf: "%\002" at - line 8.
+ ########
+ # sv.c
+ use warning 'unsafe' ;
+ *a = undef ;
+ EXPECT
+ Undefined value assigned to typeglob at - line 3.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-taint	Wed Jul 29 07:20:55 1998
***************
*** 0 ****
--- 1,25 ----
+   taint.c TODO
+ 
+   Insecure %s%s while running setuid
+   Insecure %s%s while running setgid
+   Insecure %s%s while running with -T switch
+ 
+ 
+   Insecure directory in %s%s while running setuid
+   Insecure directory in %s%s while running setgid
+   Insecure directory in %s%s while running with -T switch
+ 
+ 
+ 
+ __END__
+ # taint.c
+ use warning 'misc' ;
+ 
+ EXPECT
+ 
+ ########
+ # taint.c
+ use warning 'misc' ;
+ 
+ EXPECT
+ 
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-toke	Wed Jul 29 07:20:55 1998
***************
*** 0 ****
--- 1,311 ----
+ toke.c	AOK
+ 
+     we seem to have lost a few ambiguous warnings!!
+ 
+  
+              	1 if $a EQ $b ;
+              	1 if $a NE $b ;
+              	1 if $a LT $b ;
+              	1 if $a GT $b ;
+              	1 if $a GE $b ;
+              	1 if $a LE $b ;
+  		$a = <<;
+  		Use of comma-less variable list is deprecated 
+ 		(called 3 times via depcom)
+ 
+      \1 better written as $1 
+  	use warning 'syntax' ;
+  	s/(abc)/\1/;
+  
+      warn(warn_nosemi) 
+      Semicolon seems to be missing
+ 	$a = 1
+ 	&time ;
+ 
+ 
+      Reversed %c= operator 
+ 	my $a =+ 2 ;
+ 	$a =- 2 ;
+ 	$a =* 2 ;
+ 	$a =% 2 ;
+ 	$a =& 2 ;
+ 	$a =. 2 ;
+ 	$a =^ 2 ;
+ 	$a =| 2 ;
+ 	$a =< 2 ;
+ 	$a =/ 2 ;
+ 
+      Multidimensional syntax %.*s not supported 
+ 	my $a = $a[1,2] ;
+ 
+      You need to quote \"%s\"" 
+ 	sub fred {} ; $SIG{TERM} = fred;
+ 
+      Scalar value %.*s better written as $%.*s" 
+ 	@a[3] = 2;
+ 	@a{3} = 2;
+ 
+      Can't use \\%c to mean $%c in expression 
+ 	$_ = "ab" ; s/(ab)/\1/e;
+ 
+      Unquoted string "abc" may clash with future reserved word at - line 3.
+      warn(warn_reserved	
+ 	$a = abc;
+ 
+      chmod: mode argument is missing initial 0 
+ 	chmod 3;
+ 
+      Possible attempt to separate words with commas 
+ 	@a = qw(a, b, c) ;
+ 
+      Possible attempt to put comments in qw() list 
+ 	@a = qw(a b # c) ;
+ 
+      umask: argument is missing initial 0 
+ 	umask 3;
+ 
+      %s (...) interpreted as function 
+ 	print ("")
+ 	printf ("")
+ 	sort ("")
+ 
+      Ambiguous use of %c{%s%s} resolved to %c%s%s 
+ 	$a = ${time[2]}
+ 	$a = ${time{2}}
+ 
+ 
+      Ambiguous use of %c{%s} resolved to %c%s
+ 	$a = ${time}
+ 	sub fred {} $a = ${fred}
+ 
+      Misplaced _ in number 
+ 	$a = 1_2;
+ 	$a = 1_2345_6;
+ 
+     Bareword \"%s\" refers to nonexistent package
+ 	$a = FRED:: ;
+ 
+     Ambiguous call resolved as CORE::%s(), qualify as such or use &
+ 	sub time {} 
+ 	my $a = time()
+ 
+     Use of \\x{} without utf8 declaration
+ 	$_ = " \x{123} " ;
+ 
+ 
+     \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that
+         use utf8 ; 
+ 	$_ = "\xffe"
+      
+ __END__
+ # toke.c 
+ use warning 'deprecated' ;
+ 1 if $a EQ $b ;
+ 1 if $a NE $b ;
+ 1 if $a GT $b ;
+ 1 if $a LT $b ;
+ 1 if $a GE $b ;
+ 1 if $a LE $b ;
+ EXPECT
+ Use of EQ is deprecated at - line 3.
+ Use of NE is deprecated at - line 4.
+ Use of GT is deprecated at - line 5.
+ Use of LT is deprecated at - line 6.
+ Use of GE is deprecated at - line 7.
+ Use of LE is deprecated at - line 8.
+ ########
+ # toke.c
+ use warning 'deprecated' ;
+ format STDOUT =
+ @<<<  @|||  @>>>  @>>>
+ $a    $b    "abc" 'def'
+ .
+ ($a, $b) = (1,2,3);
+ write;
+ EXPECT
+ Use of comma-less variable list is deprecated at - line 5.
+ Use of comma-less variable list is deprecated at - line 5.
+ Use of comma-less variable list is deprecated at - line 5.
+ 1      2     abc   def
+ ########
+ # toke.c
+ use warning 'deprecated' ;
+ $a = <<;
+ 
+ EXPECT
+ Use of bare << to mean <<"" is deprecated at - line 3.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ s/(abc)/\1/;
+ EXPECT
+ \1 better written as $1 at - line 3.
+ ########
+ # toke.c
+ use warning 'semicolon' ;
+ $a = 1
+ &time ;
+ EXPECT
+ Semicolon seems to be missing at - line 3.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ my $a =+ 2 ;
+ $a =- 2 ;
+ $a =* 2 ;
+ $a =% 2 ;
+ $a =& 2 ;
+ $a =. 2 ;
+ $a =^ 2 ;
+ $a =| 2 ;
+ $a =< 2 ;
+ $a =/ 2 ;
+ EXPECT
+ Reversed += operator at - line 3.
+ Reversed -= operator at - line 4.
+ Reversed *= operator at - line 5.
+ Reversed %= operator at - line 6.
+ Reversed &= operator at - line 7.
+ Reversed .= operator at - line 8.
+ syntax error at - line 8, near "=."
+ Reversed ^= operator at - line 9.
+ syntax error at - line 9, near "=^"
+ Reversed |= operator at - line 10.
+ syntax error at - line 10, near "=|"
+ Reversed <= operator at - line 11.
+ Unterminated <> operator at - line 11.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ my $a = $a[1,2] ;
+ EXPECT
+ Multidimensional syntax $a[1,2] not supported at - line 3.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ sub fred {} ; $SIG{TERM} = fred;
+ EXPECT
+ You need to quote "fred" at - line 3.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ @a[3] = 2;
+ @a{3} = 2;
+ EXPECT
+ Scalar value @a[3] better written as $a[3] at - line 3.
+ Scalar value @a{3} better written as $a{3} at - line 4.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ $_ = "ab" ; 
+ s/(ab)/\1/e;
+ EXPECT
+ Can't use \1 to mean $1 in expression at - line 4.
+ ########
+ # toke.c
+ use warning 'reserved' ;
+ $a = abc;
+ EXPECT
+ Unquoted string "abc" may clash with future reserved word at - line 3.
+ ########
+ # toke.c
+ use warning 'octal' ;
+ chmod 3;
+ EXPECT
+ chmod: mode argument is missing initial 0 at - line 3, at end of line
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ @a = qw(a, b, c) ;
+ EXPECT
+ Possible attempt to separate words with commas at - line 3.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ @a = qw(a b #) ;
+ EXPECT
+ Possible attempt to put comments in qw() list at - line 3.
+ ########
+ # toke.c
+ use warning 'octal' ;
+ umask 3;
+ EXPECT
+ umask: argument is missing initial 0 at - line 3, at end of line
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ print ("")
+ EXPECT
+ print (...) interpreted as function at - line 3.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ printf ("")
+ EXPECT
+ printf (...) interpreted as function at - line 3.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ sort ("")
+ EXPECT
+ sort (...) interpreted as function at - line 3.
+ ########
+ # toke.c
+ use warning 'ambiguous' ;
+ $a = ${time[2]};
+ EXPECT
+ Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
+ ########
+ # toke.c
+ use warning 'ambiguous' ;
+ $a = ${time{2}};
+ EXPECT
+ Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
+ ########
+ # toke.c
+ use warning 'ambiguous' ;
+ $a = ${time} ;
+ EXPECT
+ Ambiguous use of ${time} resolved to $time at - line 3.
+ ########
+ # toke.c
+ use warning 'ambiguous' ;
+ sub fred {}
+ $a = ${fred} ;
+ EXPECT
+ Ambiguous use of ${fred} resolved to $fred at - line 4.
+ ########
+ # toke.c
+ use warning 'syntax' ;
+ $a = 1_2;
+ $a = 1_2345_6;
+ EXPECT
+ Misplaced _ in number at - line 3.
+ Misplaced _ in number at - line 4.
+ Misplaced _ in number at - line 4.
+ ########
+ # toke.c
+ use warning 'unsafe' ;
+ $a = FRED:: ;
+ EXPECT
+ Bareword "FRED::" refers to nonexistent package at - line 3.
+ ########
+ # toke.c
+ use warning 'ambiguous' ;
+ sub time {}
+ my $a = time() 
+ EXPECT
+ Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
+ ########
+ # toke.c
+ use warning 'utf8' ;
+ $_ = " \x{123} " ;
+ EXPECT
+ Use of \x{} without utf8 declaration at - line 3.
+ ########
+ # toke.c
+ use warning 'utf8' ;
+ use utf8 ;
+ $_ = " \xffe " ;
+ EXPECT
+ \xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4.
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-universal	Wed Jul 29 07:20:55 1998
***************
*** 0 ****
--- 1,11 ----
+   universal.c
+ 
+   Can't locate package %s for @%s::ISA
+ 
+ 
+ __END__
+ # universal.c
+ use warning 'misc' ;
+ 
+ EXPECT
+ 
*** /dev/null	Wed Jul 29 09:03:56 1998
--- t/pragma/warn-util	Wed Jul 29 07:20:56 1998
***************
*** 0 ****
--- 1,21 ----
+   util.c AOK
+  
+      Illegal octal digit ignored 
+ 	my $a = oct "029" ;
+ 
+      Illegal hex digit ignored 
+ 	my $a = hex "0xv9" ;
+ 
+ 
+ __END__
+ # util.c
+ use warning 'octal' ;
+ my $a = oct "029" ;
+ EXPECT
+ Illegal octal digit ignored at - line 3.
+ ########
+ # util.c
+ use warning 'unsafe' ;
+ *a =  hex "0xv9" ;
+ EXPECT
+ Illegal hex digit ignored at - line 3.
*** t/pragma/warning.t.orig	Mon Jul 20 02:19:26 1998
--- t/pragma/warning.t	Wed Jul 29 07:20:56 1998
***************
*** 16,23 ****
  END {  if ($tmpfile) { 1 while unlink $tmpfile} }
  
  my @prgs = () ;
  
! foreach (sort glob("pragma/warn-*")) {
  
      next if /(~|\.orig)$/;
  
--- 16,31 ----
  END {  if ($tmpfile) { 1 while unlink $tmpfile} }
  
  my @prgs = () ;
+ my @w_files = () ;
  
! if (@ARGV)
!   { print "ARGV = [@ARGV]\n" ; @w_files = map { s#^#./pragma/warn-#; $_ } @ARGV }
! else
!   { @w_files = sort glob("pragma/warn-*") }
! 
! foreach (@w_files) {
! 
!     next if /\.orig$/ ;
  
      next if /(~|\.orig)$/;
  
*** taint.c.orig	Mon Jul 20 09:20:11 1998
--- taint.c	Wed Jul 29 07:20:56 1998
***************
*** 25,32 ****
  	    ug = " while running with -T switch";
  	if (!PL_unsafe)
  	    croak(f, s, ug);
! 	else if (PL_dowarn)
! 	    warn(f, s, ug);
      }
  }
  
--- 25,32 ----
  	    ug = " while running with -T switch";
  	if (!PL_unsafe)
  	    croak(f, s, ug);
! 	else if (ckWARN(WARN_TAINT))
! 	    warner(WARN_TAINT, f, s, ug);
      }
  }
  
*** toke.c.orig	Wed Jul 29 07:20:02 1998
--- toke.c	Wed Jul 29 07:20:57 1998
***************
*** 208,215 ****
  void
  deprecate(char *s)
  {
!     if (PL_dowarn)
! 	warn("Use of %s is deprecated", s);
  }
  
  STATIC void
--- 208,215 ----
  void
  deprecate(char *s)
  {
!     if (ckWARN(WARN_DEPRECATED))
! 	warner(WARN_DEPRECATED, "Use of %s is deprecated", s);
  }
  
  STATIC void
***************
*** 1001,1008 ****
  	    if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
  		isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
  	    {
! 		if (PL_dowarn)
! 		    warn("\\%c better written as $%c", *s, *s);
  		*--s = '$';
  		break;
  	    }
--- 1001,1008 ----
  	    if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
  		isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
  	    {
! 		if (ckWARN(WARN_SYNTAX))
! 		    warner(WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
  		*--s = '$';
  		break;
  	    }
***************
*** 1043,1052 ****
  
  		    if (!e)
  			yyerror("Missing right brace on \\x{}");
! 		    if (dowarn && !utf)
! 			warn("Use of \\x{} without utf8 declaration");
  		    /* note: utf always shorter than hex */
! 		    d = uv_to_utf8(d, scan_hex(s + 1, e - s, &len));
  		    s = e + 1;
  			
  		}
--- 1043,1052 ----
  
  		    if (!e)
  			yyerror("Missing right brace on \\x{}");
! 		    if (ckWARN(WARN_UTF8) && !utf)
! 			warner(WARN_UTF8,"Use of \\x{} without utf8 declaration");
  		    /* note: utf always shorter than hex */
! 		    d = uv_to_utf8(d, scan_hex(s + 1, e - s - 1, &len));
  		    s = e + 1;
  			
  		}
***************
*** 1058,1065 ****
  			d = uv_to_utf8(d, uv);		/* doing a CU or UC */
  		    }
  		    else {
! 			if (dowarn && uv >= 127 && UTF)
! 			    warn(
  				"\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
  				len,s,len,s);
  			*d++ = (char)uv;
--- 1058,1065 ----
  			d = uv_to_utf8(d, uv);		/* doing a CU or UC */
  		    }
  		    else {
! 			if (ckWARN(WARN_UTF8) && uv >= 127 && UTF)
! 			    warner(WARN_UTF8,
  				"\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
  				len,s,len,s);
  			*d++ = (char)uv;
***************
*** 2457,2465 ****
  	    AOPERATOR(ANDAND);
  	s--;
  	if (PL_expect == XOPERATOR) {
! 	    if (PL_dowarn && isALPHA(*s) && PL_bufptr == PL_linestart) {
  		PL_curcop->cop_line--;
! 		warn(warn_nosemi);
  		PL_curcop->cop_line++;
  	    }
  	    BAop(OP_BIT_AND);
--- 2457,2465 ----
  	    AOPERATOR(ANDAND);
  	s--;
  	if (PL_expect == XOPERATOR) {
! 	    if (ckWARN(WARN_SEMICOLON) && isALPHA(*s) && PL_bufptr == PL_linestart) {
  		PL_curcop->cop_line--;
! 		warner(WARN_SEMICOLON, warn_nosemi);
  		PL_curcop->cop_line++;
  	    }
  	    BAop(OP_BIT_AND);
***************
*** 2491,2498 ****
  	    OPERATOR(',');
  	if (tmp == '~')
  	    PMop(OP_MATCH);
! 	if (PL_dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
! 	    warn("Reversed %c= operator",(int)tmp);
  	s--;
  	if (PL_expect == XSTATE && isALPHA(tmp) &&
  		(s == PL_linestart+1 || s[-2] == '\n') )
--- 2491,2498 ----
  	    OPERATOR(',');
  	if (tmp == '~')
  	    PMop(OP_MATCH);
! 	if (ckWARN(WARN_SYNTAX) && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
! 	    warner(WARN_SYNTAX, "Reversed %c= operator",(int)tmp);
  	s--;
  	if (PL_expect == XSTATE && isALPHA(tmp) &&
  		(s == PL_linestart+1 || s[-2] == '\n') )
***************
*** 2622,2628 ****
  	    char *t;
  	    if (*s == '[') {
  		PL_tokenbuf[0] = '@';
! 		if (PL_dowarn) {
  		    for(t = s + 1;
  			isSPACE(*t) || isALNUM(*t) || *t == '$';
  			t++) ;
--- 2622,2628 ----
  	    char *t;
  	    if (*s == '[') {
  		PL_tokenbuf[0] = '@';
! 		if (ckWARN(WARN_SYNTAX)) {
  		    for(t = s + 1;
  			isSPACE(*t) || isALNUM(*t) || *t == '$';
  			t++) ;
***************
*** 2630,2643 ****
  			PL_bufptr = skipspace(PL_bufptr);
  			while (t < PL_bufend && *t != ']')
  			    t++;
! 			warn("Multidimensional syntax %.*s not supported",
! 			     (t - PL_bufptr) + 1, PL_bufptr);
  		    }
  		}
  	    }
  	    else if (*s == '{') {
  		PL_tokenbuf[0] = '%';
! 		if (PL_dowarn && strEQ(PL_tokenbuf+1, "SIG") &&
  		    (t = strchr(s, '}')) && (t = strchr(t, '=')))
  		{
  		    char tmpbuf[sizeof PL_tokenbuf];
--- 2630,2644 ----
  			PL_bufptr = skipspace(PL_bufptr);
  			while (t < PL_bufend && *t != ']')
  			    t++;
! 			warner(WARN_SYNTAX,
! 				"Multidimensional syntax %.*s not supported",
! 			     	(t - PL_bufptr) + 1, PL_bufptr);
  		    }
  		}
  	    }
  	    else if (*s == '{') {
  		PL_tokenbuf[0] = '%';
! 		if (ckWARN(WARN_SYNTAX) && strEQ(PL_tokenbuf+1, "SIG") &&
  		    (t = strchr(s, '}')) && (t = strchr(t, '=')))
  		{
  		    char tmpbuf[sizeof PL_tokenbuf];
***************
*** 2646,2652 ****
  		    if (isIDFIRST(*t)) {
  			t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
  			if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
! 			    warn("You need to quote \"%s\"", tmpbuf);
  		    }
  		}
  	    }
--- 2647,2654 ----
  		    if (isIDFIRST(*t)) {
  			t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
  			if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
! 			    warner(WARN_SYNTAX,
! 				"You need to quote \"%s\"", tmpbuf);
  		    }
  		}
  	    }
***************
*** 2716,2722 ****
  		PL_tokenbuf[0] = '%';
  
  	    /* Warn about @ where they meant $. */
! 	    if (PL_dowarn) {
  		if (*s == '[' || *s == '{') {
  		    char *t = s + 1;
  		    while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
--- 2718,2724 ----
  		PL_tokenbuf[0] = '%';
  
  	    /* Warn about @ where they meant $. */
! 	    if (ckWARN(WARN_SYNTAX)) {
  		if (*s == '[' || *s == '{') {
  		    char *t = s + 1;
  		    while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
***************
*** 2724,2730 ****
  		    if (*t == '}' || *t == ']') {
  			t++;
  			PL_bufptr = skipspace(PL_bufptr);
! 			warn("Scalar value %.*s better written as $%.*s",
  			    t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
  		    }
  		}
--- 2726,2733 ----
  		    if (*t == '}' || *t == ']') {
  			t++;
  			PL_bufptr = skipspace(PL_bufptr);
! 			warner(WARN_SYNTAX,
! 			    "Scalar value %.*s better written as $%.*s",
  			    t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
  		    }
  		}
***************
*** 2830,2837 ****
  
      case '\\':
  	s++;
! 	if (PL_dowarn && PL_lex_inwhat && isDIGIT(*s))
! 	    warn("Can't use \\%c to mean $%c in expression", *s, *s);
  	if (PL_expect == XOPERATOR)
  	    no_op("Backslash",s);
  	OPERATOR(REFGEN);
--- 2833,2841 ----
  
      case '\\':
  	s++;
! 	if (ckWARN(WARN_SYNTAX) && PL_lex_inwhat && isDIGIT(*s))
! 	    warner(WARN_SYNTAX,"Can't use \\%c to mean $%c in expression",
! 			*s, *s);
  	if (PL_expect == XOPERATOR)
  	    no_op("Backslash",s);
  	OPERATOR(REFGEN);
***************
*** 2946,2953 ****
  		tmp = -tmp;
  		gv = Nullgv;
  		gvp = 0;
! 		if (PL_dowarn && hgv)
! 		    warn("Ambiguous call resolved as CORE::%s(), %s",
  			 GvENAME(hgv), "qualify as such or use &");
  	    }
  	}
--- 2950,2958 ----
  		tmp = -tmp;
  		gv = Nullgv;
  		gvp = 0;
! 		if (ckWARN(WARN_AMBIGUOUS) && hgv)
! 		    warner(WARN_AMBIGUOUS,
! 		    	"Ambiguous call resolved as CORE::%s(), %s",
  			 GvENAME(hgv), "qualify as such or use &");
  	    }
  	}
***************
*** 2975,2981 ****
  		if (PL_expect == XOPERATOR) {
  		    if (PL_bufptr == PL_linestart) {
  			PL_curcop->cop_line--;
! 			warn(warn_nosemi);
  			PL_curcop->cop_line++;
  		    }
  		    else
--- 2980,2986 ----
  		if (PL_expect == XOPERATOR) {
  		    if (PL_bufptr == PL_linestart) {
  			PL_curcop->cop_line--;
! 			warner(WARN_SEMICOLON, warn_nosemi);
  			PL_curcop->cop_line++;
  		    }
  		    else
***************
*** 2989,2996 ****
  		if (len > 2 &&
  		    PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
  		{
! 		    if (PL_dowarn && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
! 			warn("Bareword \"%s\" refers to nonexistent package",
  			     PL_tokenbuf);
  		    len -= 2;
  		    PL_tokenbuf[len] = '\0';
--- 2994,3002 ----
  		if (len > 2 &&
  		    PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
  		{
! 		    if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
! 			warner(WARN_UNSAFE, 
! 		  	    "Bareword \"%s\" refers to nonexistent package",
  			     PL_tokenbuf);
  		    len -= 2;
  		    PL_tokenbuf[len] = '\0';
***************
*** 3148,3158 ****
  		/* Call it a bare word */
  
  	    bareword:
! 		if (PL_dowarn) {
  		    if (lastchar != '-') {
  			for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
  			if (!*d)
! 			    warn(warn_reserved, PL_tokenbuf);
  		    }
  		}
  
--- 3154,3164 ----
  		/* Call it a bare word */
  
  	    bareword:
! 		if (ckWARN(WARN_RESERVED)) {
  		    if (lastchar != '-') {
  			for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
  			if (!*d)
! 			    warner(WARN_RESERVED, warn_reserved, PL_tokenbuf);
  		    }
  		}
  
***************
*** 3293,3299 ****
  	    LOP(OP_CRYPT,XTERM);
  
  	case KEY_chmod:
! 	    if (PL_dowarn) {
  		for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
  		if (*d != '0' && isDIGIT(*d))
  		    yywarn("chmod: mode argument is missing initial 0");
--- 3299,3305 ----
  	    LOP(OP_CRYPT,XTERM);
  
  	case KEY_chmod:
! 	    if (ckWARN(WARN_OCTAL)) {
  		for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
  		if (*d != '0' && isDIGIT(*d))
  		    yywarn("chmod: mode argument is missing initial 0");
***************
*** 3713,3727 ****
  	    s = scan_str(s);
  	    if (!s)
  		missingterm((char*)0);
! 	    if (PL_dowarn && SvLEN(PL_lex_stuff)) {
  		d = SvPV_force(PL_lex_stuff, len);
  		for (; len; --len, ++d) {
  		    if (*d == ',') {
! 			warn("Possible attempt to separate words with commas");
  			break;
  		    }
  		    if (*d == '#') {
! 			warn("Possible attempt to put comments in qw() list");
  			break;
  		    }
  		}
--- 3719,3735 ----
  	    s = scan_str(s);
  	    if (!s)
  		missingterm((char*)0);
! 	    if (ckWARN(WARN_SYNTAX) && SvLEN(PL_lex_stuff)) {
  		d = SvPV_force(PL_lex_stuff, len);
  		for (; len; --len, ++d) {
  		    if (*d == ',') {
! 			warner(WARN_SYNTAX,
! 			    "Possible attempt to separate words with commas");
  			break;
  		    }
  		    if (*d == '#') {
! 			warner(WARN_SYNTAX,
! 			    "Possible attempt to put comments in qw() list");
  			break;
  		    }
  		}
***************
*** 4096,4102 ****
  	    LOP(OP_UTIME,XTERM);
  
  	case KEY_umask:
! 	    if (PL_dowarn) {
  		for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
  		if (*d != '0' && isDIGIT(*d))
  		    yywarn("umask: argument is missing initial 0");
--- 4104,4110 ----
  	    LOP(OP_UTIME,XTERM);
  
  	case KEY_umask:
! 	    if (ckWARN(WARN_OCTAL)) {
  		for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
  		if (*d != '0' && isDIGIT(*d))
  		    yywarn("umask: argument is missing initial 0");
***************
*** 4793,4799 ****
  {
      char *w;
  
!     if (PL_dowarn && *s == ' ' && s[1] == '(') {	/* XXX gotta be a better way */
  	int level = 1;
  	for (w = s+2; *w && level; w++) {
  	    if (*w == '(')
--- 4801,4807 ----
  {
      char *w;
  
!     if (ckWARN(WARN_SYNTAX) && *s == ' ' && s[1] == '(') {	/* XXX gotta be a better way */
  	int level = 1;
  	for (w = s+2; *w && level; w++) {
  	    if (*w == '(')
***************
*** 4804,4810 ****
  	if (*w)
  	    for (; *w && isSPACE(*w); w++) ;
  	if (!*w || !strchr(";|})]oaiuw!=", *w))	/* an advisory hack only... */
! 	    warn("%s (...) interpreted as function",name);
      }
      while (s < PL_bufend && isSPACE(*s))
  	s++;
--- 4812,4818 ----
  	if (*w)
  	    for (; *w && isSPACE(*w); w++) ;
  	if (!*w || !strchr(";|})]oaiuw!=", *w))	/* an advisory hack only... */
! 	    warner(WARN_SYNTAX, "%s (...) interpreted as function",name);
      }
      while (s < PL_bufend && isSPACE(*s))
  	s++;
***************
*** 5044,5052 ****
  	    *d = '\0';
  	    while (s < send && (*s == ' ' || *s == '\t')) s++;
  	    if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
! 		if (PL_dowarn && keyword(dest, d - dest)) {
  		    char *brack = *s == '[' ? "[...]" : "{...}";
! 		    warn("Ambiguous use of %c{%s%s} resolved to %c%s%s",
  			funny, dest, brack, funny, dest, brack);
  		}
  		PL_lex_fakebrack = PL_lex_brackets+1;
--- 5052,5061 ----
  	    *d = '\0';
  	    while (s < send && (*s == ' ' || *s == '\t')) s++;
  	    if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
! 		if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
  		    char *brack = *s == '[' ? "[...]" : "{...}";
! 		    warner(WARN_AMBIGUOUS,
! 			"Ambiguous use of %c{%s%s} resolved to %c%s%s",
  			funny, dest, brack, funny, dest, brack);
  		}
  		PL_lex_fakebrack = PL_lex_brackets+1;
***************
*** 5061,5069 ****
  		PL_lex_state = LEX_INTERPEND;
  	    if (funny == '#')
  		funny = '@';
! 	    if (PL_dowarn && PL_lex_state == LEX_NORMAL &&
  	      (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
! 		warn("Ambiguous use of %c{%s} resolved to %c%s",
  		    funny, dest, funny, dest);
  	}
  	else {
--- 5070,5079 ----
  		PL_lex_state = LEX_INTERPEND;
  	    if (funny == '#')
  		funny = '@';
! 	    if (ckWARN(WARN_AMBIGUOUS) && PL_lex_state == LEX_NORMAL &&
  	      (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
! 		warner(WARN_AMBIGUOUS,
! 		    "Ambiguous use of %c{%s} resolved to %c%s",
  		    funny, dest, funny, dest);
  	}
  	else {
***************
*** 5909,5916 ****
  	       if -w is on
  	    */
  	    if (*s == '_') {
! 		if (PL_dowarn && lastub && s - lastub != 3)
! 		    warn("Misplaced _ in number");
  		lastub = ++s;
  	    }
  	    else {
--- 5919,5926 ----
  	       if -w is on
  	    */
  	    if (*s == '_') {
! 		if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
! 		    warner(WARN_SYNTAX, "Misplaced _ in number");
  		lastub = ++s;
  	    }
  	    else {
***************
*** 5923,5930 ****
  	}
  
  	/* final misplaced underbar check */
! 	if (PL_dowarn && lastub && s - lastub != 3)
! 	    warn("Misplaced _ in number");
  
  	/* read a decimal portion if there is one.  avoid
  	   3..5 being interpreted as the number 3. followed
--- 5933,5940 ----
  	}
  
  	/* final misplaced underbar check */
! 	if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
! 	    warner(WARN_SYNTAX, "Misplaced _ in number");
  
  	/* read a decimal portion if there is one.  avoid
  	   3..5 being interpreted as the number 3. followed
*** universal.c.orig	Mon Jul 20 02:19:43 1998
--- universal.c	Wed Jul 29 07:20:57 1998
***************
*** 53,60 ****
  		SV* sv = *svp++;
  		HV* basestash = gv_stashsv(sv, FALSE);
  		if (!basestash) {
! 		    if (PL_dowarn)
! 			warn("Can't locate package %s for @%s::ISA",
  			    SvPVX(sv), HvNAME(stash));
  		    continue;
  		}
--- 53,61 ----
  		SV* sv = *svp++;
  		HV* basestash = gv_stashsv(sv, FALSE);
  		if (!basestash) {
! 		    if (ckWARN(WARN_MISC))
! 			warner(WARN_SYNTAX,
! 		             "Can't locate package %s for @%s::ISA",
  			    SvPVX(sv), HvNAME(stash));
  		    continue;
  		}
*** util.c.orig	Wed Jul 29 07:20:02 1998
--- util.c	Wed Jul 29 07:20:57 1998
***************
*** 1415,1420 ****
--- 1415,1507 ----
      (void)PerlIO_flush(PerlIO_stderr());
  }
  
+ void
+ warner(U32  err, const char* pat,...)
+ {
+     va_list args;
+     char *message;
+     HV *stash;
+     GV *gv;
+     CV *cv;
+ 
+     va_start(args, pat);
+     message = mess(pat, &args);
+     va_end(args);
+ 
+     if (ckDEAD(err)) {
+ #ifdef USE_THREADS
+         DEBUG_L(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message));
+ #endif /* USE_THREADS */
+         if (PL_diehook) {
+             /* sv_2cv might call croak() */
+             SV *olddiehook = PL_diehook;
+             ENTER;
+             SAVESPTR(PL_diehook);
+             PL_diehook = Nullsv;
+             cv = sv_2cv(olddiehook, &stash, &gv, 0);
+             LEAVE;
+             if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
+                 dSP;
+                 SV *msg;
+  
+                 ENTER;
+                 msg = newSVpv(message, 0);
+                 SvREADONLY_on(msg);
+                 SAVEFREESV(msg);
+  
+                 PUSHMARK(sp);
+                 XPUSHs(msg);
+                 PUTBACK;
+                 perl_call_sv((SV*)cv, G_DISCARD);
+  
+                 LEAVE;
+             }
+         }
+         if (PL_in_eval) {
+             PL_restartop = die_where(message);
+             JMPENV_JUMP(3);
+         }
+         PerlIO_puts(PerlIO_stderr(),message);
+         (void)PerlIO_flush(PerlIO_stderr());
+         my_failure_exit();
+ 
+     }
+     else {
+         if (PL_warnhook) {
+             /* sv_2cv might call warn() */
+             dTHR;
+             SV *oldwarnhook = PL_warnhook;
+             ENTER;
+             SAVESPTR(PL_warnhook);
+             PL_warnhook = Nullsv;
+             cv = sv_2cv(oldwarnhook, &stash, &gv, 0);
+                 LEAVE;
+             if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
+                 dSP;
+                 SV *msg;
+  
+                 ENTER;
+                 msg = newSVpv(message, 0);
+                 SvREADONLY_on(msg);
+                 SAVEFREESV(msg);
+  
+                 PUSHMARK(sp);
+                 XPUSHs(msg);
+                 PUTBACK;
+                 perl_call_sv((SV*)cv, G_DISCARD);
+  
+                 LEAVE;
+                 return;
+             }
+         }
+         PerlIO_puts(PerlIO_stderr(),message);
+ #ifdef LEAKTEST
+         DEBUG_L(xstat());
+ #endif
+         (void)PerlIO_flush(PerlIO_stderr());
+     }
+ }
+ 
  #ifndef VMS  /* VMS' my_setenv() is in VMS.c */
  #ifndef WIN32
  void
***************
*** 2349,2356 ****
  	retval = n | (*s++ - '0');
  	len--;
      }
!     if (PL_dowarn && len && (*s == '8' || *s == '9'))
! 	warn("Illegal octal digit ignored");
      *retlen = s - start;
      return retval;
  }
--- 2436,2443 ----
  	retval = n | (*s++ - '0');
  	len--;
      }
!     if (len && (*s == '8' || *s == '9') && ckWARN(WARN_OCTAL))
! 	warner(WARN_OCTAL, "Illegal octal digit ignored");
      *retlen = s - start;
      return retval;
  }
***************
*** 2371,2378 ****
  		continue;
  	    else {
  		--s;
! 		if (PL_dowarn)
! 		    warn("Illegal hex digit ignored");
  		break;
  	    }
  	}
--- 2458,2465 ----
  		continue;
  	    else {
  		--s;
! 		if (ckWARN(WARN_UNSAFE))
! 		    warner(WARN_UNSAFE,"Illegal hex digit ignored");
  		break;
  	    }
  	}
*** /dev/null	Wed Jul 29 09:03:56 1998
--- warning.h	Wed Jul 29 07:20:58 1998
***************
*** 0 ****
--- 1,100 ----
+ /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+    This file is built by warning.pl
+    Any changes made here will be lost!
+ */
+ 
+ 
+ #define Off(x)                  ((x) / 8)
+ #define Bit(x)                  (1 << ((x) % 8))
+ #define IsSet(a, x)		((a)[Off(x)] & Bit(x))
+ 
+ #define G_WARN_OFF		0 	/* $^W == 0 */
+ #define G_WARN_ON		1	/* $^W != 0 */
+ #define G_WARN_ALL_ON		2	/* -W flag */
+ #define G_WARN_ALL_OFF		4	/* -X flag */
+ #define G_WARN_ALL_MASK		(G_WARN_ALL_ON|G_WARN_ALL_OFF)
+ 
+ #if 1
+ 
+ /* Part of the logic below assumes that WARN_NONE is NULL */
+ 
+ #define ckDEAD(x)							\
+ 	   (curcop->cop_warnings != WARN_ALL &&				\
+ 	    curcop->cop_warnings != WARN_NONE &&			\
+ 	    IsSet(SvPVX(curcop->cop_warnings), 2*x+1))
+ 
+ #define ckWARN(x)							\
+ 	( (curcop->cop_warnings &&					\
+ 	      (curcop->cop_warnings == WARN_ALL ||			\
+ 	       IsSet(SvPVX(curcop->cop_warnings), 2*x) ) )		\
+ 	  || (PL_dowarn & G_WARN_ON) )
+ 
+ #define ckWARN2(x,y)							\
+ 	  ( (curcop->cop_warnings &&					\
+ 	      (curcop->cop_warnings == WARN_ALL ||			\
+ 	        IsSet(SvPVX(curcop->cop_warnings), 2*x)  ||		\
+ 	        IsSet(SvPVX(curcop->cop_warnings), 2*y) ) ) 		\
+ 	    ||	(PL_dowarn & G_WARN_ON) )
+ 
+ #else
+ 
+ #define ckDEAD(x)						\
+ 	   (curcop->cop_warnings != WARN_ALL &&			\
+ 	    curcop->cop_warnings != WARN_NONE &&		\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*x+1)] & Bit(2*x+1) )
+ 
+ #define ckWARN(x)						\
+ 	( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && 	\
+ 	  curcop->cop_warnings &&				\
+ 	  ( curcop->cop_warnings == WARN_ALL ||			\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*x)] & Bit(2*x)  ) ) )
+ 
+ #define ckWARN2(x,y)						\
+ 	( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && 	\
+ 	  curcop->cop_warnings &&				\
+ 	  ( curcop->cop_warnings == WARN_ALL ||			\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*x)] & Bit(2*x) || 	\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*y)] & Bit(2*y) ) ) ) 
+ 
+ #endif
+ 
+ #define WARN_NONE		NULL
+ #define WARN_ALL		(&sv_yes)
+ 
+ #define WARN_REDEFINE		0
+ #define WARN_VOID		1
+ #define WARN_UNSAFE		2
+ #define WARN_TAINT		3
+ #define WARN_SUBSTR		4
+ #define WARN_CLOSURE		5
+ #define WARN_UNTIE		6
+ #define WARN_SIGNAL		7
+ #define WARN_UTF8		8
+ #define WARN_NUMERIC		9
+ #define WARN_DEFAULT		10
+ #define WARN_ONCE		11
+ #define WARN_SYNTAX		12
+ #define WARN_RESERVED		13
+ #define WARN_DEPRECATED		14
+ #define WARN_SEMICOLON		15
+ #define WARN_PRINTF		16
+ #define WARN_OCTAL		17
+ #define WARN_AMBIGUOUS		18
+ #define WARN_PARENTHESIS	19
+ #define WARN_PRECEDENCE		20
+ #define WARN_IO			21
+ #define WARN_NEWLINE		22
+ #define WARN_CLOSED		23
+ #define WARN_EXEC		24
+ #define WARN_UNOPENED		25
+ #define WARN_PIPE		26
+ #define WARN_UNINITIALIZED	27
+ #define WARN_RECURSION		28
+ #define WARN_MISC		29
+ 
+ #define WARNsize		8
+ #define WARN_ALLstring		"\125\125\125\125\125\125\125\125"
+ #define WARN_NONEstring		"\0\0\0\0\0\0\0\0"
+ 
+ /* end of file warning.h */
+ 
*** /dev/null	Wed Jul 29 09:03:56 1998
--- warning.pl	Wed Jul 29 07:20:58 1998
***************
*** 0 ****
--- 1,359 ----
+ #!/usr/bin/perl
+ 
+ use strict ;
+ 
+ sub DEFAULT_ON  () { 1 }
+ sub DEFAULT_OFF () { 2 }
+ 
+ my $tree = {
+        	 'unsafe'	=> { 	'untie'		=> DEFAULT_OFF,
+ 				'substr'	=> DEFAULT_OFF,
+ 				'taint'		=> DEFAULT_OFF,
+ 				'signal'	=> DEFAULT_OFF,
+ 				'closure'	=> DEFAULT_OFF,
+ 				'utf8'		=> DEFAULT_OFF,
+ 			   } ,
+        	 'io'  		=> { 	'pipe' 		=> DEFAULT_OFF,
+        				'unopened'	=> DEFAULT_OFF,
+        				'closed'	=> DEFAULT_OFF,
+        				'newline'	=> DEFAULT_OFF,
+        				'exec'		=> DEFAULT_OFF,
+        				#'wr in in file'=> DEFAULT_OFF,
+ 			   },
+        	 'syntax'	=> { 	'ambiguous'	=> DEFAULT_OFF,
+ 			     	'semicolon'	=> DEFAULT_OFF,
+ 			     	'precedence'	=> DEFAULT_OFF,
+ 			     	'reserved'	=> DEFAULT_OFF,
+ 				'octal'		=> DEFAULT_OFF,
+ 			     	'parenthesis'	=> DEFAULT_OFF,
+        	 			'deprecated'	=> DEFAULT_OFF,
+        	 			'printf'	=> DEFAULT_OFF,
+ 			   },
+        	 'void'		=> DEFAULT_OFF,
+        	 'recursion'	=> DEFAULT_OFF,
+        	 'redefine'	=> DEFAULT_OFF,
+        	 'numeric'	=> DEFAULT_OFF,
+          'uninitialized'=> DEFAULT_OFF,
+        	 'once'		=> DEFAULT_OFF,
+        	 'misc'		=> DEFAULT_OFF,
+        	 'default'	=> DEFAULT_ON,
+ 	} ;
+ 
+ 
+ ###########################################################################
+ sub tab {
+     my($l, $t) = @_;
+     $t .= "\t" x ($l - (length($t) + 1) / 8);
+     $t;
+ }
+ 
+ ###########################################################################
+ 
+ my %list ;
+ my %Value ;
+ my $index = 0 ;
+ 
+ sub walk
+ {
+     my $tre = shift ;
+     my @list = () ;
+     my ($k, $v) ;
+ 
+     while (($k, $v) = each %$tre) {
+ 
+ 	die "duplicate key $k\n" if defined $list{$k} ;
+ 	$Value{$index} = uc $k ;
+         push @{ $list{$k} }, $index ++ ;
+ 	if (ref $v)
+ 	  { push (@{ $list{$k} }, walk ($v)) }
+ 	push @list, @{ $list{$k} } ;
+     }
+ 
+    return @list ;
+ 
+ }
+ 
+ ###########################################################################
+ 
+ sub mkRange
+ {
+     my @a = @_ ;
+     my @out = @a ;
+     my $i ;
+ 
+ 
+     for ($i = 1 ; $i < @a; ++ $i) {
+       	$out[$i] = ".." 
+           if $a[$i] == $a[$i - 1] + 1 && $a[$i] + 1 == $a[$i + 1] ;
+     }
+ 
+     my $out = join(",",@out);
+ 
+     $out =~ s/,(\.\.,)+/../g ;
+     return $out;
+ }
+ 
+ ###########################################################################
+ 
+ sub mkHex
+ {
+     my ($max, @a) = @_ ;
+     my $mask = "\x00" x $max ;
+     my $string = "" ;
+ 
+     foreach (@a) {
+ 	vec($mask, $_, 1) = 1 ;
+     }
+ 
+     #$string = unpack("H$max", $mask) ;
+     #$string =~ s/(..)/\x$1/g;
+     foreach (unpack("C*", $mask)) {
+ 	$string .= '\x' . sprintf("%2.2x", $_) ;
+     }
+     return $string ;
+ }
+ 
+ ###########################################################################
+ 
+ 
+ #unlink "warning.h";
+ #unlink "lib/warning.pm";
+ open(WARN, ">warning.h") || die "Can't create warning.h: $!\n";
+ open(PM, ">lib/warning.pm") || die "Can't create lib/warning.pm: $!\n";
+ 
+ print WARN <<'EOM' ;
+ /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+    This file is built by warning.pl
+    Any changes made here will be lost!
+ */
+ 
+ 
+ #define Off(x)                  ((x) / 8)
+ #define Bit(x)                  (1 << ((x) % 8))
+ #define IsSet(a, x)		((a)[Off(x)] & Bit(x))
+ 
+ #define G_WARN_OFF		0 	/* $^W == 0 */
+ #define G_WARN_ON		1	/* $^W != 0 */
+ #define G_WARN_ALL_ON		2	/* -W flag */
+ #define G_WARN_ALL_OFF		4	/* -X flag */
+ #define G_WARN_ALL_MASK		(G_WARN_ALL_ON|G_WARN_ALL_OFF)
+ 
+ #if 1
+ 
+ /* Part of the logic below assumes that WARN_NONE is NULL */
+ 
+ #define ckDEAD(x)							\
+ 	   (curcop->cop_warnings != WARN_ALL &&				\
+ 	    curcop->cop_warnings != WARN_NONE &&			\
+ 	    IsSet(SvPVX(curcop->cop_warnings), 2*x+1))
+ 
+ #define ckWARN(x)							\
+ 	( (curcop->cop_warnings &&					\
+ 	      (curcop->cop_warnings == WARN_ALL ||			\
+ 	       IsSet(SvPVX(curcop->cop_warnings), 2*x) ) )		\
+ 	  || (PL_dowarn & G_WARN_ON) )
+ 
+ #define ckWARN2(x,y)							\
+ 	  ( (curcop->cop_warnings &&					\
+ 	      (curcop->cop_warnings == WARN_ALL ||			\
+ 	        IsSet(SvPVX(curcop->cop_warnings), 2*x)  ||		\
+ 	        IsSet(SvPVX(curcop->cop_warnings), 2*y) ) ) 		\
+ 	    ||	(PL_dowarn & G_WARN_ON) )
+ 
+ #else
+ 
+ #define ckDEAD(x)						\
+ 	   (curcop->cop_warnings != WARN_ALL &&			\
+ 	    curcop->cop_warnings != WARN_NONE &&		\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*x+1)] & Bit(2*x+1) )
+ 
+ #define ckWARN(x)						\
+ 	( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && 	\
+ 	  curcop->cop_warnings &&				\
+ 	  ( curcop->cop_warnings == WARN_ALL ||			\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*x)] & Bit(2*x)  ) ) )
+ 
+ #define ckWARN2(x,y)						\
+ 	( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && 	\
+ 	  curcop->cop_warnings &&				\
+ 	  ( curcop->cop_warnings == WARN_ALL ||			\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*x)] & Bit(2*x) || 	\
+ 	    SvPVX(curcop->cop_warnings)[Off(2*y)] & Bit(2*y) ) ) ) 
+ 
+ #endif
+ 
+ #define WARN_NONE		NULL
+ #define WARN_ALL		(&sv_yes)
+ 
+ EOM
+ 
+ 
+ $index = 0 ;
+ @{ $list{"all"} } = walk ($tree) ;
+ 
+ $index *= 2 ;
+ my $warn_size = int($index / 8) + ($index % 8 != 0) ;
+ 
+ my $k ;
+ foreach $k (sort { $a <=> $b } keys %Value) {
+     print WARN tab(5, "#define WARN_$Value{$k}"), "$k\n" ;
+ }
+ print WARN "\n" ;
+ 
+ print WARN tab(5, '#define WARNsize'),	"$warn_size\n" ;
+ #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
+ print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
+ print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
+ 
+ print WARN <<'EOM';
+ 
+ /* end of file warning.h */
+ 
+ EOM
+ 
+ close WARN ;
+ 
+ while (<DATA>) {
+     last if /^KEYWORDS$/ ;
+     print PM $_ ;
+ }
+ 
+ $list{'all'} = [ 0 .. 8 * ($warn_size/2) - 1 ] ;
+ print PM "%Bits = (\n" ;
+ foreach $k (sort keys  %list) {
+ 
+     my $v = $list{$k} ;
+     my @list = sort { $a <=> $b } @$v ;
+ 
+     print PM tab(4, "    '$k'"), '=> "', 
+ 		# mkHex($warn_size, @list), 
+ 		mkHex($warn_size, map $_ * 2 , @list), 
+ 		'", # [', mkRange(@list), "]\n" ;
+ }
+ 
+ print PM "  );\n\n" ;
+ 
+ print PM "%DeadBits = (\n" ;
+ foreach $k (sort keys  %list) {
+ 
+     my $v = $list{$k} ;
+     my @list = sort { $a <=> $b } @$v ;
+ 
+     print PM tab(4, "    '$k'"), '=> "', 
+ 		# mkHex($warn_size, @list), 
+ 		mkHex($warn_size, map $_ * 2 + 1 , @list), 
+ 		'", # [', mkRange(@list), "]\n" ;
+ }
+ 
+ print PM "  );\n\n" ;
+ while (<DATA>) {
+     print PM $_ ;
+ }
+ 
+ close PM ;
+ 
+ __END__
+ 
+ # This file was created by warning.pl
+ # Any changes made here will be lost.
+ #
+ 
+ package warning;
+ 
+ =head1 NAME
+ 
+ warning - Perl pragma to control 
+ 
+ =head1 SYNOPSIS
+ 
+     use warning;
+ 
+     use warning "all";
+     use warning "deprecated";
+ 
+     use warning;
+     no warning "unsafe";
+ 
+ =head1 DESCRIPTION
+ 
+ If no import list is supplied, all possible restrictions are assumed.
+ (This is the safest mode to operate in, but is sometimes too strict for
+ casual programming.)  Currently, there are three possible things to be
+ strict about:  
+ 
+ =over 6
+ 
+ =item C<warning deprecated>
+ 
+ This generates a runtime error if you use deprecated 
+ 
+     use warning 'deprecated';
+ 
+ =back
+ 
+ See L<perlmod/Pragmatic Modules>.
+ 
+ 
+ =cut
+ 
+ use Carp ;
+ 
+ KEYWORDS
+ 
+ sub bits {
+     my $mask ;
+     my $catmask ;
+     my $fatal = 0 ;
+     foreach my $word (@_) {
+ 	if  ($word eq 'FATAL')
+ 	  { $fatal = 1 }
+ 	elsif ($catmask = $Bits{$word}) {
+ 	  $mask |= $catmask ;
+ 	  $mask |= $DeadBits{$word} if $fatal ;
+ 	}
+ 	else
+ 	  { croak "unknown warning category '$word'" }
+     }
+ 
+     return $mask ;
+ }
+ 
+ sub import {
+     shift;
+     $^B |= bits(@_ ? @_ : 'all') ;
+ }
+ 
+ sub unimport {
+     shift;
+     $^B &= ~ bits(@_ ? @_ : 'all') ;
+ }
+ 
+ 
+ sub make_fatal
+ {
+     my $self = shift ;
+     my $bitmask = $self->bits(@_) ;
+     $SIG{__WARN__} =
+         sub
+         {
+             die @_ if $^B & $bitmask ;
+             warn @_
+         } ;
+ }
+ 
+ sub bitmask
+ {
+     return $^B ;
+ }
+ 
+ sub enabled
+ {
+     my $string = shift ;
+ 
+     return 1
+ 	if $bits{$string} && $^B & $bits{$string} ;
+    
+     return 0 ; 
+ }
+ 
+ 1;