ext/Devel/PPPort/t/ppphtest.t

   1 ################################################################################
   2 #
   3 #            !!!!!   Do NOT edit this file directly!   !!!!!
   4 #
   5 #            Edit mktests.PL and/or parts/inc/ppphtest instead.
   6 #
   7 ################################################################################
   8
   9 BEGIN {
  10   if ($ENV{'PERL_CORE'}) {
  11     chdir 't' if -d 't';
  12     @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
  13     require Config; import Config;
  14     use vars '%Config';
  15     if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
  16       print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
  17       exit 0;
  18     }
  19   }
  20   else {
  21     unshift @INC, 't';
  22   }
  23
  24   sub load {
  25     eval "use Test";
  26     require 'testutil.pl' if $@;
  27   }
  28
  29   if (203) {
  30     load();
  31     plan(tests => 203);
  32   }
  33 }
  34
  35 use Devel::PPPort;
  36 use strict;
  37 $^W = 1;
  38
  39 package Devel::PPPort;
  40 use vars '@ISA';
  41 require DynaLoader;
  42 @ISA = qw(DynaLoader);
  43 bootstrap Devel::PPPort;
  44
  45 package main;
  46
  47 BEGIN {
  48   if ($ENV{'SKIP_SLOW_TESTS'}) {
  49     for (1 .. 203) {
  50       skip("skip: SKIP_SLOW_TESTS", 0);
  51     }
  52     exit 0;
  53   }
  54 }
  55
  56 use File::Path qw/rmtree mkpath/;
  57 use Config;
  58
  59 my $tmp = 'ppptmp';
  60 my $inc = '';
  61 my $isVMS = $^O eq 'VMS';
  62 my $isMAC = $^O eq 'MacOS';
  63 my $perl = find_perl();
  64
  65 rmtree($tmp) if -d $tmp;
  66 mkpath($tmp) or die "mkpath $tmp: $!\n";
  67 chdir($tmp) or die "chdir $tmp: $!\n";
  68
  69 if ($ENV{'PERL_CORE'}) {
  70   if (-d '../../lib') {
  71     if ($isVMS) {
  72       $inc = '"-I../../lib"';
  73     }
  74     elsif ($isMAC) {
  75       $inc = '-I:::lib';
  76     }
  77     else {
  78       $inc = '-I../../lib';
  79     }
  80     unshift @INC, '../../lib';
  81   }
  82 }
  83 if ($perl =~ m!^\./!) {
  84   $perl = ".$perl";
  85 }
  86
  87 END {
  88   chdir('..') if !-d $tmp && -d "../$tmp";
  89   rmtree($tmp) if -d $tmp;
  90 }
  91
  92 ok(&Devel::PPPort::WriteFile("ppport.h"));
  93
  94 sub comment
  95 {
  96   my $c = shift;
  97   $c =~ s/^/# | /mg;
  98   $c .= "\n" unless $c =~ /[\r\n]$/;
  99   print $c;
 100 }
 101
 102 sub ppport
 103 {
 104   my @args = ('ppport.h', @_);
 105   unshift @args, $inc if $inc;
 106   my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;
 107   $run .= ' -MMac::err=unix' if $isMAC;
 108   for (@args) {
 109     $_ = qq("$_") if $isVMS && /^[^"]/;
 110     $run .= " $_";
 111   }
 112   print "# *** running $run ***\n";
 113   $run .= ' 2>&1' unless $isMAC;
 114   my @out = `$run`;
 115   my $out = join '', @out;
 116   comment($out);
 117   return wantarray ? @out : $out;
 118 }
 119
 120 sub matches
 121 {
 122   my($str, $re, $mod) = @_;
 123   my @n;
 124   eval "\@n = \$str =~ /$re/g$mod;";
 125   if ($@) {
 126     my $err = $@;
 127     $err =~ s/^/# *** /mg;
 128     print "# *** ERROR ***\n$err\n";
 129   }
 130   return $@ ? -42 : scalar @n;
 131 }
 132
 133 sub eq_files
 134 {
 135   my($f1, $f2) = @_;
 136   return 0 unless -e $f1 && -e $f2;
 137   local *F;
 138   for ($f1, $f2) {
 139     print "# File: $_\n";
 140     unless (open F, $_) {
 141       print "# couldn't open $_: $!\n";
 142       return 0;
 143     }
 144     $_ = do { local $/; <F> };
 145     close F;
 146     comment($_);
 147   }
 148   return $f1 eq $f2;
 149 }
 150
 151 my @tests;
 152
 153 for (split /\s*={70,}\s*/, do { local $/; <DATA> }) {
 154   s/^\s+//; s/\s+$//;
 155   my($c, %f);
 156   ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/;
 157   push @tests, { code => $c, files => \%f };
 158 }
 159
 160 my $t;
 161 for $t (@tests) {
 162   my $f;
 163   for $f (keys %{$t->{files}}) {
 164     my @f = split /\//, $f;
 165     if (@f > 1) {
 166       pop @f;
 167       my $path = join '/', @f;
 168       mkpath($path) or die "mkpath('$path'): $!\n";
 169     }
 170     my $txt = $t->{files}{$f};
 171     local *F;
 172     open F, ">$f" or die "open $f: $!\n";
 173     print F "$txt\n";
 174     close F;
 175     $txt =~ s/^/# | /mg;
 176     print "# *** writing $f ***\n$txt\n";
 177   }
 178
 179   eval $t->{code};
 180   if ($@) {
 181     my $err = $@;
 182     $err =~ s/^/# *** /mg;
 183     print "# *** ERROR ***\n$err\n";
 184   }
 185   ok($@, '');
 186
 187   for (keys %{$t->{files}}) {
 188     unlink $_ or die "unlink('$_'): $!\n";
 189   }
 190 }
 191
 192 sub find_perl
 193 {
 194   my $perl = $^X;
 195
 196   return $perl if $isVMS;
 197
 198   my $exe = $Config{'_exe'} || '';
 199
 200   if ($perl =~ /^perl\Q$exe\E$/i) {
 201     $perl = "perl$exe";
 202     eval "require File::Spec";
 203     if ($@) {
 204       $perl = "./$perl";
 205     } else {
 206       $perl = File::Spec->catfile(File::Spec->curdir(), $perl);
 207     }
 208   }
 209
 210   if ($perl !~ /\Q$exe\E$/i) {
 211     $perl .= $exe;
 212   }
 213
 214   warn "find_perl: cannot find $perl from $^X" unless -f $perl;
 215
 216   return $perl;
 217 }
 218
 219 __DATA__
 220
 221 my $o = ppport(qw(--help));
 222 ok($o =~ /^Usage:.*ppport\.h/m);
 223 ok($o =~ /--help/m);
 224
 225 $o = ppport(qw(--version));
 226 ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/);
 227
 228 $o = ppport(qw(--nochanges));
 229 ok($o =~ /^Scanning.*test\.xs/mi);
 230 ok($o =~ /Analyzing.*test\.xs/mi);
 231 ok(matches($o, '^Scanning', 'm'), 1);
 232 ok(matches($o, 'Analyzing', 'm'), 1);
 233 ok($o =~ /Uses Perl_newSViv instead of newSViv/);
 234
 235 $o = ppport(qw(--quiet --nochanges));
 236 ok($o =~ /^\s*$/);
 237
 238 ---------------------------- test.xs ------------------------------------------
 239
 240 Perl_newSViv();
 241
 242 ===============================================================================
 243
 244 # check if C and C++ comments are filtered correctly
 245
 246 my $o = ppport(qw(--copy=a));
 247 ok($o =~ /^Scanning.*MyExt\.xs/mi);
 248 ok($o =~ /Analyzing.*MyExt\.xs/mi);
 249 ok(matches($o, '^Scanning', 'm'), 1);
 250 ok($o =~ /^Needs to include.*ppport\.h/m);
 251 ok($o !~ /^Uses grok_bin/m);
 252 ok($o !~ /^Uses newSVpv/m);
 253 ok($o =~ /Uses 1 C\+\+ style comment/m);
 254 ok(eq_files('MyExt.xsa', 'MyExt.ra'));
 255
 256 # check if C++ are left untouched with --cplusplus
 257
 258 $o = ppport(qw(--copy=b --cplusplus));
 259 ok($o =~ /^Scanning.*MyExt\.xs/mi);
 260 ok($o =~ /Analyzing.*MyExt\.xs/mi);
 261 ok(matches($o, '^Scanning', 'm'), 1);
 262 ok($o =~ /^Needs to include.*ppport\.h/m);
 263 ok($o !~ /^Uses grok_bin/m);
 264 ok($o !~ /^Uses newSVpv/m);
 265 ok($o !~ /Uses \d+ C\+\+ style comment/m);
 266 ok(eq_files('MyExt.xsb', 'MyExt.rb'));
 267
 268 unlink qw(MyExt.xsa MyExt.xsb);
 269
 270 ---------------------------- MyExt.xs -----------------------------------------
 271
 272 newSVuv();
 273     // newSVpv();
 274   XPUSHs(foo);
 275 /* grok_bin(); */
 276
 277 ---------------------------- MyExt.ra -----------------------------------------
 278
 279 #include "ppport.h"
 280 newSVuv();
 281     /* newSVpv(); */
 282   XPUSHs(foo);
 283 /* grok_bin(); */
 284
 285 ---------------------------- MyExt.rb -----------------------------------------
 286
 287 #include "ppport.h"
 288 newSVuv();
 289     // newSVpv();
 290   XPUSHs(foo);
 291 /* grok_bin(); */
 292
 293 ===============================================================================
 294
 295 my $o = ppport(qw(--nochanges file1.xs));
 296 ok($o =~ /^Scanning.*file1\.xs/mi);
 297 ok($o =~ /Analyzing.*file1\.xs/mi);
 298 ok($o !~ /^Scanning.*file2\.xs/mi);
 299 ok($o =~ /^Uses newCONSTSUB/m);
 300 ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
 301 ok($o =~ /hint for newCONSTSUB/m);
 302 ok($o !~ /hint for sv_2pv_nolen/m);
 303 ok($o =~ /^Looks good/m);
 304
 305 $o = ppport(qw(--nochanges --nohints file1.xs));
 306 ok($o =~ /^Scanning.*file1\.xs/mi);
 307 ok($o =~ /Analyzing.*file1\.xs/mi);
 308 ok($o !~ /^Scanning.*file2\.xs/mi);
 309 ok($o =~ /^Uses newCONSTSUB/m);
 310 ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
 311 ok($o !~ /hint for newCONSTSUB/m);
 312 ok($o !~ /hint for sv_2pv_nolen/m);
 313 ok($o =~ /^Looks good/m);
 314
 315 $o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
 316 ok($o =~ /^Scanning.*file1\.xs/mi);
 317 ok($o =~ /Analyzing.*file1\.xs/mi);
 318 ok($o !~ /^Scanning.*file2\.xs/mi);
 319 ok($o !~ /^Uses newCONSTSUB/m);
 320 ok($o !~ /^Uses SvPV_nolen/m);
 321 ok($o !~ /hint for newCONSTSUB/m);
 322 ok($o !~ /hint for sv_2pv_nolen/m);
 323 ok($o =~ /^Looks good/m);
 324
 325 $o = ppport(qw(--nochanges --quiet file1.xs));
 326 ok($o =~ /^\s*$/);
 327
 328 $o = ppport(qw(--nochanges file2.xs));
 329 ok($o =~ /^Scanning.*file2\.xs/mi);
 330 ok($o =~ /Analyzing.*file2\.xs/mi);
 331 ok($o !~ /^Scanning.*file1\.xs/mi);
 332 ok($o =~ /^Uses mXPUSHp/m);
 333 ok($o =~ /^Needs to include.*ppport\.h/m);
 334 ok($o !~ /^Looks good/m);
 335 ok($o =~ /^1 potentially required change detected/m);
 336
 337 $o = ppport(qw(--nochanges --nohints file2.xs));
 338 ok($o =~ /^Scanning.*file2\.xs/mi);
 339 ok($o =~ /Analyzing.*file2\.xs/mi);
 340 ok($o !~ /^Scanning.*file1\.xs/mi);
 341 ok($o =~ /^Uses mXPUSHp/m);
 342 ok($o =~ /^Needs to include.*ppport\.h/m);
 343 ok($o !~ /^Looks good/m);
 344 ok($o =~ /^1 potentially required change detected/m);
 345
 346 $o = ppport(qw(--nochanges --nohints --nodiag file2.xs));
 347 ok($o =~ /^Scanning.*file2\.xs/mi);
 348 ok($o =~ /Analyzing.*file2\.xs/mi);
 349 ok($o !~ /^Scanning.*file1\.xs/mi);
 350 ok($o !~ /^Uses mXPUSHp/m);
 351 ok($o !~ /^Needs to include.*ppport\.h/m);
 352 ok($o !~ /^Looks good/m);
 353 ok($o =~ /^1 potentially required change detected/m);
 354
 355 $o = ppport(qw(--nochanges --quiet file2.xs));
 356 ok($o =~ /^\s*$/);
 357
 358 ---------------------------- file1.xs -----------------------------------------
 359
 360 #define NEED_newCONSTSUB
 361 #define NEED_sv_2pv_nolen
 362 #include "ppport.h"
 363
 364 newCONSTSUB();
 365 SvPV_nolen();
 366
 367 ---------------------------- file2.xs -----------------------------------------
 368
 369 mXPUSHp(foo);
 370
 371 ===============================================================================
 372
 373 my $o = ppport(qw(--nochanges));
 374 ok($o =~ /^Scanning.*FooBar\.xs/mi);
 375 ok($o =~ /Analyzing.*FooBar\.xs/mi);
 376 ok(matches($o, '^Scanning', 'm'), 1);
 377 ok($o !~ /^Looks good/m);
 378 ok($o =~ /^Uses grok_bin/m);
 379
 380 ---------------------------- FooBar.xs ----------------------------------------
 381
 382 newSViv();
 383 XPUSHs(foo);
 384 grok_bin();
 385
 386 ===============================================================================
 387
 388 my $o = ppport(qw(--nochanges));
 389 ok($o =~ /^Scanning.*First\.xs/mi);
 390 ok($o =~ /Analyzing.*First\.xs/mi);
 391 ok($o =~ /^Scanning.*second\.h/mi);
 392 ok($o =~ /Analyzing.*second\.h/mi);
 393 ok($o =~ /^Scanning.*sub.*third\.c/mi);
 394 ok($o =~ /Analyzing.*sub.*third\.c/mi);
 395 ok($o !~ /^Scanning.*foobar/mi);
 396 ok(matches($o, '^Scanning', 'm'), 3);
 397
 398 ---------------------------- First.xs -----------------------------------------
 399
 400 one
 401
 402 ---------------------------- foobar.xyz ---------------------------------------
 403
 404 two
 405
 406 ---------------------------- second.h -----------------------------------------
 407
 408 three
 409
 410 ---------------------------- sub/third.c --------------------------------------
 411
 412 four
 413
 414 ===============================================================================
 415
 416 my $o = ppport(qw(--nochanges));
 417 ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i);
 418
 419 ---------------------------- test.xs ------------------------------------------
 420
 421 #define NEED_foobar
 422
 423 ===============================================================================
 424
 425 # And now some complex "real-world" example
 426
 427 my $o = ppport(qw(--copy=f));
 428 for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) {
 429   ok($o =~ /^Scanning.*\Q$_\E/mi);
 430   ok($o =~ /Analyzing.*\Q$_\E/i);
 431 }
 432 ok(matches($o, '^Scanning', 'm'), 6);
 433
 434 ok(matches($o, '^Writing copy of', 'm'), 5);
 435 ok(!-e "mod5.cf");
 436
 437 for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
 438   ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi);
 439   ok(-e "${_}f");
 440   ok(eq_files("${_}f", "${_}r"));
 441   unlink "${_}f";
 442 }
 443
 444 ---------------------------- main.xs ------------------------------------------
 445
 446 #include "EXTERN.h"
 447 #include "perl.h"
 448 #include "XSUB.h"
 449
 450 #define NEED_newCONSTSUB
 451 #define NEED_grok_hex_GLOBAL
 452 #include "ppport.h"
 453
 454 newCONSTSUB();
 455 grok_hex();
 456 Perl_grok_bin(aTHX_ foo, bar);
 457
 458 /* some comment */
 459
 460 perl_eval_pv();
 461 grok_bin();
 462 Perl_grok_bin(bar, sv_no);
 463
 464 ---------------------------- mod1.c -------------------------------------------
 465
 466 #include "EXTERN.h"
 467 #include "perl.h"
 468 #include "XSUB.h"
 469
 470 #define NEED_grok_bin_GLOBAL
 471 #define NEED_newCONSTSUB
 472 #include "ppport.h"
 473
 474 newCONSTSUB();
 475 grok_bin();
 476 {
 477   Perl_croak ("foo");
 478   Perl_sv_catpvf();  /* I know it's wrong ;-) */
 479 }
 480
 481 ---------------------------- mod2.c -------------------------------------------
 482
 483 #include "EXTERN.h"
 484 #include "perl.h"
 485 #include "XSUB.h"
 486
 487 #define NEED_eval_pv
 488 #include "ppport.h"
 489
 490 newSViv();
 491
 492 /*
 493    eval_pv();
 494 */
 495
 496 ---------------------------- mod3.c -------------------------------------------
 497
 498 #include "EXTERN.h"
 499 #include "perl.h"
 500 #include "XSUB.h"
 501
 502 grok_oct();
 503 eval_pv();
 504
 505 ---------------------------- mod4.c -------------------------------------------
 506
 507 #include "EXTERN.h"
 508 #include "perl.h"
 509 #include "XSUB.h"
 510
 511 START_MY_CXT;
 512
 513 ---------------------------- mod5.c -------------------------------------------
 514
 515 #include "EXTERN.h"
 516 #include "perl.h"
 517 #include "XSUB.h"
 518
 519 #include "ppport.h"
 520 call_pv();
 521
 522 ---------------------------- main.xsr -----------------------------------------
 523
 524 #include "EXTERN.h"
 525 #include "perl.h"
 526 #include "XSUB.h"
 527
 528 #define NEED_eval_pv_GLOBAL
 529 #define NEED_grok_hex
 530 #define NEED_newCONSTSUB_GLOBAL
 531 #include "ppport.h"
 532
 533 newCONSTSUB();
 534 grok_hex();
 535 grok_bin(foo, bar);
 536
 537 /* some comment */
 538
 539 eval_pv();
 540 grok_bin();
 541 grok_bin(bar, PL_sv_no);
 542
 543 ---------------------------- mod1.cr ------------------------------------------
 544
 545 #include "EXTERN.h"
 546 #include "perl.h"
 547 #include "XSUB.h"
 548
 549 #define NEED_grok_bin_GLOBAL
 550 #include "ppport.h"
 551
 552 newCONSTSUB();
 553 grok_bin();
 554 {
 555   Perl_croak (aTHX_ "foo");
 556   Perl_sv_catpvf(aTHX);  /* I know it's wrong ;-) */
 557 }
 558
 559 ---------------------------- mod2.cr ------------------------------------------
 560
 561 #include "EXTERN.h"
 562 #include "perl.h"
 563 #include "XSUB.h"
 564
 565
 566 newSViv();
 567
 568 /*
 569    eval_pv();
 570 */
 571
 572 ---------------------------- mod3.cr ------------------------------------------
 573
 574 #include "EXTERN.h"
 575 #include "perl.h"
 576 #include "XSUB.h"
 577 #define NEED_grok_oct
 578 #include "ppport.h"
 579
 580 grok_oct();
 581 eval_pv();
 582
 583 ---------------------------- mod4.cr ------------------------------------------
 584
 585 #include "EXTERN.h"
 586 #include "perl.h"
 587 #include "XSUB.h"
 588 #include "ppport.h"
 589
 590 START_MY_CXT;
 591
 592 ===============================================================================
 593
 594 my $o = ppport(qw(--nochanges));
 595 ok($o =~ /Uses grok_hex/m);
 596 ok($o !~ /Looks good/m);
 597
 598 $o = ppport(qw(--nochanges --compat-version=5.8.0));
 599 ok($o !~ /Uses grok_hex/m);
 600 ok($o =~ /Looks good/m);
 601
 602 ---------------------------- FooBar.xs ----------------------------------------
 603
 604 grok_hex();
 605
 606 ===============================================================================
 607
 608 my $o = ppport(qw(--nochanges));
 609 ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
 610
 611 $o = ppport(qw(--nochanges --compat-version=5.5.3));
 612 ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
 613
 614 $o = ppport(qw(--nochanges --compat-version=5.005_03));
 615 ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
 616
 617 $o = ppport(qw(--nochanges --compat-version=5.6.0));
 618 ok($o !~ /Uses SvPVutf8_force/m);
 619
 620 $o = ppport(qw(--nochanges --compat-version=5.006));
 621 ok($o !~ /Uses SvPVutf8_force/m);
 622
 623 $o = ppport(qw(--nochanges --compat-version=5.999.999));
 624 ok($o !~ /Uses SvPVutf8_force/m);
 625
 626 $o = ppport(qw(--nochanges --compat-version=6.0.0));
 627 ok($o =~ /Only Perl 5 is supported/m);
 628
 629 $o = ppport(qw(--nochanges --compat-version=5.1000.999));
 630 ok($o =~ /Invalid version number: 5.1000.999/m);
 631
 632 $o = ppport(qw(--nochanges --compat-version=5.999.1000));
 633 ok($o =~ /Invalid version number: 5.999.1000/m);
 634
 635 ---------------------------- FooBar.xs ----------------------------------------
 636
 637 SvPVutf8_force();
 638
 639 ===============================================================================
 640
 641 my $o = ppport(qw(--nochanges));
 642 ok($o !~ /potentially required change/);
 643 ok(matches($o, '^Looks good', 'm'), 2);
 644
 645 ---------------------------- FooBar.xs ----------------------------------------
 646
 647 #define NEED_grok_numeric_radix
 648 #define NEED_grok_number
 649 #include "ppport.h"
 650
 651 GROK_NUMERIC_RADIX();
 652 grok_number();
 653
 654 ---------------------------- foo.c --------------------------------------------
 655
 656 #include "ppport.h"
 657
 658 call_pv();
 659
 660 ===============================================================================
 661
 662 # check --api-info option
 663
 664 my $o = ppport(qw(--api-info=INT2PTR));
 665 my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
 666 ok(scalar keys %found, 1);
 667 ok(exists $found{INT2PTR});
 668 ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1);
 669 ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1);
 670
 671 $o = ppport(qw(--api-info=Zero));
 672 %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
 673 ok(scalar keys %found, 1);
 674 ok(exists $found{Zero});
 675 ok(matches($o, '^No portability information available\.', 'm'), 1);
 676
 677 $o = ppport(qw(--api-info=/Zero/));
 678 %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
 679 ok(scalar keys %found, 2);
 680 ok(exists $found{Zero});
 681 ok(exists $found{ZeroD});
 682
 683 ===============================================================================
 684
 685 # check --list-provided option
 686
 687 my @o = ppport(qw(--list-provided));
 688 my %p;
 689 my $fail = 0;
 690 for (@o) {
 691   my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++;
 692   exists $p{$name} and $fail++;
 693   $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : '';
 694 }
 695 ok(@o > 100);
 696 ok($fail, 0);
 697
 698 ok(exists $p{call_sv});
 699 ok(not ref $p{call_sv});
 700
 701 ok(exists $p{grok_bin});
 702 ok(ref $p{grok_bin}, 'HASH');
 703 ok(scalar keys %{$p{grok_bin}}, 1);
 704 ok($p{grok_bin}{explicit});
 705
 706 ok(exists $p{gv_stashpvn});
 707 ok(ref $p{gv_stashpvn}, 'HASH');
 708 ok(scalar keys %{$p{gv_stashpvn}}, 1);
 709 ok($p{gv_stashpvn}{hint});
 710
 711 ok(exists $p{sv_catpvf_mg});
 712 ok(ref $p{sv_catpvf_mg}, 'HASH');
 713 ok(scalar keys %{$p{sv_catpvf_mg}}, 2);
 714 ok($p{sv_catpvf_mg}{explicit});
 715 ok($p{sv_catpvf_mg}{depend});
 716
 717 ===============================================================================
 718
 719 # check --list-unsupported option
 720
 721 my @o = ppport(qw(--list-unsupported));
 722 my %p;
 723 my $fail = 0;
 724 for (@o) {
 725   my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++;
 726   exists $p{$name} and $fail++;
 727   $p{$name} = $ver;
 728 }
 729 ok(@o > 100);
 730 ok($fail, 0);
 731
 732 ok(exists $p{utf8_distance});
 733 ok($p{utf8_distance}, '5.6.0');
 734
 735 ok(exists $p{save_generic_svref});
 736 ok($p{save_generic_svref}, '5.005_03');
 737
 738 ===============================================================================
 739
 740 # check --nofilter option
 741
 742 my $o = ppport(qw(--nochanges));
 743 ok($o =~ /^Scanning.*foo\.cpp/mi);
 744 ok($o =~ /Analyzing.*foo\.cpp/mi);
 745 ok(matches($o, '^Scanning', 'm'), 1);
 746 ok(matches($o, 'Analyzing', 'm'), 1);
 747
 748 $o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL));
 749 ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m);
 750 ok(matches($o, '^\|\s+foo\.o', 'mi'), 1);
 751 ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
 752 ok($o =~ /^Scanning.*foo\.cpp/mi);
 753 ok($o =~ /Analyzing.*foo\.cpp/mi);
 754 ok(matches($o, '^Scanning', 'm'), 1);
 755 ok(matches($o, 'Analyzing', 'm'), 1);
 756
 757 $o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL));
 758 ok($o =~ /^Scanning.*foo\.cpp/mi);
 759 ok($o =~ /Analyzing.*foo\.cpp/mi);
 760 ok($o =~ /^Scanning.*foo\.o/mi);
 761 ok($o =~ /Analyzing.*foo\.o/mi);
 762 ok($o =~ /^Scanning.*Makefile/mi);
 763 ok($o =~ /Analyzing.*Makefile/mi);
 764 ok(matches($o, '^Scanning', 'm'), 3);
 765 ok(matches($o, 'Analyzing', 'm'), 3);
 766
 767 ---------------------------- foo.cpp ------------------------------------------
 768
 769 newSViv();
 770
 771 ---------------------------- foo.o --------------------------------------------
 772
 773 newSViv();
 774
 775 ---------------------------- Makefile.PL --------------------------------------
 776
 777 newSViv();
 778
 779 ===============================================================================
 780
 781 # check if explicit variables are handled propery
 782
 783 my $o = ppport(qw(--copy=a));
 784 ok($o =~ /^Needs to include.*ppport\.h/m);
 785 ok($o =~ /^Uses PL_signals/m);
 786 ok($o =~ /^File needs PL_signals, adding static request/m);
 787 ok(eq_files('MyExt.xsa', 'MyExt.ra'));
 788
 789 unlink qw(MyExt.xsa);
 790
 791 ---------------------------- MyExt.xs -----------------------------------------
 792
 793 PL_signals = 123;
 794 if (PL_signals == 42)
 795   foo();
 796
 797 ---------------------------- MyExt.ra -----------------------------------------
 798
 799 #define NEED_PL_signals
 800 #include "ppport.h"
 801 PL_signals = 123;
 802 if (PL_signals == 42)
 803   foo();
 804