#! /usr/bin/perl
#-*- perl -*-

## Copyright (C) 2000-2005 R Development Core Team
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2, or (at your option)
## any later version.
##
## This program is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU
## General Public License for more details.
##
## A copy of the GNU General Public License is available via WWW at
## http://www.gnu.org/copyleft/gpl.html.  You can also obtain it by
## writing to the Free Software Foundation, Inc., 59 Temple Place,
## Suite 330, Boston, MA  02111-1307  USA.

## Send any bug reports to r-bugs@r-project.org

use Cwd;
use File::Basename;
use File::Copy;
use File::Find;
use File::Path;
use Getopt::Long;
use IO::File;
use R::Dcf;
use R::Logfile;
use R::Rdtools;
use R::Utils;
use R::Vars;
use Text::Wrap;

## Don't buffer output.
$| = 1;

my $revision = ' $Revision: 1.193 $ ';
my $version;
my $name;
$revision =~ / ([\d\.]*) /;
$version = $1;
($name = $0) =~ s|.*/||;

### Options
my $opt_clean = 1;
my $opt_examples = 1;
my $opt_tests = 1;
my $opt_latex = 1;
my $opt_use_gct = 0;
my $opt_codoc = 1;
my $opt_install = 1;
my $opt_vignettes = 1;
my $opt_use_valgrind = 0;
my $opt_rcfile = "";		# Only set this if $ENV{"HOME"} is set.
$opt_rcfile = &file_path($ENV{"HOME"}, ".R", "check.conf")
    if defined($ENV{"HOME"});

my $WINDOWS = ($R::Vars::OSTYPE eq "windows");

R::Vars::error("R_HOME", "R_EXE");

my @known_options = ("help|h", "version|v", "outdir|o:s", "library|l:s",
		    "no-clean", "no-examples", "no-tests", "no-latex",
		    "use-gct" => \$opt_use_gct, "no-codoc",
		    "install=s" => \$opt_install, "no-install",
		     "no-vignettes", "use-valgrind" => \$opt_use_valgrind,
		     "rcfile=s" => \$opt_rcfile);
GetOptions(@known_options) or usage();

R_version("R add-on package checker", $version) if $opt_version;
usage() if $opt_help;

$opt_clean = 0 if $opt_no_clean;
$opt_examples = 0 if $opt_no_examples;
$opt_tests = 0 if $opt_no_tests;
$opt_latex = 0 if $opt_no_latex;
$opt_codoc = 0 if $opt_no_codoc;
$opt_install = 0 if $opt_no_install;
$opt_vignettes = 0 if $opt_no_vignettes;

if($opt_install eq "fake") {
    ## If we fake installation, then we cannot *run* any code.
    $opt_examples = $opt_tests = $opt_vignettes = 0;
}
$opt_install = 0 if($opt_install eq "no");

my $opt_ff_calls = 1;
## The neverending story ...
## For the time being, allow to turn this off by setting the environment
## variable _R_CHECK_FF_CALLS_ to a Perl 'null' value.
if(defined($ENV{"_R_CHECK_FF_CALLS_"})) {
    $opt_ff_calls = $ENV{"_R_CHECK_FF_CALLS_"};
}

## Use system default unless explicitly specified otherwise.
$ENV{"R_DEFAULT_PACKAGES"} = "";

### Configurable variables
my $R_check_use_install_log =
    &R_getenv("_R_CHECK_USE_INSTALL_LOG_", "FALSE");
my $R_check_subdirs_nocase =
    &R_getenv("_R_CHECK_SUBDIRS_NOCASE_", "FALSE");
my $R_check_all_non_ISO_C =
    &R_getenv("_R_CHECK_ALL_NON_ISO_C_", "FALSE");
my $R_check_weave_vignettes =
    &R_getenv("_R_CHECK_WEAVE_VIGNETTES_", "TRUE");

## Maybe move basic configuration (and documentation) to
##   &file_path($R::Vars::R_HOME, "etc", "check.conf")
## eventually ...
for my $file ($opt_rcfile) {
    if(-r $file) {
	open(FILE, "< $file")
	    or die "Error: cannot open file '$file' for reading\n";
	my @lines = <FILE>;
	close(FILE);
	eval("@lines");
	die "Error: failed to eval config file '$file'\n$@\n" if ($@);
	## <NOTE>
	## We prefer the above to the usual recommendation
	## 	unless ($return = do($file)) {
	## 	    warn "couldn't parse $file: $@" if $@;
	## 	    warn "couldn't do $file: $!"    unless defined $return;
	## 	    warn "couldn't run $file"       unless $return;
	##  }
	## as do(FILE) cannot see lexicals in the enclosing scope.
	## </NOTE>
    }
}

$R_check_use_install_log =
    &config_val_to_logical($R_check_use_install_log);
$R_check_subdirs_nocase =
    &config_val_to_logical($R_check_subdirs_nocase);
$R_check_all_non_ISO_C =
    &config_val_to_logical($R_check_all_non_ISO_C);
$R_check_weave_vignettes =
    &config_val_to_logical($R_check_weave_vignettes);

my $startdir = R_cwd();
$opt_outdir = $startdir unless $opt_outdir;
chdir($opt_outdir)
    or die "Error: cannot change to directory '$opt_outdir'\n";
my $outdir = R_cwd();
chdir($startdir);

my $R_LIBS = $ENV{'R_LIBS'};
my $library;
if($opt_library) {
    chdir($opt_library)
	or die "Error: cannot change to directory '$opt_library'\n";
    $library = R_cwd();
    $ENV{'R_LIBS'} = env_path($library, $R_LIBS);

    chdir($startdir);
}

my $tar = R_getenv("TAR", "tar");

my $R_opts = "--vanilla";

if($opt_latex) {
    my $log = new R::Logfile();
    $log->checking("for working latex");
    open(TEXFILE,
	 "> " . &file_path(${R::Vars::TMPDIR}, "Rtextest$$.tex"))
      or die "Error: cannot open file 'Rtextest$$.tex' for writing\n";
    print TEXFILE "\\documentclass\{article\}\\begin\{document\}" .
	"test\\end\{document\}\n";
    close(TEXFILE);
    chdir($R::Vars::TMPDIR);
    if(R_system("${R::Vars::LATEX} Rtextest$$ > Rtextest$$.out")) {
	$log->result("NO");
	$HAVE_LATEX = 0;
    } else {
	$log->result("OK");
	$HAVE_LATEX = 1;
    }
    unlink(<Rtextest$$.*>);
    chdir($startdir);
    $log->close();
}

## This is the main loop over all packages to be checked.
(scalar(@ARGV) > 0) or die "Error: no packages were specified\n";
foreach my $pkg (@ARGV) {
    ## $pkg should be the path to the package (bundle) root source
    ## directory, either absolute or relative to $startdir.
    ## As from 2.1.0 it can also be a tarball

    ## $pkgdir is the corresponding absolute path.
    ## $pkgname is the name of the package (bundle).
    chdir($startdir);
    $pkg =~ s+/$++;  # strip any trailing '/'
    my $pkgname = basename($pkg);

    ## is this a tar archive?
    my $istar = 0;
    if($pkgname =~ /\.tar\.gz$/ || $pkgname =~ /\.tgz$/) {
	$pkgname =~ s/\.tar\.gz$//;
	$pkgname =~ s/\.tgz$//;
	$pkgname =~ s/_[0-9\.-]*$//;
	$istar = 1;
    }

    my $pkgoutdir = &file_path($outdir, "$pkgname.Rcheck");
    rmtree($pkgoutdir) if ($opt_clean && (-d $pkgoutdir)) ;
    if(!(-d $pkgoutdir)) {
	mkdir($pkgoutdir, 0755)
	  or die("Error: cannot create directory '$pkgoutdir'\n");
    }

    if($istar) {
	my $dir = &file_path("$pkgoutdir", "00_pkg_src");
	mkdir($dir, 0755)
	  or die("Error: cannot create directory '$dir'\n");
	if($WINDOWS) {
	    ## workaround for paths in Cygwin tar
	    $pkg =~ s+^([A-Za-x]):+/cygdrive/\1+;
	}
	if(system("$tar -zxf '$pkg' -C $dir")) {
	    die "Error: cannot untar $pkg\n";}
	$pkg = &file_path($dir, $pkgname);
    }

    $pkg =~ s/\/$//;
    (-d $pkg) or die "Error: package dir '$pkg' does not exist\n";
    chdir($pkg)
	or die "Error: cannot change to directory '$pkg'\n";
    my $pkgdir = R_cwd();
    ## my $pkgname = basename($pkgdir);
    chdir($startdir);

    $log = new R::Logfile(&file_path($pkgoutdir, "00check.log"));
    $log->message("using log directory '$pkgoutdir'");
    my @out = R_runR("cat(R.version.string, '\n', sep='')", 
		     "--slave --vanilla");
    $log->message("using @out");

    if(!$opt_library) {
	$library = $pkgoutdir;
	$ENV{'R_LIBS'} = env_path($library, $R_LIBS);
    }
    if($WINDOWS) { ## need to avoid spaces in $library
	$library = Win32::GetShortPathName($library) if $library =~ / /;
    }

    my $description;
    my $is_base_pkg = 0;
    my $is_bundle = 0;
    my $package_or_bundle = "package";
    my $package_or_bundle_name;
    ## Package sources from the R distribution are special.  They have a
    ## 'DESCRIPTION.in' file (instead of 'DESCRIPTION'), with Version
    ## field containing '2.1.0' for substitution by configure.  We
    ## test for such packages by looking for 'DESCRIPTION.in' with
    ## Priority 'base', and skip the installation test for such
    ## packages.
    if(-r &file_path($pkgdir, "DESCRIPTION.in")) {
	$description =
	  new R::Dcf(&file_path($pkgdir, "DESCRIPTION.in"));
	if($description->{"Priority"} eq "base") {
	    $log->message("looks like '${pkgname}' is a base package");
	    $log->message("skipping installation test");
	    $is_base_pkg = 1;
	}
    }

    if(!$is_base_pkg) {
	$log->checking(join("",
			    ("for file '",
			     &file_path($pkgname, "DESCRIPTION"),
			     "'")));
	if(-r &file_path($pkgdir, "DESCRIPTION")) {
	    $description =
	      new R::Dcf(&file_path($pkgdir, "DESCRIPTION"));
	    $log->result("OK");
	}
	else {
	    $log->result("NO");
	    exit(1);
	}
	if($description->{"Type"}) { # standard packages do not have this
	    $log->checking("extension type");
	    $log->result($description->{"Type"});
	    if($description->{"Type"} ne "Package") {
		$log->print("Only Type = Package extensions can be checked.\n");
		exit(0);
	    }
	}

	if($description->{"Bundle"}) {
	    $is_bundle = 1;
	    $log->message("looks like '${pkgname}' is a package bundle");
	    $package_or_bundle = "bundle";
	    $package_or_bundle_name = $description->{"Bundle"};
	}
	else {
	    $package_or_bundle_name = $description->{"Package"};
	}
	$log->message("this is $package_or_bundle " .
		      "'$package_or_bundle_name' " .
		      "version '$description->{\"Version\"}'");
	## <NOTE>
	## This check should be adequate, but would not catch a manually
	## installed package, nor one installed prior to 1.4.0.
	## </NOTE>
	$log->checking("if this is a source $package_or_bundle");
	if(defined($description->{"Built"})) {
	    $log->error();
	    $log->print("Only *source* packages can be checked.\n");
	    exit(1);
	}
	elsif($opt_install !~ /^check/) {
	    ## Check for package/bundle 'src' subdirectories with object
	    ## files (but not if installation was already performed).
	    my $any;
	    my $pat = "(a|o|[ls][ao]|sl|obj)"; # Object file extensions.
	    my @dirs;
	    if($in_bundle) {
		foreach my $ppkg (split(/\s+/,
					description->{"Contains"})) {
		    push(@dirs, &file_path($ppkg, "src"));
		}
	    }
	    else {
		@dirs = ("src");
	    }
	    foreach my $dir (@dirs) {
		if((-d &file_path($pkgdir, $dir))
		   && &list_files_with_exts(&file_path($pkgdir, $dir),
					    $pat)) {
		    $log->warning() unless $any;
		    $any++;
		    $dir = &file_path($pkgname, $dir);
		    $log->print("Subdirectory '$dir' " .
				"contains object files.\n");
		}
	    }
	    $log->result("OK") unless $any;	    
	}
	else {
	    $log->result("OK");
	}
	    
	## Option '--no-install' turns off installation and the tests
	## which require the package to be installed.  When testing
	## recommended packages bundled with R we can skip installation,
	## and do so if '--install=skip' was given.  If command line
	## option '--install' is of the form 'check:FILE', it is assumed
	## that installation was already performed with stdout/stderr to
	## FILE, the contents of which need to be checked (without
	## repeating the installation).
	## <NOTE>
	## In this case, one also needs to specify *where* the package
	## was installed to using command line option '--library'.
	## Perhaps we should check for that, although '--install=check'
	## is really only meant for repository maintainers.
	## </NOTE>
	if($opt_install) {
	    if($opt_install eq "skip") {
		$log->message("skipping installation test");
	    }
	    else {
		my $use_install_log =
		    (($opt_install =~ /^check/) ||
		     $R_check_use_install_log ||
		     !(-t STDIN && -t STDOUT));
		my $INSTALL_opts = "";
		$INSTALL_opts = "--fake" if($opt_install eq "fake");
		my $cmd;
		if($WINDOWS) {
		    $cmd = join(" ",
				("Rcmd.exe INSTALL -l",
				 &shell_quote_file_path($library),
				 "$INSTALL_opts",
				 &shell_quote_file_path($pkgdir)));
		} else {
		    $cmd = join(" ",
				(&shell_quote_file_path(${R::Vars::R_EXE}),
				 "CMD INSTALL -l",
				 &shell_quote_file_path($library),
				 "$INSTALL_opts",
				 &shell_quote_file_path($pkgdir)));
		}
		if(!$use_install_log) {
		    ## Case A: No redirection of stdout/stderr from
		    ## installation.
		    print("\n");
		    if(R_system($cmd)) {
			$log->error();
			$log->print("Installation failed.\n");
			exit(1);
		    }
		    print("\n");
		}
		else {
		    ## Case B. All output from installation redirected,
		    ## or already available in the log file.
		    $log->checking("whether $package_or_bundle " .
				   "'$package_or_bundle_name' " .
				   "can be installed");
		    my $out = &file_path($pkgoutdir, "00install.out");
		    my $install_error;
		    my @lines;
		    if($opt_install =~ /^check/) {
			copy(substr($opt_install, 6), $out);
			$opt_install = "check";
			@lines = &read_lines($out);
			$install_error =
			    ($lines[$#lines] !~ /^\* DONE/);
		    }
		    else {
			$cmd .= " >" .
			    &shell_quote_file_path($out) .
			    " 2>&1";
			$install_error = &R_system($cmd);
		    }
		    if($install_error) {
			$log->error();
			$log->print("Installation failed.\n");
			$log->print("See '$out' for details.\n");
			exit(1);
		    }
		    ## There could still be some important warnings that
		    ## we'd like to report.  For the time being, start
		    ## with compiler warnings about non ISO C code (Or
		    ## at least, what looks like it.)  In theory, we
		    ## should only do this when using GCC ...
		    @lines = &read_lines($out)
			unless($opt_install eq "check");
		    my $warn_re =
			"(" . join("|", ("^WARNING:",
					 "^Warning:",
					 ": warning: .*ISO C",
					 "missing link\\(s\\):")) . ")";
		    @lines = grep(/$warn_re/, @lines);
		    ## Ignore install time readLines() warnings about
		    ## files with incomplete final lines.  Most of these
		    ## come from .install_package_indices(), and should be
		    ## safe to ignore ...
		    $warn_re = "Warning: incomplete final line " .
			"found by readLines";
		    @lines = grep(!/$warn_re/, @lines);
		    ## Package writers cannot really do anything about
		    ## non ISO C code in *system* headers.  Also, GCC
		    ## 3.4 or better warns about function pointers
		    ## casts which are "needed" for dlsym(), but it
		    ## seems that all systems which have dlsym() also
		    ## support the cast.  Hence, try to ignore these by
		    ## default, but make it possible to get all ISO C
		    ## warnings via an environment variable.
		    if(!$R_check_all_non_ISO_C) {
			@lines = grep(!/^ *\/.*: warning: .*ISO C/,
				      @lines);
			$warn_re = "warning: *ISO C forbids.*" .
			    "function pointer";
			@lines = grep(!/$warn_re/, @lines);
		    }
		    if(scalar(@lines) > 0) {
			$log->warning();
			$log->print("Found the following " .
				    "significant warnings:\n");
			$log->print("  " . join("\n  ", @lines) . "\n");
		    }
		    else {
			$log->result("OK");
		    }
		}
	    }
	}

    }

    if($is_bundle) {
	my @bundlepkgs = split(/\s+/, $description->{"Contains"});
	foreach my $ppkg (@bundlepkgs) {
	    $log->message("checking '$ppkg' in bundle '$pkgname'");
	    $log->setstars("**");
	    chdir($startdir);
	    check_pkg(&file_path($pkgdir, $ppkg), $pkgoutdir, $startdir,
		      $library, $is_bundle, $description, $log,
		      $is_base_pkg);
	    $log->setstars("*");
	}
    }
    else {
	chdir($startdir);
	check_pkg($pkgdir, $pkgoutdir, $startdir, $library,
		  $is_bundle, $description, $log, $is_base_pkg);
    }

    if($log->{"warnings"}) {
	print("\n") ;
	$log->summary();
    }
    $log->close();
    print("\n");
}


sub check_pkg {

    my ($pkg, $pkgoutdir, $startdir, $library,
	$in_bundle, $description, $log, $is_base_pkg) = @_;
    my ($pkgdir, $pkgname);

    ## $pkg is the argument we received from the main loop.
    ## $pkgdir is the corresponding absolute path,
    ## $pkgname the name of the package.
    ## Note that we need to do repeat the checking from the main loop in
    ## the case of package bundles (and we could check for this).

    $log->checking("package directory");
    chdir($startdir);
    $pkg =~ s/\/$//;
    if(-d $pkg) {
	chdir($pkg)
	  or die "Error: cannot change to directory '$pkg'\n";
	$pkgdir = R_cwd();
	$pkgname = basename($pkgdir);
    }
    else {
	$log->error();
	$log->print("Package directory '$pkg' does not exist.\n");
	exit(1);
    }
    $log->result("OK");

    chdir($pkgdir);

    ## Build list of exclude patterns.

    my @exclude_patterns = R::Utils::get_exclude_patterns();
    my $exclude_file = ".Rbuildignore";
    ## This is a bit tricky for bundles where the build ignore pattern
    ## file is in the top-level bundle dir.
    $exclude_file = &file_path(dirname($pkgdir), $exclude_file);
    if(-f $exclude_file) {
	open(RBUILDIGNORE, "< $exclude_file");
	while(<RBUILDIGNORE>) {
	    chop;	    
	    push(@exclude_patterns, $_) if $_;
	}
	close(RBUILDIGNORE);
    }

    ## Check for portable file names.

    ## Ensure that the names of the files in the package are valid for
    ## at least the supported OS types.  Under Unix, we definitely
    ## cannot have '/'; under Windows, the control characters as well as
    ##   " * : < > ? \ |
    ## (i.e., ASCII characters 1 to 31 and 34, 36, 58, 60, 62, 63, 92,
    ## and 124) are or can be invalid.  (In addition, one cannot have
    ## one-character file names consisting of just ' ', '.', or '~'.)
    ## Based on information by Uwe Ligges, Duncan Murdoch, and Brian
    ## Ripley.

    ## Furthermore, Uwe Ligges says that Windows still does not allow
    ## the following DOS device names (by themselves or with possible
    ## extensions):
    ##
    ## Name    Function
    ## ----    --------
    ## CON     Keyboard and display
    ## PRN     System list device, usually a parallel port
    ## AUX     Auxiliary device, usually a serial port
    ## CLOCK$  System real-time clock
    ## NUL     Bit-bucket device
    ## COM1    First serial communications port
    ## COM2    Second serial communications port
    ## COM3    Third serial communications port
    ## COM4    Fourth serial communications port
    ## LPT1    First parallel printer port
    ## LPT2    Second parallel printer port
    ## LPT3    Third parallel printer port

    $log->checking("for portable file names");
    my @bad_files = ();
    sub find_wrong_names {
	my $file_path = $File::Find::name;
	$file_path =~ s/^\.[^\/]*\///;
	foreach my $p (@exclude_patterns) {
	    if($WINDOWS) {
		## Argh: Windows is case-honoring but not
		## case-insensitive ...
		return 0 if($file_path =~ /$p/i);
	    }
	    else {
		return 0 if($file_path =~ /$p/);
	    }
	}
	my $file_name = basename($file_path);
	if(grep(/[[:cntrl:]\"\*\/\:\<\>\?\\\|]/, $file_name)) {
	    push(@bad_files, $file_path);
	}
	else {
	    $file_name =~ tr/A-Z/a-z/;
	    $file_name =~ s/\..*//;
	    push(@bad_files, $file_path)
	      if(grep(/^(con|prn|aux|clock\$|nul|lpt[1-3]|com[1-4])$/,
		     $file_name));
	}
    }
    if($in_bundle) {
	chdir(dirname($pkgdir)); # more portable than '..'?
	find(\&find_wrong_names, $pkgname);
	chdir($pkgname);
    }
    else {
	find(\&find_wrong_names, ".");
    }
    if(scalar(@bad_files) > 0) {
	$log->error();
	$log->print("Found the following file(s) with " .
		    "non-portable file names:\n");
	$log->print("  " . join("\n  ", @bad_files) . "\n");
	$log->print(wrap("", "",
			 ("These are not valid file names",
			  "on all R platforms.\n",
			  "Please rename the files and try again.\n",
			  "See section 'Package structure'",
			  "in manual 'Writing R Extensions'.\n")));
	exit(1);
    }

    ## next check for name clashes on case-insensitive file systems
    ## (that is on Windows).
    %seen = (); 
    my @duplicated = ();
    sub check_case_names {
	my $file_path = lc($File::Find::name);
	if($seen{$file_path}) {push(@duplicated, $file_path);}
	$seen{$file_path}  = 1;
    }
    if($in_bundle) {
	chdir(dirname($pkgdir)); # more portable than '..'?
	find(\&check_case_names, $pkgname);
	chdir($pkgname);
    }
    else {
	find(\&check_case_names, ".");
    }
    if(scalar(@duplicated) > 0) {
	$log->error();
	$log->print("Found the following file(s) with " .
		    "duplicate lower-cased file names:\n");
	$log->print("  " . join("\n  ", @duplicated) . "\n");
	$log->print(wrap("", "",
			 ("File names must not differ just by case",
			  "to be usable on all R platforms.\n",
			  "Please rename the files and try again.\n",
			  "See section 'Package structure'",
			  "in manual 'Writing R Extensions'.\n")));
	exit(1);
    }

    $log->result("OK");

    ## Check for sufficient file permissions (Unix only).

    ## This used to be much more 'aggressive', requiring that dirs and
    ## files have mode >= 00755 and 00644, respectively (with an error
    ## if not), and that files know to be 'text' have mode 00644 (with a
    ## warning if not).  We now only require that dirs and files have
    ## mode >= 00700 and 00400, respectively, and try to fix
    ## insufficient permission in the INSTALL code (Unix only).
    ##
    ## In addition, we check whether files 'configure' and 'cleanup'
    ## exists in the top-level directory but are not executable, which
    ## is most likely not what was intended.

    if($R::Vars::OSTYPE eq "unix") {
	$log->checking("for sufficient/correct file permissions");
	my @bad_files = ();

	## Phase A.  Directories at least 700, files at least 400.
	sub find_wrong_perms_A {
	    my $filename = $File::Find::name;
	    $filename =~ s/^\.[^\/]*\///;
	    foreach my $p (@exclude_patterns) {
		## Unix only, so no special casing for Windows.
		return 0 if($filename =~ /$p/);
	    }
	    if(-d $_ && (((stat $_)[2] & 00700) < oct("700"))) {
		push(@bad_files, $filename);
	    }
	    if(-f $_ && (((stat $_)[2] & 00400) < oct("400"))) {
		push(@bad_files, $filename);
	    }
	}
	if($in_bundle) {
	    chdir(dirname($pkgdir)); # more portable than '..'?
	    find(\&find_wrong_perms_A, $pkgname);
	    chdir($pkgname);
	}
	else {
	    find(\&find_wrong_perms_A, ".");
	}
        if(scalar(@bad_files) > 0) {
	    $log->error();
	    $log->print("Found the following files with " .
			"insufficient permissions:\n");
	    $log->print("  " . join("\n  ", @bad_files) . "\n");
	    $log->print(wrap("", "",
			     ("Permissions should be at least 700",
			      "for directories and 400 for files.\n",
			      "Please fix permissions",
			      "and try again.\n")));
	    exit(1);
	}

	## Phase B.  Top-level scripts 'configure' and 'cleanup' should
	## really be mode at least 500, or they will not be necessarily
	## be used (or should we rather change *that*?)
	@bad_files = ();
	foreach my $filename ("configure", "cleanup") {
	    ## This is a bit silly ...
	    my $ignore = 0;
	    foreach my $p (@exclude_patterns) {
		if($filename =~ /$p/) {
		    $ignore = 1;
		    last;
		}
	    }
	    if(!$ignore
	       && (-f $filename)
	       && (((stat $filename)[2] & 00500) < oct("500"))) {
		push(@bad_files, $filename);
	    }
	}
	if(scalar(@bad_files) > 0) {
	    $log->warning();
	    $log->print(wrap("", "",
			     "The following files should most likely",
			     "be executable (for the owner):\n"));
	    $log->print("  " . join("\n  ", @bad_files) . "\n");
	    $log->print(wrap("", "",
			     "Please fix permissions.\n"));
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check DESCRIPTION meta-information.

    ## If we just installed the package (via R CMD INSTALL), we already
    ## validated most of the package DESCRIPTION metadata.  Otherwise,
    ## let us be defensive about this ...

    my $full =
	!$opt_install || ($opt_install eq "skip") || $is_base_pkg;
    &R::Utils::check_package_description($pkgdir, $pkgname, $log,
					 $in_bundle, $is_base_pkg,
					 $full);
    
    ## Check package dependencies.

    ## Try figuring out whether the package dependencies can be resolved
    ## at run time.  Ideally, the installation mechanism would do this,
    ## and we also do not check versions ... also see whether vignette
    ## and namespace package dependencies are recorded in DESCRIPTION.

    ## <NOTE>
    ## When checking uninstalled base or bundle packages, there is no
    ## DESCRIPTION file in the package source directory.  Hence, for
    ## simplicity, we only run this check on "installed" packages.  We
    ## could work around this, but checking uninstalled packages is a
    ## bad thing anyway.
    ##
    ## Also, if --install=skip, bundles never get DESCRIPTION files
    ## made in the source dir which is what we are checking here.
    ## </NOTE>
    if($opt_install) {
	$log->checking("package dependencies");
	## Everything listed in Depends or Suggests or Imports
	## should be available for successfully running R CMD check.
	## \VignetteDepends{} entries not "required" by the package code
	## must be in Suggests.  Note also that some of us think that a
	## package vignette must require its own package, which OTOH is
	## not required in the package DESCRIPTION file.
	## Namespace imports must really be in Depends.
	my $Rcmd = "tools:::.check_package_depends(\"${pkgname}\")\n";
	my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES=NULL");
	@out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    ## <FIXME>
	    ## These should really all be errors ...
	    ## Change this for 2.1 at least, once stubs are fully gone.
	    if(grep(/^Packages required but not available:/, @out)) {
		$log->error();
		$log->print(join("\n", @out) . "\n");
		$log->print(wrap("", "", @msg_DESCRIPTION));
		exit(1);
	    }
	    else {
		$log->warning();
		$log->print(join("\n", @out) . "\n");
		$log->print(wrap("", "", @msg_DESCRIPTION));
	    }
	    ## </FIXME>
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check index information.

    $log->checking("index information");
    my @msg_index = ("See the information on INDEX files and package",
		     "subdirectories in section 'Creating R packages'",
		     "of the 'Writing R Extensions' manual.\n");
    my $any = 0;
    if(-z "INDEX") {
	## If there is an empty INDEX file, we get no information about
	## the package contents ...
	$any++;
	$log->warning();
	$log->print("Empty file 'INDEX'.\n");
    }
    if((-d "demo")
       && &list_files_with_type("demo", "demo")) {
	my $index = &file_path("demo", "00Index");
	if(!(-s $index)) {
	    $log->warning() unless($any);
	    $any++;
	    $log->print("Empty or missing file '$index'.\n");
	}
	else {
	    my $dir = "demo";
	    my $Rcmd = "options(warn=1)\ntools:::.check_demo_index(\"$dir\")\n";
	    my @out = R_runR($Rcmd, "${R_opts} --quiet",
			     "R_DEFAULT_PACKAGES=NULL");
	    @out = grep(!/^\>/, @out);
	    if(scalar(@out) > 0) {
		$log->warning() unless($any);
		$any++;
		$log->print(join("\n", @out) . "\n");
	    }
	}
    }
    if((-d &file_path("inst", "doc"))
       && &list_files_with_type(&file_path("inst", "doc"),
				"vignette")) {
	my $dir = &file_path("inst", "doc");
	my $Rcmd = "options(warn=1)\ntools:::.check_vignette_index(\"$dir\")\n";
	my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES=NULL");
	@out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    $log->warning() unless($any);
	    $any++;
	    $log->print(join("\n", @out) . "\n");
	}
    }
    if($any) {
	$log->print(wrap("", "", @msg_index));
    }
    else {
	$log->result("OK");
    }

    ## Check package subdirectories.

    $log->checking("package subdirectories");
    my $any;
    if($R_check_subdirs_nocase) {
	## Argh.  We often get submissions where 'R' comes out as 'r',
	## or 'man' comes out as 'MAN'.  Maybe we should warn about this
	## unconditionally ...
	if((-d "r")) {
	    $log->warning() unless $any;
	    $any++;
	    $log->print("Found subdirectory 'r'.\n");
	    $log->print("Most likely, this should be 'R'.\n")
	}
	if((-d "MAN")) {
	    $log->warning() unless $any;
	    $any++;
	    $log->print("Found subdirectory 'MAN'.\n");
	    $log->print("Most likely, this should be 'man'.\n")
	}
    }
    if((-d "data") || (-d "demo") || (-d "src") || (-d "inst")) {
	## Subdirectory 'data' without data sets?
	if((-d "data") && !&list_files_with_type("data", "data")) {
	    $log->warning() unless $any;
	    $any++;
	    $log->print("Subdirectory 'data' contains no data sets.\n");
	}
	## Subdirectory 'demo' without demos?
	if((-d "demo") && !&list_files_with_type("demo", "demo")) {
	    $log->warning() unless $any;
	    $any++;
	    $log->print("Subdirectory 'demo' contains no demos.\n");
	}
	## Subdirectory 'src' without sources?
	## <NOTE>
	## If there is a Makefile (or a Makefile.win), we cannot assume
	## that source files have the predefined extensions.
	## </NOTE>
	if((-d "src")
	   && !(&list_files_with_exts("src", "([Ccf]|cc|cpp)")
		|| (-f &file_path("src", "Makefile"))
		|| (-f &file_path("src", "Makefile.win")))) {
	    $log->warning() unless $any;
	    $any++;
	    $log->print("Subdirectory 'src' contains no source files.\n");
	}
	## Do subdirectories of 'inst' interfere with R package system
	## subdirectories?
	if((-d "inst")) {
	    my @R_system_subdirs =
		("Meta", "R", "data", "demo", "exec", "libs",
		 "man", "help", "html", "latex", "R-ex");
	    my @bad_dirs = ();
	    foreach my $dir (@R_system_subdirs) {
		push(@bad_dirs, $dir)
		  if((-d &file_path("inst", $dir))
		     && &list_files(file_path("inst", $dir)));
	    }
	    if(scalar(@bad_dirs) > 0) {
		$log->warning() unless $any;
		$any++;
		$log->print(wrap("", "",
				 ("Found the following non-empty",
				  "subdirectories of 'inst' also",
				  "used by R:\n")));
		$log->print("  " . join(" ", @bad_dirs) . "\n");
		$log->print(wrap("", "",
				 ("It is recommended not to interfere",
				  "with package subdirectories",
				  "used by R.\n")));
	    }
	}
    }
    $log->result("OK") unless $any;

    ## Check R code for syntax errors.

    if(!$is_base_pkg && (-d "R")) {
	$log->checking("R files for syntax errors");
	## <NOTE>
	## We could/should really check *all* OS specific subdirs here.
	my @R_files = &list_files_with_type("R", "code");
	## </NOTE>
	my $Rcmd = "RFiles <- c(\"";
	$Rcmd .= join("\",\n\"", @R_files) . "\")\n";
	$Rcmd .= "for(f in RFiles)\n";
	$Rcmd .= "if(inherits(try(parse(f)), \"try-error\")) stop(f)\n";
        my @out = R_runR($Rcmd, "${R_opts} --quiet");
	@out = grep(/^Error:/, @out);
	if(scalar(@out) > 0) {
	    my $Rfile = $out[0];
	    $Rfile =~ s/^Error: *//;
	    $log->error();
	    $log->print("Syntax error in file " . $Rfile . "\n");
	    exit(1);
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check usage of library.dynam (if any).

    if(!$is_base_pkg && (-d "R")) {
	$log->checking("R files for library.dynam");
	my @R_files;
	if($opt_install) {
	    ## Only need to check the installed file (if installed).
	    @R_files = (&file_path($library, $pkgname, "R", $pkgname));
	}
	else {
	    ## Otherwise (if the package was not installed), we need to
	    ## check all R code files.
	    ## <NOTE>
	    ## We could/should really check all OS specific subdirs here.
	    @R_files = &list_files_with_type("R", "code");
	    ## </NOTE>
	}
	my $any = 0;
	my $ext;
	foreach my $file (@R_files) {
	    last if $any;
	    open(FILE, "< $file")
	      or die "Error: cannot open file '$file' for reading\n";
	    while(<FILE>) {
		if(/library.dynam\(\"(.*?)\"/o) {
		    my $arg = $1;
		    if($arg =~ /\.(so|sl|dll)$/) {
			$ext = $1;
			$any++;
			last;
		    }
		}
	    }
	    close(FILE);
	}
	if($any == 0) {
	    $log->result("OK");
	}
	else {
	    $log->error();
	    $log->print("library.dynam() used with extension '.$ext'.\n");
	    $log->print(wrap("", "",
			     ("The system-specific extension for",
			      "shared libraries should not be added.\n",
			      "See ?library.dynam\n")));
	    exit(1);
	}
    }

    ## Check whether methods have all arguments of the corresponding
    ## generic.

    if(-d "R") {
	$log->checking("S3 generic/method consistency");

	my @msg_S3_methods =
	  ("See section 'Generic functions and methods'",
	   "of the 'Writing R Extensions' manual.\n");

	my $Rcmd = "options(warn=1)\n";
	$Rcmd .= "options(expressions=1000)\n";
	if($opt_install) {
	    $Rcmd .= "tools::checkS3methods(package = \"${pkgname}\")\n";
	}
        else {
	    $Rcmd .= "tools::checkS3methods(dir = \"${pkgdir}\")\n";
	}

        my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");
	@out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    $log->warning();
	    $log->print(join("\n", @out) . "\n");
	    $log->print(wrap("", "", @msg_S3_methods));
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check whether replacement functions have their final argument
    ## named 'value'.

    if(-d "R") {
	$log->checking("replacement functions");

	my @msg_replace_funs =
	  ("In R, the argument of a replacement function",
	   "which corresponds to the right hand side",
	   "must be named 'value'.\n");

	my $Rcmd = "options(warn=1)\n";
	if($opt_install) {
	    $Rcmd .= "tools::checkReplaceFuns(package = \"${pkgname}\")\n";
	}
	else {
	    $Rcmd .= "tools::checkReplaceFuns(dir = \"${pkgdir}\")\n";
	}

        my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");
        @out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    ## <NOTE>
	    ## We really want to stop if we find offending replacement
	    ## functions.  But we cannot use error() because output may
	    ## contain warnings ...
	    $log->warning();
	    ## </NOTE>
	    $log->print(join("\n", @out) . "\n");
	    $log->print(wrap("", "", @msg_replace_funs));
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check foreign function calls.

    if($opt_ff_calls && (-d "R")) {
	$log->checking("foreign function calls");

	my @msg_ff_calls =
	  ("See section 'System and foreign language interfaces'",
	   "of the 'Writing R Extensions' manual.\n");

	my $Rcmd = "options(warn=1)\n";
	if($opt_install) {
	    $Rcmd .= "tools::checkFF(package = \"${pkgname}\")\n";
	}
        else {
	    $Rcmd .= "tools::checkFF(dir = \"${pkgdir}\")\n";
	}

        my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");
	@out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    $log->warning();
	    $log->print(join("\n", @out) . "\n");
	    $log->print(wrap("", "", @msg_ff_calls));
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check R documentation files.

    my @msg_writing_Rd
      = ("See chapter 'Writing R documentation files'",
	 "in manual 'Writing R Extensions'.\n");

    if(-d "man") {
	$log->checking("Rd files");

	my $Rcmd = "options(warn=1)\ntools:::check_Rd_files_in_man_dir(\"man\")\n";
	my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES=NULL");
	@out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    ## Output may indicate warnings or errors ...
	    if(grep(/^Rd files with (syntax errors|missing or empty)/,
		    @out)) {
		$log->error();
		$log->print(join("\n", @out) . "\n");
		$log->print(wrap("", "", @msg_writing_Rd));
		exit(1);
	    }
	    else {
		$log->warning();
		$log->print(join("\n", @out) . "\n");
		$log->print(wrap("", "", @msg_writing_Rd));
	    }
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check for missing documentation entries.

    if(((-d "R") || (-d "data"))) {
	$log->checking("for missing documentation entries");

	my $Rcmd= "options(warn=1)\n";
	if($opt_install) {
	    $Rcmd .= "tools::undoc(package = \"${pkgname}\")\n";
	}
	else {
	    $Rcmd .= "tools::undoc(dir = \"${pkgdir}\")\n";
	}

        my @out = R_runR($Rcmd, "${R_opts} --quiet",
                         "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");
	my @err = grep(/^Error/, @out);
	@out = grep(!/^\>/, @out);
	if(scalar(@err) > 0) {
	    $log->error();
	    $log->print(join("\n", @err) . "\n");
	    exit(1);
	}
	elsif(scalar(@out) > 0) {
	    $log->warning();
	    $log->print(join("\n", @out) . "\n");
	    my $details;
	    $details = " (including S4 classes and methods)"
	      if(grep(/^Undocumented S4/, @out));
	    $log->print(wrap("", "",
			     ("All user-level objects",
			      "in a package${details} should",
			      "have documentation entries.\n")));
	    $log->print(wrap("", "", @msg_writing_Rd));
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check for code/documentation mismatches.

    if($opt_codoc && (-d "man")) {
	$log->checking("for code/documentation mismatches");

	my $any = 0;

	## Check for code/documentation mismatches in functions.
	if(-d "R") {
	    my $Rcmd = "options(warn=1)\n";
	    if($opt_install) {
		$Rcmd .= "tools::codoc(package = \"${pkgname}\")\n";
	    }
	    else {
		$Rcmd .= "tools::codoc(dir = \"${pkgdir}\")\n";
	    }
	    my @out = R_runR($Rcmd, "${R_opts} --quiet",
			     "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");

	    @out = grep(!/^\>/, @out);
	    if(scalar(@out) > 0) {
		$any++;
		$log->warning();
		$log->print(join("\n", @out) . "\n");
	    }
	}

	## Check for code/documentation mismatches in data sets.
	if($opt_install) {
	    my $Rcmd = "options(warn=1)\ntools::codocData(package = \"${pkgname}\")\n";
	    my @out = R_runR($Rcmd, "${R_opts} --quiet",
			     "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");
	    @out = grep(!/^\>/, @out);
	    if(scalar(@out) > 0) {
		$log->warning() unless($any);
		$any++;
		$log->print(join("\n", @out) . "\n");
	    }
	}

	## Check for code/documentation mismatches in S4 classes.
	if($opt_install && (-d "R")) {
	    my $Rcmd = "options(warn=1)\ntools::codocClasses(package = \"${pkgname}\")\n";
	    my @out = R_runR($Rcmd, "${R_opts} --quiet",
			     "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");
	    @out = grep(!/^\>/, @out);
	    if(scalar(@out) > 0) {
		$log->warning() unless($any);
		$any++;
		$log->print(join("\n", @out) . "\n");
	    }
	}

	$log->result("OK") unless($any);

    }

    ## Check Rd files, for consistency of \usage with \arguments (are
    ## all arguments shown in \usage documented in \arguments?) and
    ## aliases (do all functions shown in \usage have an alias?)

    if(-d "man") {
	$log->checking("Rd \\usage sections");

	my @msg_doc_files =
	  ("Functions with \\usage entries",
	   "need to have the appropriate \\alias entries,",
	   "and all their arguments documented.\n");

	my $Rcmd = "options(warn=1)\n";
	if($opt_install) {
	    $Rcmd .= "tools::checkDocFiles(package = \"${pkgname}\")\n";
	}
	else {
	    $Rcmd .= "tools::checkDocFiles(dir = \"${pkgdir}\")\n";
	}

        my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES='utils,grDevices,graphics,stats'");
	@out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    $log->warning();
	    $log->print(join("\n", @out) . "\n");
	    $log->print(wrap("", "", @msg_doc_files));
	    $log->print(wrap("", "", @msg_writing_Rd));
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check C/C++/Fortran sources/headers for CRLF line endings.

    ## <FIXME>
    ## Does ISO C really require LF line endings?  (Reference?)
    ## We definitely know that some versions of Solaris cc and f77
    ## will not accept CRLF or CR line endings.
    ## Note that we currently only check the CRLF part.
    ## </FIXME>

    if(!$is_base_pkg && (-d "src")) {
	$log->checking("for CRLF line endings in C/C++/Fortran sources/headers");
	my @src_files = &list_files_with_exts("src", "(c|h|f|cc|cpp)");
	my @bad_files = ();
	foreach my $file (@src_files) {
	    open(FILE, "< $file")
	      or die "Error: cannot open '$file' for reading\n";
            binmode(FILE);	# for Windows
	    while(<FILE>) {
		chop;
		if($_ =~ /\r$/) {
		    push(@bad_files, $file);
		    last;
		}
	    }
	    close(FILE);
	}
	if(scalar(@bad_files) > 0) {
	    $log->warning();
	    $log->print("Found the following sources/headers with " .
			"CRLF line endings:\n");
	    $log->print("  " . join("\n  ", @bad_files) . "\n");
	    $log->print("Some Unix compilers require LF line endings.\n");
	}
	else {
	    $log->result("OK");
	}
    }

    ## Check src/Makevars[.in] for portable compilation flags.

    if((-f &file_path("src", "Makevars.in"))
       || (-f &file_path("src", "Makevars"))) {
	$log->checking("for portable compilation flags in Makevars");
	my $Rcmd = "tools:::.check_make_vars(\"src\")\n";
	my @out = R_runR($Rcmd, "${R_opts} --quiet",
			 "R_DEFAULT_PACKAGES=NULL");
	@out = grep(!/^\>/, @out);
	if(scalar(@out) > 0) {
	    $log->warning();
	    $log->print(join("\n", @out) . "\n");
	}
	else {
	    $log->result("OK");
	}
    }
    

    chdir($pkgoutdir);

    ## Run the examples.
    ## This setting applies to vignettes below too.
    ${R_opts} = ${R_opts}." -d valgrind" if $opt_use_valgrind;

    if($opt_examples && (-d &file_path($library, $pkgname, "R-ex"))) {
	$log->creating("${pkgname}-Ex.R");
	my $Rexdir = &file_path($library, $pkgname, "R-ex");
        ## $Rexdir might contain spaces (not on Windows)
        my $is_zipped = 0;
	my $cmd;

        if(-e &file_path($Rexdir, "Rex.zip")) {
            $is_zipped = 1;
	    my $UNZIP = &R_getenv("R_UNZIPCMD", "unzip");
            my $Rexfile = &file_path($Rexdir, "Rex.zip");
	    $cmd = join(" ",
			("$UNZIP", "-q",
			 &shell_quote_file_path($Rexfile),
			 "-d",
			 &shell_quote_file_path($Rexdir)));
	    if(R_system($cmd)) {
		$log->error();
		$log->print("Cannot extract examples from ZIP archive.\n");
		exit(1);
	    }
        }
        if($WINDOWS) {
            ## avoid Rcmd as line may be too long after expansion.
            ## We've forced R_HOME and Rexdir to have no spaces already.
            $cmd = "perl ${R::Vars::R_HOME}/bin/massage-Examples ".
  		     "${pkgname} ${Rexdir} ".
  		     "> ${pkgname}-Ex.R";
        } else {
	    $cmd =
		join(" ",
		     (&shell_quote_file_path(${R::Vars::R_EXE}),
		      "CMD perl",
		      &shell_quote_file_path(&file_path(${R::Vars::R_HOME},
							"share", "perl",
							"massage-Examples.pl")),
		      "${pkgname}",
		      &shell_quote_file_path(${Rexdir}),
		      "> ${pkgname}-Ex.R"));
        }

 	if(R_system($cmd)) {
  	    $log->error();
	    $log->print("Running massage-Examples to create " .
			"${pkgname}-Ex.R failed.\n");
  	    exit(1);
        }
        if($is_zipped) {
            unlink(&list_files_with_exts($Rexdir, "R"));
        }

	$log->result("OK");
	$log->checking("examples");

	if($opt_use_gct) {
            $cmd = join(" ",
			("(echo 'gctorture(TRUE)';",
			 "cat ${pkgname}-Ex.R) |",
			 &shell_quote_file_path(${R::Vars::R_EXE}),
			 "${R_opts}",
			 "> ${pkgname}-Ex.Rout 2>&1"));
	} else {
	    $cmd = join(" ",
			(&shell_quote_file_path(${R::Vars::R_EXE}),
			 "${R_opts}",
			 "< ${pkgname}-Ex.R",
			 "> ${pkgname}-Ex.Rout 2>&1"));
	}
	if(R_system($cmd)) {
	    $log->error();
	    $log->print("Running examples in ${pkgname}-Ex.R failed.\n");
	    ## Try to spot the offending example right away.
	    my $txt = join("\n", &read_lines("${pkgname}-Ex.Rout"));
	    ## Look for the header section anchored by a subsequent call
	    ## to flush(): needs to be kept in sync with the code in
	    ## massage-Examples.pl.  Should perhaps also be more
	    ## defensive about the prompt ...
	    my @chunks = split(/(> \#\#\# \* [^\n]+\n> \n> flush)/, $txt);
	    if(scalar(@chunks) > 2) {
		$log->print("The error most likely occurred in:\n\n");
		$log->print($chunks[$#chunks - 1]);
		$log->print($chunks[$#chunks] . "\n");
	    }
	    exit(1);
	}
	## Look at the output from running the examples.  For the time
	## being, report warnings about use of deprecated functions, as
	## the next release will make them defunct and hence using them
	## an error.  Also warn about loading defunct base package stubs, 
	## as load special-casing for these will be removed eventually.
	my @lines = &read_lines("${pkgname}-Ex.Rout");
	my $any;
	my @bad_lines;
	@bad_lines = grep(/^Warning: .*is deprecated.$/, @lines);
	if(scalar(@bad_lines) > 0) {
	    $log->warning();
	    $any++;
	    $log->print("Found the following significant warnings:\n");
	    $log->print("  " . join("\n  ", @bad_lines) . "\n");
	    $log->print(wrap("", "",
			     ("Deprecated functions may be defunct as",
			      "soon as of the next release of R.\n",
			      "See ?Deprecated.\n")));
	}
	@bad_lines = grep(/^Warning: package '.*' has been merged into/,
			  @lines);
	## Could make this more precise by looking for an exact match
	## for one of the defunct stubs, but we currently do not get
	## R_PKGS_STUBS from 'share/make/vars.mk'.
	if(scalar(@bad_lines) > 0) {
	    if($any) {
		$log->print("\nAdditional significant warnings:\n");
	    }
	    else {
		$log->warning();
		$any++;
		$log->print("Found the following significant " .
			    "warnings:\n");
	    }
	    $log->print("  " . join("\n  ", @bad_lines) . "\n");
	    $log->print(wrap("", "",
			     ("Support for loading defunct former base",
			      "packages may be removed as soon as of",
			      "the next release of R.\n")));
	}
	$log->result("OK") unless($any);
    }

    ## Run the package-specific tests.

    if($opt_install && $opt_tests && (-d &file_path($pkgdir, "tests"))) {
        $log->checking("tests");
        my $testsrcdir = &file_path($pkgdir, "tests");
        my $testdir = &file_path($pkgoutdir, "tests");
        if(!(-d $testdir)) {
            mkdir($testdir, 0755)
	      or die "Error: cannot create directory '$testdir'\n";
        }
        chdir($testdir);
	foreach my $file (&list_files($testsrcdir)) {
	    copy($file, basename($file));
	}
        my $makefiles = "-f " .
	    &shell_quote_file_path(&file_path(${R::Vars::R_HOME},
					      "share", "make",
					      "tests.mk"));
        if($WINDOWS) {
            $makefiles = "-f ${R::Vars::R_HOME}/share/make/wintests.mk";}
        my $makevars = "";
        if($WINDOWS && (-r "$testsrcdir/Makefile.win")) {
            $makefiles .= " -f $testsrcdir/Makefile.win";
        }
        elsif(-r &file_path($testsrcdir, "Makefile")) {
            $makefiles .= " -f " . &file_path($testsrcdir, "Makefile");
        }
        if($WINDOWS && (-r "$testsrcdir/Makevars.win")) {
            $makevars = " -f $testsrcdir/Makevars.win";
        }
        elsif(-r &file_path($testsrcdir, "Makevars")) {
            $makevars = " -f " . &file_path($testsrcdir, "Makevars");
        }
        else {
            open(MAKEVARS, "> Makevars");
            print MAKEVARS "makevars = -f Makevars\n";
            print MAKEVARS "srcdir = $testsrcdir\n";
            ## at least windows does not pass env correctly to make
            print MAKEVARS "R_LIBS = $ENV{'R_LIBS'}\n";
            print MAKEVARS "VPATH = \$(srcdir)\n\n";
            print MAKEVARS "test-src-1 =";
	    foreach my $file (&list_files_with_exts($testdir, "R")) {
                print MAKEVARS "\\\n " . basename($file);
            }
            print MAKEVARS "\n";
            print MAKEVARS "test-src-auto =";
	    foreach my $file (&list_files_with_exts($testdir, "Rin")) {
                $file =~ s/Rin$/R/;
                print MAKEVARS "\\\n " . basename($file);
            }
            print MAKEVARS "\n";
	    print MAKEVARS "USE_GCT = $opt_use_gct\n";
	    print MAKEVARS "R_OPTS = -d valgrind\n" if $opt_use_valgrind;
            close(MAKEVARS);
            $makevars = " -f Makevars";
        }
        print "\n";
        if(R_system("${R::Vars::MAKE} $makefiles $makevars")) {
            $log->error();
            exit(1);
        }
        chdir($pkgoutdir);
        $log->result("OK");
    }

    ## Check package vignettes.

    chdir($pkgoutdir);

    my $vignette_dir = &file_path($pkgdir, "inst", "doc");
    if((-d $vignette_dir)
       && &list_files_with_type($vignette_dir, "vignette")) {
	$log->checking(join(" ",
			    ("package vignettes in",
			     &sQuote(&file_path("inst", "doc")))));
	my $any = 0;

	## Do PDFs exist for all package vignettes?
	my @vignette_files =
	  &list_files_with_type($vignette_dir, "vignette");
	my @bad_vignettes = ();
	foreach my $file (@vignette_files) {
	    my $pdf_file = $file;
	    $pdf_file =~ s/\.[[:alpha:]]+$/.pdf/;
	    push(@bad_vignettes, $file) unless(-f $pdf_file);
	}
        ## A base package may not have PDFs to avoid blowing out the
	## distribution size.  *Note* that it is assumed that base
	## packages can be woven (i.e., that they only contain
	## "standard" LaTeX).
	if(!$is_base_pkg && scalar(@bad_vignettes) > 0) {
	    $log->warning();
	    $any++;
	    $log->print("Package vignettes without corresponding PDF:\n");
	    $log->print("  " . join("\n  ", @bad_vignettes) . "\n");
	}

	## Can we run the code in the vignettes?
	if($opt_vignettes) {
	    ## Should checking the vignettes assume the system default
	    ## packages, or just base?
	    my $Rcmd = "options(warn=1)\nlibrary(tools)\n";
            ## A base package does not get installed during check.
	    if(!$is_base_pkg && $opt_install) {
		$Rcmd .= "checkVignettes(package = \"${pkgname}\", " .
		         "lib.loc = \"${library}\", " .
		         "workdir = \"src\"";
	    }
	    else {
		$Rcmd .= "checkVignettes(dir = \"${pkgdir}\"";
	    }
	    $Rcmd .= ", weave = FALSE" if(!$R_check_weave_vignettes);
	    $Rcmd .= ")\n";
	    my @out = R_runR($Rcmd, "${R_opts} --quiet");
	    ## Vignette could redefine the prompt, e.g. to 'R>' ...
	    @out = grep(!/^[[:alnum:]]*\>/, @out);	    
	    ## Or to "empty".  As empty lines in the output will most
	    ## likely not indicate a problem ...
	    @out = grep(!/^[[:space:]]*$/, @out);
	    if(scalar(@out) > 0) {
		$log->warning() unless($any);
		$any++;
		$log->print(join("\n", @out) . "\n");
	    }
	}

	$log->result("OK") unless($any);
    }

    ## Run LaTeX on the manual.

    if($opt_latex) {
        my $latex_dir = &file_path($library, $pkgname, "latex");
	if(-d $latex_dir) {
	    $ENV{'TEXINPUTS'} =
	      env_path(&file_path($R::Vars::R_HOME, "share", "texmf"),
		       $ENV{'TEXINPUTS'});
            my $is_zipped = 0;
            # latex files might have been zipped
            if(-f &file_path($latex_dir, "Rhelp.zip")) {
                $is_zipped = 1;
		my $UNZIP = &R_getenv("R_UNZIPCMD", "unzip");
		my $latex_file = &file_path($latex_dir, "Rhelp.zip");
		$cmd = join(" ",
			    ("$UNZIP", "-q",
			     &shell_quote_file_path($latex_file),
			     "-d",
			     &shell_quote_file_path($latex_dir)));
                if(R_system($cmd)) {
		    $log->error();
		    $log->print("Unzipping latex files failed.\n");
		    exit(1);
                }
            }
	    $log->creating("${pkgname}-manual.tex");
	    open(MANUAL, "> ${pkgname}-manual.tex")
	      or die("Error: cannot open file '${pkgname}-manual.tex'" .
		     "for writing\n");
	    print MANUAL "\\documentclass\{article\}\n" .
	      "\\usepackage[ae,hyper]\{Rd\}\n\\begin\{document\}\n";
	    my @tex_files = &list_files_with_exts($latex_dir, "tex");
	    foreach my $file (@tex_files) {
		open(FILE, "< $file")
		  or die("Error: cannot open file '$file' for reading\n");
		while(<FILE>) {
		    print MANUAL $_;
		}
		close(FILE);
	    }
	    print MANUAL "\\end\{document\}\n";
	    close(MANUAL);
            if($is_zipped) {
		unlink(&list_files_with_exts($latex_dir, "tex"));
            }
	    $log->result("OK");
	    if($HAVE_LATEX) {
		$log->checking("${pkgname}-manual.tex");
		## <NOTE>
		## We use \nonstopmode{} so that LaTeX really gives an
	        ## error (and returns) if something is wrong, and all
	        ## info goes to ${pkgname}-manual.log.
		## We also suppress all output from running LaTeX.
                ## We could also write stdout to a tempfile me}-mat\}\n";
	    close(MANUAL);
            if($is_zipped) {
		unlink(&list_files_with_exts($latex_dir, "tex"));
            }
	    $log->result("OK");
	    if($HAVE_LATEX) {
		$log->checking("${pkgname}-manual.tex");
		## <NOTE>
		## We use \nonstopmode{} so that LaTeX really gives an
	        ## error (and returns) if something is wrong, and all
	        ## info goes to ${pkgname}-manual.log.
		## We also suppress all output from running LaTeX.
                ## We could also write stdout to a tempfile me}-mat\}\n";
	    close(MANUAL);
            if($is_zipped) {
		unlink(&list_files_with_exts($latex_dir, "tex"));
            }
	    $log->result("OK");
	    if($HAVE_LATEX) {
		$log->checking("${pkgname}-manual.tex");
		## <NOTE>
		## We use \nonstopmode{} so that LaTeX really gives an
	        ## error (and returns) if something is wrong, and all
	        ## info goes to ${pkgname}-manual.log.
		## We also suppress all output from running LaTeX.
                ## We could also write stdout to a tempfile me}-mat\}\n";
	    close(MANUAL);
            if($is_zipped) {
		unlink(&list_files_with_exts($latex_dir, "tex"));
            }
	    $log->result("OK");
	    if($HAVE_LATEX) {
		$log->checking("${pkgname}-manual.tex");
		## <NOTE>
		## We use \nonstopmode{} so that LaTeX really gives an
	        ## error (and returns) if something is wrong, and all
	        ## info goes to ${pkgname}-manual.log.
		## We also suppress all output from running LaTeX.
                ## We could also write stdout to a tempfile me}-mat\}\n";
	    close(MANUAL);
            if($is_zipped) {
		unlink(&list_files_with_exts($latex_dir, "tex"));
            }
	    $log->result("OK");
	    if($HAVE_LATEX) {
		$log->checking("${pkgname}-manual.tex");
		## <NOTE>
		## We use \nonstopmode{} so that LaTeX really gives an
	        ## error (and returns) if something is wrong, and all
	        ## info goes to ${pkgname}-manual.log.
		## We also suppress all output from running LaTeX.
                ## We could also write stdout to a tempfile me}-mat\}\n";
	    close(MANUAL);
            if($is_zipped) {
		unlink(&list_files_with_exts($latex_dir, "tex"));
            }
	    $log->result("OK");
	    if($HAVE_LATEX) {
		$log->checking("${pkgname}-manual.tex");
		## <NOTE>
		## We use \nonstopmode{} so that LaTeX really gives an
	        ## error (and returns) if something is wrong, and all
	        ## info goes to ${pkgname}-manual.log.
		## We also suppress all output from running LaTeX.
                ## We could also write stdout to a tempfile me}-mat\}\n";
	    close(MANUAL);
            if($is_zipped) {
		unlink(&list_files_with_exts($latex_dir, "tex"));
            }
	    $log->result("OK");
	    if($HAVE_LATEX) {
		$log->checking("${pkgname}-manual.tex");
		## <NOTE>
		## We use \nonstopmode{} so that LaTeX really gives an
	        ## error (and return