makepp/Makesubs.pm
# $Id: Makesubs.pm,v 1.14 2003/07/19 23:21:57 grholt Exp $
###############################################################################
#
# This package contains subroutines which are can be called from a makefile.
# Subroutines in this package are called in two ways:
# 1) Any line which isn't a rule or an assignment and has at the left margin a
# word is interpreted as a subroutine call to a subroutine in the makefile
# package, or if not in the makefile package, in this package. "s_" is
# prefixed to the name before the perl function is looked up.
# 2) Any function that is in a make expression (e.g., $(xyz abc)) attempts to
# call a perl function in the make package, and failing that, in this
# package. "f_" is prefixed to the name first.
#
# All subroutine names in this package are automatically exported to each
# makefile package by Makefile::load.
#
package Makesubs;
use strict qw(vars subs);
use TextSubs;
use FileInfo;
use FileInfo_makepp;
use MakeEvent qw(wait_for when_done read_wait);
use Config;
#
# Import a few subroutines from elsewhere:
#
foreach (qw(find_makepp_info find_makepp_info_register
parse_command_line print_log print_error)) {
*$_ = *{"main::$_"};
}
*read_makefile_line = *Makefile::read_makefile_line;
*read_makefile_line_stripped = *Makefile::read_makefile_line_stripped;
*unread_makefile_line = *Makefile::unread_makefile_line;
###############################################################################
#
# Command scanners included with makepp:
#
my %dir_warnings;
my %already_warned_missing;
#
# Scan C command, looking for sources and includes and libraries.
#
@Makesubs::system_include_dirs = ( file_info("/usr/local/include"),
file_info("/usr/include") );
#@system_lib_dirs = ( file_info("/usr/local/lib"),
# file_info("/usr/lib") );
sub scanner_c_compilation {
my ($action, $rule) = @_; # Name the arguments.
my $build_cwd = $rule->build_cwd; # Access the default directory.
$main::has_md5_signatures and # Use the MD5 signature checking when we can.
$rule->set_signature_method_default($Signature::c_compilation_md5::c_compilation_md5);
if ($main::log_level) {
my $printable_cmd = $action;
$printable_cmd =~ s/\n/\\n/g; # Make it fit on one line.
main::print_log("Scanning command $printable_cmd from directory ", $build_cwd->name);
}
my @include_dirs;
my @lib_dirs;
my @libs; # Libs that we link with.
my @obj_files; # Objects and libraries.
my @source_files;
my $stop_at_obj; # True if we don't use the libraries.
my %all_sources; # Hash of FileInfo structs for each source
# file.
local $_; # Don't mess up caller's $_.
$action =~ s/\n.*//s; # Strip out everything after the newline, since
# that won't be a compilation command.
my $pos = index_ignoring_quotes($action, ";");
$pos > 0 and # Was there a semicolon in this rule?
$action = substr($action, 0, $pos); # Discard everything after
# that, since it's not a gcc command.
my @cmd_words = split_on_whitespace($action);
# Get the pieces of the command.
shift @cmd_words; # Get rid of the compiler name.
while (defined($_ = shift @cmd_words)) { # Get the next word.
if (/^-I(.*)/) { # Specifying a new include directory?
my $incdir = $1; # Get the directory.
length($incdir) == 0 and $incdir = shift @cmd_words;
# There can be a space between -I and the
# directory name.
my $dirinfo = file_info($incdir, $build_cwd)->dereference;
if (!$dirinfo->is_or_will_be_dir) {
$main::warn_level and
main::print_error("warning: invalid directory " . $dirinfo->absolute_filename . " mentioned in compile command " . $rule->source)
unless $dir_warnings{$dirinfo->absolute_filename}++;
# Don't give the same warning more than
# once.
} else {
push @include_dirs, $dirinfo;
}
}
elsif (/^-L(.*)/) { # Specifying new link library directory?
my $ldir = $1; # Get the name of the directory.
length($ldir) == 0 and $ldir = shift @cmd_words;
my $dirinfo = file_info($ldir, $build_cwd)->dereference;
if (!$dirinfo->is_or_will_be_dir) {
$main::warn_level &&
main::print_error("warning: invalid directory $1 mentioned in compile command")
unless $dir_warnings{$dirinfo->absolute_filename}++;
# Don't give the same warning more than
# once.
} else {
push @lib_dirs, $dirinfo;
}
}
elsif ($_ eq "-c") {
$stop_at_obj = 1; # Ignore the link specs.
}
elsif ($_ eq "-o") { # Specify output file?
my $tname = shift @cmd_words; # Get the name.
$tname and $rule->add_target(file_info($tname, $build_cwd));
}
elsif (/^-l(.*)$/) { # Specify a link library?
push @libs, $1;
}
elsif (/^-/) { # Some other option?
# Just ignore it.
} elsif (/^[\<\>](.*)/) { # Redirect?
$1 or shift @cmd_words; # Get from the next word if not in this word.
}
elsif (/\.(?:o|lo|la|a|sa|so|so\.*)$/) { # Extension of an object file?
if (/[\*\?\[]/) { # Might be a wildcarded file?
# push @obj_files, Glob::zglob_fileinfo($_, $build_cwd);
# Get all the files.
}
else {
push @obj_files, file_info($_, $build_cwd);
}
}
elsif (is_cpp_source_name($_)) { # Looks like a source file?
if (/[\*\?\[]/) { # Might be a wildcarded file?
# foreach my $src_info (Glob::zglob_fileinfo($_, $build_cwd)) {
# push @source_files, $src_info unless $all_sources{$src_info}++;
# }
}
else { # Regular old filename.
my $src_info = file_info($_, $build_cwd);
unless ($all_sources{$src_info}++) { # Already seen this source?
push @source_files, file_info($_, $build_cwd);
}
}
}
}
#
# Scan the source files for includes:
#
for (my $src_idx = 0; $src_idx < @source_files; ++$src_idx) {
# Use this instead of a foreach because we will
# add additional files to this list.
my $src_info = $source_files[$src_idx];
my $status = main::wait_for(main::build($src_info));
# Make sure the file is available.
$rule->add_dependency($src_info); # Mark this as a dependency.
$status and return $status; # Quit if the build failed.
#
# Get the include information for this file. Check the information from the
# last build, if there is any. Otherwise, we have to rescan the file.
#
my @includes;
my @system_includes;
my $includes = $src_info->build_info_string("INCLUDES");
# Do we already know what this file includes?
my $system_includes = $src_info->build_info_string("SYSTEM_INCLUDES");
if (defined($includes) && defined($system_includes)) {
@includes = split(' ', $includes);
@system_includes = split(' ', $system_includes);
}
else { # We don't know what this file includes.
# We'll have to scan it.
#
# If this directory is writable, then scan the file. Otherwise, don't bother;
# we assume it's some system include file which doesn't change.
#
my $absname = $src_info->absolute_filename;
if ($absname !~ m@/usr/(?:X11(?:R.)?/|local/)include\b@ &&
# Never scan stuff in the system directories.
# This can lead to problems if we build as
# a user and then install as root. This won't
# completely solve the problem, but it will
# make it much less common.
$src_info->{".."}->is_writable) {
print "Scanning $absname\n" unless $main::quiet_flag;
local *SRCFILE; # Make a local file handle.
if (!open(SRCFILE, $absname)) {
main::print_error("warning: could not scan $absname for includes--$!");
next; # Don't try to save the information.
} else {
while (defined($_ = <SRCFILE>)) {
if (/^\s*\#\s*include\s*([\<\"])([^\"\<\>]+)[\"\>]/) { # Either form of include?
my $include_fname = $2;
if ($1 eq '"') { # Non-system include?
push @includes, $2;
} else {
push @system_includes, $2;
}
}
}
close SRCFILE; # Done with this file
$src_info->set_build_info_string(INCLUDES => join(" ", @includes),
SYSTEM_INCLUDES => join(" ", @system_includes));
# Store the information for next time.
}
}
}
#
# Find the exact location of each of these include files:
#
inc_file_loop:
foreach my $include_fname (@includes) {
#
# Check for non-system include files in the same directory as the file itself.
#
my $inc_finfo = file_info($include_fname, $src_info->{".."});
if ($inc_finfo->exists_or_can_be_built) {
push @source_files, $inc_finfo # Remember it.
unless $all_sources{$inc_finfo}++; # Don't duplicate files.
next inc_file_loop;
}
#
# Check the directories specified in the include path:
#
foreach my $incdir (@include_dirs) {
my $inc_finfo = file_info($include_fname, $incdir);
if ($inc_finfo->exists_or_can_be_built) {
push @source_files, $inc_finfo # Remember it.
unless $all_sources{$inc_finfo}++; # Don't duplicate files.
next inc_file_loop;
}
}
#
# Do the same thing for the system includes, except that we don't check files
# that they include--we assume they don't change. We also don't list them
# explicitly as dependencies.
#
foreach my $incdir (@Makesubs::system_include_dirs) {
next inc_file_loop if FileInfo::file_exists(file_info($include_fname, $incdir));
}
$main::warn_level and
main::print_error("warning: can't locate file $include_fname, included from ",
$src_info->absolute_filename, "\nInclude path is:\n ",
join("\n ",
map { $_->absolute_filename } @include_dirs))
unless $already_warned_missing{$include_fname}++;
}
#
# Do the same thing for the system includes. This isn't quite the same,
# because if we don't find a system include file, then we don't complain--we
# assume it's in one of the system directories. Since @system_include_dirs
# probably isn't an exhaustive list, this keeps us from giving annoying
# warnings about things which aren't a problem.
#
system_inc_file_loop:
foreach my $include_fname (@system_includes) {
foreach my $incdir (@include_dirs) {
my $inc_finfo = file_info($include_fname, $incdir);
if ($inc_finfo->exists_or_can_be_built) {
# Exists or can be built?
push @source_files, $inc_finfo # Remember it.
unless $all_sources{$inc_finfo}++; # Don't duplicate files.
next system_inc_file_loop;
}
}
# Not found--assume it is in /usr/include, and
# don't bother checking.
}
} # End loop through source files.
$stop_at_obj and return; # If no linking to do, ignore libraries.
#
# At this point, we've got a list of all the source files that this depends
# on. Now, if we're going to be linking, look for the -l libs.
#
libloop:
foreach my $libname (@libs) {
foreach my $libdirinfo ($build_cwd, @lib_dirs) {
foreach (qw(la so sa a)) { # Common extensions.
my $lib_info = file_info("lib$libname.$_", $libdirinfo);
if ($lib_info->exists_or_can_be_built) {
push @obj_files, $lib_info; # Found the library.
next libloop;
}
}
}
#
# Not found in the explicitly specified directories. We probably ought to
# search through the system library directories, but the trouble is we don't
# really know where they are, and I don't know where to get that information
# reliably. It would be nice to give a warning message that makepp doesn't
# know whether a library needs to be built or not, but I don't see how to do
# it.
#
}
foreach (@obj_files) { # Mark each of the objects as a dependency.
$rule->add_dependency(file_info($_, $build_cwd));
}
}
#
# This scanner exists only to allow the user to say ":scanner none" to suppress
# the default scanner.
#
sub scanner_none {
}
#
# Skip to the next command (after a semicolon or newline) and scan again.
# This is used to ignore an echo or something like that.
#
sub scanner_skip_command {
my ($action, $rule) = @_; # Name the arguments.
$action =~ s/^.*?[;\n]// and # Skip to newline or semicolon.
$rule->scan_action($action); # Scan the remainder of the action.
}
#
# This scanner simply moves to the next word that doesn't begin with
# - and scans again.
#
sub scanner_skip_word {
my ($action, $rule) = @_; # Name the arguments.
$action =~ s/^\s+//; # Leading whitespace messes up the regular
# expression below.
while ($action =~ s/^\S+\s+//) { # Strip off another word.
$action =~ s/^[\"\'\(]//; # Strip off leading quotes in case it's
# something like sh -c "cc ...".
if ($action !~ /^-/) { # Word that doesn't look like an option?
$rule->scan_action($action); # Scan it now.
last; # Don't go any further.
}
}
}
#
# This array contains the list of the default scanners used for various
# command words.
#
%Makesubs::scanners =
(
# These words usually introduce another command
# which actually is the real compilation command.
"libtool" => \&scanner_skip_word,
"sh" => \&scanner_skip_word,
"purify" => \&scanner_skip_word,
"ignore_error" => \&scanner_skip_word,
"echo" => \&scanner_skip_command,
"noecho" => \&scanner_skip_word,
"fast_cc" => \&scanner_skip_word,
"condor_compile" => \&scanner_skip_word,
"cc" => \&scanner_c_compilation, # These are all the C/C++
"gcc" => \&scanner_c_compilation, # compilers I can think of.
"c++" => \&scanner_c_compilation,
"g++" => \&scanner_c_compilation,
"CC" => \&scanner_c_compilation,
"cxx" => \&scanner_c_compilation,
"c89" => \&scanner_c_compilation,
"pcc" => \&scanner_c_compilation,
"kcc" => \&scanner_c_compilation,
"kgcc" => \&scanner_c_compilation,
"egcc" => \&scanner_c_compilation,
"pgcc" => \&scanner_c_compilation,
"pg++" => \&scanner_c_compilation,
);
#
# An internal subroutine that converts FileInfo structures to printable
# names. Takes either a single FileInfo structure, an array of FileInfo
# structures, or a reference to an array of FileInfo structures.
#
sub relative_filenames {
my @ret_vals;
my $cwd = $Makesubs::rule->build_cwd;
foreach (@_) {
next unless defined $_; # Skip undef things--results in a blank.
if (ref($_) eq 'ARRAY') {
push @ret_vals, relative_filenames(@$_);
}
else {
push @ret_vals, $_->name($cwd);
}
}
return @ret_vals;
}
###############################################################################
#
# Functions that are intended to be invoked by make expressions. These
# all begin with the prefix "f_", which is added before we look up the
# name of the function. These functions are called with the following
# arguments:
# a) The text after the function name in the makefile (with other macros
# already expanded).
# b) The makefile.
# c) The line number in the makefile that this expression occured in.
#
#
# Return the absolute filename of all the arguments.
#
sub f_absolute_filename {
my $makefile = $_[1];
my @files = split_on_whitespace($_[0]); # Get a list of files.
my @ret_names;
foreach (@files) {
push @ret_names, file_info(unquote($_), $makefile->{CWD})->absolute_filename;
}
return join(" ", @ret_names);
}
sub f_addprefix {
my ($prefix, $text) = split(/,\s+/, $_[0]); # Get the prefix.
return join(" ", map { "$prefix$_" } split(' ', $text));
}
sub f_addsuffix {
my ($suffix, $text) = split(/,\s+/, $_[0]); # Get the prefix.
return join(" ", map { "$_$suffix" } split(' ', $text));
}
sub f_basename {
my @ret_vals;
foreach (split ' ', $_[0]) {
if (m@(\.[^./\,]*)$@) { # Match the extension, but don't look into the
# directory for a period.
push @ret_vals, substr($_, 0, length($_)-length($1)); # Take it off
# (without using $PRE or $POST or a regex
# that has lots and lots of backtracking).
} else {
push @ret_vals, $_; # No extension. Return the whole filename.
}
}
return join(" ", @ret_vals);
}
sub f_dir {
my @ret_vals;
foreach (split ' ', $_[0]) {
if (m@^(.*/)@) { push @ret_vals, $1; }
else { push @ret_vals, './'; }
}
return join(" ", @ret_vals);
}
sub f_dir_noslash { # An internal routine that does the same
# thing but doesn't return a trailing slash.
my @ret_vals;
foreach (split ' ', $_[0]) {
if (m@^(.*)/@) { push @ret_vals, $1; }
else { push @ret_vals, '.'; }
}
return join(" ", @ret_vals);
}
#
# Perform a pattern substitution on file names. This differs from patsubst
# in that it will perform correctly when alternate names for directories are
# given (as long as they precede the percent sign). For example,
#
# $(filesubst ./src/%.c, %.o, $(wildcard src/*.c))
#
# will work with filesubst but not with patsubst.
#
sub f_filesubst {
my ($src, $dest, $words) = split(/,\s*/, $_[0]);
# Get the patterns.
my ($makefile, $makefile_line) = @_[1,2]; # Name the other arguments.
#
# First we eat away at the directories on the source until we find the
# percent sign. We remember where this directory is. Then we consider each
# of the words and strip off leading directories until we reach that
# directory. Then we run through patsubst.
#
my $startdir = ($src =~ s@^/+@@) ? $FileInfo::root : $makefile->{CWD};
# The directory we're in if there are no
# other directories specified.
while ($src =~ s@([^%/]+)/+@@) { # Strip off a leading directory that
# doesn't contain the % sign.
$startdir = file_info($1, $startdir)->dereference;
# Move to that directory.
}
#
# Now eat away at the directories in the words until we reach the starting
# directory.
#
my @words;
foreach (split(' ', $words)) {
my $thisdir = (s@^/+@@) ? $FileInfo::root : $makefile->{CWD};
while ($thisdir != $startdir &&
s@([^/]+)/+@@) { # Another directory?
$thisdir = file_info($1, $thisdir)->dereference;
}
push @words, $_; # What's left is the filename relative to that
# directory.
}
return join(" ", TextSubs::pattern_substitution($src, $dest, @words));
}
sub f_filter {
my ($filters, $words) = split(/,\s*/, $_[0]);
my @filters = split(' ', $filters); # Can be more than one filter.
foreach (@filters) { # Convert these into regular expressions.
s/([\.\+\(\)])/\\$1/g; # Protect all the periods and other special chars.
s/\*/\.\*/g; # Replace '*' with '.*'.
s/\%/\.\*/g; # Replace '%' with '.*'.
$_ = "^$_\$"; # Anchor the pattern.
}
my @ret_words;
wordloop:
foreach (split(' ', $words)) { # Now look at each word.
foreach my $filter (@filters) {
if (/$filter/) { # Does it match this filter?
push @ret_words, $_;
next wordloop;
}
}
}
return join(" ", @ret_words);
}
sub f_filter_out {
my ($filters, $words) = split(/,\s*/, $_[0]);
my @filters = split(' ', $filters); # Can be more than one filter.
foreach (@filters) { # Convert these into regular expressions.
s/([\.\+\(\)])/\\$1/g; # Protect all the periods and other special chars.
s/\*/\.\*/g; # Replace '*' with '.*'.
s/\%/\.\*/g; # Replace '%' with '.*'.
$_ = "^$_\$"; # Anchor the pattern.
}
my @ret_words;
wordloop:
foreach (split(' ', $words)) { # Now look at each word.
foreach my $filter (@filters) {
next wordloop if /$filter/; # Skip if it matches this filter.
}
push @ret_words, $_;
}
return join(" ", @ret_words);
}
#
# Find one of several executables in PATH.
#
sub f_find_program {
my @names = split(' ', $_[0]); # Get the programs to look for.
my ($makefile, $makefile_line) = @_[1,2]; # Access the other arguments.
my @pathdirs = map { file_info($_, $makefile->{CWD}) }
split(/:/, $makefile->{EXPORTS}{PATH} || $ENV{'PATH'});
# Get the list of directories to search.
foreach my $name (@names) { # Find it in the path:
foreach my $dir (@pathdirs) {
if (file_info($name, $dir)->is_executable) {
return $name;
}
}
}
return $names[0]; # None of the programs were executable.
}
#
# Find a file in a specified path, or in the environment variable PATH if
# nothing is specified.
#
sub f_findfile {
my ($name, $path) = split(/\,\s*/, $_[0]); # Get what to look for, and where
# to look for it.
my ($makefile, $makefile_line) = @_[1,2]; # Access the other arguments.
my @pathdirnames = split(/[:\s]+/, $path || $ENV{'PATH'});
# Get a separate list of directories.
my @names = split(' ', $name); # Get a list of names to find.
foreach $name (@names) { # Look for each one in the path:
foreach my $dir (@pathdirnames) {
my $finfo = file_info($name, file_info($dir, $makefile->{CWD}));
# Get the finfo structure.
if ($finfo->file_exists) { # Found it?
$name = $finfo->absolute_filename; # Replace it with the full name.
last; # Skip to the next thing to look for.
}
}
}
return join(" ", @names);
}
#
# Find a file by searching for it in the current directory, then in ., ..,
# etc.
# Modified from function contributed by Matthew Lovell.
#
sub f_find_upwards {
my @fnames = map { unquote($_) } split_on_whitespace($_[0]);
my $makefile = $_[1];
my @ret_names;
my $this_dir_devid = ($makefile->{CWD}->stat_array)->[0];
# Remember what device this is mounted on
# so we can avoid crossing file system
# boundaries.
foreach my $fname (@fnames) {
my $found = 0;
my $finfo;
for (my $dirinfo = $makefile->{CWD};
$dirinfo && ($dirinfo->stat_array)->[0] == $this_dir_devid;
# Don't cross device boundaries. This is
# intended to avoid trouble with automounters
# or dead network file systems.
$dirinfo = $dirinfo->{".."}) { # Look in all directories above us.
$finfo = file_info($fname, $dirinfo);
if ($finfo->exists_or_can_be_built) { # Found file in the path?
$found = 1;
last; # done searching
}
}
$found or die "cannot find file $fname\n";
push @ret_names, $finfo->relative_filename($makefile->{CWD});
}
return join(" ", @ret_names);
}
sub f_findstring {
my ($find, $in) = split(/,/, $_[0]);
return (index($in, $find) >= 0) ? $find : '';
}
sub f_firstword {
return (split(' ', $_[0]))[0] || '';
}
#
# The if function is unusual, because its arguments have not
# been expanded before we call it. The if function is defined so that
# only the expression that is actually used is expanded. E.g., if the
# if statement is true, then only the then expression is expanded, and
# any side effects of the else expression do not happen.
#
sub f_if {
my ($text, $makefile, $makefile_line) = @_; # Name the arguments.
my $first_comma = index_ignoring_quotes($text, ',');
# Find the first comma.
$first_comma >= 0 or die "$makefile_line: $(if ) with only one argument\n";
my $cond = $makefile->expand_text(substr($text, 0, $first_comma), $makefile_line);
# Evaluate the condition.
$cond =~ s/^\s+//; # Strip out whitespace on the response.
$cond =~ s/\s+$//;
$text = substr($text, $first_comma+1); # Get the text w/o the comma.
my $second_comma = index_ignoring_quotes($text, ',');
# Find the boundary between the then and the
# else clause.
if ($cond) { # Is the condition true?
my $then;
if ($second_comma >= 0) { # Was there an else clause?
$then = substr($text, 0, $second_comma);
} else {
$then = $text; # No else clause, then clause is the rest.
}
$then =~ s/^\s+//; # Strip out leading whitespace.
$then =~ s/\s+$//; # Strip out trailing whitespace.
return $makefile->expand_text($then, $makefile_line);
} else { # Condition was false. Extract the else
# clause.
$second_comma >= 0 or return ''; # No else clause.
my $else = substr($text, $second_comma+1); # Get the text.
$else =~ s/^\s+//; # Strip out leading whitespace.
$else =~ s/\s+$//; # Strip out trailing whitespace.
return $makefile->expand_text($else, $makefile_line);
}
}
#
# Infer the linker command from a list of objects. If any of the objects
# is fortran, we use $(FC) as a linker; if any of the objects is C++, we
# use $(CXX); otherwise, we use $(CC).
#
# This function is mostly used by the default link rules (see
# builtin_rules.mk).
#
sub f_infer_linker {
my ($text, $makefile, $makefile_line) = @_; # Name the arguments.
my @objs = split(' ', $text); # Get a list of objects.
#
# First build all the objs. Until we build them, we don't actually know what
# source files went into them. They've probably been built, but we must
# make sure.
#
my @build_handles;
foreach my $obj (@objs) {
$obj = file_info($obj, $makefile->{CWD}); # Replace the name with the
# fileinfo.
my $bh = main::build($obj); # Build this one.
$bh and push @build_handles, $bh;
}
my $status = wait_for @build_handles; # Wait for them all to build.
$status and die "Error while compiling\n"; # Maybe I'll come up with a better
# error message later.
#
# Now see what source files these were built from. Unfortunately, the
# dependencies have been sorted, so we can't just look at the first one.
#
my $is_fortran = 0; # Assume it's not fortran or C++.
my $is_cpp = 0;
foreach my $obj (@objs) {
foreach my $source_name(split(/\01/, $obj->build_info_string("SORTED_DEPS") || '')) {
$source_name =~ /\.f$/ and $is_fortran = 1;
$source_name =~ /\.(?:c\+\+|cc|cxx|C|cpp|moc)$/ and $is_cpp = 1;
}
}
my $linker = '$(CC)'; # Assume we can use the ordinary C linker.
$is_cpp and $linker = '$(CXX)';
$is_fortran and $linker = '$(FC)';
return $makefile->expand_text($linker, $makefile_line);
# Figure out what those things expand to.
}
#
# Usage:
# target : $(infer_objs seed-list, list of possible objs)
#
sub f_infer_objects {
my ($text, $makefile, $makefile_line) = @_; # Name the arguments.
my ($seed_objs, $candidate_list) = split(/,\s*/, $text);
# Get the arguments.
$candidate_list or die "infer_objects called without a candidate list\n";
$Makesubs::rule or die "infer_objects called outside of a rule\n";
my $build_cwd = $Makesubs::rule->build_cwd;
#
# Build up a list of all the possibilities:
#
my %candidate_objs;
foreach my $candidate_obj (map(Glob::zglob_fileinfo_atleastone($_, $build_cwd),
split(' ', $candidate_list))) {
# Get a list of all the possible objs.
my $objname = $candidate_obj->{NAME};
$objname =~ s/\.[^\.]+$//; # Strip off the extension.
if ($candidate_objs{$objname}) { # Already something by this name?
ref($candidate_objs{$objname}) eq 'ARRAY' or
$candidate_objs{$objname} = [ $candidate_objs{$objname} ];
# Make into an array as appropriate.
push @{$candidate_objs{$objname}}, $candidate_obj;
}
else { # Just one obj?
$candidate_objs{$objname} = $candidate_obj;
}
}
#
# Now look at the list of all the include files. This is a little tricky
# because we don't know the include files until we've actually built the
# dependencies.
#
my %source_names; # These are the names of include files for
# which are look for the corresponding objects.
my @build_handles; # Where we put the handles for building objects.
my @deps = map { Glob::zglob_fileinfo($_, $build_cwd) } split(' ', $seed_objs);
# Start with the seed files
# themselves.
$main::log_level and
main::print_log("infer_objects called with seed objects ",
join(" ", map { $_->name } @deps));
foreach (@deps) {
my $name = $_->{NAME};
$name =~ s/\.[^\.]+$//; # Strip off the extension.
$source_names{$name}++; # Indicate that we already have this as a
# source file.
}
my $dep_idx = 0;
#
# Build everything, so we know what everything's dependencies are. Initially,
# we'll only have a few objects to start from, so we build all of those, in
# parallel if possible. (That's why the loop structure is so complicated
# here.) Then we infer additional objects, build those in parallel, and
# so on.
#
for (;;) {
while ($dep_idx < @deps) { # Look at each dependency currently available.
my $o_info = $deps[$dep_idx]; # Access the FileInfo for this object.
my $bh = main::build($o_info); # Start building it.
my $handle = when_done $bh, # Build this dependency.
sub { # Called when the build is finished:
$bh->status and return $bh->status;
# Skip if an error occured.
my @this_sources = split(/\01/, $o_info->build_info_string("SORTED_DEPS") || '');
# Get the list of source files that went into
# it.
foreach (@this_sources) {
my $name = $_; # Make a copy of the file.
$name =~ s@.*/@@; # Strip off the path.
$name =~ s/\.[^\.]+$//; # Strip off the extension.
unless ($source_names{$name}++) { # Did we already know about that source?
if (ref($candidate_objs{$name}) eq 'FileInfo') { # Found a file?
$main::log_level and
main::print_log("infer_objects: adding ",
$candidate_objs{$name}->name,
" to dependency list because of $_");
push @deps, $candidate_objs{$name}; # Scan for its dependencies.
}
elsif (ref($candidate_objs{$name}) eq 'ARRAY') { # More than 1 match?
main::print_error($Makesubs::rule->source, " in infer_objects: more than one possible object for include file $_:\n ",
join("\n ", map { $_->absolute_filename } @{$candidate_objs{$name}}),
"\n");
}
}
}
};
defined($handle) and push @build_handles, $handle;
# Is this something we need to wait for?
++$dep_idx;
}
last unless @build_handles; # Quit if nothing to wait for.
my $status = wait_for @build_handles; # Wait for them all to build, and
# try again.
@build_handles = (); # We're done with those handles.
$status and last; # Quit if there was an error.
}
#
# At this point, we have built all the dependencies, and we also have a
# complete list of all the objects.
#
return join(" ", map { $_->relative_filename($build_cwd) } @deps);
}
sub f_join {
my ($words1, $words2) = split(/,/, $_[0]);
# Get the two lists of words.
defined($words2) or die "$_[2]: $(join ) called with < 2 arguments\n";
my @words1 = split(' ', $words1);
my @words2 = split(' ', $words2);
my $maxidx = @words1; # Get the number of words in the output.
$maxidx < @words2 and $maxidx = @words2;
my @outwords;
for (my $idx = 0; $idx < $maxidx; ++$idx) {
push @outwords, ($words1[$idx] || '') . ($words2[$idx] || '');
# Do the concatenation.
}
return join(' ', @outwords);
}
sub f_notdir {
my @ret_vals;
foreach (split ' ', $_[0]) {
if (m@^.*/([^/]+)@) { push @ret_vals, $1; }
else { push @ret_vals, $_; }
}
return join(" ", @ret_vals);
}
#
# Return only the files in the list that are actually targets of some rule:
#
sub f_only_targets {
my ($text, $makefile, $makefile_line) = @_; # Name the arguments.
my @ret_files;
my $build_cwd = $makefile->{CWD};
foreach (split(' ', $_[0])) {
foreach my $finfo (Glob::zglob_fileinfo($_, $build_cwd)) {
$finfo->get_rule(1) and
push @ret_files, $finfo->name($build_cwd);
}
}
return join(" ", @ret_files);
}
#
# Return only the files in the list that are not targets of some rule:
#
sub f_only_nontargets {
my ($text, $makefile, $makefile_line) = @_; # Name the arguments.
my @ret_files;
my $build_cwd = $makefile->{CWD};
foreach (split(' ', $_[0])) {
foreach my $finfo (Glob::zglob_fileinfo_atleastone($_, $build_cwd)) {
$finfo->get_rule(1) or
push @ret_files, $finfo->name($build_cwd);
}
}
return join(" ", @ret_files);
}
#
# Figure out where a variable came from:
#
sub f_origin {
my ($varname, $makefile, $makefile_line) = @_;
my $answer = "undefined"; # Assume we don't know what this variable is.
if ($Makesubs::perl_unfriendly_symbols{$varname}) {
$answer = "automatic";
}
elsif (defined($ {$makefile->{PACKAGE} . "::$varname"})) {
$answer = "file";
}
elsif ($makefile->{ENVIRONMENT}{$varname}) {
$answer = "environment";
}
elsif (defined(*{$makefile->{PACKAGE} . "::f_$varname"}{CODE})) { # Function?
if ($varname =~ /^(?:foreach|targets?|dependency|dependencies|inputs?|outputs?)$/) {
$answer = "automatic";
} else {
$answer = "default"; # Must be a variable like "CC".
}
}
if ($makefile->{COMMAND_LINE_VARS}{$varname}) { # Overriden by command line?
$answer = "command line";
}
return $answer;
}
#
# Perform a pattern substitution:
#
sub f_patsubst {
my ($src, $dest, $words) = split(/,\s*/, $_[0]);
# Get the arguments.
return join(" ", TextSubs::pattern_substitution($src, $dest,
split_on_whitespace($words)));
}
#
# Mark targets as phony:
#
sub f_phony {
my ($str, $makefile, $makefile_line) = @_; # Name the arguments.
foreach (split_on_whitespace($str)) {
main::find_makepp_info(unquote($_), $makefile->{CWD})->{IS_PHONY} = 1;
}
return $str; # Just return our argument.
}
sub f_print {
print $_[0], "\n"; # Print the text.
$_[0]; # Just return it verbatim.
}
#
# Return a filename for a given file relative to the current directory.
# (Modified from Matthew Lovell's contribution.)
#
sub f_relative_filename {
my $makefile = $_[1];
my @files = split_on_whitespace($_[0]); # Get a list of files.
my @ret_names;
foreach (@files) {
push @ret_names, file_info(unquote($_), $makefile->{CWD})->relative_filename($makefile->{CWD});
}
return join(" ", @ret_names);
}
#
# Return a filename relative to a given directory.
# Syntax: $(relative_to file1 file2, path/to/other/directory)
#
sub f_relative_to {
my $makefile = $_[1];
my @ret_names;
my ($files, $dir, @extra_junk) = split(/,/, $_[0]);
defined($dir) && @extra_junk == 0 or
die "wrong number of arguments to \$(relative_to file, dir)\n";
$dir =~ s/^\s+//; # Trim whitespace.
$dir =~ s/\s+$//;
my @files = split_on_whitespace($files);
my $dirinfo = file_info(unquote($dir), $makefile->{CWD});
# Directory this is relative to.
foreach (@files) {
push @ret_names, file_info(unquote($_), $makefile->{CWD})->relative_filename($dirinfo);
}
return join(" ", @ret_names);
}
sub f_shell {
my ($str, $makefile, $makefile_line) = @_; # Name the arguments.
chdir $makefile->{CWD}; # Make sure we're in the correct directory.
my $shell_output = '';
if (!$main::can_fork) { # Doesn't support forking well?
$shell_output = `$str`; # Run the shell command.
$? == 0 or
die "error $? running shell command `$str'\n";
}
else {
#
# We used to use perl's backquotes operators but these seem to have trouble,
# especially when doing parallel builds. The backquote operator doesn't seem
# to capture all of the output. Every once in a while (sometimes more often,
# depending on system load and whether it's a parallel build) the backquote
# operator returns without giving any output, even though the shell command
# is actually executed; evidently it's finishing before it's captured all
# the output. So we try a different approach here.
# This is about the third different technique that I've tried, and this one
# (finally) seems to work. I'm still not 100% clear on why some of the
# other ones didn't.
#
local (*INHANDLE, *OUTHANDLE); # Make a pair of file handles.
pipe(INHANDLE, OUTHANDLE) or die "can't make pipe--$!\n";
my $proc_handle = new MakeEvent::Process sub { # Wait for process to finish.
#
# This is the child process. Redirect our standard output to the pipe.
#
close INHANDLE; # Don't read from the handle any more.
close STDOUT;
open(STDOUT,">&OUTHANDLE") || die "can't redirect stdout--$!\n";
exec(TextSubs::format_exec_args($str));
die "exec failed--$!n";
};
close OUTHANDLE; # In parent, get rid of the output handle.
my $line;
my $n_errors_remaining = 3;
for (;;) {
my $n_chars = sysread(INHANDLE, $line, 8192); # Try to read.
if (!defined($n_chars)) { # An error on the read?
$n_errors_remaining-- > 0 and next; # Probably "Interrupted system call".
die "read error--$!\n";
}
last if $n_chars == 0; # No characters read--other process closed pipe.
$shell_output .= $line;
}
wait_for $proc_handle; # Should not really be necessary.
close INHANDLE;
}
$shell_output =~ s/\r?\n/ /g; # Get rid of newlines.
$shell_output =~ s/\s+$//; # Strip out trailing whitespace.
return $shell_output;
}
sub f_sort {
#
# Sort is documented to remove duplicates as well as to sort the string.
#
my @ret_words = sort split ' ', $_[0]; # Get the words.
my $idx = 1; # Now remove duplicates:
while ($idx < @ret_words) {
if ($ret_words[$idx] eq $ret_words[$idx-1]) {
splice @ret_words, $idx, 1; # Remove duplicated word.
} else {
++$idx; # Skip unique word.
}
}
join(" ", @ret_words);
}
sub f_stem {
defined($Makesubs::rule) || die "\$(stem) or \$* used outside of rule\n";
defined($Makesubs::rule->{PATTERN_STEM}) and
return $Makesubs::rule->{PATTERN_STEM};
return f_basename(&f_target);
# If there's no stem, just strip off the
# target's suffix. This is what GNU make
# does.
}
sub f_strip {
return join(" ", split(' ', $_[0]));
}
sub f_subst {
my ($from, $to, $text) = split(/,/, $_[0]);
$from = quotemeta($from);
my @ret_vals;
foreach (split(' ', $text)) {
(my $newval = $_) =~ s/$from/$to/g;
push(@ret_vals, $newval);
}
join(" ", @ret_vals);
}
sub f_suffix {
my @ret_vals;
foreach (split ' ', $_[0]) {
if (m@\.([^\./]*)$@) { push @ret_vals, $1; }
}
join(" ", @ret_vals);
}
sub f_wildcard {
my ($line, $makefile, $makefile_line) = @_; # Name the arguments.
my $cwd = $Makesubs::rule ? $Makesubs::rule->build_cwd : $makefile->{CWD};
# Get the default directory.
join(" ", map { Glob::zglob($_, $cwd) } split(' ', $line));
}
sub f_word {
my ($wordidx, $text) = split(/,\s*/, $_[0]);
return (split(' ', $text))[$wordidx-1] || '';
}
sub f_wordlist {
my ($startidx, $endidx, $text) = split(/,\s*/, $_[0]);
if ($startidx > $endidx) { my $temp = $startidx; $startidx = $endidx; $endidx = $temp; }
return join(" ", (split(' ', $text))[$startidx-1 .. $endidx-1]);
}
sub f_words {
my @wordlist = split(' ', $_[0]);
return scalar(@wordlist);
}
###############################################################################
#
# Define special automatic variables:
#
sub f_target {
defined($Makesubs::rule) || die "\$(target) or \$\@ used outside of rule\n";
return $Makesubs::rule->{EXPLICIT_TARGETS}[0]->name($Makesubs::rule->build_cwd);
}
*f_output = *f_target;
sub f_targets {
defined($Makesubs::rule) ||
die "\$(targets) or \$(outputs) used outside of rule\n";
return join(" ", relative_filenames($Makesubs::rule->{EXPLICIT_TARGETS}));
}
*f_outputs = *f_targets;
sub f_dependency {
defined($Makesubs::rule) ||
die "\$(dependency) or \$(input) used outside of rule\n";
my $finfo = $Makesubs::rule->{EXPLICIT_DEPENDENCIES}[0];
$finfo or return ''; # No dependencies.
return $finfo->name($Makesubs::rule->build_cwd);
}
*f_input = *f_dependency;
sub f_dependencies {
defined($Makesubs::rule) ||
die "\$(dependencies) or \$(inputs) or \$^ used outside of rule\n";
return join(" ", relative_filenames($Makesubs::rule->{EXPLICIT_DEPENDENCIES}));
}
*f_inputs = *f_dependencies;
sub f_sorted_dependencies {
defined($Makesubs::rule) || die "\$(sorted_dependencies) or \$(sorted_inputs) or \$\^ used outside of rule\n";
return Makesubs::f_sort join(" ", relative_filenames($Makesubs::rule->{EXPLICIT_DEPENDENCIES}));
}
*f_sorted_inputs = *f_sorted_dependencies;
#
# Foreach is a little bit trick, since we have to support the new
# $(foreach) automatic variable, but also the old GNU make function
# foreach. We can tell the difference pretty easily by whether we have
# any arguments.
#
sub f_foreach {
my ($text, $makefile, $makefile_line) = @_; # Name the arguments.
if ($text !~ /\S/) { # No argument?
defined($Makesubs::rule) && defined($Makesubs::rule->{FOREACH}) or
return "\$(foreach)"; # Just delay the expansion.
# This is necessary because target strings
# may get expanded before the foreach variable
# is defined.
# die "\$(foreach) used outside of rule, or in a rule that has no :foreach clause\n";
return $Makesubs::rule->{FOREACH}->name($Makesubs::rule->build_cwd);
}
#
# At this point we know we're trying to expand the old GNU make foreach
# function. The syntax is $(foreach VAR,LIST,TEXT), where TEXT is
# expanded once with VAR set to each value in LIST. When we get here,
# because of some special code in expand_text, VAR,LIST,TEXT has not yet
# been expanded.
#
my $first_comma = index_ignoring_quotes($text, ','); # Find the variable name.
$first_comma >= 0 or
die "$makefile_line: $(foreach VAR,LIST,TEXT) called with only one argument\n";
my $varname = $makefile->expand_text(substr($text, 0, $first_comma));
# Get the name of the variable.
$varname =~ s/^\s+//; # Strip off leading and trailing whitespace.
$varname =~ s/\s+$//;
$text = substr($text, $first_comma+1); # Get rid of the variable name.
my $second_comma = index_ignoring_quotes($text, ','); # Find the next comma.
$second_comma >= 0 or
die "$makefile_line: $(foreach VAR,LIST,TEXT) called with only two arguments\n";
my $list = $makefile->expand_text(substr($text, 0, $second_comma));
$text = substr($text, $second_comma+1);
my $ret_str = '';
foreach (split(' ', $list)) { # Expand text:
local $makefile->{COMMAND_LINE_VARS}{$varname} = $_;
# Make it a command line variable so that it
# overrides even an environment variable.
# The local makes it so it goes away at the
# end of the loop.
$ret_str .= ' ' . $makefile->expand_text($text, $makefile_line);
}
length($ret_str) < 1 and return ''; # No values in list.
return substr($ret_str, 1); # Get rid of the extra space we put in at the
# beginning.
}
#
# $(MAKE) needs to expand to the name of the program we use to replace a
# recursive make invocation. We pretend it's a function with no arguments.
#
sub f_MAKE {
if ($main::traditional_recursive_make) { # Do it the bozo way?
unless ($Makesubs::make_name) { # Haven't figured it out yet?
$Makesubs::make_name = $0; # Get the name of the program.
unless ($Makesubs::make_name =~ m@^/@) { # Not absolute?
#
# We have to search the path to figure out where we came from.
#
foreach (split(/:/, $ENV{'PATH'}), '.') {
my $finfo = file_info("$_/$0", $main::original_cwd);
if ($finfo->file_exists) { # Is this our file?
$Makesubs::make_name = $finfo->absolute_filename;
last;
}
}
}
}
return $Config{'bin'} . "/perl " . $Makesubs::make_name . " --recursive_makepp";
# All the rest of the info is passed in the
# MAKEFLAGS environment variable.
# The --recursive option is just a flag that
# helps the build subroutine identify this as
# a recursive make command. It doesn't
# actually do anything.
} else {
if (!$main::can_fork) {
die "makepp: recursive make without --traditional not supported on this platform\n";
}
my $makefile = $_[1]; # Get the makefile we're run from.
my $recursive_makepp = $Config{'bin'} . "/perl " .
file_info($main::datadir, $main::original_cwd)->absolute_filename .
"/recursive_makepp";
# Sometimes we can be run as ../makepp, and
# if we didn't hard code the paths into
# makepp, the directories may be relative.
# However, since recursive make is usually
# invoked in a separate directory, the
# path must be absolute.
return "$recursive_makepp " . join(" ", map { "$_=" . requote($makefile->{COMMAND_LINE_VARS}{$_}) } keys %{$makefile->{COMMAND_LINE_VARS}});
}
}
sub f_MAKE_COMMAND { return &f_MAKE; }
#
# Now define all the cryptic one-character symbols, and anything else that
# isn't a valid subroutine name:
#
%Makesubs::perl_unfriendly_symbols =
("@" => \&f_target,
"<" => \&f_dependency,
"^" => \&f_dependencies,
"?" => \&f_sorted_dependencies,
"+" => \&f_sorted_dependencies,
"*" => \&f_stem,
"&" => sub { "" }, # Perl makefiles use this for some reason, but
# $& is a perl variable whose value is '$', so
# we don't want to look for the perl variable
# $&.
'@D' => sub { f_dir_noslash f_target },
'@F' => sub { f_notdir f_target },
'*D' => sub { f_dir_noslash f_stem },
'*F' => sub { f_notdir f_stem },
'<D' => sub { f_dir_noslash f_dependency },
'<F' => sub { f_notdir f_dependency },
'^D' => sub { f_dir_noslash f_dependencies },
'^F' => sub { f_notdir f_dependencies },
);
###############################################################################
#
# Makefile statements. These are all called with the following arguments:
# a) The whole line of text (with the statement word removed).
# b) The makefile this is associated with.
# c) A printable string describing which line of the makefile the statement
# was on.
#
#
# Handle the no_implicit_load statement. This statement marks some
# directories not to be loaded by the implicit load mechanism, in case
# there are makefiles there that you really don't want to load.
#
sub s_no_implicit_load {
my ($text_line, $makefile, $makefile_line) = @_; # Name the arguments.
my $cwd = $Makesubs::rule ? $Makesubs::rule->build_cwd : $makefile->{CWD};
# Get the default directory.
local $main::implicitly_load_makefiles = 0;
# Temporarily turn off makefile loading for
# the expansion of this wildcard.
my @dirs = map { Glob::zglob_fileinfo($_, $cwd) }
split(' ', $makefile->expand_text($text_line, $makefile_line));
# Get a list of things matching the wildcard.
foreach my $dir (@dirs) {
$dir->is_or_will_be_dir and $dir->{NO_IMPLICIT_LOAD} = 1;
# Tag them so they don't load later.
}
}
#
# Export statement.
#
sub s_export {
my ($text_line, $makefile, $makefile_line) = @_; # Name the arguments.
if ($text_line =~ /^\s*([^\s=\#]+)\s*=\s*(.*)$/) { # Assignment?
$ {$makefile->{PACKAGE} . "::$1"} = $makefile->expand_text($2, $makefile_line);
# Do the assignment. (This is a := assignment.)
$text_line = $1; # Pretend just the variable name was present.
}
foreach (split(' ', $makefile->expand_text($text_line, $makefile_line))) {
$makefile->{EXPORTS}{$_} = undef;
# Mark these variables for export. We'll
# fill out their values later.
}
}
#
# Include statement:
#
sub s_include {
my ($text_line, $makefile, $makefile_line) = @_;
# Name the arguments.
my @files = split(' ', $makefile->expand_text($text_line, $makefile_line));
# Get a list of files.
my $this_dir_devid = ($makefile->{CWD}->stat_array)->[0];
# Remember what device this is mounted on
# so we can avoid crossing file system
# boundaries.
foreach my $file (@files) {
my $finfo;
for (my $dirinfo = $makefile->{CWD};
$dirinfo && ($dirinfo->stat_array)->[0] == $this_dir_devid;
$dirinfo = $dirinfo->{".."}) { # Look in all directories above us.
$finfo = file_info($file, $dirinfo);
if ($finfo->exists_or_can_be_built) { # Found file in the path?
wait_for main::build($finfo, 0) and # Build it if necessary, or link
# it from a repository.
die "can't build " . $finfo->absolute_filename . ", needed at $makefile_line\n";
# Quit if the build failed.
last; # We're done searching.
}
}
#
# If it wasn't found anywhere in the directory tree, search the standard
# include files supplied with makepp. We don't try to build these files or
# link them from a repository.
#
unless ($finfo->file_exists) { # Not found anywhere in directory tree?
foreach (@{$makefile->{INCLUDE_PATH}}) {
$finfo = file_info($file, $_); # See if it's here.
last if $finfo->file_exists;
}
$finfo->file_exists or
die "can't find include file $file\n";
}
$main::log_level and
main::print_log("Including ", $finfo->name);
$makefile->read_makefile($finfo); # Read the file.
}
'';
}
#
# This subroutine does exactly the same thing as include, except that it
# doesn't die with an error message if the file doesn't exist.
#
sub s__include {
my ($text_line, $makefile, $makefile_line) = @_;
# Name the arguments.
foreach (split(' ', $makefile->expand_text($text_line, $makefile_line))) {
eval { s_include($_, $makefile, $makefile_line); };
}
$@ = ''; # Discard any error.
}
#
# Load one or several makefiles.
#
sub s_load_makefile {
my ($text_line, $makefile, $makefile_line) = @_; # Name the arguments.
my (@words) = split(' ', $makefile->expand_text($text_line, $makefile_line));
my %command_line_vars = %{$makefile->{COMMAND_LINE_VARS}};
# Extra command line variables. Start out
# with a copy of the current command line
# variables.
my (@include_path) = @{$makefile->{INCLUDE_PATH}};
# Make a copy of the include path (so we can
# modify it with -I).
#
# First pull out the variable assignments.
#
my @makefiles;
while (defined($_ = shift @words)) { # Any words left?
if (/^(\w+)=(.*)/) { # Found a variable?
$command_line_vars{$1} = unquote($2);
}
elsif (/^-I(\S*)/) { # Specification of the include path?
unshift @include_path, ($1 || shift @words);
# Grab the next word if it wasn't specified in
# the same word.
}
else { # Unrecognized. Must be name of a makefile.
push @makefiles, $_;
}
}
#
# Now process the makefiles:
#
foreach (@makefiles) {
s/^-F//; # Support the archaic syntax that put -F
# before the filename.
my $mfile = file_info($_, $makefile->{CWD});
# Get info on the file.
my $mdir = $mfile; # Assume it is actually a directory.
$mfile->is_or_will_be_dir or $mdir = $mfile->{".."};
# Default directory is the directory the
# makefile is in.
&Makefile::load($mfile, $mdir, \%command_line_vars, "", \@include_path,
$makefile->{ENVIRONMENT}); # Load the makefile.
}
}
#
# Begin a whole block of perl code.
#
sub s_perl_begin {
my ($junk, $makefile, $makefile_line) = @_;
# Name the arguments.
my $perl_code;
my $line;
while (defined($line = &read_makefile_line)) { # Get the next line.
last if $line =~ /^perl_end/; # Found the terminator?
$perl_code .= $line;
}
chdir $makefile->{CWD}; # Make sure we're in the correct directory
# because some perl code will expect this.
eval "no strict; package $makefile->{PACKAGE};\n$perl_code";
if ($@) { # Try to convert the line number into
# something that's more readable.
my ($starting_line, $makefile_name) = ('random subroutine', 1);
if ($makefile_line =~ /(.*):(\d+)$/) { # Get the name of the makefile and
$makefile_name = $1; # the starting line number, so we can fix the
$starting_line = $2; # error message.
}
my $error = $@; # Make a modifiable copy.
$error =~ s{\(eval \d+\)(?:\[.*?\])? line (\d+)}{"$makefile_name:" . ($starting_line+$1-1)}eg;
# Try to fix up the line numbers.
die $error; # Resignal the error.
}
}
#
# Register an action scanner.
# Usage from the makefile:
# register_scanner command_word scanner_subroutine_name
#
#
sub s_register_scanner {
my ($text_line, $makefile, $makefile_line) = @_; # Name the arguments.
my (@fields) = split_on_whitespace($text_line);
# Get the words.
@fields == 2 or die "$makefile_line: invalid register_scanner line\n";
my $command_word = unquote($fields[1]); # Remove quotes, etc.
my $scanner_sub = \&{$makefile->{PACKAGE} . "::$fields[2]"};
# Get a reference to the subroutine.
$makefile->register_scanner($command_word, $scanner_sub);
}
#
# Load from repositories:
#
sub s_repository {
my ($text_line, $makefile, $makefile_line) = @_; # Name the arguments.
foreach my $rdir (split(' ', $makefile->expand_text($text_line, $makefile_line))) {
# Get a list of repository directories.
if ($rdir =~ /^([^=]+)=(.*)$/) { # Destination directory specified?
my $rinfo = file_info($2, $makefile->{CWD});
my $dst_info = file_info($1, $makefile->{CWD});
main::load_repository($rinfo, $dst_info);
}
else {
my $rinfo = file_info($rdir, $makefile->{CWD});
# Get the fileinfo structure.
main::load_repository($rinfo, $makefile->{CWD});
# Load all the files.
}
}
}
#
# Set the default signature method for all rules in this makefile:
#
sub s_signature {
my ($args, $makefile, $makefile_line) = @_;
$args =~ /^\s*(\w+)\s*$/ or
die "$makefile_line: invalid signature statement\n";
my $sigmethod = $1;
if ($sigmethod eq 'default') { # Return to the default method?
delete $makefile->{DEFAULT_SIGNATURE_METHOD}; # Get rid of any previous
# stored signature method.
return;
}
defined $ {"Signature::${sigmethod}::${sigmethod}"} or
die "$makefile_line: invalid signature method $sigmethod\n";
$makefile->{DEFAULT_SIGNATURE_METHOD} = $ {"Signature::${sigmethod}::${sigmethod}"};
}
#
# This function allows the user to do something in the makefile like:
# sub subname {
# ... perl code
# }
#
sub s_sub { # Yes, we can actually have a function with
# the name "sub".
my ($subr_text, $makefile, $makefile_line) = @_;
# Name the arguments.
unless ($subr_text =~ /\}\s*$/) { # Subroutine is not entirely inline?
$subr_text .= "\n"; # Put the newline in that got removed.
my $line;
while (defined($line = &read_makefile_line)) { # Get the next line.
$subr_text .= $line;
last if $line =~ /^\}/; # Stop at a brace at the left margin.
}
}
#
# At this point, $subr_text contains the text of the subroutine. Evaluate
# it:
#
eval "no strict; package $makefile->{PACKAGE}; sub $subr_text";
if ($@) { # Try to convert the line number into
# something that's more readable.
my ($starting_line, $makefile_name) = ('random subroutine', 1);
if ($makefile_line =~ /(.*):(\d+)$/) { # Get the name of the makefile and
$makefile_name = $1; # the starting line number, so we can fix the
$starting_line = $2; # error message.
}
my $error = $@; # Make a modifiable copy.
$error =~ s{\(eval \d+\)(?:\[.*?\])? line (\d+)}{"$makefile_name:" . ($starting_line+$1-1)}eg;
# Try to fix up the line numbers.
die $error; # Resignal the error.
}
}
#
# Don't export a variable to child processes.
#
sub s_unexport {
my ($text_line, $makefile, $makefile_line) = @_;
# Name the arguments.
return unless $makefile->{EXPORTS};
foreach (split(' ', $makefile->expand_text($text_line, $makefile_line))) {
# Look at each variable listed.
delete $makefile->{EXPORTS}{$_};
}
}
###############################################################################
#
# Default values of various variables. These are implemented as functions
# with no arguments so that:
# a) They are visible to all makefiles, yet are easily overridden.
# (If we just put them in makepp_builtin_rules.mk, then they are not
# visible in the makefile except in rules, because makepp_builtin_rules.mk
# is loaded after the makefile. That's where they were for a while but
# that was discovered not to work well.)
# b) The $(origin ) function can work with them.
#
sub f_AR { 'ar' }
sub f_ARFLAGS { 'rv' }
sub f_AS { 'as' }
sub f_CC { $_[1]->expand_text('$(find_program gcc egcc pgcc c89 cc)', $_[2]) }
sub f_CFLAGS { $_[1]->expand_text('$(if $(filter %gcc, $(CC)), -g -Wall, -g)', $_[2]) }
sub f_CXX { $_[1]->expand_text('$(find_program g++ c++ pg++ cxx CC)', $_[2]) }
sub f_CXXFLAGS { $_[1]->expand_text('$(if $(filter g++ c++, $(CXX)), -g -Wall, -g)', $_[2]) }
sub f_F77 { $_[1]->expand_text('$(find_program f77 g77 fort77)', $_[2]) }
sub f_FC { $_[1]->expand_text('$(F77)', $_[2]) }
sub f_LIBTOOL { 'libtool' }
sub f_LD { 'ld' }
sub f_MAKEINFO { 'makeinfo' }
sub f_LEX { $_[1]->expand_text('$(find_program lex flex)', $_[2]) }
sub f_RM { 'rm -f' }
sub f_YACC { $_[1]->expand_text('$(if $(filter bison, $(find_program yacc bison)), bison -y, yacc)', $_[2]) }
1;