1# $Id: Subs.pm,v 1.198 2012/03/04 13:56:35 pfeiffer Exp $ 2 3=head1 NAME 4 5Mpp::Subs - Functions and statements for makefiles 6 7=head1 DESCRIPTION 8 9This package contains subroutines which can be called from a makefile. 10Subroutines in this package are called in two ways: 11 12=over 13 14=item 1) 15 16Any line which isn't a rule or an assignment and has at the left margin a word 17is interpreted as a subroutine call to a subroutine in the makefile package, 18or if not in the makefile package, in this package. "s_" is prefixed to the 19name before the Perl function is looked up. 20 21=item 2) 22 23Any function that is in a make expression (e.g., $(xyz abc)) attempts to call 24a Perl function in the make package, and failing that, in this package. "f_" 25is prefixed to the name first. 26 27=back 28 29All official subroutine names in this package are automatically exported to 30each makefile package by Mpp::Makefile::load. See the regexps in import, for 31which ones are official. 32 33=cut 34 35package Mpp::Subs; 36 37use strict qw(vars subs); 38 39use Mpp::Text qw(index_ignoring_quotes split_on_whitespace requote 40 unquote unquote_split_on_whitespace format_exec_args); 41use Mpp::File; 42use Mpp::FileOpt; 43use Mpp::Event qw(wait_for when_done read_wait); 44use Mpp::Glob qw(zglob zglob_fileinfo); 45use Mpp::CommandParser; 46use Mpp::CommandParser::Gcc; 47 48# eval successfully or die with a fixed error message 49our( $makefile, $makefile_line ); 50sub eval_or_die($$$) { 51 my $code = $_[0]; 52 # Make $makefile and $makefile_line available to the Perl code, so that it 53 # can call f_* and s_* subroutines. 54 local( undef, $makefile, $makefile_line ) = @_; # Name the arguments. 55 56 (my $line = $makefile_line) =~ s/(.+):(\d+)(?:\(.+\))?$/#line $2 "$1"/; 57 &touched_filesystem; 58 $code = qq{ 59 no strict; package $makefile->{PACKAGE}; 60 \@Cxt=(\$Mpp::Subs::makefile, \$Mpp::Subs::makefile_line); 61$line 62$code}; 63 if( wantarray ) { 64 my @result = eval $code; 65 &touched_filesystem; 66 die $@ if $@; 67 @result; 68 } elsif( defined wantarray ) { 69 my $result = eval $code; 70 &touched_filesystem; 71 die $@ if $@; 72 $result; 73 } else { 74 eval $code; 75 &touched_filesystem; 76 die $@ if $@; 77 } 78} 79 80our $rule; 81 82############################################################################### 83# 84# Command parsers included with makepp: 85# 86# Parse C command, looking for sources and includes and libraries. 87# 88# TODO: is $ENV{INCLUDE} a reliable alternative on native Windows? And if 89# ActiveState is to call MinGW gcc, must makepp translate directory names? 90our @system_include_dirs = grep -d, qw(/usr/local/include /usr/include); 91our @system_lib_dirs = grep -d, qw(/usr/local/lib /usr/lib /lib); 92 93sub p_gcc_compilation { 94 shift; 95 Mpp::CommandParser::Gcc->new( @_ ); 96} 97# TODO: remove the deprecated backwards compatibility scanner_ variants. 98*scanner_gcc_compilation = \&p_gcc_compilation; 99 100sub p_c_compilation { 101 shift; 102 Mpp::CommandParser::Gcc->new_no_gcc( @_ ); 103} 104*scanner_c_compilation = \&p_c_compilation; 105 106sub p_esql_compilation { 107 shift; 108 require Mpp::CommandParser::Esql; 109 Mpp::CommandParser::Esql->new( @_ ); 110} 111*scanner_esql_compilation = \&p_esql_compilation; 112 113sub p_vcs_compilation { 114 shift; 115 require Mpp::CommandParser::Vcs; 116 Mpp::CommandParser::Vcs->new( @_ ); 117} 118*scanner_vcs_compilation = \&p_vcs_compilation; 119 120sub p_swig { 121 shift; 122 require Mpp::CommandParser::Swig; 123 Mpp::CommandParser::Swig->new( @_ ); 124} 125*scanner_swig = \&p_swig; 126 127# 128# This parser exists only to allow the user to say ":parser none" to suppress 129# the default parser. 130# 131sub scanner_none { 132 $_[1]{SCANNER_NONE} = 1; 133 shift; 134 Mpp::CommandParser->new( @_ ); 135} 136 137# 138# This parser simply moves to the next word that doesn't begin with 139# - and parses again. 140# 141sub scanner_skip_word { 142 #my ($action, $myrule, $dir) = @_; 143 my ($action) = @_; # Name the arguments. 144 145 $action =~ s/^\s+//; # Leading whitespace messes up the regular 146 # expression below. 147 while ($action =~ s/^\S+\s+//) { # Strip off another word. 148 $action =~ s/^([\"\'\(])//; # Strip off leading quotes in case it's 149 # something like sh -c "cc ...". 150 if( defined $1 ) { 151 my $compl = ${{qw!" " ' ' ( \)!}}{$1}; 152 $action =~ s/$compl//; 153 } 154 next if $action =~ /^-/; # Word that doesn't look like an option? 155 local $_[1]{LEXER} if $_[1]{LEXER}; # Don't skip next word on recursion. 156 local $_[1]{LEXER_OBJ} if $_[1]{LEXER_OBJ}; # ditto 157 my $lexer = new Mpp::Lexer; 158 $_[1]{SCANNER_NONE} = 1 159 if Mpp::Lexer::parse_command( $lexer, $action, $_[1], $_[2], $_[1]{MAKEFILE}{ENVIRONMENT} ); 160 last; # Don't go any further. 161 } 162 new Mpp::Lexer; 163} 164 165# These are implemented in Mpp::Lexer::find_command_parser 166(*p_none, *p_skip_word, *p_shell) = @Mpp::Text::N; 167 168# 169# This array contains the list of the default parsers used for various 170# command words. 171# 172our %parsers = 173 ( 174 # These words usually introduce another command 175 # which actually is the real compilation command: 176 ash => \&p_shell, 177 bash => \&p_shell, 178 csh => \&p_shell, 179 ksh => \&p_shell, 180 sh => \&p_shell, 181 tcsh => \&p_shell, 182 zsh => \&p_shell, 183 eval => \&p_shell, 184 185 ccache => \&p_skip_word, 186 condor_compile => \&p_skip_word, 187 cpptestscan => \&p_skip_word, # Parasoft c++test 188 diet => \&p_skip_word, # dietlibc 189 distcc => \&p_skip_word, 190 fast_cc => \&p_skip_word, 191 libtool => \&p_skip_word, 192 purecov => \&p_skip_word, 193 purify => \&p_skip_word, 194 quantify => \&p_skip_word, 195 time => \&p_skip_word, 196 197 # All the C/C++ compilers we have run into so far: 198 aCC => \&p_c_compilation, # HP C++. 199 bcc32 => \&p_c_compilation, # Borland C++ 200 c89 => \&p_c_compilation, 201 c99 => \&p_c_compilation, 202 cc => \&p_c_compilation, 203 CC => \&p_c_compilation, 204 ccppc => \&p_c_compilation, # Green Hills compilers. 205 clang => \&p_c_compilation, # LLVM 206 cl => \&p_c_compilation, # MS Visual C/C++ 207 'c++' => \&p_c_compilation, 208 cpp => \&p_c_compilation, # The C/C++ preprocessor. 209 cxppc => \&p_c_compilation, 210 cxx => \&p_c_compilation, 211 icc => \&p_c_compilation, # Intel 212 icl => \&p_c_compilation, # Intel? 213 ingcc => \&p_c_compilation, # Ingres wrapper 214 insure => \&p_c_compilation, # Parasoft Insure++ 215 kcc => \&p_c_compilation, # KAI C++. 216 lsbcc => \&p_c_compilation, # LSB wrapper around cc. 217 'lsbc++' => \&p_c_compilation, 218 pcc => \&p_c_compilation, 219 xlC => \&p_c_compilation, 220 xlc => \&p_c_compilation, # AIX 221 xlc_r => \&p_c_compilation, 222 xlC_r => \&p_c_compilation, 223 224 vcs => \&p_vcs_compilation, 225 226 apre => \&p_esql_compilation, # Altibase APRE*C/C++ 227 db2 => \&p_esql_compilation, # IBM DB2 228 dmppcc => \&p_esql_compilation, # CASEMaker DBMaker 229 ecpg => \&p_esql_compilation, # PostgreSQL 230 esql => \&p_esql_compilation, # IBM Informix ESQL/C / Mimer 231 esqlc => \&p_esql_compilation, # Ingres 232 gpre => \&p_esql_compilation, # InterBase / Firebird 233 proc => \&p_esql_compilation, # Oracle 234 yardpc => \&p_esql_compilation, # YARD 235 236 swig => \&p_swig 237); 238 239@parsers{ map "$_.exe", keys %parsers } = values %parsers 240 if Mpp::is_windows; 241 242 243# 244# An internal subroutine that converts Mpp::File structures to printable 245# names. Takes either a single Mpp::File structure, an array of Mpp::File 246# structures, or a reference to an array of Mpp::File structures. 247# 248sub relative_filenames { 249 my @ret_vals; 250 251 my $cwd = $rule->build_cwd; 252 foreach (@_) { 253 next unless defined; # Skip undef things--results in a blank. 254 push @ret_vals, (ref() eq 'ARRAY') ? relative_filenames(@$_) : relative_filename $_, $cwd; 255 } 256 257 @ret_vals; 258} 259 260############################################################################### 261# 262# Functions that are intended to be invoked by make expressions. These 263# all begin with the prefix "f_", which is added before we look up the 264# name of the function. These functions are called with the following 265# arguments: 266# a) The text after the function name in the makefile (with other macros 267# already expanded). 268# b) The makefile. 269# c) The line number in the makefile that this expression occurred in. 270# 271 272# 273# Define all the cryptic one-character symbols, and anything else that isn't a 274# valid subroutine name: 275# 276our %perl_unfriendly_symbols = 277 ('@' => \&f_target, 278 '<' => \&f_dependency, 279 '^' => \&f_dependencies, 280 '?' => \&f_changed_dependencies, 281 '+' => \&f_sorted_dependencies, 282 '*' => \&f_stem, 283 '&' => '', # Perl makefiles use this for some reason, but 284 # $& is a perl pattern match variable. 285 '/' => Mpp::is_windows > 1 ? '\\' : '/', 286 287 '@D' => \&f_target, # Special handling in expand_variable for /^.[DF]$/. 288 '@F' => \&f_target, 289 '*D' => \&f_stem, 290 '*F' => \&f_stem, 291 '<D' => \&f_dependency, 292 '<F' => \&f_dependency, 293 '^D' => \&f_dependencies, 294 '^F' => \&f_dependencies 295 ); 296 297# 298# Obtain the single arg of a makefile f_function. 299# This utility takes the same 3 parameters as f_* functions, so call it as: &arg 300# 301# It gives you the expanded value of the calling f_function's single arg, if the 302# first parameter is a ref to a string, else just the unexpanded string. 303# If the 2nd arg is false it also doesn't expand. 304# 305# If the f_function doesn't take an arg, there is no need to call this. 306# 307sub arg { $_[1] && ref $_[0] ? $_[1]->expand_text( ${$_[0]}, $_[2] ) : $_[0] } 308 309# 310# Obtain multiple args of a makefile f_function. 311# This utility takes the same 3 parameters as arg 312# 313# Additional parameters: 314# max: number of args (default 2): give ~0 (maxint) for endless 315# min: number of args (default 0 if max is ~0, else same as max) 316# only_comma: don't eat space around commas 317# 318sub args { 319 local $_ = ref $_[0] ? ${$_[0]} : $_[0]; # Make a modifiable copy 320 my $max = $_[3] || 2; 321 my $min = ($_[4] or $max == ~0 ? 1 : $max) - 1; 322 pos = 0; 323 while( length() > pos ) { 324 /\G[^,\$]+/gc; 325 if( /\G,/gc ) { 326 --$min if $min; 327 last unless --$max; 328 my $pos = pos; 329 substr $_, $pos - 1, 1, "\01"; 330 pos = $pos; 331 } elsif( /\G\$/gc ) { 332 &Mpp::Text::skip_over_make_expression; 333 } 334 } 335 tr/\01/,/, 336 die $_[2] || 'somewhere', ': $(', (caller 1)[3], " $_) $min more arguments expected\n" if $min; 337 $_ = $_[1]->expand_text( $_, $_[2] ) if $_[1] && ref $_[0] && /\$/; 338 $_[5] ? split "\01", $_, -1 : split /\s*\01\s*/, $_, -1; 339} 340 341# 342# Return the absolute filename of all the arguments. 343# 344sub f_absolute_filename { 345 my $cwd = $_[1] && $_[1]{CWD}; 346 join ' ', 347 map absolute_filename( file_info unquote(), $cwd ), 348 split_on_whitespace &arg; 349} 350*f_abspath = \&f_absolute_filename; 351 352sub f_absolute_filename_nolink { 353 my $cwd = $_[1]{CWD}; 354 join ' ', 355 map absolute_filename_nolink( file_info unquote(), $cwd ), 356 split_on_whitespace &arg; 357} 358*f_realpath = \&f_absolute_filename_nolink; 359 360sub f_addprefix { 361 my( $prefix, $text ) = args $_[0], $_[1], $_[2], 2, 2, 1; # Get the prefix. 362 join ' ', map "$prefix$_", split ' ', $text; 363} 364 365sub f_addsuffix { 366 my( $suffix, $text ) = args $_[0], $_[1], $_[2], 2, 2, 1; # Get the suffix. 367 join ' ', map "$_$suffix", split ' ', $text; 368} 369 370sub f_and { 371 my $ret = ''; 372 for my $cond ( args $_[0], undef, $_[2], ~0 ) { 373 $ret = $_[1] && ref $_[0] ? $_[1]->expand_text( $cond, $_[2] ) : $cond; 374 return '' unless length $ret; 375 } 376 $ret; 377} 378 379sub f_or { 380 for my $cond ( args $_[0], undef, $_[2], ~0 ) { 381 $cond = $_[1]->expand_text( $cond, $_[2] ) 382 if $_[1] && ref $_[0]; 383 return $cond if length $cond; 384 } 385 ''; 386} 387 388sub f_basename { 389 join ' ', map { s!\.[^./,]*$!!; $_ } split ' ', &arg; 390} 391 392our $call_args = 1; # In nested call, don't inherit outer extra args. 393sub f_call { 394 my @args= args $_[0], $_[1], $_[2], ~0, 1, 1; 395 local @perl_unfriendly_symbols{0..($#args>$call_args ? $#args : $call_args)} = @args; # assign to $0, $1, $2... 396 local $call_args = $#args; 397 local $Mpp::Makefile::expand_bracket; 398 $_[1]->expand_variable( $args[0], $_[2] ); 399} 400 401sub f_dir { 402 join ' ', map { m@^(.*/)@ ? $1 : './' } split ' ', &arg; 403} 404 405sub f_dir_noslash { # An internal routine that does the same 406 # thing but doesn't return a trailing slash. 407 join ' ', map { m@^(.*)/@ ? $1 : '.'} split ' ', &arg; 408} 409 410sub f_error { 411 die "$_[2]: *** ".&arg."\n"; # Throw the text. 412} 413 414# 415# Perform a pattern substitution on file names. This differs from patsubst 416# in that it will perform correctly when alternate names for directories are 417# given (as long as they precede the percent sign). For example, 418# 419# $(filesubst ./src/%.c, %.o, $(wildcard src/*.c)) 420# 421# will work with filesubst but not with patsubst. 422# 423sub f_filesubst { 424 my( $src, $dest, $words, $set_stem ) = args $_[0], $_[1], $_[2], 4, 3; 425 # Get the patterns. 426 die "$_[2]: filesubst has extra argument `$set_stem'\n" if defined $set_stem && $set_stem ne '_'; 427 my $cwd = $_[1]{CWD}; 428# 429# First we eat away at the directories on the source until we find the 430# percent sign. We remember where this directory is. Then we consider each 431# of the words and strip off leading directories until we reach that 432# directory. Then we run through patsubst. 433# 434 my $startdir = ($src =~ s@^/+@@) ? $Mpp::File::root : $cwd; 435 # The directory we're in if there are no 436 # other directories specified. 437 438 while ($src =~ s@([^%/]+)/+@@) { # Strip off a leading directory that 439 # doesn't contain the % sign. 440 $startdir = dereference file_info $1, $startdir; 441 # Move to that directory. 442 } 443 444# 445# Now eat away at the directories in the words until we reach the starting 446# directory. 447# 448 my @words; 449 foreach( split ' ', $words ) { 450 my $thisdir = (s@^/+@@) ? $Mpp::File::root : $cwd; 451 $thisdir = dereference file_info $1, $thisdir 452 while $thisdir != $startdir && s@([^/]+)/+@@; # Another directory? 453 push @words, case_sensitive_filenames ? $_ : lc; 454 # What's left is the filename relative to that 455 # directory. 456 } 457 458 local $Mpp::Text::set_stem = 1 if $set_stem; 459 join ' ', Mpp::Text::pattern_substitution 460 case_sensitive_filenames ? $src : lc $src, 461 $dest, 462 @words; 463} 464 465sub f_filter { 466 my( $filters, $words ) = args $_[0], $_[1], $_[2]; 467 my @filters = split ' ', $filters; # Can be more than one filter. 468 foreach (@filters) { # Convert these into regular expressions. 469 s/([.+()])/\\$1/g; # Protect all the periods and other special chars. 470 s/[*%]/\.\*/g; # Replace '*' and '%' with '.*'. 471 $_ = qr/^$_$/; # Anchor the pattern. 472 } 473 474 my @ret_words; 475 wordloop: 476 foreach( split ' ', $words ) { # Now look at each word. 477 foreach my $filter (@filters) { 478 if (/$filter/) { # Does it match this filter? 479 push @ret_words, $_; 480 next wordloop; 481 } 482 } 483 } 484 485 join ' ', @ret_words; 486} 487 488 489sub f_filter_out { 490 my ($filters, $words) = args $_[0], $_[1], $_[2]; 491 my @filters = split ' ', $filters; # Can be more than one filter. 492 foreach (@filters) { # Convert these into regular expressions. 493 s/([.+()])/\\$1/g; # Protect all the periods and other special chars. 494 s/[*%]/\.\*/g; # Replace '*' and '%' with '.*'. 495 $_ = qr/^$_$/; # Anchor the pattern. 496 } 497 498 my @ret_words; 499 wordloop: 500 foreach( split ' ', $words ) { # Now look at each word. 501 foreach my $filter (@filters) { 502 next wordloop if /$filter/; # Skip if it matches this filter. 503 } 504 push @ret_words, $_; 505 } 506 507 join ' ', @ret_words; 508} 509 510sub f_filter_out_dirs { 511 #my ($text, $mkfile) = @_; # Name the arguments. 512 join ' ', grep { !is_or_will_be_dir file_info $_, $_[1]{CWD} } split ' ', &arg; 513} 514 515# 516# Find one of several executables in PATH. Optional 4th arg means to return found path. 517# Does not consider last chance rules or autoloads if PATH is used. 518# 519# On Windows this is ugly, because an executable xyz is usually not present, 520# instead there is xyz.exe. If we want the full path with the builtin rules 521# we need to depend on xyz as long as xyz.exe hasn't been built, because 522# that's where Unix makefiles put the dependencies. To make matters worse, 523# stat may lie about xyz when only xyz.exe exists. 524# 525sub f_find_program { 526 my $mkfile = $_[1]; # Access the other arguments. 527 528 my @pathdirs; # Remember the list of directories to search. 529 my $first_round = 1; 530 foreach my $name ( split ' ', &arg) { 531 if( $name =~ /\// || Mpp::is_windows > 1 && $name =~ /\\/ ) { # Either relative or absolute? 532 my $finfo = path_file_info $name, $mkfile->{CWD}; 533 my $exists = Mpp::File::exists_or_can_be_built $finfo; 534 if( Mpp::is_windows && $name !~ /\.exe$/ ) { 535 my( $exists_exe, $finfo_exe ); 536 $exists_exe = Mpp::File::exists_or_can_be_built $finfo_exe = Mpp::File::path_file_info "$name.exe", $mkfile->{CWD} 537 if !$exists || 538 $_[3] && $Mpp::File::stat_exe_separate ? !exists $finfo->{xEXISTS} : !open my $fh, '<', absolute_filename $finfo; 539 # Check for exe, but don't bother returning it, unless full path wanted. 540 # If stat has .exe magic, xEXISTS is meaningless. 541 return $_[3] ? absolute_filename( $finfo_exe ) : $name if $exists_exe; 542 } 543 return $_[3] ? absolute_filename( $finfo ) : $name if $exists; 544 next; 545 } 546 @pathdirs = Mpp::Text::split_path( $mkfile->{EXPORTS} ) unless @pathdirs; 547 foreach my $dir (@pathdirs) { # Find the programs to look for in the path: 548 # Avoid publishing nonexistent dirs in the path. This works around 549 # having unquoted drive letters in the path looking like relative 550 # directories. 551 if( $first_round ) { 552 $dir = path_file_info $dir, $mkfile->{CWD}; 553 undef $dir unless is_or_will_be_dir $dir; 554 } 555 next unless $dir; 556 my $finfo = file_info $name, $dir; 557 my $exists = Mpp::File::exists_or_can_be_built $finfo, undef, undef, 1; 558 if( Mpp::is_windows && $name !~ /\.exe$/ ) { 559 my( $exists_exe, $finfo_exe ); 560 $exists_exe = Mpp::File::exists_or_can_be_built $finfo_exe = file_info( "$name.exe", $dir ), undef, undef, 1 561 if !$exists || 562 $_[3] && $Mpp::File::stat_exe_separate ? !exists $finfo->{xEXISTS} : !open my $fh, '<', absolute_filename $finfo; 563 # Check for exe, but don't bother returning it, unless full path wanted. 564 return $_[3] ? absolute_filename( $finfo_exe ) : $name if $exists_exe; 565 } 566 return $_[3] ? absolute_filename( $finfo ) : $name if $exists; 567 } 568 $first_round = 0; 569 } 570 571 Mpp::log NOT_FOUND => ref $_[0] ? ${$_[0]} : $_[0], $_[2]; 572 'not-found'; # None of the programs were executable. 573} 574 575# 576# Find a file in a specified path, or in the environment variable PATH if 577# nothing is specified. 578# 579sub f_findfile { 580 my ($name, $path) = args $_[0], $_[1], $_[2]; # Get what to look for, and where 581 # to look for it. 582 my $mkfile = $_[1]; # Access the other arguments. 583 my @pathdirnames = $path ? split( /\s+|:/, $path ) : 584 Mpp::Text::split_path( $mkfile->{EXPORTS} ); 585 # Get a separate list of directories. 586 my @names = split ' ', $name; # Get a list of names to find. 587 foreach $name (@names) { # Look for each one in the path: 588 foreach my $dir (@pathdirnames) { 589 my $finfo = file_info $name, file_info $dir, $mkfile->{CWD}; 590 # Get the finfo structure. 591 if( file_exists $finfo ) { # Found it? 592 $name = absolute_filename $finfo; # Replace it with the full name. 593 last; # Skip to the next thing to look for. 594 } 595 } 596 } 597 598 join ' ', @names; 599} 600 601# 602# Find a file by searching for it in the current directory, then in ., .., 603# etc. 604# Modified from function contributed by Matthew Lovell. 605# 606# Two versions are supplied: $(find_upwards ...) is the original function: 607# its behavior, when given multiple filenames, it attempts to find all 608# the requested files 609# 610sub f_find_upwards { 611 my $cwd = $_[1] && $_[1]{CWD}; 612 my @ret_names; 613 my $cwd_devid; # Remember what device this is mounted on 614 # so we can avoid crossing file system boundaries. 615 for( split_on_whitespace &arg ) { 616 $_ = unquote; 617 my $found; 618 my $dirinfo = $cwd; 619 while( 1 ) { 620 my $finfo = file_info $_, $dirinfo; 621 if( Mpp::File::exists_or_can_be_built $finfo ) { # Found file in the path? 622 $found = 1; 623 push @ret_names, relative_filename $finfo, $cwd; 624 last; # done searching 625 } 626 last unless $dirinfo = $dirinfo->{'..'}; # Look in all directories above us. 627 last if (stat_array $dirinfo)->[Mpp::File::STAT_DEV] != 628 ($cwd_devid ||= (stat_array $cwd)->[Mpp::File::STAT_DEV]); 629 # Don't cross device boundaries. This is 630 # intended to avoid trouble with automounters 631 # or dead network file systems. 632 } 633 $found or die "find_upwards: cannot find file $_\n"; 634 } 635 636 join ' ', @ret_names; 637} 638 639# 640# $(find_first_upwards ...) is similar, but reverses the order of the loop. 641# It looks for any of the named files at one directory-level, before going 642# to "..", where it then also looks for any of the filenames. It returns the 643# first file that it finds. With a 4th true arg, returns a Mpp::File instead. 644# If the 4th arg is a ref, only returns files that already exist. 645# 646sub f_find_first_upwards { 647 my @fnames = unquote_split_on_whitespace &arg; 648 my $cwd = $_[1] && $_[1]{CWD}; 649 650 my $cwd_devid; # Remember what device this is mounted on 651 # so we can avoid crossing file system boundaries. 652 my $dirinfo = $cwd; 653 while( 1 ) { 654 for( @fnames ) { 655 my $finfo = file_info $_, $dirinfo; 656 return $_[3] ? $finfo : relative_filename $finfo, $cwd 657 if ref $_[3] ? 658 file_exists $finfo : 659 Mpp::File::exists_or_can_be_built $finfo; # Found file in the path? 660 } 661 last unless $dirinfo = $dirinfo->{'..'}; # Look in all directories above us. 662 last if (stat_array $dirinfo)->[Mpp::File::STAT_DEV] != 663 ($cwd_devid ||= (stat_array $cwd)->[Mpp::File::STAT_DEV]); 664 # Don't cross device boundaries. This is 665 # intended to avoid trouble with automounters 666 # or dead network file systems. 667 } 668 return if $_[3]; 669 die "find_first_upwards cannot find any of the requested files: @fnames\n"; 670} 671 672sub f_findstring { 673 my( $find, $in ) = args $_[0], $_[1], $_[2], 2, 2, 1; 674 675 (index($in, $find) >= 0) ? $find : ''; 676} 677 678sub f_firstword { 679 (split ' ', &arg, 2)[0] || ''; 680} 681 682# 683# Return the first available file of a list of possible candidates. 684# This can be used to make your makefiles work in several different 685# environments. 686# 687sub f_first_available { 688 foreach my $fname (split ' ', &arg) { 689 Mpp::File::exists_or_can_be_built( file_info $fname, $_[1]->{CWD} ) and return $fname; 690 } 691 ''; 692} 693 694# 695# The if function is unusual, because its arguments have not 696# been expanded before we call it. The if function is defined so that 697# only the expression that is actually used is expanded. E.g., if the 698# if statement is true, then only the then expression is expanded, and 699# any side effects of the else expression do not happen. 700# 701sub f_if { 702 my( $cond, $then, $else ) = args $_[0], undef, $_[2], 3, 2, 1; 703 my( undef, $mkfile, $mkfile_line, $iftrue ) = @_; # Name the arguments. 704 $cond = ref $_[0] ? $mkfile->expand_text( $cond, $mkfile_line ) : $cond; # Evaluate the condition. 705 $cond =~ s/^\s+//; # Strip out whitespace on the response. 706 $cond =~ s/\s+$//; 707 if( $cond || !$iftrue && $cond ne "" ) { 708 ref $_[0] ? $mkfile->expand_text( $then, $mkfile_line ) : $then; 709 } elsif( defined $else ) { 710 ref $_[0] ? $mkfile->expand_text( $else, $mkfile_line ) : $else; 711 } else { 712 ''; 713 } 714} 715sub f_iftrue { 716 $_[3] = 1; 717 goto &f_if; 718} 719 720# 721# Infer the linker command from a list of objects. If any of the objects 722# is Fortran, we use $(FC) as a linker; if any of the objects is C++, we 723# use $(CXX); otherwise, we use $(CC). 724# 725# This function is mostly used by the default link rules (see 726# makepp_builtin_rules.mk). 727# 728sub f_infer_linker { 729 my @objs = split ' ', &arg; # Get a list of objects. 730 my( undef, $mkfile, $mkfile_line ) = @_; # Name the arguments. 731# 732# First build all the objs. Until we build them, we don't actually know what 733# source files went into them. They've probably been built, but we must 734# make sure. 735# 736 my @build_handles; 737 &Mpp::maybe_stop; 738 foreach my $obj (@objs) { 739 $obj = file_info($obj, $mkfile->{CWD}); # Replace the name with the 740 # fileinfo. 741 my $bh = prebuild( $obj, $mkfile, $mkfile_line ); 742 # Build this one. 743 $bh and push @build_handles, $bh; 744 } 745 746 my $status = wait_for @build_handles; # Wait for them all to build. 747 $status and die "Error while compiling\n"; # Maybe I'll come up with a better 748 # error message later. 749 750# 751# Now see what source files these were built from. Unfortunately, the 752# dependencies have been sorted, so we can't just look at the first one. 753# 754 my $linker; 755 foreach my $obj (@objs) { 756 foreach my $source_name( split /\01/, Mpp::File::build_info_string($obj, 'SORTED_DEPS') || '' ) { 757 # TODO: Why is $(FC) only Fortran 77? What about .f90 files? 758 $source_name =~ /\.f(?:77)?$/ and $linker = '$(FC)'; 759 $source_name =~ /\.(?:c\+\+|cc|cxx|C|cpp|moc)$/ and $linker ||= '$(CXX)'; 760 } 761 } 762 $linker ||= '$(CC)'; # Assume we can use the ordinary C linker. 763 764 $mkfile->expand_text($linker, $mkfile_line); 765 # Figure out what those things expand to. 766} 767 768# 769# Usage: 770# target : $(infer_objs seed-list, list of possible objs) 771# 772sub f_infer_objects { 773 my ($seed_objs, $candidate_list) = args $_[0], $_[1], $_[2]; 774 my (undef, $mkfile, $mkfile_line) = @_; # Name the arguments. 775 776 my $build_cwd = $rule ? $rule->build_cwd : $mkfile->{CWD}; 777 778# 779# Build up a list of all the possibilities: 780# 781 my %candidate_objs; 782 foreach my $candidate_obj (map Mpp::Glob::zglob_fileinfo_atleastone($_, $build_cwd), split ' ', $candidate_list) { 783 # Get a list of all the possible objs. 784 my $objname = $candidate_obj->{NAME}; 785 $objname =~ s/\.[^\.]+$//; # Strip off the extension. 786 if ($candidate_objs{$objname}) { # Already something by this name? 787 ref($candidate_objs{$objname}) eq 'ARRAY' or 788 $candidate_objs{$objname} = [ $candidate_objs{$objname} ]; 789 # Make into an array as appropriate. 790 push @{$candidate_objs{$objname}}, $candidate_obj; 791 } 792 else { # Just one obj? 793 $candidate_objs{$objname} = $candidate_obj; 794 } 795 } 796# 797# Now look at the list of all the include files. This is a little tricky 798# because we don't know the include files until we've actually built the 799# dependencies. 800# 801 my %source_names; # These are the names of include files for 802 # which are look for the corresponding objects. 803 804 my @build_handles; # Where we put the handles for building objects. 805 my @deps = map zglob_fileinfo($_, $build_cwd), split ' ', $seed_objs; 806 # Start with the seed files themselves. 807 @deps or die "infer_objects called with no seed objects that exist or can be built\n"; 808 Mpp::log INFER_SEED => \@deps 809 if $Mpp::log_level; 810 811 foreach (@deps) { 812 my $name = $_->{NAME}; 813 $name =~ s/\.[^\.]+$//; # Strip off the extension. 814 $source_names{$name}++; # Indicate that we already have this as a 815 # source file. 816 } 817 818 819 my $dep_idx = 0; 820 821 &Mpp::maybe_stop; 822# 823# Build everything, so we know what everything's dependencies are. Initially, 824# we'll only have a few objects to start from, so we build all of those, in 825# parallel if possible. (That's why the loop structure is so complicated 826# here.) Then we infer additional objects, build those in parallel, and 827# so on. 828# 829 for (;;) { 830 while ($dep_idx < @deps) { # Look at each dependency currently available. 831 my $o_info = $deps[$dep_idx]; # Access the Mpp::File for this object. 832 my $bh = prebuild( $o_info, $mkfile, $mkfile_line ); 833 # Start building it. 834 my $handle = when_done $bh, # Build this dependency. 835 sub { # Called when the build is finished: 836 defined($bh) && $bh->status and return $bh->status; 837 # Skip if an error occurred. 838 my @this_sources = split /\01/, Mpp::File::build_info_string($o_info,'SORTED_DEPS') || ''; 839 # Get the list of source files that went into 840 # it. 841 foreach (@this_sources) { 842 my $name = $_; # Make a copy of the file. 843 $name =~ s@.*/@@; # Strip off the path. 844 $name =~ s/\.[^\.]+$//; # Strip off the extension. 845 unless ($source_names{$name}++) { # Did we already know about that source? 846 if (ref($candidate_objs{$name}) eq 'Mpp::File') { # Found a file? 847 Mpp::log INFER_DEP => $candidate_objs{$name}, $_ 848 if $Mpp::log_level; 849 push @deps, $candidate_objs{$name}; # Scan for its dependencies. 850 } 851 elsif (ref($candidate_objs{$name}) eq 'ARRAY') { # More than 1 match? 852 Mpp::print_error('`', $mkfile_line, "' in infer_objects: more than one possible object for include file $_:\n ", 853 join("\n ", map absolute_filename( $_ ), @{$candidate_objs{$name}}), 854 "\n"); 855 } 856 } 857 } 858 }; 859 860 if (defined($handle)) { # Something we need to wait for? 861 $handle->{STATUS} && !$Mpp::keep_going and 862 die "$mkfile_line: infer_objects failed because dependencies could not be built\n"; 863 push @build_handles, $handle; 864 } 865 ++$dep_idx; 866 } 867 868 last unless @build_handles; # Quit if nothing to wait for. 869 my $status = wait_for @build_handles; # Wait for them all to build, and 870 # try again. 871 @build_handles = (); # We're done with those handles. 872 $status and last; # Quit if there was an error. 873 } 874 875# 876# At this point, we have built all the dependencies, and we also have a 877# complete list of all the objects. 878# 879 join ' ', map relative_filename( $_, $build_cwd ), @deps; 880} 881 882sub f_info { 883 print &arg."\n"; # Print the text. 884 ''; 885} 886 887sub f_join { 888 my ($words1, $words2) = args $_[0], $_[1], $_[2], 2, 2, 1; 889 # Get the two lists of words. 890 my @words1 = split ' ', $words1; 891 my @words2 = split ' ', $words2; 892 893 for my $word ( @words1 ) { 894 last unless @words2; 895 $word .= shift @words2; 896 } 897 push @words1, @words2; 898 join ' ', @words1; 899} 900 901# 902# map Perl code to variable values 903# 904sub f_makemap { 905 my( $list, $code ) = args $_[0], $_[1], $_[2]; 906 $code = eval_or_die "sub {$code\n;defined}", $_[1], $_[2]; 907 $_[1]->cd; # Make sure we're in the correct directory 908 join ' ', grep &$code, split_on_whitespace $list; 909} 910sub f_map { 911 my( $list, $code ) = args $_[0], undef, $_[2]; 912 $code = eval_or_die "sub {$code\n;defined}", $_[1], $_[2]; 913 $_[1]->cd; # Make sure we're in the correct directory 914 join ' ', grep &$code, split_on_whitespace ref $_[0] ? $_[1]->expand_text( $list, $_[2] ) : $list; 915} 916 917# 918# make a temporary file name, similarly to the like named Unix command 919# 920our @temp_files; 921END { Mpp::File::unlink $_ for @temp_files } 922sub f_mktemp { 923 my $template = &arg; 924 my $mkfile = $_[1]; 925 $mkfile ||= \%Mpp::Subs::; # Any old hash for default LAST_TEMP_FILE & CWD 926 return $mkfile->{LAST_TEMP_FILE} || die "No previous call to \$(mktemp)\n" if $template eq '/'; 927 $template ||= 'tmp.'; 928 my $Xmax = 9; 929 $Xmax = length( $1 ) - 1 if $template =~ s/(X+)$//; 930 my $finfo; 931 for( 0..999 ) { # Should not normally loop at all. 932 my $X = ''; 933 for( 0..$Xmax ) { 934 my $chr = (!$_ && $Xmax) ? $$ % (26 + 26 + 10) : int rand 26 + 26 + 10; 935 # First is from pid, if at least two given. 936 $X .= $chr < 10 ? 937 $chr : 938 chr $chr - 10 + ($chr < 26 + 10 ? 939 ord 'a' : 940 -26 + ord 'A'); 941 } 942 $mkfile->{LAST_TEMP_FILE} = $template . $X; 943 $finfo = file_info $mkfile->{LAST_TEMP_FILE}, $mkfile->{CWD}; 944 # Default to global CWD, to make this easier to use without makefile. 945 unless( $finfo->{MKTEMP}++ || file_exists $finfo ) { 946 push @temp_files, $finfo; 947 return $mkfile->{LAST_TEMP_FILE}; 948 } 949 } 950 die "$_[2]: too many tries necessary to make unique filename for $_[0]\n"; 951} 952 953# 954# Force all the targets to be made. 955# 956sub f_prebuild { 957 my $names = &arg; 958 my( undef, $mkfile, $mkfile_line ) = @_; 959 960 my @build_handles; 961 &Mpp::maybe_stop; 962 for( split_on_whitespace $names ) { 963 push @build_handles, prebuild( file_info( unquote(), $mkfile->{CWD} ), 964 $mkfile, $mkfile_line ); 965 # Start building this target. 966 } 967 my $status = wait_for @build_handles; # Wait for them all to complete before 968 # we continue. 969 $status and die "\$(prebuild $names) failed\n"; 970 971 $names; # Return arguments verbatim now that we have 972 # built them. 973} 974*f_make = \&f_prebuild; 975 976sub f_notdir { 977 join ' ', map { m@^.*/([^/]+)@ ? $1 : $_ } split ' ', &arg; 978} 979 980# 981# Return only the files in the list that are actually targets of some rule: 982# 983sub f_only_targets { 984 my $phony = $_[3]; 985 my $cwd = $_[1] && $_[1]{CWD}; 986 my @ret_files; 987 988 foreach (split ' ', &arg) { 989 foreach my $finfo (zglob_fileinfo($_, $cwd, 0, $phony)) { 990 $phony || exists($finfo->{RULE}) and 991 push @ret_files, relative_filename $finfo, $cwd; 992 } 993 } 994 995 join ' ', @ret_files; 996} 997 998# 999# Return only the targets in the list that are phony: 1000# 1001sub f_only_phony_targets { 1002 $_[3] = \1; 1003 goto &f_only_targets; 1004} 1005 1006# 1007# Return only the files in the list that are not targets of some rule: 1008# 1009sub f_only_nontargets { 1010 my $cwd = $_[1] && $_[1]{CWD}; 1011 my @ret_files; 1012 1013 foreach (split ' ', &arg) { 1014 foreach my $finfo (Mpp::Glob::zglob_fileinfo_atleastone($_, $cwd)) { 1015 exists($finfo->{RULE}) or 1016 push @ret_files, relative_filename $finfo, $cwd; 1017 } 1018 } 1019 1020 join ' ', @ret_files; 1021} 1022 1023# 1024# Returns only the existing files that were generated by makepp, according 1025# to the build info. 1026# 1027sub f_only_generated { 1028 #my ($text, $mkfile) = @_; # Name the arguments. 1029 my $cwd = $_[1] && $_[1]{CWD}; 1030 my @ret_files; 1031 1032 foreach (split ' ', &arg) { 1033 foreach my $finfo (Mpp::Glob::zglob_fileinfo_atleastone($_, $cwd, 0,0,1)) { 1034 Mpp::File::was_built_by_makepp( $finfo ) and 1035 push @ret_files, relative_filename $finfo, $cwd; 1036 } 1037 } 1038 1039 join ' ', @ret_files; 1040} 1041 1042# 1043# Returns only the existing files that were generated by makepp, according 1044# to the build info, but are no longer targets. 1045# 1046sub f_only_stale { 1047 my $cwd = $_[1] && $_[1]{CWD}; 1048 my @ret_files; 1049 1050 foreach (split ' ', &arg) { 1051 foreach my $finfo (Mpp::Glob::zglob_fileinfo_atleastone($_, $cwd, 0,0,1)) { 1052 Mpp::File::is_stale( $finfo ) and 1053 push @ret_files, relative_filename $finfo, $cwd; 1054 } 1055 } 1056 1057 join ' ', @ret_files; 1058} 1059 1060# 1061# Figure out where a variable came from: 1062# 1063sub f_origin { 1064 my $varname = &arg; 1065 my $mkfile = $_[1]; 1066 $perl_unfriendly_symbols{$varname} ? 'automatic' : 1067 $Mpp::Makefile::private && defined $Mpp::Makefile::private->{PRIVATE_VARS}{$varname} ? 'file' : 1068 defined ${$mkfile->{PACKAGE} . "::$varname"} ? 'file' : 1069 defined ${"Mpp::global::$varname"} ? 'global' : 1070 $mkfile->{COMMAND_LINE_VARS}{$varname} ? 'command line' : 1071 $mkfile->{ENVIRONMENT}{$varname} ? 'environment' : 1072 !defined( *{$mkfile->{PACKAGE} . "::f_$varname"}{CODE} ) ? 'undefined' : 1073 $varname =~ /^(?:foreach|targets?|dependenc(?:y|ies)|inputs?|outputs?)$/ ? 'automatic' : 1074 'default'; # Must be a variable like "CC". 1075} 1076 1077# 1078# Perform a pattern substitution: 1079# 1080sub f_patsubst { 1081 my ($src, $dest, $words) = args $_[0], $_[1], $_[2], 3; 1082 # Get the arguments. 1083 join ' ', Mpp::Text::pattern_substitution( $src, $dest, 1084 split_on_whitespace $words ); 1085} 1086 1087# 1088# evaluate Perl code as a function 1089# 1090sub f_makeperl { 1091 $_[1]->cd; # Make sure we're in the correct directory 1092 join ' ', grep { defined } eval_or_die &arg, $_[1], $_[2]; 1093} 1094sub f_perl { 1095 if( ref $_[0] ) { 1096 f_makeperl ${$_[0]}, $_[1], $_[2]; # deref to avoid expansion 1097 } else { 1098 goto &f_makeperl 1099 } 1100} 1101 1102# 1103# Mark targets as phony: 1104# 1105sub f_phony { 1106 my $text = &arg; 1107 undef file_info( unquote(), $_[1]{CWD} )->{xPHONY} 1108 for split_on_whitespace $text; 1109 $text; # Just return our argument. 1110} 1111 1112sub f_print { 1113 my $text = &arg; 1114 print "$text\n"; # Print the text. 1115 $text; # Just return it verbatim. 1116} 1117 1118# 1119# Return a filename for a given file relative to the current directory. 1120# (Modified from Matthew Lovell's contribution.) 1121# 1122sub f_relative_filename { 1123 my( $files, $slash ) = args $_[0], $_[1], $_[2], 2, 1; 1124 my $cwd = $_[1]{CWD}; 1125 join ' ', 1126 map { 1127 $_ = relative_filename file_info( unquote(), $cwd ), $cwd; 1128 !$slash || m@/@ ? $_ : "./$_" 1129 } split_on_whitespace $files; 1130} 1131 1132# 1133# Return a filename relative to a given directory. 1134# Syntax: $(relative_to file1 file2, path/to/other/directory) 1135# 1136sub f_relative_to { 1137 my ($files, $dir, $slash) = args $_[0], $_[1], $_[2], 3, 2; 1138 my $cwd = $_[1]{CWD}; 1139 defined $dir or die "wrong number of arguments to \$(relative_to file, dir)\n"; 1140 $dir =~ s/^\s+//; # Trim whitespace. 1141 $dir =~ s/\s+$//; 1142 my $dirinfo = file_info unquote( $dir ), $cwd; 1143 # Directory this is relative to. 1144 join ' ', 1145 map { 1146 $_ = relative_filename file_info( unquote(), $cwd ), $dirinfo; 1147 !$slash || m@/@ ? $_ : "./$_" 1148 } split_on_whitespace $files; 1149} 1150 1151sub f_shell { 1152 my $str = &arg; 1153 my( undef, $mkfile, $mkfile_line ) = @_; # Name the arguments. 1154 1155 local %ENV; # Pass all exports to the subshell. 1156 $mkfile->setup_environment; 1157 1158 $mkfile->cd; # Make sure we're in the correct directory. 1159 my $shell_output = ''; 1160 if( Mpp::is_windows ) { # Doesn't support forking well? 1161 if( Mpp::is_windows != 1 ) { 1162 $shell_output = `$str`; # Run the shell command. 1163 } else { # ActiveState not using command.com, but `` still does 1164 my @cmd = format_exec_args $str; 1165 if( @cmd == 3 ) { # sh -c 1166 substr $cmd[2], 0, 0, '"'; 1167 $cmd[2] .= '"'; 1168 } 1169 $shell_output = `@cmd`; 1170 } 1171 $? == 0 or 1172 warn "shell command `$str' returned `$?' at `$mkfile_line'\n"; 1173 } else { 1174# 1175# We used to use Perl's backquotes operators but these seem to have trouble, 1176# especially when doing parallel builds. The backquote operator doesn't seem 1177# to capture all of the output. Every once in a while (sometimes more often, 1178# depending on system load and whether it's a parallel build) the backquote 1179# operator returns without giving any output, even though the shell command 1180# is actually executed; evidently it's finishing before it's captured all 1181# the output. So we try a different approach here. 1182# This is about the third different technique that I've tried, and this one 1183# (finally) seems to work. I'm still not 100% clear on why some of the 1184# other ones didn't. 1185# 1186 local (*INHANDLE, *OUTHANDLE); # Make a pair of file handles. 1187 pipe(INHANDLE, OUTHANDLE) or die "can't make pipe--$!\n"; 1188 my $proc_handle = new Mpp::Event::Process sub { # Wait for process to finish. 1189 # 1190 # This is the child process. Redirect our standard output to the pipe. 1191 # 1192 close INHANDLE; # Don't read from the handle any more. 1193 close STDOUT; 1194 open(STDOUT,'>&OUTHANDLE') || die "can't redirect stdout--$!\n"; 1195 exec format_exec_args $str; 1196 die "exec $str failed--$!\n"; 1197 }, ERROR => sub { 1198 warn "shell command `$str' returned `$_[0]' at `$mkfile_line'\n"; 1199 }; 1200 1201 close OUTHANDLE; # In parent, get rid of the output handle. 1202 my $line; 1203 my $n_errors_remaining = 3; 1204 for (;;) { 1205 my $n_chars = sysread(INHANDLE, $line, 8192); # Try to read. 1206 unless( defined $n_chars ) { # An error on the read? 1207 $n_errors_remaining-- > 0 and next; # Probably "Interrupted system call". 1208 die "read error--$!\n"; 1209 } 1210 last if $n_chars == 0; # No characters read--other process closed pipe. 1211 $shell_output .= $line; 1212 } 1213 wait_for $proc_handle; # Should not really be necessary. 1214 close INHANDLE; 1215 } 1216 $shell_output =~ s/\r?\n/ /g # Get rid of newlines. 1217 unless $Mpp::Makefile::s_define; 1218 $shell_output =~ s/\s+$//s; # Strip out trailing whitespace. 1219 $shell_output; 1220} 1221 1222sub f_sort { 1223# 1224# Sort is documented to remove duplicates as well as to sort the string. 1225# 1226 my $last = ''; 1227 join ' ', map { $last eq $_ ? () : ($last = $_) } 1228 sort split ' ', &arg; 1229} 1230 1231sub f_stem { 1232 unless( defined $rule ) { 1233 warn "\$(stem) or \$* used outside of rule at `$_[2]'\n"; 1234 return ''; 1235 } 1236 defined $rule->{PATTERN_STEM} and 1237 return $rule->{PATTERN_STEM}; 1238 1239 f_basename &f_target; # If there's no stem, just strip off the 1240 # target's suffix. This is what GNU make 1241 # does. 1242} 1243 1244sub f_strip { 1245 join ' ', split ' ', &arg; 1246} 1247 1248sub f_subst { 1249 my( $from, $to, $text ) = args $_[0], $_[1], $_[2], 3, 3, 1; 1250 $from = quotemeta($from); 1251 join ' ', map { s/$from/$to/g; $_ } split ' ', $text; 1252} 1253 1254sub f_suffix { 1255 join ' ', map { m@(\.[^\./]*)$@ ? $1 : () } split ' ', &arg; 1256} 1257 1258# 1259# Mark targets as temporary: 1260# 1261sub f_temporary { 1262 my $text = &arg; 1263 undef file_info( unquote(), $_[1]{CWD} )->{xTEMP} 1264 for split_on_whitespace $text; 1265 $text; # Just return our argument. 1266} 1267 1268 1269sub f_wildcard { 1270 my $cwd = $rule ? $rule->build_cwd : $_[1]{CWD}; 1271 # Get the default directory. 1272 1273 join ' ', map zglob($_, $cwd), split ' ', &arg; 1274} 1275 1276sub f_wordlist { 1277 my ($startidx, $endidx, $text) = args $_[0], $_[1], $_[2], 3, 2; 1278 if( defined $text ) { 1279 my @wordlist = split ' ', $text; 1280 $_ < 0 and $_ += @wordlist + 1 for $startidx, $endidx; 1281 1282 # These are defined behaviors in GNU make, so we generate no warnings: 1283 return '' if $startidx > $endidx; 1284 $endidx = @wordlist if $endidx > @wordlist; 1285 1286 join ' ', @wordlist[$startidx-1 .. $endidx-1]; 1287 } else { # 2nd arg is the text 1288 join ' ', (split ' ', $endidx)[map { $_ > 0 ? $_ - 1 : $_ } split ' ', $startidx]; 1289 } 1290} 1291*f_word = \&f_wordlist; # It's a special case of the index-list form. 1292 1293sub f_words { 1294 # Must map split result, or implicit assignment to @_ takes place 1295 scalar map undef, split ' ', &arg; 1296} 1297 1298############################################################################### 1299# 1300# Define special automatic variables: 1301# 1302sub f_target { 1303 unless( defined $rule ) { 1304 warn "\$(output), \$(target) or \$\@ used outside of rule at `$_[2]'\n"; 1305 return ''; 1306 } 1307 my $arg = defined $_[0] ? &arg : 0; 1308 relative_filename $rule->{EXPLICIT_TARGETS}[$arg ? ($arg > 0 ? $arg - 1 : $arg) : 0], 1309 $rule->build_cwd; 1310} 1311*f_output = \&f_target; 1312 1313sub f_targets { 1314 unless( defined $rule ) { 1315 warn "\$(outputs) or \$(targets) used outside of rule at `$_[2]'\n"; 1316 return ''; 1317 } 1318 my $arg = defined $_[0] ? &arg : 0; 1319 join ' ', relative_filenames 1320 $arg ? 1321 [@{$rule->{EXPLICIT_TARGETS}}[map { $_ > 0 ? $_ - 1 : $_ } split ' ', $arg]] : 1322 $rule->{EXPLICIT_TARGETS}; 1323} 1324*f_outputs = *f_targets; 1325 1326sub f_dependency { 1327 unless( defined $rule ) { 1328 warn "\$(dependency) or \$(input) or \$< used outside of rule at `$_[2]'\n"; 1329 return ''; 1330 } 1331 my $arg = defined $_[0] ? &arg : 0; 1332 my $finfo = $rule->{EXPLICIT_DEPENDENCIES}[$arg ? ($arg > 0 ? $arg - 1 : $arg) : 0]; 1333 $finfo or return ''; # No dependencies. 1334 1335 relative_filename $finfo, $rule->build_cwd; 1336} 1337*f_input = *f_dependency; 1338 1339sub f_dependencies { 1340 unless( defined $rule ) { 1341 warn "\$(dependencies) or \$(inputs) or \$^ used outside of rule at `$_[2]'\n"; 1342 return ''; 1343 } 1344 my $arg = defined $_[0] ? &arg : 0; 1345 join ' ', relative_filenames 1346 $arg ? 1347 [@{$rule->{EXPLICIT_DEPENDENCIES}}[map { $_ > 0 ? $_ - 1 : $_ } split ' ', $arg]] : 1348 $rule->{EXPLICIT_DEPENDENCIES}; 1349} 1350*f_inputs = *f_dependencies; 1351 1352# 1353# Return the list of inputs that have changed. Note that this function 1354# should only be called in the action of a rule, which means that we're 1355# only called from find_all_targets_dependencies. 1356# 1357sub f_changed_inputs { 1358 unless( defined $rule && defined $rule->{EXPLICIT_TARGETS} ) { 1359 warn "\$(changed_dependencies) or \$(changed_inputs) or \$? used outside of rule at `$_[2]'\n"; 1360 return ''; 1361 } 1362 my @changed_dependencies = 1363 $rule->build_check_method->changed_dependencies 1364 ($rule->{EXPLICIT_TARGETS}[0], 1365 $rule->signature_method, 1366 $rule->build_cwd, 1367 @{$rule->{EXPLICIT_DEPENDENCIES}}); 1368 1369 # Somehow we can't pass this to sort directly 1370 my @filenames = relative_filenames @changed_dependencies; 1371 join ' ', sort @filenames; 1372} 1373*f_changed_dependencies = \&f_changed_inputs; 1374 1375sub f_sorted_dependencies { 1376 unless( defined $rule ) { 1377 warn "\$(sorted_dependencies) or \$(sorted_inputs) or \$+ used outside of rule at `$_[2]'\n"; 1378 return ''; 1379 } 1380 Mpp::Subs::f_sort join ' ', relative_filenames $rule->{EXPLICIT_DEPENDENCIES}; 1381} 1382*f_sorted_inputs = *f_sorted_dependencies; 1383 1384# 1385# Foreach is a little bit tricky, since we have to support the new 1386# $(foreach) automatic variable, but also the old GNU make function 1387# foreach. We can tell the difference pretty easily by whether we have 1388# any arguments. 1389# 1390sub f_foreach { 1391 my( undef, $mkfile, $mkfile_line ) = @_; # Name the arguments. 1392 unless( $_[0] ) { # No argument? 1393 defined $rule && defined $rule->{FOREACH} or 1394 die "\$(foreach) used outside of rule, or in a rule that has no :foreach clause at `$_[2]'\n"; 1395 return relative_filename $rule->{FOREACH}, $rule->build_cwd; 1396 } 1397 1398# 1399# At this point we know we're trying to expand the old GNU make foreach 1400# function. The syntax is $(foreach VAR,LIST,TEXT), where TEXT is 1401# expanded once with VAR set to each value in LIST. When we get here, 1402# because of some special code in expand_text, VAR,LIST,TEXT has not yet 1403# been expanded. 1404# 1405 my( $var, $list, $text ) = args $_[0], undef, $_[2], 3, 3, 1; 1406 # Get the arguments. 1407 $var = ref $_[0] ? $mkfile->expand_text( $var, $mkfile_line ) : $var; 1408 my $ret_str = ''; 1409 my $sep = ''; 1410 $Mpp::Makefile::private ? 1411 (local $Mpp::Makefile::private->{PRIVATE_VARS}{$var}) : 1412 (local $Mpp::Makefile::private); 1413 local $Mpp::Makefile::private->{VAR_REEXPAND}{$var} = 0 if $Mpp::Makefile::private->{VAR_REEXPAND}; 1414 # We're going to expand ourselves. No need to 1415 # override this if there are no values, 1416 # leading to a false lookup anyway. 1417 for( split ' ', ref $_[0] ? $mkfile->expand_text( $list, $mkfile_line ) : $list ) { # Expand text 1418 $Mpp::Makefile::private->{PRIVATE_VARS}{$var} = $_; 1419 # Make it a private variable so that it 1420 # overrides even any other variable. 1421 # The local makes it so it goes away at the 1422 # end of the loop. 1423 $ret_str .= $sep . (ref $_[0] ? $mkfile->expand_text( $text, $mkfile_line ) : $text); 1424 $sep = ' '; # Next time add a space 1425 } 1426 1427 $ret_str; 1428} 1429 1430sub f_warning { 1431 warn &arg." at `$_[2]'\n"; # Print the text. 1432 ''; 1433} 1434 1435sub f_xargs { 1436 my( $command, $list, $postfix, $max_length ) = args $_[0], $_[1], $_[2], 3, 2; 1437 $postfix = '' unless defined $postfix; 1438 $max_length ||= 1000; 1439 $max_length -= length $postfix; 1440 1441 my( $piece, @pieces ) = $command; 1442 for my $elt ( split ' ', $list ) { 1443 if( length( $piece ) + length( $elt ) < $max_length ) { 1444 $piece .= " $elt"; 1445 } else { 1446 push @pieces, "$piece $postfix"; 1447 $piece = $command; 1448 redo; 1449 } 1450 } 1451 push @pieces, "$piece $postfix" 1452 if $piece ne $command; 1453 join "\n", @pieces; 1454} 1455 1456# 1457# Internal function for builtin rule on Windows. This is a hack to make a 1458# phony target xyz that depends on xyz.exe. set_rule marks xyz as a phony 1459# target *after* it has associated a rule with the target, because it 1460# specifically rejects builtin rules for phony targets (to prevent disasters). 1461# 1462*f__exe_phony_ = sub { 1463 my $cwd = $rule->build_cwd; 1464 my $phony = substr relative_filename( $rule->{FOREACH}, $cwd ), 0, -4; # strip .exe 1465 file_info( $phony, $cwd )->{_IS_EXE_PHONY_} = 1; 1466 $phony; 1467} if Mpp::is_windows; 1468 1469# 1470# $(MAKE) needs to expand to the name of the program we use to replace a 1471# recursive make invocation. We pretend it's a function with no arguments. 1472# 1473sub f_MAKE { 1474 require Mpp::Recursive; 1475 goto &f_MAKE; # Redefined. 1476} 1477*f_MAKE_COMMAND = \&f_MAKE; 1478 1479############################################################################### 1480# 1481# Makefile statements. These are all called with the following arguments: 1482# a) The whole line of text (with the statement word removed). 1483# b) The makefile this is associated with. 1484# c) A printable string describing which line of the makefile the statement 1485# was on. 1486# 1487 1488# 1489# Define a build cache for this makefile. 1490# 1491sub s_build_cache {#_ 1492 my ($fname, $mkfile, $mkfile_line) = @_; 1493 my $var = delete $_[3]{global} ? \$Mpp::BuildCache::global : \$mkfile->{BUILD_CACHE}; 1494 1495 $fname = $mkfile->expand_text( $fname, $mkfile_line ) 1496 if $mkfile; 1497 $fname =~ s/^\s+//; 1498 $fname =~ s/\s+$//; # Strip whitespace. 1499 1500 if ($fname eq 'none') { # Turn off build cache? 1501 undef $$var; 1502 } else { 1503 $fname = absolute_filename file_info $fname, $mkfile->{CWD} 1504 if $mkfile; # Make sure we work even if cwd is wrong. 1505 1506 require Mpp::BuildCache; # Load the build cache mechanism. 1507 warn "$mkfile_line: Setting another build cache.\n" 1508 if $$var; 1509 $$var = new Mpp::BuildCache( $fname ); 1510 } 1511} 1512 1513# 1514# Build_check statement. 1515# 1516sub s_build_check {#_ 1517 my( $name, $mkfile, $mkfile_line ) = @_; 1518 my $global = delete $_[3]{global}; 1519 my $var = $global ? \$Mpp::BuildCheck::default : \$mkfile->{DEFAULT_BUILD_CHECK_METHOD}; 1520 1521 $name = $mkfile->expand_text( $name, $mkfile_line ) 1522 if $mkfile; 1523 $name =~ s/^\s*(\w+)\s*$/$1/ or 1524 die "$mkfile_line: invalid build_check statement\n"; 1525 if( $name ne 'default' ) { 1526 $$var = eval "use Mpp::BuildCheck::$name; \$Mpp::BuildCheck::${name}::$name" || 1527 eval "use BuildCheck::$name; warn qq!$mkfile_line: name BuildCheck::$name is deprecated, rename to Mpp::BuildCheck::$name\n!; \$BuildCheck::${name}::$name" 1528 or die "$mkfile_line: invalid build_check method $name\n"; 1529 } elsif( $global ) { # Return to the default method? 1530 $$var = $Mpp::BuildCheck::exact_match::exact_match; 1531 } else { 1532 undef $$var; 1533 } 1534} 1535 1536# 1537# Handle the no_implicit_load statement. This statement marks some 1538# directories not to be loaded by the implicit load mechanism, in case 1539# there are makefiles there that you really don't want to load. 1540# 1541sub s_no_implicit_load { 1542 my ($text_line, $mkfile, $mkfile_line) = @_; # Name the arguments. 1543 1544 $text_line = $mkfile->expand_text($text_line, $mkfile_line); 1545 my $cwd = $rule ? $rule->build_cwd : $mkfile->{CWD}; 1546 # Get the default directory. 1547 1548 local $Mpp::implicitly_load_makefiles; # Temporarily turn off makefile 1549 # loading for the expansion of this wildcard. 1550 1551 my @dirs = map zglob_fileinfo($_, $cwd), 1552 split ' ', $mkfile->expand_text($text_line, $mkfile_line); 1553 # Get a list of things matching the wildcard. 1554 foreach my $dir (@dirs) { 1555 undef $dir->{xNO_IMPLICIT_LOAD} if is_or_will_be_dir $dir; 1556 # Tag them so they don't load later. 1557 } 1558} 1559 1560# 1561# Include statement: 1562# 1563our( $defer_include, @defer_include ); # gmake cludge 1564sub s_include {#__ 1565 my( undef, $mkfile, $mkfile_line, $keyword ) = @_; 1566 # Name the arguments. 1567 if( $defer_include ) { 1568 push @defer_include, $keyword->{ignore} ? \&s__include : \&s_include, @_[0..2]; 1569 return; 1570 } 1571 1572 for my $file ( split ' ', $mkfile->expand_text( $_[0], $mkfile_line )) { # Get a list of files. 1573 my $finfo = f_find_first_upwards $Mpp::Makefile::c_preprocess ? $file : "$file.makepp $file", 1574 $mkfile, $mkfile_line, 1; # Search for special makepp versions of files as well. 1575 if( $Mpp::Makefile::c_preprocess ) { 1576 eval { $mkfile->read_makefile($finfo) }; 1577 die $@ if 1578 $@ and $keyword->{ignore} ? !/^can't read makefile/ : 1; 1579 } else { 1580 $finfo and 1581 wait_for prebuild( $finfo, $mkfile, $mkfile_line ) and 1582 # Build it if necessary, or link it from a repository. 1583 die "can't build " . absolute_filename( $finfo ) . ", needed at $mkfile_line\n"; 1584 # Quit if the build failed. 1585# 1586# If it wasn't found anywhere in the directory tree, search the standard 1587# include files supplied with makepp. We don't try to build these files or 1588# link them from a repository. 1589# 1590 unless( $finfo ) { # Not found anywhere in directory tree? 1591 foreach (@{$mkfile->{INCLUDE_PATH}}) { 1592 $finfo = file_info($file, $_); # See if it's here. 1593 last if file_exists $finfo; 1594 } 1595 unless( file_exists $finfo ) { 1596 next if $keyword->{ignore}; 1597 die "makepp: can't find include file `$file'\n"; 1598 } 1599 } 1600 1601 Mpp::log LOAD_INCL => $finfo, $mkfile_line 1602 if $Mpp::log_level; 1603 $mkfile->read_makefile($finfo); # Read the file. 1604 } 1605 } 1606} 1607 1608# 1609# This subroutine does exactly the same thing as include, except that it 1610# doesn't die with an error message if the file doesn't exist. 1611# 1612sub s__include {#_ 1613 s_include @_[0..2], {ignore => 1};#__ 1614} 1615 1616# 1617# Load one or several makefiles. 1618# 1619sub s_load_makefile {#_ 1620 my ($text_line, $mkfile, $mkfile_line) = @_; # Name the arguments. 1621 1622 my @words = split_on_whitespace $mkfile->expand_text($text_line, $mkfile_line); 1623 1624 $mkfile->cleanup_vars; 1625 my %command_line_vars = %{$mkfile->{COMMAND_LINE_VARS}}; 1626 # Extra command line variables. Start out 1627 # with a copy of the current command line 1628 # variables. 1629 my @include_path = @{$mkfile->{INCLUDE_PATH}}; 1630 # Make a copy of the include path (so we can 1631 # modify it with -I). 1632# 1633# First pull out the variable assignments. 1634# 1635 my @makefiles; 1636 while (defined($_ = shift @words)) { # Any words left? 1637 if (/^(\w+)=(.*)/) { # Found a variable? 1638 $command_line_vars{$1} = unquote($2); 1639 } 1640 elsif (/^-I(\S*)/) { # Specification of the include path? 1641 unshift @include_path, ($1 || shift @words); 1642 # Grab the next word if it wasn't specified in 1643 # the same word. 1644 } 1645 else { # Unrecognized. Must be name of a makefile. 1646 push @makefiles, $_; 1647 } 1648 } 1649 1650 my $set_do_build = $Mpp::File::root->{DONT_BUILD} && 1651 $Mpp::File::root->{DONT_BUILD} == 2 && # Was set implicitly through root makefile. 1652 !Mpp::File::dont_build( $mkfile->{CWD} ); 1653 # Our dir is to be built, so propagate that to 1654 # loaded makefiles' dirs. 1655# 1656# Now process the makefiles: 1657# 1658 foreach (@makefiles) { 1659 s/^-F//; # Support the archaic syntax that put -F 1660 # before the filename. 1661 my $mfile = file_info $_, $mkfile->{CWD}; 1662 # Get info on the file. 1663 my $mdir = $mfile; # Assume it is actually a directory. 1664 is_or_will_be_dir $mfile or $mdir = $mfile->{'..'}; 1665 # Default directory is the directory the 1666 # makefile is in. 1667 if( $set_do_build && Mpp::File::dont_build( $mdir ) && $mdir->{DONT_BUILD} == 2 ) { 1668 # Inherited from '/'. 1669 my @descend = $mdir; 1670 while( @descend ) { 1671 my $finfo = shift @descend; 1672 next unless $finfo->{DONT_BUILD} && $finfo->{DONT_BUILD} == 2; 1673 # Not yet propagated from '/' or manually set? 1674 undef $finfo->{DONT_BUILD}; 1675 push @descend, values %{$finfo->{DIRCONTENTS}} if $finfo->{DIRCONTENTS}; 1676 } 1677 } 1678 Mpp::Makefile::load( $mfile, $mdir, \%command_line_vars, '', \@include_path, 1679 $mkfile->{ENVIRONMENT} ); # Load the makefile. 1680 } 1681} 1682 1683# 1684# This function allows the user to do something in the makefile like: 1685# makeperl { 1686# ... perl code 1687# } 1688# 1689sub s_makeperl { s_perl( @_[0..2], {make => 1} ) } 1690 1691# 1692# This function allows the user to do something in the makefile like: 1693# makesub subname { 1694# ... perl code 1695# } 1696# 1697sub s_makesub { s_sub( @_[0..2], {make => 1} ) } 1698 1699# 1700# Begin a whole block of perl { } code. 1701# 1702sub s_perl {#__ 1703 my ($perl_code, $mkfile, $mkfile_line, $keyword) = @_; 1704 # Name the arguments. 1705 $perl_code = Mpp::Makefile::read_block( $keyword->{make} ? 'makeperl' : 'perl', $perl_code ); 1706 $perl_code = $mkfile->expand_text($perl_code, $mkfile_line) if $keyword->{make}; 1707 $mkfile->cd; # Make sure we're in the correct directory 1708 # because some Perl code will expect this. 1709 eval_or_die $perl_code, $mkfile, $mkfile_line; 1710} 1711 1712 1713# 1714# Begin a whole block of Perl code. 1715# 1716sub s_perl_begin {#_ 1717 my ($perl_code, $mkfile, $mkfile_line) = @_; 1718 # Name the arguments. 1719 warn "$mkfile_line: trailing cruft after statement: `$perl_code'\n" 1720 if $perl_code; 1721 $perl_code = Mpp::Makefile::read_block( perl_begin => $perl_code, qr/perl[-_]end/ ); 1722 $mkfile->cd; # Make sure we're in the correct directory 1723 # because some Perl code will expect this. 1724 eval_or_die $perl_code, $mkfile, $mkfile_line; 1725} 1726 1727# 1728# Build targets immediately. 1729# Useful when the list of targets depends on files that might be generated. 1730# 1731sub s_prebuild {#__ 1732 my ($text_line, $mkfile, $mkfile_line) = @_; 1733 my (@words) = split_on_whitespace $mkfile->expand_text($text_line, $mkfile_line); 1734 1735 &Mpp::maybe_stop; 1736 for my $target (@words) { 1737 my $finfo = file_info $target, $mkfile->{CWD}; 1738 # TBD: If prebuild returns undef, then that could mean that the file 1739 # didn't need to be built, but it could also means that there was a 1740 # dependency loop. We ought to generate an error in the latter case. 1741 wait_for prebuild( $finfo, $mkfile, $mkfile_line ) and 1742 die "failed to prebuild $target\n"; 1743 } 1744} 1745*s_make = \&s_prebuild; 1746sub prebuild { 1747 my ($finfo, $mkfile, $mkfile_line ) = @_; 1748 Mpp::log PREBUILD => $finfo, $mkfile_line 1749 if $Mpp::log_level; 1750 if( my $myrule = Mpp::File::get_rule $finfo ) { 1751 # If the file to be built is governed by the present Makefile, then 1752 # just initialize the Mpp::Makefile and build it based on what we know so far, 1753 # because then the file will *always* be built with the same limited 1754 # knowledge (unless there are multiple rules for it, in which case a 1755 # warning will be issued anyway). On the other hand, if the file is 1756 # governed by another Makefile that isn't fully loaded yet, then issue 1757 # a warning, because then you could get weird dependencies on the order in 1758 # which Makefiles were loaded. Note that this warning isn't guaranteed to 1759 # show up when it's called for, because targets that are built via direct 1760 # calls to Mpp::build() don't undergo this check. 1761 warn 'Attempting to build ' . &absolute_filename . " before its makefile is completely loaded\n" 1762 unless ref( $myrule ) eq 'Mpp::DefaultRule' || 1763 exists $finfo->{BUILD_HANDLE} || 1764 $myrule->makefile == $mkfile || 1765 $myrule->makefile->{INITIALIZED}; 1766 } 1767 Mpp::build($finfo); 1768} 1769 1770# 1771# Register an autoload. 1772# Usage from the makefile: 1773# autoload filename ... 1774# 1775sub s_autoload {#__ 1776 my ($text_line, $mkfile, $mkfile_line) = @_; # Name the arguments. 1777 1778 ++$Mpp::File::n_last_chance_rules; 1779 my (@fields) = split_on_whitespace $mkfile->expand_text($text_line, $mkfile_line); 1780 push @{$mkfile->{AUTOLOAD} ||= []}, @fields; 1781} 1782 1783# 1784# Register an action scanner. 1785# Usage from the makefile: 1786# register_scanner command_word scanner_subroutine_name 1787# 1788# 1789sub s_register_scanner {#_ 1790 my( undef, $mkfile, $mkfile_line ) = @_; # Name the arguments. 1791 warn "$mkfile_line: register-scanner deprecated, please use register-parser at `$_[2]'\n"; 1792 1793 my( @fields ) = split_on_whitespace $mkfile->expand_text( $_[0], $mkfile_line ); 1794 # Get the words. 1795 @fields == 2 or die "$mkfile_line: register_scanner needs 2 arguments\n"; 1796 my $command_word = unquote $fields[0]; # Remove quotes, etc. 1797 $fields[1] =~ tr/-/_/; 1798 my $scanner_sub = $fields[1] =~ /^(?:scanner_)?none$/ ? 1799 undef : (*{"$mkfile->{PACKAGE}::$fields[1]"}{CODE} || *{"$mkfile->{PACKAGE}::scanner_$fields[1]"}{CODE}); 1800 # Get a reference to the subroutine. 1801 $mkfile->register_parser($command_word, $scanner_sub); 1802} 1803 1804# 1805# Register a command parser. Usage from the makefile: 1806# register_command_parser command_word command_parser_class_name 1807# 1808# 1809sub s_register_parser {#_ 1810 my( undef, $mkfile, $mkfile_line ) = @_; # Name the arguments. 1811 1812 my( @fields ) = unquote_split_on_whitespace $mkfile->expand_text( $_[0], $mkfile_line ); 1813 # Get the words. 1814 @fields == 2 or die "$mkfile_line: register_command_parser needs 2 arguments at `$_[2]'\n"; 1815 $fields[1] =~ tr/-/_/; 1816 $fields[1] = 1817 *{"$mkfile->{PACKAGE}::p_$fields[1]"}{CODE} || 1818 *{"$fields[1]::factory"}{CODE} || 1819 *{"Mpp::CommandParser::$fields[1]::factory"}{CODE} || 1820 *{"$fields[1]::factory"}{CODE} || 1821 die "$mkfile_line: invalid command parser $fields[1]\n"; 1822 $mkfile->register_parser( @fields ); 1823} 1824*s_register_command_parser = \&s_register_parser; 1825 1826# 1827# Register an input filename suffix for a particular command. 1828# Usage from the makefile: 1829# register_input_suffix command_word suffix ... 1830# 1831sub s_register_input_suffix { 1832 my ($text_line, $mkfile, $mkfile_line) = @_; # Name the arguments. 1833 1834 my( $command_word, @fields ) = # Get the words. 1835 unquote_split_on_whitespace($mkfile->expand_text($text_line, $mkfile_line)); 1836 1837 no strict 'refs'; 1838 my $hashref = \%{$mkfile->{PACKAGE} . '::input_suffix_hash'}; 1839 push @{$hashref->{$command_word} ||= []}, @fields; 1840} 1841 1842# 1843# Load from repositories: 1844# 1845sub s_repository {#__ 1846 require Mpp::Repository; 1847 goto &s_repository; # Redefined. 1848} 1849sub s_vpath {#__ 1850 require Mpp::Repository; 1851 goto &s_vpath; # Redefined. 1852} 1853 1854# 1855# Add runtime dependencies for an executable. 1856# 1857sub s_runtime {#__ 1858 my ($text, $mkfile, $mkfile_line) = @_; # Name the arguments. 1859 1860 (my $comma = index_ignoring_quotes $text, ',') >= 0 or # Find the command 1861 die "$mkfile_line: runtime EXE,LIST called with only one argument\n"; 1862 my $exelist = $mkfile->expand_text(substr($text, 0, $comma), $mkfile_line); 1863 substr $text, 0, $comma+1, ''; # Get rid of the variable name. 1864 my @deps = map file_info($_, $mkfile->{CWD}), split_on_whitespace $mkfile->expand_text($text, $mkfile_line); 1865 for my $exe ( map file_info($_, $mkfile->{CWD}), split_on_whitespace $exelist) { 1866 for my $dep (@deps) { 1867 $exe->{RUNTIME_DEPS}{$dep} = $dep; 1868 } 1869 } 1870} 1871 1872# 1873# Set the default signature method for all rules in this makefile or globally: 1874# 1875sub s_signature {#__ 1876 my( $name, $mkfile, $mkfile_line ) = @_; 1877 my $global = delete $_[3]{global}; 1878 my $override = delete $_[3]{override}; 1879 my $var = $global ? \$Mpp::Signature::default : \$mkfile->{DEFAULT_SIGNATURE_METHOD}; 1880 my $name_var = $global ? \$Mpp::Signature::default_name : \$mkfile->{DEFAULT_SIG_METHOD_NAME}; 1881 my $override_var = $global ? \$Mpp::Signature::override : \$mkfile->{DEFAULT_SIG_OVERRIDE}; 1882 $name = $mkfile->expand_text( $name, $mkfile_line ) 1883 if $mkfile; 1884 $name =~ s/^\s*(.*?)\s*$/$1/; 1885 if( $name ne 'default' ) { 1886 $$var = Mpp::Signature::get( $name, $mkfile_line ); 1887 if( defined $$var ) { 1888 $$name_var = $name; 1889 $$override_var = $override; 1890 } else { 1891# 1892# The signature methods and build check methods used to be the same thing, 1893# so for backward compatibility, see if this is actually a build check 1894# method. 1895# 1896 $var = eval "use Mpp::BuildCheck::$name; \$Mpp::BuildCheck::${name}::$name" || 1897 eval "use BuildCheck::$name; warn qq!$mkfile_line: name BuildCheck::$name is deprecated, rename to Mpp::BuildCheck::$name\n!; \$BuildCheck::${name}::$name"; 1898 if( defined $var ) { 1899 warn "$mkfile_line: requesting build check method $name via signature is deprecated.\n"; 1900 if( $global ) { 1901 $Mpp::BuildCheck::default = $var; 1902 } else { 1903 $mkfile->{DEFAULT_BUILD_CHECK_METHOD} = $var; 1904 } 1905 } else { 1906 die "$mkfile_line: invalid signature method $name\n"; 1907 } 1908 } 1909 } else { # Return to the default method? 1910 undef $$name_var; 1911 undef $$var; 1912 $$override_var = $override; 1913 } 1914} 1915 1916# 1917# This function allows the user to do something in the makefile like: 1918# sub subname { 1919# ... perl code 1920# } 1921# 1922sub s_sub {#__ 1923 my ($subr_text, $mkfile, $mkfile_line, $keyword) = @_; # Name the arguments. 1924 $subr_text = Mpp::Makefile::read_block( $keyword->{make} ? 'makesub' : 'sub', $subr_text ); 1925 $subr_text = $mkfile->expand_text($subr_text, $mkfile_line) if defined $keyword->{make}; 1926 eval_or_die "sub $subr_text", $mkfile, $mkfile_line; 1927} 1928 1929# 1930# Don't export a variable to child processes. 1931# 1932sub s_unexport {#__ 1933 my ($text_line, $mkfile, $mkfile_line) = @_; # Name the arguments. 1934 delete @{$mkfile->{EXPORTS}}{split ' ', $mkfile->expand_text($text_line, $mkfile_line)} 1935 if $mkfile->{EXPORTS}; # Look at each variable listed. 1936} 1937 1938 1939# 1940# Execute an external Perl script within the running interpreter. 1941# 1942sub run(@) { 1943 local( $0, @ARGV ) = @_; # Name the arguments. 1944 $0 = f_find_program $0, 1945 $rule ? $rule->{MAKEFILE} : $makefile, 1946 $rule ? $rule->{RULE_SOURCE} : $makefile_line 1947 unless -f $0; # not relative or absolute 1948 local $SIG{__WARN__} = local $SIG{__DIE__} = 'DEFAULT'; 1949 die $@ || "$0 failed--$!\n" 1950 if !defined do $0 and $@ || $!; 1951} 1952 1953############################################################################### 1954# 1955# Default values of various variables. These are implemented as functions 1956# with no arguments so that: 1957# a) They are visible to all makefiles, yet are easily overridden. 1958# (If we just put them in makepp_builtin_rules.mk, then they are not 1959# visible in the makefile except in rules, because makepp_builtin_rules.mk 1960# is loaded after the makefile. That's where they were for a while but 1961# that was discovered not to work well.) 1962# b) The $(origin ) function can work with them. 1963# 1964sub f_AR() { 'ar' } 1965sub f_ARFLAGS() { 'rv' } 1966sub f_AS() { 'as' } 1967my $CC; 1968sub f_CC { $CC ||= f_find_program 'gcc egcc pgcc c89 cc' . (Mpp::is_windows?' cl bcc32':''), $_[1], $_[2] } 1969sub f_CFLAGS { f_if \('$(filter %gcc, $(CC)), -g -Wall, ' . (Mpp::is_windows?' $(if $(filter %cl %cl.exe %bcc32 %bcc32.exe, $(CC)), , -g)':'-g')), $_[1], $_[2] } 1970sub f_CURDIR { absolute_filename $_[1]{CWD} } 1971my $CXX; 1972sub f_CXX { $CXX ||= f_find_program 'g++ c++ pg++ cxx ' . (Mpp::is_windows?'cl bcc32':'CC aCC'), $_[1], $_[2] } 1973sub f_CXXFLAGS { f_if \('$(filter %g++ %c++, $(CXX)), -g -Wall, ' . (Mpp::is_windows?'$(if $(filter %cl %cl.exe %bcc32 %bcc32.exe, $(CXX)), , -g)':'-g')), $_[1], $_[2] } 1974my $F77; 1975sub f_F77 { $F77 ||= f_find_program 'f77 g77 fort77', $_[1], $_[2] } 1976sub f_FC { $_[1]->expand_variable('F77', $_[2]) } 1977my $LEX; 1978sub f_LEX { $LEX ||= f_find_program 'lex flex', $_[1], $_[2] } 1979sub f_LIBTOOL() { 'libtool' } 1980sub f_LD() { 'ld' } 1981sub f_MAKEINFO() { 'makeinfo' } 1982*f_PWD = \&f_CURDIR; 1983# Can't use &rm -f, because it might get used in a complex Shell construct. 1984sub f_RM() { 'rm -f' } 1985my $YACC; 1986sub f_YACC { $YACC ||= f_if \'$(filter bison, $(find_program yacc bison)), bison -y, yacc', $_[1], $_[2] } 1987 1988sub f_ROOT { $_[1]{CWD}{ROOT} ? relative_filename( $_[1]{CWD}{ROOT}, $_[1]{CWD} ) : '' } 1989 1990# Don't use Exporter so we don't have to keep a huge list. 1991sub import() { 1992 my $package = caller; 1993 no warnings 'redefine'; # In case we are reimporting this 1994 for( keys %Mpp::Subs:: ) { 1995 $_[1] ? /^(?:$_[1])/ : /^[fps]_/ or # functions, parsers and statements only 1996 /^args?$/ or 1997 /^run/ or 1998 /^scanner_/ or 1999 next; 2000 my $coderef = *{"Mpp::Subs::$_"}{CODE}; 2001 *{$package . "::$_"} = $coderef if $coderef; 2002 } 2003} 2004 20051; 2006