[acl2-books] r992 committed - Add some error handling for missing directories in certlib
acl2-...@googlecode.com
Author: sswords
Date: Thu Mar 1 09:02:40 2012
Log: Add some error handling for missing directories in certlib
http://code.google.com/p/acl2-books/source/detail?r=992
Modified:
/trunk/cert.pl
/trunk/certlib.pl
/trunk/critpath.pl
=======================================
--- /trunk/cert.pl Wed Feb 15 11:56:51 2012
+++ /trunk/cert.pl Thu Mar 1 09:02:40 2012
@@ -86,6 +86,15 @@
"believe_cache" => 0 );
my $cache_file = 0;
my $bin_dir = $ENV{'CERT_PL_BIN_DIR'};
+# Remove trailing slash from and canonicalize bin_dir
+if ($bin_dir) {
+ my $cbin_dir = canonical_path(remove_trailing_slash($bin_dir));
+ if (! $cbin_dir) {
+ die("Fatal: bad path in environment var CERT_PL_BIN_DIR=$bin_dir");
+ }
+ $bin_dir = $cbin_dir;
+}
+
$base_path = abs_canonical_path(".");
@@ -354,15 +363,27 @@
$no_build = 1;},
"acl2|a=s" => \$acl2,
"acl2-books|b=s" => \$acl2_books,
- "bin=s" => \$bin_dir,
+ "bin=s" => sub {
+ shift;
+ my $arg = shift;
+ $bin_dir = canonical_path(remove_trailing_slash($arg));
+ if (!$bin_dir) {
+ die("Fatal: bad path in directive --bin $arg\n");
+ }
+ },
"include|i=s" => sub {shift;
push(@includes, shift);},
"include-after|ia=s" => sub {shift;
push(@include_afters,
shift);},
- "relative-paths|r=s" => sub {shift;
- $base_path =
- abs_canonical_path(shift);},
+ "relative-paths|r=s" => sub {
+ shift;
+ my $arg = shift;
+ $base_path = abs_canonical_path($arg);
+ if (! $base_path) {
+ die("Fatal: bad path in directive --relative-paths/-r $arg\n");
+ }
+ },
"svn-status" => sub {push (@run_sources,
sub { my $target = shift;
print `svn status --no-ignore $target`;
@@ -398,8 +419,6 @@
return ( substr($dir,-1) eq "/" && $dir ne "/" )
? substr($dir,0,-1) : $dir;
}
-# Remove trailing slash from bin_dir, if any
-$bin_dir = $bin_dir && canonical_path(remove_trailing_slash($bin_dir));
certlib_set_opts(\%certlib_opts);
=======================================
--- /trunk/certlib.pl Mon Feb 13 13:38:07 2012
+++ /trunk/certlib.pl Thu Mar 1 09:02:40 2012
@@ -29,6 +29,11 @@
# use Cwd;
use Cwd 'abs_path';
+# Note: for debugging you can enable this use and then print an error
message
+# using
+# carp "Description of the error\n";
+# and you get a backtrace as well.
+# use Carp;
sub human_time {
@@ -85,6 +90,7 @@
my ($vol, $dir, $file) = File::Spec->splitpath($abspath);
if (! -d $dir) {
print "Oops, trying to go into $dir\n";
+ return 0;
}
my $absdir = Cwd::fast_abs_path($dir);
if ($absdir) {
@@ -107,7 +113,7 @@
} else {
my $res;
my $abs_path = abs_canonical_path($fname);
- if ($BASE_PATH) {
+ if ($BASE_PATH && $abs_path) {
my $relpath = File::Spec->abs2rel($abs_path, $BASE_PATH);
$res = $relpath ? $relpath : ".";
} else {
@@ -708,8 +714,9 @@
my $local_dirs = shift;
my $dirpath;
- $local_dirs && ($dirpath = $local_dirs->{$name});
- if (! defined($dirpath)) {
+ if ($local_dirs && exists $local_dirs->{$name}) {
+ $dirpath = $local_dirs->{$name};
+ } else {
$dirpath = $dirs{$name} ;
}
return $dirpath;
@@ -905,15 +912,22 @@
my $fullname;
if ($dirname) {
my $dirpath = lookup_colon_dir($dirname, $local_dirs);
- unless (defined($dirpath)) {
+ unless ($dirpath) {
print "Warning: Unknown :dir entry in ($cmd \"$relname\" :dir
$dirname) for $basename\n";
print_dirs($local_dirs) if $debugging;
return 0;
}
+ print "expand $dirname -> $dirpath\n" if $debugging;
$fullname = canonical_path(rel_path($dirpath, $relname . $ext));
+ if (! $fullname) {
+ print ":dir entry in ($cmd \"$relname\" :dir $dirname) produced bad
path\n";
+ }
} else {
my $dir = dirname($basename);
$fullname = canonical_path(rel_path($dir, $relname . $ext));
+ if (! $fullname) {
+ print "bad path in ($cmd \"$relname\")\n";
+ }
}
return $fullname;
}
@@ -986,8 +1000,11 @@
my $name = $event->[1];
my $dir = $event->[2];
my $basedir = dirname($fname);
- $local_dirs->{$name} = canonical_path(rel_path($basedir,
- $dir));
+ my $newdir = canonical_path(rel_path($basedir, $dir));
+ if (! $newdir) {
+ print "Bad path processing (add-include-book-dir :$name \"$dir\") in
$fname\n";
+ }
+ $local_dirs->{$name} = $newdir;
print "src_deps: add_dir $name $local_dirs->{$name}\n" if
$debugging;
} elsif ($type eq $include_book_event) {
@@ -997,6 +1014,10 @@
$local_dirs,
"include-book",
".cert");
+ if (! $fullname) {
+ print "Bad path in (include-book \"$bookname\""
+ . ($dir ? " :dir $dir)" : ")") . " in $fname\n";
+ }
print "include-book fullname: $fullname\n" if $debugging;
$fullname && push(@$certdeps, $fullname);
} elsif ($type eq $depends_on_event && !$book_only) {
@@ -1005,6 +1026,10 @@
my $fullname = expand_dirname_cmd($depname, $fname, $dir,
$local_dirs,
"depends-on", "");
+ if (! $fullname) {
+ print "Bad path in (depends-on \"$depname\""
+ . ($dir ? " :dir $dir)" : ")") . " in $fname\n";
+ }
$fullname && push(@$srcdeps, $fullname);
} elsif ($type eq $loads_event) {
my $srcname = $event->[1];
@@ -1023,6 +1048,9 @@
$seen,
$fname);
$two_pass = $two_pass || $local_two_pass;
+ } else {
+ print "Bad path in (loads \"$srcname\""
+ . ($dir ? " :dir $dir)" : ")") . " in $fname\n";
}
} elsif ($type eq $two_pass_event) {
$two_pass = 1;
@@ -1044,6 +1072,9 @@
$seen,
$fname);
$two_pass = $two_pass || $local_two_pass;
+ } else {
+ print "Bad path in (ld \"$srcname\""
+ . ($dir ? " :dir $dir)" : ")") . " in $fname\n";
}
} else {
print "Warning: LD event in book context in $fname:\n";
@@ -1155,7 +1186,10 @@
}
if ($imagefile) {
- push(@{$srcdeps}, canonical_path($imagefile));
+ my $imfilepath = canonical_path($imagefile);
+ # Won't check the result of canonical_path because we're
+ # already in the right directory.
+ push(@{$srcdeps}, $imfilepath);
my $line;
if (open(my $im, "<", $imagefile)) {
$line = <$im>;
@@ -1362,9 +1396,13 @@
if (substr($str, 0, 3) eq '-p ') {
# Deps-of.
my $name = canonical_path(to_source_name(substr($str,3)));
- my ($deps) = find_deps($name, $cache, 1, $tscache, 0);
- push (@targets, @$deps);
- push (@$label_targets, @$deps) if $label_started;
+ if ($name) {
+ my ($deps) = find_deps($name, $cache, 1, $tscache, 0);
+ push (@targets, @$deps);
+ push (@$label_targets, @$deps) if $label_started;
+ } else {
+ print "Bad path for target: $str\n";
+ }
} elsif (substr($str, -1, 1) eq ':') {
# label.
my $label = substr($str,0,-1); # everything but the :
@@ -1378,8 +1416,12 @@
} else {
# filename.
my $target = canonical_path(to_cert_name($str));
- push(@targets, $target);
- push(@$label_targets, $target) if $label_started;
+ if ($target) {
+ push(@targets, $target);
+ push(@$label_targets, $target) if $label_started;
+ } else {
+ print "Bad path for target: $str\n";
+ }
}
}
# print "Labels:\n";
=======================================
--- /trunk/critpath.pl Mon Feb 13 13:38:07 2012
+++ /trunk/critpath.pl Thu Mar 1 09:02:40 2012
@@ -152,13 +152,22 @@
foreach my $target (@user_targets) {
- push (@targets, canonical_path(to_cert_name($target)));
+ my $path = canonical_path(to_cert_name($target));
+ if ($path) {
+ push (@targets, $path);
+ } else {
+ print "Warning: bad target path $target\n";
+ }
}
foreach my $top (@deps_of) {
- my ($certdeps) =
- find_deps(canonical_path(to_source_name($top)), $cache, 1, \%tscache);
- push (@targets, @{$certdeps});
+ my $path = canonical_path(to_source_name($top));
+ if ($path) {
+ my ($certdeps) = find_deps($path, $cache, 1, \%tscache);
+ push (@targets, @{$certdeps});
+ } else {
+ print "Warning: bad path in --deps-of/-p $top\n";
+ }
}
unless (@targets) {