# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
-require 5.005;
-use File::Basename;
-
-my $me = basename ($0);
-
-## --------- ##
-## Request. ##
-## --------- ##
-
-package Request;
BEGIN
{
my $prefix = "@prefix@";
- # FIXME: Import Struct into Autoconf.
my $perllibdir = $ENV{'autom4te_perllibdir'} || "@datadir@";
unshift @INC, "$perllibdir";
}
+## --------- ##
+## Request. ##
+## --------- ##
+
+package Request;
+
use Data::Dumper;
use Autom4te::General;
use Autom4te::Struct;
(
# The key of the cache file.
'cache' => "\$",
- # True if the cache file is up to date.
+ # True iff %MACRO contains all the macros we want to trace.
'valid' => "\$",
# The include path.
'path' => '@',
);
+# $REQUEST-OBJ
+# retrieve ($SELF, %ATTR)
+# -----------------------
# Find a request with the same path and source.
+# Private.
sub retrieve
{
my ($self, %attr) = @_;
return undef;
}
+
+# $REQUEST-OBJ
+# register ($SELF, %ATTR)
+# -----------------------
# NEW should not be called directly.
-sub register
+# Private.
+sub register ($%)
{
my ($self, %attr) = @_;
}
-# request(%REQUEST)
-# -----------------
+# $REQUEST-OBJ
+# request($SELF, %REQUEST)
+# ------------------------
# Return a request corresponding to $REQUEST{path} and $REQUEST{source},
# using a cache value if it exists.
-sub request
+sub request ($%)
{
my ($self, %request) = @_;
- my $obj = Request->retrieve (%request) || Request->register (%request);
+ my $req = Request->retrieve (%request) || Request->register (%request);
# If there are new traces to produce, then we are not valid.
foreach (@{$request{'macro'}})
{
- if (! exists ${$obj->macro}{$_})
+ if (! exists ${$req->macro}{$_})
{
- ${$obj->macro}{$_} = 1;
- $obj->valid (0);
- }
+ ${$req->macro}{$_} = 1;
+ $req->valid (0);
+ }
}
- return $obj;
+ # It would be great to have $REQ check that it up to date wrt its
+ # dependencies, but that requires gettting traces (to fetch the
+ # included files), which is out of the scope of Request
+ # (currently?).
+
+ return $req;
}
# Serialize a request or all the current requests.
# $BOOL
-# up_to_date_p ($REQ, $FILE)
-# --------------------------
-# If $FILE up to date?
-# We need $REQ since we check $FILE against all its dependencies,
-# and we use the traces on `include' to find them.
-sub up_to_date_p ($$)
+# up_to_date_p ($REQ)
+# -------------------
+# Is the cache file of $REQ up to date?
+# $REQ is `valid' if it corresponds to the request and exists, which
+# does not mean it is up to date. It is up to date if, in addition,
+# it's younger than its dependencies.
+sub up_to_date_p ($)
{
- my ($req, $file) = @_;
+ my ($req) = @_;
- # If STDOUT or doesn't exist, it sure is outdated!
return 0
- if $file eq '-' || ! -f $file;
+ if ! $req->valid;
# We can't answer properly if the traces are not computed since we
# need to know what other files were included.
+ my $file = "$me.cache/" . $req->cache;
return 0
- if ! -f "$me.cache/" . $req->cache;
+ if ! -f $file;
# We depend at least upon the arguments.
my @dep = @ARGV;
handle_traces ($req, "$tmp/dependencies",
('include' => '$1',
'm4_include' => '$1'));
- my $mtime = (stat ($file))[9];
+ my $mtime = mtime ($file);
my $deps = new IO::File ("$tmp/dependencies");
push @dep, map { chomp; find_file ($_) } $deps->getlines;
foreach (@dep)
{
verbose "$file depends on $_";
- if ($mtime < (stat ($_))[9])
+ if ($mtime < mtime ($_))
{
verbose "$file depends on $_ which is more recent";
return 0;
# Add the new trace requests.
my $req = Request->request ('source' => \@ARGV,
- 'path' => \@include,
- 'macro' => [keys %trace, @preselect]);
+ 'path' => \@include,
+ 'macro' => [keys %trace, @preselect]);
+# If $REQ is not up to date, declare it invalid.
+$req->valid (0)
+ if ! up_to_date_p ($req);
+
+# We now know whether we can trust the Request object. Say it.
if ($verbose)
{
print STDERR "$me: the trace request object is:\n";
print STDERR $req->marshall;
}
-# We need to run M4 if
-# - for traces
-# + there is no cache, or
-# + it does not include the traces we need, or
-# + it exists but is outdated
-# - for output if it is not /dev/null and
-# + it doesn't exist, or
-# + it is outdated
+# We need to run M4 if (i) $REQ is invalid, or (ii) we are expanding
+# (i.e., not tracing) and the output is older than the cache file
+# (since the later is valid if it's older than the dependencies).
+# STDOUT is pretty old.
+my $output_mtime = mtime ($output);
+
handle_m4 ($req, keys %{$req->macro})
if (! $req->valid
- || ! up_to_date_p ($req, "$me.cache/" . $req->cache)
- || (! %trace && ! up_to_date_p ($req, "$output")));
+ || (! %trace && $output_mtime < mtime ("$me.cache/" . $req->cache)));
+
+# Now output...
if (%trace)
{
- # Producing traces.
- # Trying to produce the output only when needed is very
- # error prone here, as you'd have to check that the trace
- # requests have not changed etc.
+ # Always produce traces, since even if the output is young enough,
+ # there is no guarantee that the traces use the same *format*
+ # (e.g., `-t FOO:foo' and `-t FOO:bar' are both using the same M4
+ # traces, hence the M4 traces cache is usable, but its formating
+ # will yield different results).
handle_traces ($req, $output, %trace);
}
else
{
- # Actual M4 expansion.
+ # Actual M4 expansion, only if $output is too old.
handle_output ($output)
- if ! up_to_date_p ($req, $output);
+ if $output_mtime < mtime ("$me.cache/" . $req->cache);
}
-# All went fine, the cache is valid.
-$req->valid (1);
+# If all went fine, the cache is valid.
+$req->valid (1)
+ if $exit_status == 0;
Request->save ("$me.cache/requests");
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
+# This file is basically Perl 5.6's Class::Struct, but made compatible
+# with Perl 5.5. If someday this has to be updated, be sure to rename
+# all the occurrences of Class::Struct into Autom4te::Struct, otherwise
+# if we `use' a Perl module (e.g., File::stat) that uses Class::Struct,
+# we would have two packages defining the same symbols. Boom.
+
package Autom4te::Struct;
## See POD after __END__
}
{
- package Class::Struct::Tie_ISA;
+ package Autom4te::Struct::Tie_ISA;
sub TIEARRAY {
my $class = shift;
sub STORE {
my ($self, $index, $value) = @_;
- Class::Struct::_subclass_error();
+ Autom4te::Struct::_subclass_error();
}
sub FETCH {
\@{$class . '::ISA'};
};
_subclass_error() if @$isa;
- tie @$isa, 'Class::Struct::Tie_ISA';
+ tie @$isa, 'Autom4te::Struct::Tie_ISA';
# Create constructor.
=head1 NAME
-Class::Struct - declare struct-like datatypes as Perl classes
+Autom4te::Struct - declare struct-like datatypes as Perl classes
=head1 SYNOPSIS
- use Class::Struct;
+ use Autom4te::Struct;
# declare struct, based on array:
struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
# declare struct, based on hash:
struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
package CLASS_NAME;
- use Class::Struct;
+ use Autom4te::Struct;
# declare struct, based on array, implicit class name:
struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
package Myobj;
- use Class::Struct;
+ use Autom4te::Struct;
# declare struct with four types of elements:
struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
=head1 DESCRIPTION
-C<Class::Struct> exports a single function, C<struct>.
+C<Autom4te::Struct> exports a single function, C<struct>.
Given a list of element names and types, and optionally
a class name, C<struct> creates a Perl 5 class that implements
a "struct-like" data structure.
microseconds), and C<rusage> has two elements, each of which is of
type C<timeval>.
- use Class::Struct;
+ use Autom4te::Struct;
struct( rusage => {
ru_utime => timeval, # seconds
accessor accordingly.
package MyObj;
- use Class::Struct;
+ use Autom4te::Struct;
# declare the struct
struct ( 'MyObj', { count => '$', stuff => '%' } );
struct's constructor.
- use Class::Struct;
+ use Autom4te::Struct;
struct Breed =>
{
=head1 Author and Modification History
+Modified by Akim Demaille, 2001-08-03
+
+ Rename as Autom4te::Struct to avoid name clashes with
+ Class::Struct.
+
+ Make it compatible with Perl 5.5.
Modified by Damian Conway, 1999-03-05, v0.58.
projects / thirdparty / autoconf.git / commitdiff
