X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/0403a1ad8ff01aaac2d09a986ea6bb5210472459..dbdb57e61cddbe8e7a199ac438f0523d0c20e4ce:/pp_pack.c diff --git a/pp_pack.c b/pp_pack.c index 044ea7f..40c3100 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -1826,7 +1826,7 @@ PP(pp_unpack) { dSP; dPOPPOPssrl; - I32 gimme = GIMME_V; + U8 gimme = GIMME_V; STRLEN llen; STRLEN rlen; const char *pat = SvPV_const(left, llen); @@ -2674,7 +2674,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) NV anv; fromstr = NEXTFROM; anv = SvNV(fromstr); -# if defined(VMS) && !defined(_IEEE_FP) +# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT) /* IEEE fp overflow shenanigans are unavailable on VAX and optional * on Alpha; fake it if we don't have them. */ @@ -2684,15 +2684,17 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) afloat = -FLT_MAX; else afloat = (float)anv; # else -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) +# if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) if(Perl_isnan(anv)) afloat = (float)NV_NAN; else -#endif +# endif +# ifdef NV_INF /* a simple cast to float is undefined if outside * the range of values that can be represented */ afloat = (float)(anv > FLT_MAX ? NV_INF : anv < -FLT_MAX ? -NV_INF : anv); +# endif # endif PUSH_VAR(utf8, cur, afloat, needs_swap); } @@ -2703,7 +2705,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) NV anv; fromstr = NEXTFROM; anv = SvNV(fromstr); -# if defined(VMS) && !defined(_IEEE_FP) +# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT) /* IEEE fp overflow shenanigans are unavailable on VAX and optional * on Alpha; fake it if we don't have them. */ @@ -3040,7 +3042,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) * of pack() (and all copies of the result) are * gone. */ - if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) && + if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1) + || (SvPADTMP(fromstr) && !SvREADONLY(fromstr)))) { Perl_ck_warner(aTHX_ packWARN(WARN_PACK), "Attempt to pack pointer to temporary value");