Regression with Perl 5.6.0 in the Compress::Raw::* modules

[pmqs]

The Compress::Raw::* modules have been using version 5.52 of Devel-PPPort for years. Lately an issue with clang compiler warnings cropped up so I needed to refresh it.

Updating to 3.71 fixed the clang issue, but broke the test harness when I use Perl 5.6. All other Perl versions are fine. Example at https://github.com/pmqs/Compress-Raw-Zlib/actions/runs/5910264156/job/16031671226

I tried a few versions of Devel-PPPort but could not get one that fixed both the clang issue and worked with perl 5.6. Think that the 5.6 issue starts with Devel-PPPort 3.57

I suspect there is one underlying issue, but there are two distinct failures

Use of substr

Looking at the failing tests a key observation is the use of substr as a parameter to one of the zlib methods. Like this, for example

my $status = $x->deflate(substr($contents,0), $X);

I remember adding these particular tests years ago because the use of substr caused problems in the past.

Below will reproduce the failure

use Test::More ;

use Compress::Raw::Zlib ;

foreach (1)
{
    my $contents = 'x' x 5000 ;
    # foreach (1 .. 5000)
    #   { $contents .= chr int rand 255 }
    ok  my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ;

    my $X ;
    if (1) {
        # this triggers the failure
        my $status = $x->deflate(substr($contents,0), $X);
        cmp_ok $status, '==', Z_OK ;
    } else {
        # this is the workaround
        my $data = substr($contents,0) ;
        my $status = $x->deflate($data, $X);
        cmp_ok $status, '==', Z_OK ;
    }

    cmp_ok $x->flush($X), '==', Z_OK  ;

    my $append = "Appended" ;
    $X .= $append ;

    ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ;

    my $Z;
    my $keep = $X ;
    $status = $k->inflate(substr($X, 0), $Z) ;

    cmp_ok $status, '==', Z_STREAM_END ;

    # test fails at this line
    ok $contents eq $Z ;
    ok $X eq $append;
}

this is the output I get

ok 1
ok 2
ok 3
ok 4
ok 5
not ok 6
#   Failed test at bugs/ppport/substr.pl line 38.
ok 7

One point - in the real test harness some of the substr lines will throw a Use of uninitialized value in subroutine entry warning. For some reason that isn't happening in the test file. No idea why.

non-PV buffer

The second failure is in the test harness file t/019nonpv.t

These tests pass buffers that are created like this

my $data = "abcd";
my $input = *data;
$x->deflate($input, $output)

Not sure if this is a variation on the substr issue.

---

I can collect more data if needed.

[pali]

Hello, it would be nice to provide example how to trigger this bug without external modules, or with just simple C/XS module. This could help me and other people to check if the problem is in ppport, perl or external module.

[pmqs]

I've done some digging. Enclosed module, demo-1.1.tar.gz, is a stripped down example with a test file for each of the two issues I'm seeing.

Issue looks very similar in both tests, so I'll only walk through the first one.

This is the striped down XS code. All it does take an SV as parameter. It dereferences it, if needed, then uses SvPV_nomg to get a pointer to the data payload. I used Perl_sv_dump to dump the SV before & after dereferencing

void
testit(buf)
    SV *	buf
 CODE:
    char *  data ;
    STRLEN    origlen ;
    printf("\nBefore deRef of input buffer\n");
    Perl_sv_dump(buf);
    printf("\n");
    data = SvPV_nomg(buf, origlen);
    printf("Data buffer %p, %lu bytes\n", data, origlen);

    /* If the input buffer is a reference, dereference it */
    buf = deRef(buf, "deflate") ;

    printf("\nAfter deRef of input buffer\n");
    Perl_sv_dump(buf);
    printf("\n");
    data = SvPV_nomg(buf, origlen);
    printf("Data buffer %p, %lu bytes\n", data, origlen);

Once built, just run perl -Mblib t/test.t

With Perl 5.30.2 I get this

Before deRef of input buffer
SV = PVLV(0x5576e43b77b0) at 0x5576e42fb0c8
  REFCNT = 1
  FLAGS = (TEMP,GMG,SMG)
  IV = 0
  NV = 0
  PV = 0
  MAGIC = 0x5576e430d2b0
    MG_VIRTUAL = &PL_vtbl_substr
    MG_TYPE = PERL_MAGIC_substr(x)
  TYPE = x
  TARGOFF = 0
  TARGLEN = 0
  TARG = 0x5576e43f7ac0
  FLAGS = 2
    SV = PV(0x5576e42e1010) at 0x5576e43f7ac0
      REFCNT = 2
      FLAGS = (POK,IsCOW,pPOK)
      PV = 0x5576e4390eb0 "abc"\0
      CUR = 3
      LEN = 10
      COW_REFCNT = 1

Data buffer 0x5576e378c1d1, 0 bytes

After deRef of input buffer
SV = PVLV(0x5576e43b77b0) at 0x5576e42fb0c8
  REFCNT = 1
  FLAGS = (GMG,SMG,POK,pPOK)
  IV = 0
  NV = 0
  PV = 0x5576e4a82950 "abc"\0
  CUR = 3
  LEN = 10
  MAGIC = 0x5576e430d2b0
    MG_VIRTUAL = &PL_vtbl_substr
    MG_TYPE = PERL_MAGIC_substr(x)
  TYPE = x
  TARGOFF = 0
  TARGLEN = 0
  TARG = 0x5576e43f7ac0
  FLAGS = 2
    SV = PV(0x5576e42e1010) at 0x5576e43f7ac0
      REFCNT = 2
      FLAGS = (POK,IsCOW,pPOK)
      PV = 0x5576e4390eb0 "abc"\0
      CUR = 3
      LEN = 10
      COW_REFCNT = 1

Data buffer 0x5576e4a82950, 3 bytes
Back from testit: STRING is [abc]

The Data buffer and length returned from SvPV_nomg looks fine -- it matches the PV value

Now the same test with 5.6

Before deRef of input buffer
SV = PVLV(0x55f83f2b1c58) at 0x55f83f4b43d0
  REFCNT = 1
  FLAGS = (PADMY,GMG,SMG,pPOK)
  IV = 0
  NV = 0
  PV = 0x55f83f251f70 "abc"\0
  CUR = 3
  LEN = 4
  MAGIC = 0x55f83f251fd0
    MG_VIRTUAL = &PL_vtbl_substr
    MG_TYPE = 'x'
  TYPE = x
  TARGOFF = 0
  TARGLEN = 3
  TARG = 0x55f83f2b09f0
SV = PV(0x55f83f23f708) at 0x55f83f2b09f0
  REFCNT = 2
  FLAGS = (PADBUSY,PADMY,POK,pPOK)
  PV = 0x55f83f244960 "abc"\0
  CUR = 3
  LEN = 4

Data buffer 0x55f83d6af441, 0 bytes

After deRef of input buffer
SV = PVLV(0x55f83f2b1c58) at 0x55f83f4b43d0
  REFCNT = 1
  FLAGS = (PADMY,GMG,SMG,pPOK)
  IV = 0
  NV = 0
  PV = 0x55f83f251f70 "abc"\0
  CUR = 3
  LEN = 4
  MAGIC = 0x55f83f251fd0
    MG_VIRTUAL = &PL_vtbl_substr
    MG_TYPE = 'x'
  TYPE = x
  TARGOFF = 0
  TARGLEN = 3
  TARG = 0x55f83f2b09f0
SV = PV(0x55f83f23f708) at 0x55f83f2b09f0
  REFCNT = 2
  FLAGS = (PADBUSY,PADMY,POK,pPOK)
  PV = 0x55f83f244960 "abc"\0
  CUR = 3
  LEN = 4

Data buffer 0x55f83d6af441, 0 bytes
Back from testit: STRING is [abc]

and there is the problem -- the value returned from SvPV_nomg is 0x55ac033af441. That doesn't match the PV at all.

[pali]

Thanks for the input. Can also paste your perl testit() function and how you call it? I'm interesting how was SV input parameter created.

[pmqs]

Thanks for the input. Can also paste your perl testit() function and how you call it? I'm interesting how was SV input parameter created.

The testit is in the XS code I posted.

This is how it is invoked.

my $string = "abc";
demo::testit(substr($string, 0));

[pali]

Thank you for input. I have reproduced this issue. I been looking at it and I think now I know where is the problem and how to fix.

Problem is in the SvPV_nomg(), more precisely in Perl_sv_2pv() function which this macro calls. Perl_sv_2pv() function prior to Perl 5.18 has an issue which cause that it returns empty string if it is called scalar which has PV/string value but does not have any other (NV, IV, ...). This problem was fixed in Perl 5.18 in commit 4bac9ae (Magic flags harmonization).

My proposed fix is for Perl < 5.18 version to redefine sv_2pv() macro/function to something like this:

#if PERL_VERSION < 18
#ifdef sv_2pv
#undef sv_2pv
#endif
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
#define sv_2pv(sv, lp) ({ SV *_sv_2pv = (sv); SvPOKp(_sv_2pv) ? ((*(lp) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv(aTHX_ _sv_2pv, (lp)); })
#else
#define sv_2pv(sv, lp) (SvPOKp(sv) ? ((*(lp) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv(aTHX_ (sv), (lp)))
#endif
#endif

After redefining, Perl 5.6 SvPV_nomg() macro starts using fixed version.

After putting this code into demo.xs after the ppport.h line, I was not able to trigger it anymore.

Can you check if it works correctly?

If yes then the fix should be integrated into parts/inc/SvPV file in Devel-PPPort.

[pmqs]

Can you check if it works correctly?

That worked fine, both with gcc & clang version of 5.6

Also tried on GitHub for a second opinion. All ok there as well

[pali]

Perfect! Would you like to prepare a proper fix for Devel-PPPort (into file parts/inc/SvPV)?

[pmqs]

Perfect! Would you like to prepare a proper fix for Devel-PPPort (into file parts/inc/SvPV)?

Thanks, but no. I'll pass on that.

[pali]

Ok, pull request is there: #232

I had to slightly modify my above change as it did not compile for Perl versions 5.10+.