1#!/usr/bin/perl 2 3#----------------------------------------------------------------------------- 4# Z88DK Z80 Macro Assembler 5# 6# Copyright (C) Paulo Custodio, 2011-2019 7# License: http://www.perlfoundation.org/artistic_license_2_0 8# 9# Common utils for tests 10#----------------------------------------------------------------------------- 11 12use Modern::Perl; 13use Config; 14use Path::Tiny; 15use File::Slurp; 16use Capture::Tiny::Extended 'capture'; 17use Test::Differences; 18use List::Uniq 'uniq'; 19use Data::HexDump; 20 21my $OBJ_FILE_VERSION = "14"; 22my $STOP_ON_ERR = grep {/-stop/} @ARGV; 23my $KEEP_FILES = grep {/-keep/} @ARGV; 24my $test = "test"; 25 26sub z80asm { $ENV{Z80ASM_EXE} || "./z80asm" } 27 28my @TEST_EXT = (qw( asm lis inc bin map o lib sym def err 29 exe c cpp lst prj i reloc tap P )); 30my @MAIN_TEST_FILES; 31my @TEST_FILES; 32my @IDS = ("", 0 .. 20); 33my %FILE; 34 35for my $ext (@TEST_EXT) { 36 for my $id (@IDS) { 37 my $file = $FILE{$ext}{$id} = $test.$id.".".$ext; 38 my $sub_name = $ext.$id."_file"; 39 no strict 'refs'; 40 *$sub_name = sub { return $file }; 41 42 push @MAIN_TEST_FILES, $file if $id eq ""; 43 push @TEST_FILES, $file; 44 } 45} 46 47#------------------------------------------------------------------------------ 48sub _unlink_files { 49 my($line, @files) = @_; 50 @files = grep {-f} uniq(@files); 51 is unlink(@files), scalar(@files), "$line unlink @files"; 52 while (grep {-f} @files) { sleep 1 }; # z80asm sometimes cannot create errfile 53} 54 55#------------------------------------------------------------------------------ 56sub unlink_testfiles { 57 my(@additional_files) = @_; 58 my $line = "[line ".((caller)[2])."]"; 59 if ($KEEP_FILES) { 60 diag "$line -keep : kept test files"; 61 } 62 else { 63 _unlink_files($line, @TEST_FILES, @additional_files, 64 'test'.$Config{_exe}, <test*.bin>, <test*.reloc>); 65 } 66} 67 68#------------------------------------------------------------------------------ 69# Args: 70# asm, asm1, asm2, ... : source text, asm is main file; can use " : " to split lines 71# org : >= 0 to define -r{org}, undef for no -r, org = decimal value 72# options : additional assemble options 73# out : expected output, if any 74# err : expected compile errors, if any 75# linkerr : expected link errors, if any 76# bin : expected binary output if defined, undef if compilation should fail 77# nolist : true to remove -l option 78 79sub t_z80asm { 80 my(%args) = @_; 81 82 my $line = "[line ".((caller)[2])."]"; 83 84 _unlink_files($line, @TEST_FILES); 85 86 # build input files 87 my @asm; 88 my @o; 89 my @lst; 90 my @sym; 91 for my $id (@IDS) { 92 my $asm = $args{"asm$id"} or next; 93 $asm =~ s/\s+:\s+/\n/g; 94 $asm .= "\n"; 95 96 write_file($FILE{asm}{$id}, $asm); 97 push @asm, $FILE{asm}{$id}; 98 push @o, $FILE{o}{$id}; 99 push @lst, $FILE{lis}{$id}; 100 push @sym, $FILE{sym}{$id}; 101 } 102 103 # assemble 104 my $cmd = z80asm()." "; 105 exists($args{nolist}) or 106 $cmd .= "-l "; 107 $cmd .= "-b "; 108 109 # org 110 if ( exists($args{org}) && $args{org} > 0 ){ 111 $cmd .= "-r".$args{org}." "; 112 } 113 114 exists($args{options}) 115 and $cmd .= $args{options} ." "; 116 $cmd .= "@asm"; 117 118 ok 1, "$line $cmd"; 119 120 my($stdout, $stderr, $return) = capture { 121 system $cmd; 122 }; 123 124 my $errors; 125 126 # check stdout 127 $args{out} ||= ""; chomp_eol($args{out}); chomp_eol($stdout); 128 my $ok_out = is_text($stdout, $args{out}, "$line out"); 129 $errors++ unless $ok_out; 130 131 # check stderr 132 $args{err} ||= ""; $args{linkerr} ||= ""; 133 chomp_eol($args{err}); chomp_eol($args{linkerr}); chomp_eol($stderr); 134 my $exp_err_screen = my $exp_err_file = $args{err}.$args{linkerr}; 135 my $ok_err_screen = is_text($stderr, $exp_err_screen, "$line err"); 136 $errors++ unless $ok_err_screen; 137 if ($stderr && $stderr !~ /option.*deprecated/) { # option deprecated: before error file is created 138 ok -f err_file(), "$line ".err_file(); 139 my $got_err_file = read_file(err_file(), err_mode => 'quiet') // ""; 140 chomp_eol($got_err_file); 141 is_text($exp_err_file, $got_err_file, "$line err file"); 142 } 143 144 # check retval 145 if (defined($args{bin})) { # asm success 146 $errors++ unless $return == 0; 147 ok $return == 0, "$line exit value"; 148 149 # warning -> got_err_file 150 # ok ! -f err_file(), "$line no ".err_file(); 151 152 ok -f $_, "$line $_" for (@o, bin_file()); 153 154 # map file 155 if ($cmd =~ / (-m) /) { 156 ok -f map_file(), "$line ".map_file(); 157 } 158 else { 159 ok ! -f map_file(), "$line no ".map_file(); 160 } 161 162 my $binary = read_file(bin_file(), binmode => ':raw', err_mode => 'quiet'); 163 t_binary($binary, $args{bin}, $line); 164 } 165 elsif ($args{linkerr}) { # asm OK but link failed 166 $errors++ unless $return != 0; 167 ok $return != 0, "$line exit value"; 168 169 ok -f err_file(), "$line ".err_file(); 170 171 ok -f $_, "$line $_" for (@o); 172 ok ! -f $_, "$line no $_" for (bin_file(), map_file()); 173 174 if ($cmd =~ / -x(\S+)/) { 175 my $lib = $1; 176 $lib .= ".lib" unless $lib =~ /\.lib$/i; 177 178 ok ! -f $1, "$line no $lib"; 179 } 180 } 181 else { # asm failed 182 $errors++ unless $return != 0; 183 ok $return != 0, "$line exit value"; 184 185 ok -f err_file(), "$line ".err_file(); 186 187 ok ! -f $_, "$line no $_" for (@o, bin_file(), map_file()); 188 189 if ($cmd =~ / -x(\S+)/) { 190 my $lib = $1; 191 $lib .= ".lib" unless $lib =~ /\.lib$/i; 192 193 ok ! -f $1, "$line no $lib"; 194 } 195 } 196 197 # list file or symbol table 198 if (defined($args{bin})) { 199 if ($cmd =~ / (-l) /) { 200 ok -f $_, "$line $_" for (@lst); 201 } 202 else { 203 ok ! -f $_, "$line no $_" for (@lst); 204 } 205 206 if ($cmd =~ / (-s) /) { 207 ok -f $_, "$line $_" for (@sym); 208 } 209 else { 210 ok ! -f $_, "$line no $_" for (@sym); 211 } 212 } 213 elsif ($args{linkerr}) { # asm OK but link failed 214 ok -f $_, "$line $_" for (@lst); 215 216 if ($cmd =~ / (-s) /) { 217 ok -f $_, "$line $_" for (@sym); 218 } 219 else { 220 ok ! -f $_, "$line no $_" for (@sym); 221 } 222 } 223 else { 224 ok ! -f $_, "$line no $_" for (@lst); 225 ok ! -f $_, "$line no $_" for (@sym); 226 } 227 228 exit 1 if $errors && $STOP_ON_ERR; 229} 230 231#------------------------------------------------------------------------------ 232sub t_z80asm_error { 233 my($code, $expected_err, $options) = @_; 234 235 my $line = "[line ".((caller)[2])."]"; 236 (my $test_name = $code) =~ s/\n.*/.../s; 237 ok 1, "$line t_z80asm_error $test_name - $expected_err"; 238 239 _unlink_files($line, @MAIN_TEST_FILES); 240 write_file(asm_file(), "$code\n"); 241 242 my $cmd = z80asm()." ".($options || "")." ".asm_file(); 243 ok 1, "$line $cmd"; 244 my($stdout, $stderr, $return) = capture { 245 system $cmd; 246 }; 247 is $stdout, "", "$line stdout"; 248 is_text( $stderr, $expected_err, "$line stderr" ); 249 ok $return != 0, "$line exit value"; 250 ok -f err_file(), "$line error file found"; 251 ok ! -f o_file(), "$line object file deleted"; 252 ok ! -f bin_file(), "$line binary file deleted"; 253 if (defined($options) && $options =~ /-x(\S+)/) { 254 my $lib = $1; 255 $lib .= ".lib" unless $lib =~ /\.lib$/i; 256 257 ok ! -f $1, "$line library file deleted"; 258 } 259 260 is_text( read_file(err_file(), err_mode => 'quiet'), 261 $expected_err, "$line error in error file" ); 262 263 exit 1 if $return == 0 && $STOP_ON_ERR; 264} 265 266#------------------------------------------------------------------------------ 267sub t_z80asm_ok { 268 my($address_hex, $code, $expected_binary, $options, $expected_warnings) = @_; 269 270 $expected_warnings ||= ""; 271 chomp_eol($expected_warnings); 272 273 my $line = "[line ".((caller)[2])."]"; 274 (my $test_name = $code) =~ s/\n.*/.../s; 275 ok 1, "$line t_z80asm_ok $test_name - ". 276 hexdump(substr($expected_binary, 0, 16)). 277 (length($expected_binary) > 16 ? "..." : ""); 278 279 _unlink_files($line, @MAIN_TEST_FILES); 280 write_file(asm_file(), "org 0x$address_hex\n$code\n"); 281 282 my $cmd = z80asm()." -l -b ".($options || "")." ".asm_file(); 283 ok 1, "$line $cmd"; 284 my($stdout, $stderr, $return) = capture { 285 system $cmd; 286 }; 287 288 is $stdout, "", "$line stdout"; 289 chomp_eol($stderr); 290 is_text( $stderr, $expected_warnings, "$line stderr" ); 291 292 ok $return == 0, "$line exit value"; 293 ok ! -f err_file(), "$line no error file"; 294 ok -f bin_file(), "$line bin file found"; 295 296 my $binary = read_file(bin_file(), binmode => ':raw', err_mode => 'quiet'); 297 t_binary($binary, $expected_binary, $line); 298 299 exit 1 if $return != 0 && $STOP_ON_ERR; 300} 301 302#------------------------------------------------------------------------------ 303sub t_binary { 304 my($binary, $expected_binary, $test_name) = @_; 305 306 $test_name //= "[line ".((caller)[2])."]"; 307 $binary //= ""; 308 $expected_binary //= ""; 309 my $ok = $binary eq $expected_binary; 310 ok $ok, "$test_name binary"; 311 if (! $ok) { 312 my $addr = 0; 313 $addr++ while (substr($binary, $addr, 1) eq substr($expected_binary, $addr, 1)); 314 diag sprintf("$test_name Assembly differs at %04X:\n". 315 ".....got: %s\n". 316 "expected: %s\n", 317 $addr, 318 hexdump(substr($binary, $addr, 16)), 319 hexdump(substr($expected_binary, $addr, 16))); 320 321 # show winmergeu 322 if ($ENV{DEBUG}) { 323 write_file("test.binary.got", HexDump($binary)); 324 write_file("test.binary.expected", HexDump($expected_binary)); 325 system "winmergeu test.binary.got test.binary.expected"; 326 die "aborted"; 327 } 328 329 exit 1 if $STOP_ON_ERR; 330 } 331} 332 333#------------------------------------------------------------------------------ 334sub t_z80asm_capture { 335 my($args, $expected_out, $expected_err, $expected_retval) = @_; 336 337 my $line = "[line ".((caller)[2])."]"; 338 ok 1, $line." t_z80asm_capture - ".z80asm()." ".$args; 339 340 my($stdout, $stderr, $return) = capture { 341 system z80asm()." ".$args; 342 }; 343 344 is_text( $stdout, $expected_out, "$line stdout" ); 345 is_text( $stderr, $expected_err, "$line stderr" ); 346 ok !!$return == !!$expected_retval, "$line retval"; 347 348 exit 1 if $STOP_ON_ERR && 349 ($stdout ne $expected_out || 350 $stderr ne $expected_err || 351 !!$return != !!$expected_retval); 352} 353 354#------------------------------------------------------------------------------ 355sub hexdump { 356 return join(' ', map { sprintf("%02X", ord($_)) } split(//, shift)); 357} 358 359#------------------------------------------------------------------------------ 360# return object file binary representation 361sub objfile { 362 my(%args) = @_; 363 364 exists($args{ORG}) and die; 365 366 my $o = "Z80RMF".$OBJ_FILE_VERSION; 367 368 # store empty pointers; mark position for later 369 my $name_addr = length($o); $o .= pack("V", -1); 370 my $expr_addr = length($o); $o .= pack("V", -1); 371 my $symbols_addr = length($o); $o .= pack("V", -1); 372 my $lib_addr = length($o); $o .= pack("V", -1); 373 my $code_addr = length($o); $o .= pack("V", -1); 374 375 # store expressions 376 if ($args{EXPR}) { 377 store_ptr(\$o, $expr_addr); 378 for (@{$args{EXPR}}) { 379 @$_ == 8 or die; 380 my($type, $filename, $line_nr, $section, $asmptr, $ptr, $target_name, $text) = @$_; 381 $o .= $type . pack_lstring($filename) . pack("V", $line_nr) . 382 pack_string($section) . pack("vv", $asmptr, $ptr) . 383 pack_string($target_name) . pack_lstring($text); 384 } 385 $o .= "\0"; 386 } 387 388 # store symbols 389 if ($args{SYMBOLS}) { 390 store_ptr(\$o, $symbols_addr); 391 for (@{$args{SYMBOLS}}) { 392 @$_ == 7 or die; 393 my($scope, $type, $section, $value, $name, $def_filename, $line_nr) = @$_; 394 $o .= $scope . $type . pack_string($section) . 395 pack("V", $value) . pack_string($name) . 396 pack_string($def_filename) . pack("V", $line_nr); 397 } 398 $o .= "\0"; 399 } 400 401 # store library 402 if ($args{LIBS}) { 403 store_ptr(\$o, $lib_addr); 404 for my $name (@{$args{LIBS}}) { 405 $o .= pack_string($name); 406 } 407 } 408 409 # store name 410 store_ptr(\$o, $name_addr); 411 $o .= pack_string($args{NAME}); 412 413 # store code 414 if ( $args{CODE} ) { 415 ref($args{CODE}) eq 'ARRAY' or die; 416 store_ptr(\$o, $code_addr); 417 for (@{$args{CODE}}) { 418 @$_ == 4 or die; 419 my($section, $org, $align, $code) = @$_; 420 $o .= pack("V", length($code)) . 421 pack_string($section) . 422 pack("VV", $org, $align) . 423 $code; 424 } 425 $o .= pack("V", -1); 426 } 427 428 return $o; 429} 430 431#------------------------------------------------------------------------------ 432# store a pointer to the end of the binary object at the given address 433sub store_ptr { 434 my($robj, $addr) = @_; 435 my $ptr = length($$robj); 436 my $packed_ptr = pack("V", $ptr); 437 substr($$robj, $addr, length($packed_ptr)) = $packed_ptr; 438} 439 440#------------------------------------------------------------------------------ 441sub pack_string { 442 my($string) = @_; 443 return pack("C", length($string)).$string; 444} 445 446#------------------------------------------------------------------------------ 447sub pack_lstring { 448 my($string) = @_; 449 return pack("v", length($string)).$string; 450} 451 452#------------------------------------------------------------------------------ 453sub read_binfile { 454 my($file) = @_; 455 ok -f $file, "$file exists"; 456 return scalar read_file($file, binmode => ':raw'); 457} 458 459#------------------------------------------------------------------------------ 460sub write_binfile { 461 my($file, $data) = @_; 462 write_file($file, {binmode => ':raw'}, $data); 463} 464 465#------------------------------------------------------------------------------ 466# return library file binary representation 467sub libfile { 468 my(@o_files) = @_; 469 my $lib = "Z80LMF".$OBJ_FILE_VERSION; 470 for my $i (0 .. $#o_files) { 471 my $o_file = $o_files[$i]; 472 my $next_ptr = ($i == $#o_files) ? 473 -1 : length($lib) + 4 + 4 + length($o_file); 474 475 $lib .= pack("V", $next_ptr); 476 $lib .= pack("V", length($o_file)); 477 $lib .= $o_file; 478 } 479 480 return $lib; 481} 482 483#------------------------------------------------------------------------------ 484sub t_compile_module { 485 my($init_code, $main_code, $compile_args) = @_; 486 487 # modules to include always 488 $compile_args .= " lib/alloc.o "; 489 490 # wait for previous run to finish 491 while (-f 'test'.$Config{_exe} && ! unlink('test'.$Config{_exe})) { 492 sleep(1); 493 } 494 495 my($CFLAGS, $CXXFLAGS, $LDFLAGS) = get_gcc_options(); 496 497 # get list of object files 498 my %modules; 499 while ($compile_args =~ /(\S+)\.[co]\b/ig) { 500 $modules{$1}++; 501 } 502 503 # make modules (once per run) 504 our %made_modules; 505 my @make_modules; 506 for (keys %modules) { 507 push @make_modules, "$_.o" unless $made_modules{$_}++; 508 } 509 if (@make_modules) { 510 my $make = "gmake @make_modules"; 511 note "line ", (caller)[2], ": $make"; 512 513 my $ok = (0 == system($make)); 514 ok $ok, "gmake"; 515 516 exit 1 if !$ok; # no need to cotinue if compilation failed 517 } 518 519 # create code skeleton 520 $main_code = " 521#include <stdlib.h> 522#include <stdio.h> 523 524".join("\n", map {"#include \"$_\""} grep {-f $_} map {"$_.h"} sort keys %modules)."\n".' 525#undef main 526 527#define TITLE(title) fprintf(stderr, "\n---- TEST: %s ----\n\n", (title) ) 528 529#define TEST_DIE(err_condition, err_message, expr_str) \ 530 do { \ 531 if ( err_condition ) { \ 532 fprintf(stderr, err_message " (%s) at file %s, line %d\n", \ 533 expr_str, __FILE__, __LINE__); \ 534 exit(1); \ 535 } \ 536 } while(0) 537 538#define ASSERT(expr) TEST_DIE( ! (expr), "TEST FAILED", #expr ) 539 540void dump_file ( char *filename ) 541{ 542 FILE *fp; 543 int addr, c; 544 545 ASSERT( fp = fopen( filename, "rb") ); 546 547 fprintf(stderr, "File: %s:", filename); 548 for ( addr = 0; (c = fgetc(fp)) != EOF; addr++ ) { 549 if (addr % 16 == 0) 550 fprintf(stderr, "\n%4X ", addr); 551 if (c > 0x20 && c < 0x7F) 552 fprintf(stderr, " %1c ", c); 553 else 554 fprintf(stderr, "<%02X> ", c); 555 } 556 fprintf(stderr, "\n"); 557 fclose(fp); 558} 559'.$init_code.' 560int main (int argc, char **argv) 561{ 562 { 563'.$main_code." 564 } 565 566 return 0; 567} 568 569"; 570 571 write_file("test.c", $main_code); 572 573 # build 574 my $cc = "cc $CFLAGS -O0 -o test$Config{_exe} test.c $compile_args $LDFLAGS"; 575 note "line ", (caller)[2], ": $cc"; 576 577 my $ok = (0 == system($cc)); 578 ok $ok, "cc"; 579 580 exit 1 if !$ok; # no need to cotinue if compilation failed 581} 582 583#------------------------------------------------------------------------------ 584sub t_run_module { 585 my($args, $expected_out, $expected_err, $expected_exit) = @_; 586 587 note "line ", (caller)[2], ": test$Config{_exe} @$args"; 588 my($out, $err, $exit) = capture { system("./test$Config{_exe}", @$args) }; 589 note "line ", (caller)[2], ": exit ", $exit >> 8; 590 591 $err = normalize($err); 592 593 is_text( $out, $expected_out ); 594 is_text( $err, $expected_err ); 595 is !!$exit, !!$expected_exit; 596 597 # if DEBUG, call winmergeu to compare out and err with expected out and err 598 if ($ENV{DEBUG} && $out."##".$err ne $expected_out."##".$expected_err) { 599 my $temp_input = $0.".tmp"; 600 my @input = read_file($0); 601 write_file($temp_input, @input[0 .. (caller)[2] - 1], $out, "OUT\n", $err, "ERR\n" ); 602 system "winmergeu \"$0\" \"$temp_input\""; 603 die "aborted"; 604 } 605 606 exit 1 if $STOP_ON_ERR && 607 ($out ne $expected_out || 608 $err ne $expected_err || 609 !!$exit != !!$expected_exit); 610} 611 612#------------------------------------------------------------------------------ 613# convert addresses to sequencial numbers 614# convert line numbers to sequencial numbers 615sub normalize { 616 my($err) = @_; 617 618 # MAP memory addresses - map only first occurrence of each address 619 # as the OS may reuse addresses 620 my $sentence_re = qr/alloc \d+ bytes at|new class \w+ at|delete class \w+ at|free \d+ bytes at|free memory leak of \d+ bytes at|\w+_(?:init|fini|copy)/; 621 622 my $addr_seq; 623 for ($err) { 624 while (my($sentence, $addr) = /($sentence_re) ((0x)+[0-9A-F]+\b)/i) { # in Linux we get 0x0xHHHH 625 $addr_seq++; 626 627 # replace only first occurrence 628 s/(alloc \d+ bytes at) $addr/$1 ADDR_$addr_seq/; 629 s/(new class \w+ at) $addr/$1 ADDR_$addr_seq/; 630 s/(delete class \w+ at) $addr/$1 ADDR_$addr_seq/; 631 s/(free \d+ bytes at) $addr/$1 ADDR_$addr_seq/; 632 s/(free memory leak of \d+ bytes at) $addr/$1 ADDR_$addr_seq/; 633 s/(\w+_init) $addr/$1 ADDR_$addr_seq/g; 634 s/(\w+_fini) $addr/$1 ADDR_$addr_seq/g; 635 s/(\w+_copy) $addr/$1 ADDR_$addr_seq/g; 636 } 637 } 638 639 # map code line numbers 640 my %line_map; 641 while ($err =~ /((\w+\.[ch])\((\d+)\))/gi) { 642 $line_map{$2}{$3} = undef; 643 } 644 for my $file (keys %line_map) { 645 my $count; 646 for my $line (sort {$a <=> $b} keys %{$line_map{$file}}) { 647 my $new_line = ++$count; 648 $line_map{$file}{$line} = $new_line; 649 $err =~ s/$file\($line\)/$file\($new_line\)/gi; 650 } 651 } 652 653 # mask error number - random value on memory exception 654 $err =~ s/(The value of errno was) \d+/$1 0/gi; 655 $err =~ s/(thrown at \w+ \(\w+\.c):\d+/$1:0/gi; 656 657 return $err; 658} 659 660#------------------------------------------------------------------------------ 661# get version and date from hist.c 662sub get_copyright { 663 my $hist = read_file("hist.c"); 664 my($copyright) = $hist =~ /\#define \s+ COPYRIGHT \s+ \" (.*?) \"/x or die; 665 666 my $config = read_file("../config.h"); 667 my($version) = $config =~ /\#define \s+ Z88DK_VERSION \s+ \" (.*?) \" /x or die; 668 669 my $copyrightmsg = "Z80 Module Assembler ".$version."\n(c) ".$copyright; 670 671 return $copyrightmsg; 672} 673 674#------------------------------------------------------------------------------ 675# Get compilation options 676#------------------------------------------------------------------------------ 677sub get_gcc_options { 678 our %FLAGS; 679 680 if ( ! %FLAGS ) { 681 my %vars; 682 open(my $pipe, "gmake -p|") or die; 683 while (<$pipe>) { 684 if (/^(\w+)\s*[:+]?=\s*(.*)/) { 685 my($flag, $text) = ($1, $2); 686 $vars{$flag} = $text; 687 } 688 } 689 close($pipe) or die; 690 691 while (my($flag, $text) = each %vars) { 692 if ($flag =~ /(CFLAGS|CXXFLAGS|LDFLAGS)$/) { 693 my $redo; 694 do { 695 $redo = 0; 696 $redo += ($text =~ s/\$\((\w+)\)/ $vars{$1} || "" /ge); 697 $redo += ($text =~ s/\$\(shell (.*?)\)/ `$1` /ge); 698 } while ($redo); 699 700 $text =~ s/\s+/ /g; 701 702 $FLAGS{$flag} = join(" ", ($FLAGS{$flag}//''), $text); 703 } 704 } 705 } 706 707 return map {$_ // ''} @FLAGS{qw( LOCAL_CFLAGS LOCAL_CXXFLAGS LDFLAGS )}; 708}; 709 710#------------------------------------------------------------------------------ 711# EOL-agnostic text compare 712#------------------------------------------------------------------------------ 713sub is_text { 714 my($got, $expected, $name) = @_; 715 716 # normalize white space 717 for ($got, $expected) { 718 s/[ \t]+/ /g; 719 s/\r\n/\n/g; 720 s/\s+\z//; 721 } 722 eq_or_diff_text($got, $expected, $name); 723 return $got eq $expected; 724} 725 726sub chomp_eol { 727 local $_ = shift; 728 s/[\r\n]+\z//; 729 return $_; 730} 731 7321; 733