t/30_DDump-s.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 # I would like more tests, but contents change over every perl version
   7 use Test::More tests => 6;
   8 use Test::NoWarnings;
   9
  10 use Data::Peek;
  11
  12 $Data::Peek::has_perlio = $Data::Peek::has_perlio = 0;
  13
  14 ok (1, "DDump () NOT using PerlIO");
  15
  16 my @tests;
  17 {   local $/ = "==\n";
  18     chomp (@tests = <DATA>);
  19     }
  20
  21 # Determine what newlines this perl generates in sv_peek
  22 my @nl = ("\\n") x 2;
  23
  24 my $var = "";
  25
  26 foreach my $test (@tests) {
  27     my ($in, $expect) = split m/\n--\n/ => $test;
  28     $in eq "" and next;
  29     SKIP: {
  30         eval "\$var = $in;";
  31         my $dump = DDump ($var);
  32
  33         if ($in =~ m/20ac/) {
  34             if ($] < 5.008) {
  35                 skip "No UTF8 in ancient perl", 1;
  36                 }
  37             else {
  38                 @nl = ($dump =~ m/PV = 0x\w+ "([^"]+)".*"([^"]+)"/);
  39                 diag "# This perl dumps \\n as (@nl)";
  40                 # Catch differences in \n
  41                 $dump =~ s/"ab\Q$nl[0]\E(.*?)"ab\Q$nl[1]\E/"ab\\n$1"ab\\n/g;
  42                 }
  43             }
  44
  45         $dump =~ s/\b0x[0-9a-f]+\b/0x****/g;
  46         $dump =~ s/\b(REFCNT =) [0-9]{4,}/$1 -1/g;
  47
  48         $dump =~ s/\bLEN = (?:[1-9]|1[0-6])\b/LEN = 8/g; # aligned at long long?
  49
  50         $dump =~ s/\bPADBUSY\b,?//g     if $] < 5.010;
  51
  52         $dump =~ s/\bUV = /IV = /g      if $] < 5.008;
  53         $dump =~ s/,?\bIsUV\b//g        if $] < 5.008;
  54
  55         my @expect = split m/(?<=\n)\|\n+/ => $expect;
  56
  57         $in   =~ s/[\s\n]+/ /g;
  58
  59         my @match = grep { $dump eq $_ } @expect;
  60         if (@match == 1) {
  61             is ($dump, $match[0], "DDump ($in)");
  62             }
  63         else {
  64             my $match = shift @expect;
  65             is ($dump, $match, "DDump ($in)");
  66             diag ("DDump ($in) neither matches\n$_") for @expect;
  67             }
  68         }
  69     }
  70
  71 1;
  72
  73 __END__
  74 undef
  75 --
  76 SV = PV(0x****) at 0x****
  77   REFCNT = 1
  78   FLAGS = (PADMY)
  79   PV = 0x**** ""\0
  80   CUR = 0
  81   LEN = 8
  82 |
  83 SV = PV(0x****) at 0x****
  84   REFCNT = 1
  85   FLAGS = (PADMY)
  86   PV = 0
  87 ==
  88 0
  89 --
  90 SV = PVIV(0x****) at 0x****
  91   REFCNT = 1
  92   FLAGS = (PADMY,IOK,pIOK)
  93   IV = 0
  94   PV = 0x**** ""\0
  95   CUR = 0
  96   LEN = 8
  97 |
  98 SV = PVIV(0x****) at 0x****
  99   REFCNT = 1
 100   FLAGS = (PADMY,IOK,pIOK)
 101   IV = 0
 102   PV = 0
 103 ==
 104 1
 105 --
 106 SV = PVIV(0x****) at 0x****
 107   REFCNT = 1
 108   FLAGS = (PADMY,IOK,pIOK)
 109   IV = 1
 110   PV = 0x**** ""\0
 111   CUR = 0
 112   LEN = 8
 113 |
 114 SV = PVIV(0x****) at 0x****
 115   REFCNT = 1
 116   FLAGS = (PADMY,IOK,pIOK)
 117   IV = 1
 118   PV = 0
 119 ==
 120 ""
 121 --
 122 SV = PVIV(0x****) at 0x****
 123   REFCNT = 1
 124   FLAGS = (PADMY,POK,pPOK)
 125   IV = 1
 126   PV = 0x**** ""\0
 127   CUR = 0
 128   LEN = 8
 129 |
 130 SV = PVIV(0x****) at 0x****
 131   REFCNT = 1
 132   FLAGS = (PADMY,POK,IsCOW,pPOK)
 133   IV = 1
 134   PV = 0x**** ""\0
 135   CUR = 0
 136   LEN = 8
 137   COW_REFCNT = 0