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