This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[inseparable changes from match from perl-5.003_97a to perl-5.003_97b]
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>
Fri, 4 Apr 1997 00:00:00 +0000 (00:00 +0000)
committerChip Salzenberg <chip@atlantic.net>
Fri, 4 Apr 1997 00:00:00 +0000 (00:00 +0000)
 BUILD PROCESS

Subject: Don't suggest 'Configure -der' in config.sh comments
From: Chip Salzenberg <chip@perl.com>
Files: Configure

 CORE LANGUAGE CHANGES

Subject: Make assignment to C<$)> call setgroups()
From: Chip Salzenberg <chip@perl.com>
Files: Configure config_H config_h.SH mg.c plan9/config.plan9 pod/perldelta.pod vms/config.vms win32/config.H win32/config.w32

Subject: Grandfather "$$<digit>" in strings
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod toke.c

Subject: Disconnect warn and die hooks _after_ object destruction
From: Chip Salzenberg <chip@perl.com>
Files: perl.c

Subject: Forbid recursive substitutions
From: Chip Salzenberg <chip@perl.com>
Files: cop.h pod/perldelta.pod pod/perldiag.pod pp_ctl.c pp_hot.c

 DOCUMENTATION

Subject: Document required module versions
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod

 LIBRARY AND EXTENSIONS

Subject: Updates to Math::Complex and Math::Trig
From: Jarkko Hietaniemi <Jarkko.Hietaniemi@cc.hut.fi>
Files: lib/Math/Complex.pm lib/Math/Trig.pm pod/perldelta.pod t/lib/complex.t

 OTHER CORE CHANGES

Subject: length($') isn't
Date: Mon, 07 Apr 1997 03:30:44 -0400
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: mg.c
Msg-ID: 199704070730.DAA07310@aatma.engin.umich.edu

    (applied based on p5p patch as commit 645a7cbb1f14932f058231f0a4f808b88ebe8703)

Subject: Fix obscure regex bug related to leading C<.*>
From: Chip Salzenberg <chip@perl.com>
Files: toke.c

Subject: Add warning for glob failure
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c

Subject: Fix C<perl -V> in presence of local patches
From: Chip Salzenberg <chip@perl.com>
Files: perl.c

21 files changed:
Changes
Configure
config_H
config_h.SH
cop.h
lib/Math/Complex.pm
lib/Math/Trig.pm
mg.c
patchlevel.h
perl.c
plan9/config.plan9
pod/perldelta.pod
pod/perldiag.pod
pod/perltoc.pod
pp_ctl.c
pp_hot.c
t/lib/complex.t
toke.c
vms/config.vms
win32/config.H
win32/config.w32

diff --git a/Changes b/Changes
index 8419886..fc9c9c7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -35,6 +35,7 @@ file, and their current addresses (as of March 1997):
     Ulrich Pfeifer      <pfeifer@charly.informatik.uni-dortmund.de>
     Tom Phoenix         <rootbeer@teleport.com>
     Norbert Pueschel    <pueschel@imsdd.meb.uni-bonn.de>
+    Dean Roehrich       <roehrich@cray.com>
     Roderick Schertler  <roderick@argon.org>
     Ilya Zakharevich    <ilya@math.ohio-state.edu>
 
@@ -45,6 +46,118 @@ And the Keepers of the Patch Pumpkin:
 
 
 -------------------
+ Version 5.003_97b
+-------------------
+
+Working on the second public beta...
+
+ CORE LANGUAGE CHANGES
+
+  Title:  "Make assignment to C<$)> call setgroups()"
+   From:  Chip Salzenberg
+  Files:  Configure config_H config_h.SH mg.c plan9/config.plan9
+          pod/perldelta.pod vms/config.vms win32/config.H
+          win32/config.w32
+
+  Title:  "Grandfather "$$<digit>" in strings"
+   From:  Chip Salzenberg
+  Files:  pod/perldiag.pod toke.c
+
+  Title:  "Disconnect warn and die hooks _after_ object destruction"
+   From:  Chip Salzenberg
+  Files:  perl.c
+
+  Title:  "Forbid recursive substitutions"
+   From:  Chip Salzenberg
+  Files:  cop.h pod/perldelta.pod pod/perldiag.pod pp_ctl.c pp_hot.c
+
+ CORE PORTABILITY
+
+  Title:  "Use SSize_t for values of PerlIO_{read,write}"
+   From:  Chip Salzenberg
+  Files:  perlio.c perlio.h perlsdio.h pp_sys.c
+
+  Title:  "perlwin-97a_4: win32 environ fix"
+   From:  Gurusamy Sarathy
+ Msg-ID:  <199704060431.XAA23400@aatma.engin.umich.edu>
+   Date:  Sat, 05 Apr 1997 23:31:11 -0500
+  Files:  win32/win32.c win32/win32io.c win32/win32io.h win32/win32iop.h
+
+ OTHER CORE CHANGES
+
+  Title:  "length($') isn't"
+   From:  Gurusamy Sarathy
+ Msg-ID:  <199704070730.DAA07310@aatma.engin.umich.edu>
+   Date:  Mon, 07 Apr 1997 03:30:44 -0400
+  Files:  mg.c
+
+  Title:  "Fix obscure regex bug related to leading C<.*>"
+   From:  Chip Salzenberg
+  Files:  toke.c
+
+  Title:  "Add warning for glob failure"
+   From:  Chip Salzenberg
+  Files:  pod/perldelta.pod pod/perldiag.pod pp_hot.c
+
+  Title:  "Fix C<perl -V> in presence of local patches"
+   From:  Chip Salzenberg
+  Files:  perl.c
+
+ BUILD PROCESS
+
+  Title:  "Don't suggest 'Configure -der' in config.sh comments"
+   From:  Chip Salzenberg
+  Files:  Configure
+
+ LIBRARY AND EXTENSIONS
+
+  Title:  "CGI->redirect patch"
+   From:  Doug MacEachern
+ Msg-ID:  <199704051527.KAA11280@postman.osf.org>
+   Date:  Sat, 05 Apr 1997 10:27:52 -0500
+  Files:  lib/CGI.pm
+
+  Title:  "Updates to Math::Complex and Math::Trig"
+   From:  Jarkko Hietaniemi
+  Files:  lib/Math/Complex.pm lib/Math/Trig.pm pod/perldelta.pod
+          t/lib/complex.t
+
+  Title:  "Fix FindBin under Win32, and document success"
+   From:  Nick Ing-Simmons and Gurusamy Sarathy
+ Msg-ID:  <199704051504.QAA09507@ni-s.u-net.com>
+   Date:  Sat, 5 Apr 1997 16:04:52 +0100
+  Files:  README.win32 lib/Cwd.pm lib/FindBin.pm
+
+ TESTS
+
+   (no other changes)
+
+ UTILITIES
+
+  Title:  "Patch for 'perldoc -f'"
+   From:  Gisle Aas
+ Msg-ID:  <199704061732.TAA00353@bergen.sn.no>
+   Date:  Sun, 6 Apr 1997 19:32:04 +0200
+  Files:  utils/perldoc.PL
+
+ DOCUMENTATION
+
+  Title:  "Document required module versions"
+   From:  Chip Salzenberg
+  Files:  pod/perldelta.pod
+
+  Title:  "Document sample function perl_eval()"
+   From:  Doug MacEachern
+ Msg-ID:  <199704051524.KAA06090@postman.osf.org>
+   Date:  Sat, 05 Apr 1997 10:24:43 -0500
+  Files:  pod/perlcall.pod pod/perlembed.pod
+
+  Title:  "Make L<perltrap> refer to L<perldelta>"
+   From:  Chip Salzenberg
+  Files:  pod/perltrap.pod
+
+
+-------------------
  Version 5.003_97a
 -------------------
 
@@ -265,7 +378,7 @@ planning on making 5.003_98 the second public beta.
 
  TESTS
 
-   (no changes)
+   (no other changes)
 
  UTILITIES
 
@@ -485,7 +598,7 @@ planning on making 5.003_98 the second public beta.
 
  TESTS
 
-   (no changes)
+   (no other changes)
 
  UTILITIES
 
@@ -643,7 +756,7 @@ planning on making 5.003_98 the second public beta.
 
  BUILD PROCESS
 
-   (no changes)
+   (no other changes)
 
  LIBRARY AND EXTENSIONS
 
@@ -1011,7 +1124,7 @@ planning on making 5.003_98 the second public beta.
 
  TESTS
 
-   (no changes)
+   (no other changes)
 
  UTILITIES
 
@@ -3898,7 +4011,7 @@ updates.  We'll get to 5.004 RSN, I promise.  :-)
  CORE PORTABILITY
 
   Title:  "_13: patches for unicos/unicosmk"
-   From:  Dean Roehrich <roehrich@cray.com>
+   From:  Dean Roehrich
  Msg-ID:  <199612202038.OAA22805@poplar.cray.com>
    Date:  Fri, 20 Dec 1996 14:38:50 -0600
   Files:  Configure MANIFEST hints/unicos.sh hints/unicosmk.sh
@@ -7975,7 +8088,7 @@ Index: utils/h2ph.PL
 Index: utils/h2xs.PL
 
     Date: Sat, 21 Sep 1996 16:38:24 -0500
-    From: Dean Roehrich <roehrich@cray.com>
+    From: Dean Roehrich
     Subject: h2xs bug fix
 
     The h2xs that is in perl5.003_05 has a regexp bug which prevents it from
index 43fb081..88ba08d 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -304,6 +304,7 @@ d_ftime=''
 d_gettimeod=''
 d_Gconvert=''
 d_getgrps=''
+d_setgrps=''
 d_gethent=''
 aphostname=''
 d_gethname=''
@@ -8490,20 +8491,24 @@ gidtype="$ans"
 set getgroups d_getgrps
 eval $inlibc
 
-: Find type of 2nd arg to getgroups
+: see if setgroups exists
+set setgroups d_setgrps
+eval $inlibc
+
+: Find type of 2nd arg to getgroups (and setgroups)
 echo " "
-case "$d_getgrps" in
-'define')
+case "$d_getgrps$d_setgrps" in
+*define*)
        case "$groupstype" in
        '') dflt="$gidtype" ;;
        *)  dflt="$groupstype" ;;
        esac
        $cat <<EOM
-What is the type of the second argument to getgroups()?  Usually this
-is the same as group ids, $gidtype, but not always.
+What is the type of the second argument to getgroups() and setgroups()?
+Usually this is the same as group ids, $gidtype, but not always.
 
 EOM
-       rp='What type is the second argument to getgroups()?'
+       rp='What type is the second argument to getgroups() and setgroups()?'
        . ./myread
        groupstype="$ans"
        ;;
@@ -9921,10 +9926,10 @@ echo "Creating config.sh..." >&4
 $spitshell <<EOT >config.sh
 $startsh
 #
-# This file was produced by running the Configure script. It holds all the
-# definitions figured out by Configure. Should you modify one of these values,
-# do not forget to propagate your changes by running "Configure -der". You may
-# instead choose to run each of the .SH files by yourself, or "Configure -S".
+# This file was produced by running the Configure script.  It holds all
+# the definitions figured out by Configure.  Should you modify any of
+# these values, do not forget to propagate your changes by running
+# "Configure -S"; or, equivalently, you may run each .SH file yourself.
 #
 
 # Configuration time: $cf_time
@@ -10035,6 +10040,7 @@ d_fpathconf='$d_fpathconf'
 d_fsetpos='$d_fsetpos'
 d_ftime='$d_ftime'
 d_getgrps='$d_getgrps'
+d_setgrps='$d_setgrps'
 d_gethent='$d_gethent'
 d_gethname='$d_gethname'
 d_getlogin='$d_getlogin'
index fbc1206..87fc608 100644 (file)
--- a/config_H
+++ b/config_H
  *     available to get the list of process groups.  If unavailable, multiple
  *     groups are probably not supported.
  */
+/* HAS_SETGROUPS:
+ *     This symbol, if defined, indicates that the setgroups() routine is
+ *     available to set the list of process groups.  If unavailable, multiple
+ *     groups are probably not supported.
+ */
 #define HAS_GETGROUPS          /**/
+#define HAS_SETGROUPS          /**/
 
 /* HAS_GETHOSTENT:
  *     This symbol, if defined, indicates that the gethostent routine is
 
 /* Groups_t:
  *     This symbol holds the type used for the second argument to
- *     getgroups().  Usually, this is the same of gidtype, but
+ *     [gs]etgroups().  Usually, this is the same of gidtype, but
  *     sometimes it isn't.  It can be int, ushort, uid_t, etc... 
  *     It may be necessary to include <sys/types.h> to get any 
  *     typedef'ed information.  This is only required if you have
- *     getgroups().
+ *     getgroups() or setgroups().
  */
-#ifdef HAS_GETGROUPS
-#define Groups_t gid_t /* Type for 2nd arg to getgroups() */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */
 #endif
 
 /* DB_Prefix_t:
index 23cb896..938cf51 100755 (executable)
@@ -298,7 +298,13 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
  *     available to get the list of process groups.  If unavailable, multiple
  *     groups are probably not supported.
  */
+/* HAS_SETGROUPS:
+ *     This symbol, if defined, indicates that the setgroups() routine is
+ *     available to set the list of process groups.  If unavailable, multiple
+ *     groups are probably not supported.
+ */
 #$d_getgrps HAS_GETGROUPS              /**/
+#$d_setgrps HAS_SETGROUPS              /**/
 
 /* HAS_GETHOSTENT:
  *     This symbol, if defined, indicates that the gethostent routine is
@@ -990,14 +996,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
 
 /* Groups_t:
  *     This symbol holds the type used for the second argument to
- *     getgroups().  Usually, this is the same of gidtype, but
+ *     [gs]etgroups().  Usually, this is the same of gidtype, but
  *     sometimes it isn't.  It can be int, ushort, uid_t, etc... 
  *     It may be necessary to include <sys/types.h> to get any 
  *     typedef'ed information.  This is only required if you have
- *     getgroups().
+ *     getgroups() or setgroups().
  */
-#ifdef HAS_GETGROUPS
-#define Groups_t $groupstype   /* Type for 2nd arg to getgroups() */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t $groupstype   /* Type for 2nd arg to [gs]etgroups() */
 #endif
 
 /* DB_Prefix_t:
diff --git a/cop.h b/cop.h
index 72a9483..3383ceb 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -241,6 +241,7 @@ struct subst {
        cx->sb_s                = s,                                    \
        cx->sb_m                = m,                                    \
        cx->sb_strend           = strend,                               \
+       cx->sb_subbase          = Nullch,                               \
        cx->sb_rx               = rx,                                   \
        cx->cx_type             = CXt_SUBST
 
index 9000543..20762bd 100644 (file)
@@ -2,7 +2,7 @@
 #
 # Complex numbers and associated mathematical functions
 # -- Raphael Manfredi, September 1996
-# -- Jarkko Hietaniemi, March 1997
+# -- Jarkko Hietaniemi, March-April 1997
 
 require Exporter;
 package Math::Complex;
@@ -12,7 +12,7 @@ use strict;
 use vars qw($VERSION @ISA
            @EXPORT %EXPORT_TAGS
            $package $display
-           $pi $i $ilog10 $logn %logn);
+           $i $logn %logn);
 
 @ISA = qw(Exporter);
 
@@ -20,7 +20,7 @@ $VERSION = 1.01;
 
 my @trig = qw(
              pi
-             tan
+             sin cos tan
              csc cosec sec cot cotan
              asin acos atan
              acsc acosec asec acot acotan
@@ -135,10 +135,16 @@ sub cplxe {
 #
 # The number defined as 2 * pi = 360 degrees
 #
-sub pi () {
-       $pi = 4 * atan2(1, 1) unless $pi;
-       return $pi;
-}
+
+use constant pi => 4 * atan2(1, 1);
+
+#
+# log2inv
+#
+# Used in log10().
+#
+
+use constant log10inv => 1 / log(10);
 
 #
 # i
@@ -146,9 +152,10 @@ sub pi () {
 # The number defined as i*i = -1;
 #
 sub i () {
-       $i = bless {} unless $i;                # There can be only one i
+        return $i if ($i);
+       $i = bless {};
        $i->{'cartesian'} = [0, 1];
-       $i->{'polar'} = [1, pi/2];
+       $i->{'polar'}     = [1, pi/2];
        $i->{c_dirty} = 0;
        $i->{p_dirty} = 0;
        return $i;
@@ -199,9 +206,8 @@ sub update_polar {
 #
 sub plus {
        my ($z1, $z2, $regular) = @_;
-       $z2 = cplx($z2, 0) unless ref $z2;
        my ($re1, $im1) = @{$z1->cartesian};
-       my ($re2, $im2) = @{$z2->cartesian};
+       my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
        unless (defined $regular) {
                $z1->set_cartesian([$re1 + $re2, $im1 + $im2]);
                return $z1;
@@ -216,9 +222,8 @@ sub plus {
 #
 sub minus {
        my ($z1, $z2, $inverted) = @_;
-       $z2 = cplx($z2, 0) unless ref $z2;
        my ($re1, $im1) = @{$z1->cartesian};
-       my ($re2, $im2) = @{$z2->cartesian};
+       my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
        unless (defined $inverted) {
                $z1->set_cartesian([$re1 - $re2, $im1 - $im2]);
                return $z1;
@@ -251,12 +256,19 @@ sub multiply {
 # Die on division by zero.
 #
 sub divbyzero {
-    warn "$_[0]: Division by zero.\n";
-    warn "(Because in the definition of $_[0], $_[1] is 0)\n"
-       if (defined $_[1]);
+    my $mess = "$_[0]: Division by zero.\n";
+
+    if (defined $_[1]) {
+       $mess .= "(Because in the definition of $_[0], the divisor ";
+       $mess .= "$_[1] " unless ($_[1] eq '0');
+       $mess .= "is 0)\n";
+    }
+
     my @up = caller(1);
-    my $dmess = "Died at $up[1] line $up[2].\n";
-    die $dmess;
+    
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
 }
 
 #
@@ -302,9 +314,8 @@ sub power {
 #
 sub spaceship {
        my ($z1, $z2, $inverted) = @_;
-       $z2 = cplx($z2, 0) unless ref $z2;
-       my ($re1, $im1) = @{$z1->cartesian};
-       my ($re2, $im2) = @{$z2->cartesian};
+       my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
+       my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
        my $sgn = $inverted ? -1 : 1;
        return $sgn * ($re1 <=> $re2) if $re1 != $re2;
        return $sgn * ($im1 <=> $im2);
@@ -459,8 +470,8 @@ sub exp {
 sub log {
        my ($z) = @_;
        $z = cplx($z, 0) unless ref $z;
-       my ($r, $t) = @{$z->polar};
        my ($x, $y) = @{$z->cartesian};
+       my ($r, $t) = @{$z->polar};
        $t -= 2 * pi if ($t >  pi() and $x < 0);
        $t += 2 * pi if ($t < -pi() and $x < 0);
        return (ref $z)->make(log($r), $t);
@@ -478,12 +489,13 @@ sub ln { Math::Complex::log(@_) }
 #
 # Compute log10(z).
 #
+
 sub log10 {
        my ($z) = @_;
-       my $ilog10 = 1 / log(10) unless defined $ilog10;
-       return log(cplx($z, 0)) * $ilog10 unless ref $z;
+
+       return log(cplx($z, 0)) * log10inv unless ref $z;
        my ($r, $t) = @{$z->polar};
-       return (ref $z)->make(log($r) * $ilog10, $t * $ilog10);
+       return (ref $z)->make(log($r) * log10inv, $t * log10inv);
 }
 
 #
@@ -506,6 +518,7 @@ sub logn {
 #
 sub cos {
        my ($z) = @_;
+       $z = cplx($z, 0) unless ref $z;
        my ($x, $y) = @{$z->cartesian};
        my $ey = exp($y);
        my $ey_1 = 1 / $ey;
@@ -520,6 +533,7 @@ sub cos {
 #
 sub sin {
        my ($z) = @_;
+       $z = cplx($z, 0) unless ref $z;
        my ($x, $y) = @{$z->cartesian};
        my $ey = exp($y);
        my $ey_1 = 1 / $ey;
@@ -618,6 +632,7 @@ sub asin {
 #
 sub atan {
        my ($z) = @_;
+       $z = cplx($z, 0) unless ref $z;
        divbyzero "atan($z)", "i - $z" if ($z == i);
        return i/2*log((i + $z) / (i - $z));
 }
@@ -629,25 +644,27 @@ sub atan {
 #
 sub asec {
        my ($z) = @_;
+       divbyzero "asec($z)", $z if ($z == 0);
        return acos(1 / $z);
 }
 
 #
-# acosec
+# acsc
 #
 # Computes the arc cosecant sec(z) = asin(1 / z).
 #
-sub acosec {
+sub acsc {
        my ($z) = @_;
+       divbyzero "acsc($z)", $z if ($z == 0);
        return asin(1 / $z);
 }
 
 #
-# acsc
+# acosec
 #
-# Alias for acosec().
+# Alias for acsc().
 #
-sub acsc { Math::Complex::acosec(@_) }
+sub acosec { Math::Complex::acsc(@_) }
 
 #
 # acot
@@ -656,6 +673,7 @@ sub acsc { Math::Complex::acosec(@_) }
 #
 sub acot {
        my ($z) = @_;
+       $z = cplx($z, 0) unless ref $z;
        divbyzero "acot($z)", "$z - i" if ($z == i);
        return i/-2 * log((i + $z) / ($z - i));
 }
@@ -674,8 +692,7 @@ sub acotan { Math::Complex::acot(@_) }
 #
 sub cosh {
        my ($z) = @_;
-       $z = cplx($z, 0) unless ref $z;
-       my ($x, $y) = @{$z->cartesian};
+       my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
        my $ex = exp($x);
        my $ex_1 = 1 / $ex;
        return ($ex + $ex_1)/2 unless ref $z;
@@ -690,8 +707,7 @@ sub cosh {
 #
 sub sinh {
        my ($z) = @_;
-       $z = cplx($z, 0) unless ref $z;
-       my ($x, $y) = @{$z->cartesian};
+       my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
        my $ex = exp($x);
        my $ex_1 = 1 / $ex;
        return ($ex - $ex_1)/2 unless ref $z;
@@ -768,7 +784,7 @@ sub cotanh { Math::Complex::coth(@_) }
 #
 sub acosh {
        my ($z) = @_;
-       $z = cplx($z, 0) unless ref $z; # asinh(-2)
+       $z = cplx($z, 0) unless ref $z;
        return log($z + sqrt($z*$z - 1));
 }
 
@@ -779,7 +795,7 @@ sub acosh {
 #
 sub asinh {
        my ($z) = @_;
-       $z = cplx($z, 0) unless ref $z; # asinh(-2)
+       $z = cplx($z, 0) unless ref $z;
        return log($z + sqrt($z*$z + 1));
 }
 
@@ -790,8 +806,8 @@ sub asinh {
 #
 sub atanh {
        my ($z) = @_;
-       $z = cplx($z, 0) unless ref $z; # atanh(-2)
        divbyzero 'atanh(1)', "1 - $z" if ($z == 1);
+       $z = cplx($z, 0) unless ref $z;
        my $cz = (1 + $z) / (1 - $z);
        return log($cz) / 2;
 }
@@ -832,8 +848,8 @@ sub acosech { Math::Complex::acsch(@_) }
 #
 sub acoth {
        my ($z) = @_;
-       $z = cplx($z, 0) unless ref $z; # acoth(-2)
        divbyzero 'acoth(1)', "$z - 1" if ($z == 1);
+       $z = cplx($z, 0) unless ref $z;
        my $cz = (1 + $z) / ($z - 1);
        return log($cz) / 2;
 }
@@ -852,8 +868,8 @@ sub acotanh { Math::Complex::acoth(@_) }
 #
 sub atan2 {
        my ($z1, $z2, $inverted) = @_;
-       my ($re1, $im1) = @{$z1->cartesian};
-       my ($re2, $im2) = @{$z2->cartesian};
+       my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
+       my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
        my $tan;
        if (defined $inverted && $inverted) {   # atan(z2/z1)
                return pi * ($re2 > 0 ? 1 : -1) if $re1 == 0 && $im1 == 0;
@@ -1341,7 +1357,7 @@ Here are some examples:
        $k = exp(i * 2*pi/3);
        print "$j - $k = ", $j - $k, "\n";
 
-=head1 CAVEATS
+=head1 ERRORS DUE TO DIVISION BY ZERO
 
 The division (/) and the following functions
 
@@ -1349,6 +1365,8 @@ The division (/) and the following functions
        sec
        csc
        cot
+       asec
+       acsc
        atan
        acot
        tanh
@@ -1364,13 +1382,22 @@ cannot be computed for all arguments because that would mean dividing
 by zero. These situations cause fatal runtime errors looking like this
 
        cot(0): Division by zero.
-       (Because in the definition of cot(0), sin(0) is 0)
+       (Because in the definition of cot(0), the divisor sin(0) is 0)
        Died at ...
 
+For the C<csc>, C<cot>, C<asec>, C<acsc>, C<csch>, C<coth>, C<asech>,
+C<acsch>, the argument cannot be C<0> (zero). For the C<atanh>,
+C<acoth>, the argument cannot be C<1> (one). For the C<atan>, C<acot>,
+the argument cannot be C<i> (the imaginary unit).  For the C<tan>,
+C<sec>, C<tanh>, C<sech>, the argument cannot be I<pi/2 + k * pi>, where
+I<k> is any integer.
+
 =head1 BUGS
 
-Saying C<use Math::Complex;> exports many mathematical routines in the caller
-environment.  This is construed as a feature by the Author, actually... ;-)
+Saying C<use Math::Complex;> exports many mathematical routines in the
+caller environment and even overrides some (C<sin>, C<cos>, C<sqrt>,
+C<log>, C<exp>).  This is construed as a feature by the Authors,
+actually... ;-)
 
 The code is not optimized for speed, although we try to use the cartesian
 form for addition-like operators and the trigonometric form for all
@@ -1388,3 +1415,7 @@ operation (for instance) between two overloaded entities.
 
        Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>
        Jarkko Hietaniemi <F<jhi@iki.fi>>
+
+=cut
+
+# eof
index 7c3570c..4098f34 100644 (file)
@@ -1,6 +1,7 @@
 #
 # Trigonometric functions, mostly inherited from Math::Complex.
 # -- Jarkko Hietaniemi, April 1997
+# -- Raphael Manfredi, September 1996 (indirectly: because of Math::Complex)
 #
 
 require Exporter;
@@ -12,8 +13,7 @@ use Math::Complex qw(:trig);
 
 use vars qw($VERSION $PACKAGE
            @ISA
-           @EXPORT
-           $pi2 $DR $RD $DG $GD $RG $GR);
+           @EXPORT);
 
 @ISA = qw(Exporter);
 
@@ -26,40 +26,13 @@ my @angcnv = qw(rad_to_deg rad_to_grad
 @EXPORT = (@{$Math::Complex::EXPORT_TAGS{'trig'}},
           @angcnv);
 
-sub pi2 () {
-    $pi2 = 2 * pi unless ($pi2);
-    $pi2;
-}
-
-sub DR () {
-    $DR = pi2/360 unless ($DR);
-    $DR;
-}
-
-sub RD () {
-    $RD = 360/pi2 unless ($RD);
-    $RD;
-}
-
-sub DG () {
-    $DG = 400/360 unless ($DG);
-    $DG;
-}
-
-sub GD () {
-    $GD = 360/400 unless ($GD);
-    $GD;
-}
-
-sub RG () {
-    $RG = 400/pi2 unless ($RG);
-    $RG;
-}
-
-sub GR () {
-    $GR = pi2/400 unless ($GR);
-    $GR;
-}
+use constant pi2 => 2 * pi;
+use constant DR  => pi2/360;
+use constant RD  => 360/pi2;
+use constant DG  => 400/360;
+use constant GD  => 360/400;
+use constant RG  => 400/pi2;
+use constant GR  => pi2/400;
 
 #
 # Truncating remainder.
@@ -74,29 +47,17 @@ sub remt ($$) {
 # Angle conversions.
 #
 
-sub rad_to_deg ($) {
-    remt(RD * $_[0], 360);
-}
+sub rad_to_deg ($)  { remt(RD * $_[0], 360) }
 
-sub deg_to_rad ($) {
-    remt(DR * $_[0], pi2);
-}
+sub deg_to_rad ($)  { remt(DR * $_[0], pi2) }
 
-sub grad_to_deg ($) {
-    remt(GD * $_[0], 360);
-}
+sub grad_to_deg ($) { remt(GD * $_[0], 360) }
 
-sub deg_to_grad ($) {
-    remt(DG * $_[0], 400);
-}
+sub deg_to_grad ($) { remt(DG * $_[0], 400) }
 
-sub rad_to_grad ($) {
-    remt(RG * $_[0], 400);
-}
+sub rad_to_grad ($) { remt(RG * $_[0], 400) }
 
-sub grad_to_rad ($) {
-    remt(GR * $_[0], pi2);
-}
+sub grad_to_rad ($) { remt(GR * $_[0], pi2) }
 
 =head1 NAME
 
@@ -169,7 +130,39 @@ The trigonometric constant B<pi> is also defined.
 
        $pi2 = 2 * pi;
 
-=head2 SIMPLE ARGUMENTS, COMPLEX RESULTS
+=head2 ERRORS DUE TO DIVISION BY ZERO
+
+The following functions
+
+       tan
+       sec
+       csc
+       cot
+       asec
+       acsc
+       tanh
+       sech
+       csch
+       coth
+       atanh
+       asech
+       acsch
+       acoth
+
+cannot be computed for all arguments because that would mean dividing
+by zero. These situations cause fatal runtime errors looking like this
+
+       cot(0): Division by zero.
+       (Because in the definition of cot(0), the divisor sin(0) is 0)
+       Died at ...
+
+For the C<csc>, C<cot>, C<asec>, C<acsc>, C<csch>, C<coth>, C<asech>,
+C<acsch>, the argument cannot be C<0> (zero). For the C<atanh>,
+C<acoth>, the argument cannot be C<1> (one). For the C<tan>, C<sec>,
+C<tanh>, C<sech>, the argument cannot be I<pi/2 + k * pi>, where I<k> is
+any integer.
+
+=head2 SIMPLE (REAL) ARGUMENTS, COMPLEX RESULTS
 
 Please note that some of the trigonometric functions can break out
 from the B<real axis> into the B<complex plane>. For example
@@ -193,8 +186,8 @@ should produce something like this (take or leave few last decimals):
 
        1.5707963267949-1.31695789692482i
 
-That is, a complex number with the real part of approximately E<1.571>
-and the imaginary part of approximately E<-1.317>.
+That is, a complex number with the real part of approximately C<1.571>
+and the imaginary part of approximately C<-1.317>.
 
 =head1 ANGLE CONVERSIONS
 
@@ -209,33 +202,24 @@ and the imaginary part of approximately E<-1.317>.
        $gradians = deg_to_grad($degrees);
        $gradians = rad_to_grad($radians);
 
-The full circle is 2 B<pi> radians or E<360> degrees or E<400> gradians.
+The full circle is 2 I<pi> radians or I<360> degrees or I<400> gradians.
 
-=head1
+=head1 BUGS
 
-The following functions
+Saying C<use Math::Trig;> exports many mathematical routines in the
+caller environment and even overrides some (C<sin>, C<cos>).  This is
+construed as a feature by the Authors, actually... ;-)
 
-       tan
-       sec
-       csc
-       cot
-       atan
-       acot
-       tanh
-       sech
-       csch
-       coth
-       atanh
-       asech
-       acsch
-       acoth
+The code is not optimized for speed, especially because we use
+C<Math::Complex> and thus go quite near complex numbers while doing
+the computations even when the arguments are not. This, however,
+cannot be completely avoided if we want things like C<asin(2)> to give
+an answer instead of giving a fatal runtime error.
 
-cannot be computed for all arguments because that would mean dividing
-by zero. These situations cause fatal runtime errors looking like this
+=head1 AUTHORS
 
-       cot(0): Division by zero.
-       (Because in the definition of cot(0), sin(0) is 0)
-       Died at ...
+       Jarkko Hietaniemi <F<jhi@iki.fi>>
+       Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>
 
 =cut
 
diff --git a/mg.c b/mg.c
index f1dc828..54ca044 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -20,7 +20,7 @@
 # include <unistd.h>
 #endif
 
-#ifdef HAS_GETGROUPS
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
 #  ifndef NGROUPS
 #    define NGROUPS 32
 #  endif
@@ -307,7 +307,7 @@ MAGIC *mg;
            if (rx->subend && (s = rx->endp[0])) {
                i = rx->subend - s;
                if (i >= 0)
-                   return 0;
+                   return i;
            }
        }
        return 0;
@@ -1518,7 +1518,29 @@ MAGIC* mg;
        tainting |= (uid && (euid != uid || egid != gid));
        break;
     case ')':
+#ifdef HAS_SETGROUPS
+       {
+           char *p = SvPV(sv, na);
+           Groups_t gary[NGROUPS];
+
+           SET_NUMERIC_STANDARD();
+           while (isSPACE(*p))
+               ++p;
+           egid = I_V(atof(p));
+           for (i = 0; i < NGROUPS; ++i) {
+               while (*p && !isSPACE(*p))
+                   ++p;
+               while (isSPACE(*p))
+                   ++p;
+               if (!*p)
+                   break;
+               gary[i] = I_V(atof(p));
+           }
+           (void)setgroups(i, gary);
+       }
+#else  /* HAS_SETGROUPS */
        egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+#endif /* HAS_SETGROUPS */
        if (delaymagic) {
            delaymagic |= DM_EGID;
            break;                              /* don't do magic till later */
index 6cc0f69..e768691 100644 (file)
@@ -39,6 +39,7 @@
 static char    *local_patches[] = {
        NULL
        ,"Dev97A - First development patch to 5.003_97"
+       ,"Dev97B - Second development patch to 5.003_97"
        ,NULL
 };
 
diff --git a/perl.c b/perl.c
index 2b53a81..7ffd52a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -195,14 +195,6 @@ register PerlInterpreter *sv_interp;
     }
 #endif
 
-    /* unhook hooks which will soon be, or use, destroyed data */
-    SvREFCNT_dec(warnhook);
-    warnhook = Nullsv;
-    SvREFCNT_dec(diehook);
-    diehook = Nullsv;
-    SvREFCNT_dec(parsehook);
-    parsehook = Nullsv;
-
     LEAVE;
     FREETMPS;
 
@@ -229,6 +221,14 @@ register PerlInterpreter *sv_interp;
        sv_clean_objs();
     }
 
+    /* unhook hooks which will soon be, or use, destroyed data */
+    SvREFCNT_dec(warnhook);
+    warnhook = Nullsv;
+    SvREFCNT_dec(diehook);
+    diehook = Nullsv;
+    SvREFCNT_dec(parsehook);
+    parsehook = Nullsv;
+
     if (destruct_level == 0){
 
        DEBUG_P(debprofdump());
@@ -645,7 +645,7 @@ setuid perl scripts securely.\n");
 #if defined(LOCAL_PATCH_COUNT)
                if (LOCAL_PATCH_COUNT > 0) {
                    int i;
-                   sv_catpv(Sv,"print \"  Locally applied patches:\\n\",");
+                   sv_catpv(Sv,"\"  Locally applied patches:\\n\",");
                    for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
                        if (localpatches[i]) {
                            sprintf(buf,"\"  \\t%s\\n\",",localpatches[i]);
index 9965c73..463c094 100644 (file)
  *     available to get the list of process groups.  If unavailable, multiple
  *     groups are probably not supported.
  */
+/* HAS_SETGROUPS:
+ *     This symbol, if defined, indicates that the setgroups() routine is
+ *     available to set the list of process groups.  If unavailable, multiple
+ *     groups are probably not supported.
+ */
 #undef HAS_GETGROUPS           /* config-skip */
+#undef HAS_SETGROUPS           /* config-skip */
 
 /* HAS_GETHOSTENT:
  *     This symbol, if defined, indicates that the gethostent routine is
 
 /* Groups_t:
  *     This symbol holds the type used for the second argument to
- *     getgroups().  Usually, this is the same of gidtype, but
+ *     [gs]etgroups().  Usually, this is the same of gidtype, but
  *     sometimes it isn't.  It can be int, ushort, uid_t, etc... 
  *     It may be necessary to include <sys/types.h> to get any 
  *     typedef'ed information.  This is only required if you have
- *     getgroups().
+ *     getgroups() or setgroups().
  */
-#ifdef HAS_GETGROUPS
-#define Groups_t gid_t /* Type for 2nd arg to getgroups() */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */
 #endif
 
 /* DB_Prefix_t:
index 0d3dd84..1447fd4 100644 (file)
@@ -84,13 +84,30 @@ After this code executes in Perl 5.004, $a{b} exists but $a[2] does
 not.  In Perl 5.002 and 5.003, both $a{b} and $a[2] would have existed
 (but $a[2]'s value would have been undefined).
 
+=head2 C<$)> is writable
+
+The C<$)> special variable has always (well, in Perl 5, at least)
+reflected not only the current effective group, but also the group
+list as returned by the C<getgroups()> C function (if there is one).
+However, due to an oversight, assigning to C<$)> has not called
+C<setgroups()>, only C<setegid()>.
+
+In Perl 5.004, assigning to C<$)> is exactly symmetrical with
+examining it: The first number in its string value is used as the
+effective gid, and all the others are passed to the C<setgroups()> C
+function (if there is one).
+
 =head2 Fixed parsing of $$<digit>, &$<digit>, etc.
 
-A bug in previous versions of Perl 5.0 prevented proper parsing of
-numeric special variables as symbolic references.  That bug has been
-fixed.  As a result, the string "$$0" is no longer equivalent to
-C<$$."0">, but rather to C<${$0}>.  To get the old behavior, change
-"$$" followed by a digit to "${$}".
+Perl versions before 5.004 misinterpreted any type marker followed by
+"$" and a digit.  For example, "$$0" was incorrectly taken to mean
+"${$}0" instead of "${$0}".  This bug is (mostly) fixed in Perl 5.004.
+
+However, the developers of Perl 5.004 could not fix this bug completely,
+because at least two widely-used modules depend on the old meaning of
+"$$0" in a string.  So Perl 5.004 still interprets "$$<digit>" in the
+old (broken) way inside strings; but it generates this message as a
+warning.  And in Perl 5.005, this special treatment will cease.
 
 =head2 No resetting of $. on implicit close
 
@@ -600,6 +617,17 @@ relative to the local time zone, in the VMS tradition.
 
 =head1 Modules
 
+=head2 Required Updates
+
+Though Perl 5.004 is compatible with almost all modules that work
+with Perl 5.003, there are a few exceptions:
+
+    Module   Required Version for Perl 5.004
+    ------   -------------------------------
+    Filter   1.12
+    LWP      5.08
+    Tk       Tk400.202 (-w makes noise)
+
 =head2 Installation directories
 
 The I<installperl> script now places the Perl source files for
@@ -698,14 +726,20 @@ more operations.  These are overloaded:
 And these functions are now exported:
 
     pi i Re Im arg
-    log10 logn cbrt root
-    tan cotan asin acos atan acotan
-    sinh cosh tanh cotanh asinh acosh atanh acotanh
+    log10 logn ln cbrt root
+    tan
+    csc sec cot
+    asin acos atan
+    acsc asec acot
+    sinh cosh tanh
+    csch sech coth
+    asinh acosh atanh
+    acsch asech acoth
     cplx cplxe
 
 =head2 Math::Trig
 
-This module provides a simpler interface to parts of Math::Complex for
+This new module provides a simpler interface to parts of Math::Complex for
 those who need trigonometric functions only for real numbers.
 
 =head2 DB_File
@@ -994,6 +1028,17 @@ architecture. On a 32-bit architecture the largest hex literal is
 architecture. On a 32-bit architecture the largest octal literal is
 037777777777.
 
+=item internal error: glob failed
+
+(P) Something went wrong with the external program(s) used for C<glob>
+and C<E<lt>*.cE<gt>>.  This may mean that your csh (C shell) is
+broken.  If so, you should change all of the csh-related variables in
+config.sh:  If you have tcsh, make the variables refer to it as if it
+were csh (e.g. C<full_csh='/usr/bin/tcsh'>); otherwise, make them all
+empty (except that C<d_csh> should be C<'undef'>) so that Perl will
+think csh is missing.  In either case, after editing config.sh, run
+C<./Configure -S> and rebuild Perl.
+
 =item Name "%s::%s" used only once: possible typo
 
 (W) Typographical errors often show up as unique variable names.
@@ -1078,6 +1123,12 @@ commas if you don't want them to appear in your data:
 
     qw! a b c !;
 
+=item Recursive substitution detected
+
+(F) The replacement string of a substitution caused the recursive
+execution of that very same substituion.  Perl cannot keep track of
+special variables (C<$1>, etc.) under such circumstances.
+
 =item Scalar value @%s{%s} better written as $%s{%s}
 
 (W) You've used a hash slice (indicated by @) to select a single element of
@@ -1120,6 +1171,18 @@ Note that under some systems, like OS/2, there may be different flavors of
 Perl executables, some of which may support fork, some not. Try changing
 the name you call Perl by to C<perl_>, C<perl__>, and so on.
 
+=item Use of "$$<digit>" to mean "${$}<digit>" is deprecated
+
+(D) Perl versions before 5.004 misinterpreted any type marker followed
+by "$" and a digit.  For example, "$$0" was incorrectly taken to mean
+"${$}0" instead of "${$0}".  This bug is (mostly) fixed in Perl 5.004.
+
+However, the developers of Perl 5.004 could not fix this bug completely,
+because at least two widely-used modules depend on the old meaning of
+"$$0" in a string.  So Perl 5.004 still interprets "$$<digit>" in the
+old (broken) way inside strings; but it generates this message as a
+warning.  And in Perl 5.005, this special treatment will cease.
+
 =item Value of %s can be "0"; test with defined()
 
 (W) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>,
index 89c8a2a..0543595 100644 (file)
@@ -1203,6 +1203,17 @@ and execute the specified command.
 
 (P) Something went badly wrong in the regular expression parser.
 
+=item internal error: glob failed
+
+(P) Something went wrong with the external program(s) used for C<glob>
+and C<E<lt>*.cE<gt>>.  This may mean that your csh (C shell) is
+broken.  If so, you should change all of the csh-related variables in
+config.sh:  If you have tcsh, make the variables refer to it as if it
+were csh (e.g. C<full_csh='/usr/bin/tcsh'>); otherwise, make them all
+empty (except that C<d_csh> should be C<'undef'>) so that Perl will
+think csh is missing.  In either case, after editing config.sh, run
+C<./Configure -S> and rebuild Perl.
+
 =item internal urp in regexp at /%s/
 
 (P) Something went badly awry in the regular expression parser.
@@ -1897,6 +1908,12 @@ which is why it's currently left out of your copy.
 (F) More than 100 levels of inheritance were used.  Probably indicates
 an unintended loop in your inheritance hierarchy.
 
+=item Recursive substitution detected
+
+(F) The replacement string of a substitution caused the recursive
+execution of that very same substituion.  Perl cannot keep track of
+special variables (C<$1>, etc.) under such circumstances.
+
 =item Reference miscount in sv_replace()
 
 (W) The internal sv_replace() function was handed a new SV with a
@@ -2447,6 +2464,18 @@ a term, so it's looking for the corresponding right angle bracket, and not
 finding it.  Chances are you left some needed parentheses out earlier in
 the line, and you really meant a "less than".
 
+=item Use of "$$<digit>" to mean "${$}<digit>" is deprecated
+
+(D) Perl versions before 5.004 misinterpreted any type marker followed
+by "$" and a digit.  For example, "$$0" was incorrectly taken to mean
+"${$}0" instead of "${$0}".  This bug is (mostly) fixed in Perl 5.004.
+
+However, the developers of Perl 5.004 could not fix this bug completely,
+because at least two widely-used modules depend on the old meaning of
+"$$0" in a string.  So Perl 5.004 still interprets "$$<digit>" in the
+old (broken) way inside strings; but it generates this message as a
+warning.  And in Perl 5.005, this special treatment will cease.
+
 =item Use of $# is deprecated
 
 (D) This was an ill-advised attempt to emulate a poorly defined B<awk> feature.
@@ -2477,10 +2506,10 @@ a split() explicitly to an array (or list).
 
 =item Use of inherited AUTOLOAD for non-method %s() is deprecated
 
-As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked up
-as methods (using the C<@ISA> hierarchy) even when the subroutines to be
-autoloaded were called as plain functions (e.g. C<Foo::bar()>), not as
-methods (e.g. C<Foo->bar()> or C<$obj->bar()>).
+(D) As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked
+up as methods (using the C<@ISA> hierarchy) even when the subroutines to
+be autoloaded were called as plain functions (e.g. C<Foo::bar()>), not
+as methods (e.g. C<Foo->bar()> or C<$obj->bar()>).
 
 This bug will be rectified in Perl 5.005, which will use method lookup
 only for methods' C<AUTOLOAD>s.  However, there is a significant base
index 467f02c..ce590dc 100644 (file)
@@ -833,6 +833,8 @@ file on another machine?
 
 =item Subroutine arguments created only when they're modified
 
+=item C<$)> is writable
+
 =item Fixed parsing of $$<digit>, &$<digit>, etc.
 
 =item No resetting of $. on implicit close
@@ -887,6 +889,8 @@ constant NAME => VALUE, use locale, use ops, use vmsish
 
 =over
 
+=item Required Updates
+
 =item Installation directories
 
 =item Module information summary
@@ -937,18 +941,20 @@ resolve method `%s' overloading `%s' in package `%s', Constant subroutine
 %s redefined, Constant subroutine %s undefined, Copy method did not return
 a reference, Died, Exiting pseudo-block via %s, Illegal character %s
 (carriage return), Illegal switch in PERL5OPT: %s, Integer overflow in hex
-number, Integer overflow in octal number, Name "%s::%s" used only once:
-possible typo, Null picture in formline, Offset outside string, Out of
-memory!, Out of memory during request for %s, Possible attempt to put
-comments in qw() list, Possible attempt to separate words with commas,
-Scalar value @%s{%s} better written as $%s{%s}, Stub found while resolving
-method `%s' overloading `%s' in package `%s', Too late for "B<-T>" option,
-untie attempted while %d inner references still exist, Unrecognized
-character %s, Unsupported function fork, Value of %s can be "0"; test with
-defined(), Variable "%s" may be unavailable, Variable "%s" will not stay
-shared, Warning: something's wrong, Ill-formed logical name |%s| in
-prime_env_iter, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX,
-PERL_SH_DIR too long, Process terminated by SIG%s
+number, Integer overflow in octal number, internal error: glob failed, Name
+"%s::%s" used only once: possible typo, Null picture in formline, Offset
+outside string, Out of memory!, Out of memory during request for %s,
+Possible attempt to put comments in qw() list, Possible attempt to separate
+words with commas, Recursive substitution detected, Scalar value @%s{%s}
+better written as $%s{%s}, Stub found while resolving method `%s'
+overloading `%s' in package `%s', Too late for "B<-T>" option, untie
+attempted while %d inner references still exist, Unrecognized character %s,
+Unsupported function fork, Use of "$$<digit>" to mean "${$}<digit>" is
+deprecated, Value of %s can be "0"; test with defined(), Variable "%s" may
+be unavailable, Variable "%s" will not stay shared, Warning: something's
+wrong, Ill-formed logical name |%s| in prime_env_iter, Got an error from
+DosAllocMem, Malformed PERLLIB_PREFIX, PERL_SH_DIR too long, Process
+terminated by SIG%s
 
 =item BUGS
 
@@ -2429,6 +2435,8 @@ callback
 
 =item Alternate Stack Manipulation
 
+=item Creating and calling an anonymous subroutine in C
+
 =back
 
 =item SEE ALSO
@@ -4093,7 +4101,7 @@ functions
 
 =item USAGE
 
-=item CAVEATS
+=item ERRORS DUE TO DIVISION BY ZERO
 
 =item BUGS
 
@@ -4109,12 +4117,18 @@ functions
 
 =over
 
-=item SIMPLE ARGUMENTS, COMPLEX RESULTS
+=item ERRORS DUE TO DIVISION BY ZERO
+
+=item SIMPLE (REAL) ARGUMENTS, COMPLEX RESULTS
 
 =back
 
 =item ANGLE CONVERSIONS
 
+=item BUGS
+
+=item AUTHORS
+
 =head2 NDBM_File - Tied access to ndbm files
 
 =item SYNOPSIS
index 4f41374..aabdff5 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -119,9 +119,6 @@ PP(pp_substcont)
        if (!cx->sb_rxtainted)
            cx->sb_rxtainted = SvTAINTED(TOPs);
        sv_catsv(dstr, POPs);
-       if (rx->subbase)
-           Safefree(rx->subbase);
-       rx->subbase = cx->sb_subbase;
 
        /* Are we done */
        if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig,
@@ -139,10 +136,10 @@ PP(pp_substcont)
            SvLEN_set(targ, SvLEN(dstr));
            SvPVX(dstr) = 0;
            sv_free(dstr);
-
            (void)SvPOK_only(targ);
            SvSETMAGIC(targ);
            SvTAINT(targ);
+
            PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
            LEAVE_SCOPE(cx->sb_oldsave);
            POPSUBST(cx);
@@ -159,10 +156,7 @@ PP(pp_substcont)
     cx->sb_m = m = rx->startp[0];
     sv_catpvn(dstr, s, m-s);
     cx->sb_s = rx->endp[0];
-    cx->sb_subbase = rx->subbase;
     cx->sb_rxtainted |= rx->exec_tainted;
-
-    rx->subbase = Nullch;      /* so recursion works */
     RETURNOP(pm->op_pmreplstart);
 }
 
index 2f735a3..0422017 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1171,7 +1171,8 @@ do_readline()
                IoFLAGS(io) |= IOf_START;
            }
            else if (type == OP_GLOB) {
-               (void)do_close(last_in_gv, FALSE);
+               if (do_close(last_in_gv, FALSE) & ~0xFF)
+                   warn("internal error: glob failed");
            }
            if (gimme == G_SCALAR) {
                (void)SvOK_off(TARG);
@@ -1386,6 +1387,13 @@ PP(pp_iter)
     RETPUSHYES;
 }
 
+static void
+leave_subst(p)
+void *p;
+{
+    ((PMOP*)p)->op_private &= ~OPpLVAL_INTRO;
+}
+
 PP(pp_subst)
 {
     dSP; dTARG;
@@ -1410,8 +1418,8 @@ PP(pp_subst)
     int force_on_match = 0;
     I32 oldsave = savestack_ix;
 
-    if (pm->op_pmflags & PMf_CONST)    /* known replacement string? */
-       dstr = POPs;
+    /* known replacement string? */
+    dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
     if (op->op_flags & OPf_STACKED)
        TARG = POPs;
     else {
@@ -1427,6 +1435,13 @@ PP(pp_subst)
        force_on_match = 1;
     TAINT_NOT;
 
+    if (pm->op_private & OPpLVAL_INTRO)
+       croak("Recursive substitution detected");
+    if (!dstr) {
+       SAVEDESTRUCTOR(leave_subst, pm);
+       pm->op_private |= OPpLVAL_INTRO;
+    }
+
   force_it:
     if (!pm || !s)
        DIE("panic: do_subst");
@@ -1480,7 +1495,7 @@ PP(pp_subst)
     once = !(rpm->op_pmflags & PMf_GLOBAL);
 
     /* known replacement string? */
-    c = (rpm->op_pmflags & PMf_CONST) ? SvPV(dstr, clen) : Nullch;
+    c = dstr ? SvPV(dstr, clen) : Nullch;
 
     /* can do inplace substitution? */
     if (c && clen <= rx->minlen) {
@@ -1630,13 +1645,12 @@ PP(pp_subst)
        LEAVE_SCOPE(oldsave);
        RETURN;
     }
-
-    PUSHs(&sv_no);
-    LEAVE_SCOPE(oldsave);
-    RETURN;
+    goto ret_no;
 
 nope:
     ++BmUSEFUL(pm->op_pmshort);
+
+ret_no:
     PUSHs(&sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
index 46114fb..310e6f5 100755 (executable)
@@ -4,7 +4,7 @@
 #
 # Regression tests for the Math::Complex pacakge
 # -- Raphael Manfredi, September 1996
-# -- Jarkko Hietaniemi, March 1997
+# -- Jarkko Hietaniemi, March-April 1997
 
 BEGIN {
     chdir 't' if -d 't';
@@ -49,6 +49,38 @@ while (<DATA>) {
        }
 }
 
+# test the divbyzeros
+
+test_dbz(
+        'i/0',
+#       'tan(pi/2)',   # may succeed thanks to floating point inaccuracies
+#       'sec(pi/2)',   # may succeed thanks to floating point inaccuracies
+        'csc(0)',
+        'cot(0)',
+        'atan(i)',
+        'asec(0)',
+        'acsc(0)',
+        'acot(i)',
+#       'tanh(pi/2)',  # may succeed thanks to floating point inaccuracies
+#       'sech(pi/2)',  # may succeed thanks to floating point inaccuracies
+        'csch(0)',
+        'coth(0)',
+        'atanh(1)',
+        'asech(0)',
+        'acsch(0)',
+        'acoth(1)'
+       );
+
+sub test_dbz {
+    for my $op (@_) {
+       $test++;
+
+       push(@script, qq(eval '$op';));
+       push(@script, qq(print 'not ' unless (\$@ =~ /Division by zero/);));
+       push(@script, qq(print "ok $test\n";));
+    }
+}
+
 print "1..$test\n";
 eval join '', @script;
 die $@ if $@;
diff --git a/toke.c b/toke.c
index 724c214..c40955a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4388,7 +4388,12 @@ I32 ck_uni;
     }
     if (*s == '$' && s[1] &&
       (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
-       return s;
+    {
+       if (isDIGIT(s[1]) && lex_state == LEX_INTERPNORMAL)
+           deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
+       else
+           return s;
+    }
     if (*s == '{') {
        bracket = s;
        s++;
@@ -4589,7 +4594,8 @@ register PMOP *pm;
            }
        }
        /* promote the better string */
-       if ((!pm->op_pmshort && !(pm->op_pmregexp->reganch & ROPT_ANCH)) ||
+       if ((!pm->op_pmshort &&
+            !(pm->op_pmregexp->reganch & ROPT_ANCH_GPOS)) ||
            ((pm->op_pmflags & PMf_SCANFIRST) &&
             (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
            SvREFCNT_dec(pm->op_pmshort);               /* ok if null */
index c602396..57a6ea5 100644 (file)
  *     available to get the list of process groups.  If unavailable, multiple
  *     groups are probably not supported.
  */
+/* HAS_SETGROUPS:
+ *     This symbol, if defined, indicates that the setgroups() routine is
+ *     available to set the list of process groups.  If unavailable, multiple
+ *     groups are probably not supported.
+ */
 #undef HAS_GETGROUPS           /**/
+#undef HAS_SETGROUPS           /**/
 
 /* HAS_UNAME:
  *     This symbol, if defined, indicates that the C program may use the
 
 /* Groups_t:
  *     This symbol holds the type used for the second argument to
- *     getgroups().  Usually, this is the same of gidtype, but
+ *     [gs]etgroups().  Usually, this is the same of gidtype, but
  *     sometimes it isn't.  It can be int, ushort, uid_t, etc... 
  *     It may be necessary to include <sys/types.h> to get any 
  *     typedef'ed information.  This is only required if you have
- *     getgroups().
+ *     getgroups() or setgroups.
  */
-#ifdef HAS_GETGROUPS
-#define Groups_t unsigned int  /* Type for 2nd arg to getgroups() */  /* config-skip */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t unsigned int  /* config-skip */
 #endif
 
 /* DB_Prefix_t:
index 420afcc..fc70d4d 100644 (file)
  *     available to get the list of process groups.  If unavailable, multiple
  *     groups are probably not supported.
  */
+/* HAS_SETGROUPS:
+ *     This symbol, if defined, indicates that the setgroups() routine is
+ *     available to set the list of process groups.  If unavailable, multiple
+ *     groups are probably not supported.
+ */
 /*#define HAS_GETGROUPS                /**/
+/*#define HAS_SETGROUPS                /**/
 
 /* HAS_GETHOSTENT:
  *     This symbol, if defined, indicates that the gethostent routine is
 
 /* Groups_t:
  *     This symbol holds the type used for the second argument to
- *     getgroups().  Usually, this is the same of gidtype, but
+ *     [gs]etgroups().  Usually, this is the same of gidtype, but
  *     sometimes it isn't.  It can be int, ushort, uid_t, etc... 
  *     It may be necessary to include <sys/types.h> to get any 
  *     typedef'ed information.  This is only required if you have
- *     getgroups().
+ *     getgroups() or setgroups().
  */
-#ifdef HAS_GETGROUPS
-#define Groups_t gid_t /* Type for 2nd arg to getgroups() */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */
 #endif
 
 /* DB_Prefix_t:
index e8a1c03..cadbdfa 100644 (file)
@@ -128,6 +128,7 @@ d_fork='undef'
 d_fpathconf='undef'
 d_fsetpos='define'
 d_getgrps='undef'
+d_setgrps='undef'
 d_gethent='undef'
 d_gethname='undef'
 d_getlogin='undef'