From: Perl 5 Porters Date: Fri, 4 Apr 1997 00:00:00 +0000 (+0000) Subject: [inseparable changes from match from perl-5.003_97a to perl-5.003_97b] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5cd24f17b72b10f8506d70fba1ec4dd25224c257;hp=daff0e373f3630eaa9dbded0adcc04185f454487;p=p5sagit%2Fp5-mst-13.2.git [inseparable changes from match from perl-5.003_97a to perl-5.003_97b] BUILD PROCESS Subject: Don't suggest 'Configure -der' in config.sh comments From: Chip Salzenberg Files: Configure CORE LANGUAGE CHANGES Subject: 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 Subject: Grandfather "$$" in strings From: Chip Salzenberg Files: pod/perldiag.pod toke.c Subject: Disconnect warn and die hooks _after_ object destruction From: Chip Salzenberg Files: perl.c Subject: Forbid recursive substitutions From: Chip Salzenberg Files: cop.h pod/perldelta.pod pod/perldiag.pod pp_ctl.c pp_hot.c DOCUMENTATION Subject: Document required module versions From: Chip Salzenberg Files: pod/perldelta.pod LIBRARY AND EXTENSIONS Subject: 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 OTHER CORE CHANGES Subject: length($') isn't Date: Mon, 07 Apr 1997 03:30:44 -0400 From: Gurusamy Sarathy 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 Files: toke.c Subject: Add warning for glob failure From: Chip Salzenberg Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c Subject: Fix C in presence of local patches From: Chip Salzenberg Files: perl.c --- diff --git a/Changes b/Changes index 8419886..fc9c9c7 100644 --- a/Changes +++ b/Changes @@ -35,6 +35,7 @@ file, and their current addresses (as of March 1997): Ulrich Pfeifer Tom Phoenix Norbert Pueschel + Dean Roehrich Roderick Schertler Ilya Zakharevich @@ -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 "$$" 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 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 refer to L" + 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 + 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 + 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 43fb081..88ba08d 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 <&4 $spitshell <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 fbc1206..87fc608 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 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 23cb896..938cf51 100755 --- a/config_h.SH +++ b/config_h.SH @@ -298,7 +298,13 @@ sed <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 <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 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 --- 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 9000543..20762bd 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, C, C, C, C, C, C, +C, the argument cannot be C<0> (zero). For the C, +C, the argument cannot be C<1> (one). For the C, C, +the argument cannot be C (the imaginary unit). For the C, +C, C, C, the argument cannot be I, where +I is any integer. + =head1 BUGS -Saying C exports many mathematical routines in the caller -environment. This is construed as a feature by the Author, actually... ;-) +Saying C exports many mathematical routines in the +caller environment and even overrides some (C, C, C, +C, C). 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 > Jarkko Hietaniemi > + +=cut + +# eof diff --git a/lib/Math/Trig.pm b/lib/Math/Trig.pm index 7c3570c..4098f34 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 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, C, C, C, C, C, C, +C, the argument cannot be C<0> (zero). For the C, +C, the argument cannot be C<1> (one). For the C, C, +C, C, the argument cannot be I, where I is +any integer. + +=head2 SIMPLE (REAL) ARGUMENTS, COMPLEX RESULTS Please note that some of the trigonometric functions can break out from the B into the B. 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 radians or E<360> degrees or E<400> gradians. +The full circle is 2 I radians or I<360> degrees or I<400> gradians. -=head1 +=head1 BUGS -The following functions +Saying C exports many mathematical routines in the +caller environment and even overrides some (C, C). 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 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 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 > + Raphael Manfredi > =cut diff --git a/mg.c b/mg.c index f1dc828..54ca044 100644 --- a/mg.c +++ b/mg.c @@ -20,7 +20,7 @@ # include #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 */ diff --git a/patchlevel.h b/patchlevel.h index 6cc0f69..e768691 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 2b53a81..7ffd52a 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 9965c73..463c094 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 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 0d3dd84..1447fd4 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 C function (if there is one). +However, due to an oversight, assigning to C<$)> has not called +C, only C. + +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 C +function (if there is one). + =head2 Fixed parsing of $$, &$, 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 "$$" 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 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 +and C*.cE>. 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); otherwise, make them all +empty (except that C 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, C, and so on. +=item Use of "$$" to mean "${$}" 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 "$$" 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 , <*> (glob), C, diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 89c8a2a..0543595 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 +and C*.cE>. 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); otherwise, make them all +empty (except that C 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 "$$" to mean "${$}" 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 "$$" 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 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 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), not as -methods (e.g. Cbar()> or C<$obj->bar()>). +(D) As an (ahem) accidental feature, C 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), not +as methods (e.g. Cbar()> or C<$obj->bar()>). This bug will be rectified in Perl 5.005, which will use method lookup only for methods' Cs. However, there is a significant base diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 467f02c..ce590dc 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 $$, &$, 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 "$$" to mean "${$}" 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 4f41374..aabdff5 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 2f735a3..0422017 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 46114fb..310e6f5 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 () { } } +# 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 --- 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("\"$$\" to mean \"${$}\""); + 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 c602396..57a6ea5 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 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 420afcc..fc70d4d 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 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 e8a1c03..cadbdfa 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'