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