summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changes125
-rwxr-xr-xConfigure26
-rw-r--r--config_H14
-rwxr-xr-xconfig_h.SH14
-rw-r--r--cop.h1
-rw-r--r--lib/Math/Complex.pm119
-rw-r--r--lib/Math/Trig.pm142
-rw-r--r--mg.c24
-rw-r--r--patchlevel.h1
-rw-r--r--perl.c18
-rw-r--r--plan9/config.plan914
-rw-r--r--pod/perldelta.pod81
-rw-r--r--pod/perldiag.pod37
-rw-r--r--pod/perltoc.pod42
-rw-r--r--pp_ctl.c8
-rw-r--r--pp_hot.c30
-rwxr-xr-xt/lib/complex.t34
-rw-r--r--toke.c10
-rw-r--r--vms/config.vms14
-rw-r--r--win32/config.H14
-rw-r--r--win32/config.w321
21 files changed, 555 insertions, 214 deletions
diff --git a/Changes b/Changes
index 8419886555..fc9c9c73c1 100644
--- 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
diff --git a/Configure b/Configure
index 43fb081143..88ba08d022 100755
--- 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'
diff --git a/config_H b/config_H
index fbc12062d2..87fc608c65 100644
--- a/config_H
+++ b/config_H
@@ -284,7 +284,13 @@
* 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
@@ -976,14 +982,14 @@
/* 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:
diff --git a/config_h.SH b/config_h.SH
index 23cb89623b..938cf51a21 100755
--- a/config_h.SH
+++ b/config_h.SH
@@ -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 72a9483174..3383ceb055 100644
--- 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
diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm
index 9000543438..20762bdfa1 100644
--- a/lib/Math/Complex.pm
+++ b/lib/Math/Complex.pm
@@ -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
diff --git a/lib/Math/Trig.pm b/lib/Math/Trig.pm
index 7c3570c840..4098f34448 100644
--- a/lib/Math/Trig.pm
+++ b/lib/Math/Trig.pm
@@ -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 b6d5afbb1f..54ca0442c3 100644
--- 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
@@ -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 */
diff --git a/patchlevel.h b/patchlevel.h
index 6cc0f69743..e768691681 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -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 2b53a8114a..7ffd52a01d 100644
--- 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]);
diff --git a/plan9/config.plan9 b/plan9/config.plan9
index 9965c73d37..463c0942fb 100644
--- a/plan9/config.plan9
+++ b/plan9/config.plan9
@@ -259,7 +259,13 @@
* 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
@@ -1006,14 +1012,14 @@
/* 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:
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 0d3dd84ab0..1447fd4959 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -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()>,
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 89c8a2ac5c..0543595527 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -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
diff --git a/pod/perltoc.pod b/pod/perltoc.pod
index 467f02c31d..ce590dcb8d 100644
--- a/pod/perltoc.pod
+++ b/pod/perltoc.pod
@@ -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
diff --git a/pp_ctl.c b/pp_ctl.c
index 4f41374c6d..aabdff582b 100644
--- 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);
}
diff --git a/pp_hot.c b/pp_hot.c
index 2f735a3bf6..0422017d74 100644
--- 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;
diff --git a/t/lib/complex.t b/t/lib/complex.t
index 46114fbf5b..310e6f5e3c 100755
--- a/t/lib/complex.t
+++ b/t/lib/complex.t
@@ -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 724c214722..c40955a101 100644
--- 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 */
diff --git a/vms/config.vms b/vms/config.vms
index c60239618d..57a6ea5a9a 100644
--- a/vms/config.vms
+++ b/vms/config.vms
@@ -243,7 +243,13 @@
* 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
@@ -1734,14 +1740,14 @@
/* 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:
diff --git a/win32/config.H b/win32/config.H
index 420afcccac..fc70d4dd47 100644
--- a/win32/config.H
+++ b/win32/config.H
@@ -279,7 +279,13 @@
* 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
@@ -971,14 +977,14 @@
/* 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:
diff --git a/win32/config.w32 b/win32/config.w32
index e8a1c03af8..cadbdfa80f 100644
--- a/win32/config.w32
+++ b/win32/config.w32
@@ -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'
View Lorry Controller Status