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)\|(?:\s*#.*)?\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 | # as of 5.19.3
  83 SV = PV(0x****) at 0x****
  84   REFCNT = 1
  85   FLAGS = (PADMY)
  86   PV = 0
  87 | # as of 5.21.5
  88 SV = PV(0x****) at 0x****
  89   REFCNT = 1
  90   FLAGS = ()
  91   PV = 0
  92 ==
  93 0
  94 --
  95 SV = PVIV(0x****) at 0x****
  96   REFCNT = 1
  97   FLAGS = (PADMY,IOK,pIOK)
  98   IV = 0
  99   PV = 0x**** ""\0
 100   CUR = 0
 101   LEN = 8
 102 | # as of 5.19.3
 103 SV = PVIV(0x****) at 0x****
 104   REFCNT = 1
 105   FLAGS = (PADMY,IOK,pIOK)
 106   IV = 0
 107   PV = 0
 108 | # as of 5.21.5
 109 SV = PVIV(0x****) at 0x****
 110   REFCNT = 1
 111   FLAGS = (IOK,pIOK)
 112   IV = 0
 113   PV = 0
 114 ==
 115 1
 116 --
 117 SV = PVIV(0x****) at 0x****
 118   REFCNT = 1
 119   FLAGS = (PADMY,IOK,pIOK)
 120   IV = 1
 121   PV = 0x**** ""\0
 122   CUR = 0
 123   LEN = 8
 124 | # as of 5.19.3
 125 SV = PVIV(0x****) at 0x****
 126   REFCNT = 1
 127   FLAGS = (PADMY,IOK,pIOK)
 128   IV = 1
 129   PV = 0
 130 | # as of 5.21.5
 131 SV = PVIV(0x****) at 0x****
 132   REFCNT = 1
 133   FLAGS = (IOK,pIOK)
 134   IV = 1
 135   PV = 0
 136 ==
 137 ""
 138 --
 139 SV = PVIV(0x****) at 0x****
 140   REFCNT = 1
 141   FLAGS = (PADMY,POK,pPOK)
 142   IV = 1
 143   PV = 0x**** ""\0
 144   CUR = 0
 145   LEN = 8
 146 | # as of 5.19.3
 147 SV = PVIV(0x****) at 0x****
 148   REFCNT = 1
 149   FLAGS = (PADMY,POK,IsCOW,pPOK)
 150   IV = 1
 151   PV = 0x**** ""\0
 152   CUR = 0
 153   LEN = 8
 154   COW_REFCNT = 0
 155 | # as of 5.21.5
 156 SV = PVIV(0x****) at 0x****
 157   REFCNT = 1
 158   FLAGS = (POK,IsCOW,pPOK)
 159   IV = 1
 160   PV = 0x**** ""\0
 161   CUR = 0
 162   LEN = 8
 163   COW_REFCNT = 0