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