The R Project SVN – R – Diff – /trunk/src/scripts/check.in


#! @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 $gzip = R_getenv("R_GZIPCMD", "gzip");
 
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(R_system("$gzip -dc '$pkg' | $tar -xf - -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 '@VERSION@' 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",
	   "The \\usage entries must correspond to syntactically",
	   "valid R code.\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_SHARE_DIR},
							"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_SHARE_DIR},
					      "make", "tests.mk"));
        if($WINDOWS) {
            $makefiles = "-f ${R::Vars::R_SHARE_DIR}/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_install && $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_SHARE_DIR, "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 and replay
                ## this in case of problems.  But does this really help?
		my $cmd = "${R::Vars::LATEX}";
		$cmd .= " '\\nonstopmode{}\\input{${pkgname}-manual.tex}'";
		$cmd .= " >/dev/null 2>&1";
		## </NOTE>
		if(R_system($cmd)) {
		    $log->error();
		    $log->print("LaTeX errors when creating DVI version.\n");
		    $log->print("This typically indicates Rd problems.\n");
		    exit(1);
		}
		$log->result("OK");
	    }
	}
	else {
	    if($HAVE_LATEX) {
		$log->checking("DVI version of manual");
		my $cmd;
		if($WINDOWS) {
		    $cmd = join(" ",
				("Rcmd.exe Rd2dvi --batch --no-preview",
				 "-o ${pkgname}-manual.dvi >/dev/null 2>&1",
				 "$pkgdir"));
		} else {
		    $cmd = join(" ",
				(&shell_quote_file_path("${R::Vars::R_EXE}"),
				 "CMD Rd2dvi --batch --no-preview",
				 "-o ${pkgname}-manual.dvi >/dev/null 2>&1",
				 "$pkgdir"));
		}
		if(R_system($cmd)) {
		    $log->error();
		    $log->print("LaTeX errors when creating DVI version.\n");
		    $log->print("This typically indicates Rd problems.\n");
		    exit(1);
		}
		$log->result("OK");
	    }
	}
    }
}
 

sub usage {
    print STDERR <<END;
Usage: R CMD $name [options] pkgs
 
Check R packages from package sources, which can be directories or 
gzipped package 'tar' archives with extension '.tar.gz' or '.tgz'.
 
A variety of diagnostic checks on directory structure, index and
control files are performed.  The package is installed into the log
directory (which includes the translation of all Rd files into several
formats), and the Rd files are tested by LaTeX (if available).  All
examples and tests provided by the package are tested to see if they
run successfully.
 
Options:
  -h, --help            print short help message and exit
  -v, --version         print 'check' version info and exit
  -l, --library=LIB     library directory used for test installation
                        of packages (default is outdir)
  -o, --outdir=DIR      directory used for logfiles, R output, etc.
                        (default is 'pkg.Rcheck' in current directory,
			where 'pkg' is the name of the package checked)
      --no-clean        do not clean outdir before using it
      --no-codoc        do not check for code/documentation mismatches
      --no-examples     do not run the examples in the Rd files
      --no-install      skip installation and associated tests
      --no-tests        do not run code in tests subdirectory
      --no-vignettes    do not check vignettes in Sweave format
      --no-latex        do not run LaTeX on help files
      --use-gct         use 'gctorture(TRUE)' when running examples/tests
      --use-valgrind    use 'valgrind' when running examples/tests/vignettes
      --rcfile=FILE     read configuration values from FILE
      
By default, all test sections are turned on.
 
Email bug reports to <r-bugs\@r-project.org>.
END
    exit 0;
}

Rev 34111	Rev 34311
1	`#! @PERL@`	1	`#! @PERL@`
2	`#-- perl --`	2	`#-- perl --`
3		3
4	`## Copyright (C) 2000-2005 R Development Core Team`	4	`## Copyright (C) 2000-2005 R Development Core Team`
5	`##`	5	`##`
6	`## This program is free software; you can redistribute it and/or modify`	6	`## This program is free software; you can redistribute it and/or modify`
7	`## it under the terms of the GNU General Public License as published by`	7	`## it under the terms of the GNU General Public License as published by`
8	`## the Free Software Foundation; either version 2, or (at your option)`	8	`## the Free Software Foundation; either version 2, or (at your option)`
9	`## any later version.`	9	`## any later version.`
10	`##`	10	`##`
11	`## This program is distributed in the hope that it will be useful, but`	11	`## This program is distributed in the hope that it will be useful, but`
12	`## WITHOUT ANY WARRANTY; without even the implied warranty of`	12	`## WITHOUT ANY WARRANTY; without even the implied warranty of`
13	`## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU`	13	`## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU`
14	`## General Public License for more details.`	14	`## General Public License for more details.`
15	`##`	15	`##`
16	`## A copy of the GNU General Public License is available via WWW at`	16	`## A copy of the GNU General Public License is available via WWW at`
17	`## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by`	17	`## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by`
18	`## writing to the Free Software Foundation, Inc., 59 Temple Place,`	18	`## writing to the Free Software Foundation, Inc., 59 Temple Place,`
19	`## Suite 330, Boston, MA 02111-1307 USA.`	19	`## Suite 330, Boston, MA 02111-1307 USA.`
20		20
21	`## Send any bug reports to r-bugs@r-project.org`	21	`## Send any bug reports to r-bugs@r-project.org`
22		22
23	`use Cwd;`	23	`use Cwd;`
24	`use File::Basename;`	24	`use File::Basename;`
25	`use File::Copy;`	25	`use File::Copy;`
26	`use File::Find;`	26	`use File::Find;`
27	`use File::Path;`	27	`use File::Path;`
28	`use Getopt::Long;`	28	`use Getopt::Long;`
29	`use IO::File;`	29	`use IO::File;`
30	`use R::Dcf;`	30	`use R::Dcf;`
31	`use R::Logfile;`	31	`use R::Logfile;`
32	`use R::Rdtools;`	32	`use R::Rdtools;`
33	`use R::Utils;`	33	`use R::Utils;`
34	`use R::Vars;`	34	`use R::Vars;`
35	`use Text::Wrap;`	35	`use Text::Wrap;`
36		36
37	`## Don't buffer output.`	37	`## Don't buffer output.`
38	`$\| = 1;`	38	`$\| = 1;`
39		39
40	`my $revision = ' $Revision: 1.193 $ ';`	40	`my $revision = ' $Revision: 1.193 $ ';`
41	`my $version;`	41	`my $version;`
42	`my $name;`	42	`my $name;`
43	`$revision =~ / ([\d\.]*) /;`	43	`$revision =~ / ([\d\.]*) /;`
44	`$version = $1;`	44	`$version = $1;`
45	`($name = $0) =~ s\|.*/\|\|;`	45	`($name = $0) =~ s\|.*/\|\|;`
46		46
47	`### Options`	47	`### Options`
48	`my $opt_clean = 1;`	48	`my $opt_clean = 1;`
49	`my $opt_examples = 1;`	49	`my $opt_examples = 1;`
50	`my $opt_tests = 1;`	50	`my $opt_tests = 1;`
51	`my $opt_latex = 1;`	51	`my $opt_latex = 1;`
52	`my $opt_use_gct = 0;`	52	`my $opt_use_gct = 0;`
53	`my $opt_codoc = 1;`	53	`my $opt_codoc = 1;`
54	`my $opt_install = 1;`	54	`my $opt_install = 1;`
55	`my $opt_vignettes = 1;`	55	`my $opt_vignettes = 1;`
56	`my $opt_use_valgrind = 0;`	56	`my $opt_use_valgrind = 0;`
57	`my $opt_rcfile = ""; # Only set this if $ENV{"HOME"} is set.`	57	`my $opt_rcfile = ""; # Only set this if $ENV{"HOME"} is set.`
58	`$opt_rcfile = &file_path($ENV{"HOME"}, ".R", "check.conf")`	58	`$opt_rcfile = &file_path($ENV{"HOME"}, ".R", "check.conf")`
59	`if defined($ENV{"HOME"});`	59	`if defined($ENV{"HOME"});`
60		60
61	`my $WINDOWS = ($R::Vars::OSTYPE eq "windows");`	61	`my $WINDOWS = ($R::Vars::OSTYPE eq "windows");`
62		62
63	`R::Vars::error("R_HOME", "R_EXE");`	63	`R::Vars::error("R_HOME", "R_EXE");`
64		64
65	`my @known_options = ("help\|h", "version\|v", "outdir\|o:s", "library\|l:s",`	65	`my @known_options = ("help\|h", "version\|v", "outdir\|o:s", "library\|l:s",`
66	`"no-clean", "no-examples", "no-tests", "no-latex",`	66	`"no-clean", "no-examples", "no-tests", "no-latex",`
67	`"use-gct" => \$opt_use_gct, "no-codoc",`	67	`"use-gct" => \$opt_use_gct, "no-codoc",`
68	`"install=s" => \$opt_install, "no-install",`	68	`"install=s" => \$opt_install, "no-install",`
69	`"no-vignettes", "use-valgrind" => \$opt_use_valgrind,`	69	`"no-vignettes", "use-valgrind" => \$opt_use_valgrind,`
70	`"rcfile=s" => \$opt_rcfile);`	70	`"rcfile=s" => \$opt_rcfile);`
71	`GetOptions(@known_options) or usage();`	71	`GetOptions(@known_options) or usage();`
72		72
73	`R_version("R add-on package checker", $version) if $opt_version;`	73	`R_version("R add-on package checker", $version) if $opt_version;`
74	`usage() if $opt_help;`	74	`usage() if $opt_help;`
75		75
76	`$opt_clean = 0 if $opt_no_clean;`	76	`$opt_clean = 0 if $opt_no_clean;`
77	`$opt_examples = 0 if $opt_no_examples;`	77	`$opt_examples = 0 if $opt_no_examples;`
78	`$opt_tests = 0 if $opt_no_tests;`	78	`$opt_tests = 0 if $opt_no_tests;`
79	`$opt_latex = 0 if $opt_no_latex;`	79	`$opt_latex = 0 if $opt_no_latex;`
80	`$opt_codoc = 0 if $opt_no_codoc;`	80	`$opt_codoc = 0 if $opt_no_codoc;`
81	`$opt_install = 0 if $opt_no_install;`	81	`$opt_install = 0 if $opt_no_install;`
82	`$opt_vignettes = 0 if $opt_no_vignettes;`	82	`$opt_vignettes = 0 if $opt_no_vignettes;`
83		83
84	`if($opt_install eq "fake") {`	84	`if($opt_install eq "fake") {`
85	`## If we fake installation, then we cannot run any code.`	85	`## If we fake installation, then we cannot run any code.`
86	`$opt_examples = $opt_tests = $opt_vignettes = 0;`	86	`$opt_examples = $opt_tests = $opt_vignettes = 0;`
87	`}`	87	`}`
88	`$opt_install = 0 if($opt_install eq "no");`	88	`$opt_install = 0 if($opt_install eq "no");`
89		89
90	`my $opt_ff_calls = 1;`	90	`my $opt_ff_calls = 1;`
91	`## The neverending story ...`	91	`## The neverending story ...`
92	`## For the time being, allow to turn this off by setting the environment`	92	`## For the time being, allow to turn this off by setting the environment`
93	`## variable _R_CHECK_FF_CALLS_ to a Perl 'null' value.`	93	`## variable _R_CHECK_FF_CALLS_ to a Perl 'null' value.`
94	`if(defined($ENV{"_R_CHECK_FF_CALLS_"})) {`	94	`if(defined($ENV{"_R_CHECK_FF_CALLS_"})) {`
95	`$opt_ff_calls = $ENV{"_R_CHECK_FF_CALLS_"};`	95	`$opt_ff_calls = $ENV{"_R_CHECK_FF_CALLS_"};`
96	`}`	96	`}`
97		97
98	`## Use system default unless explicitly specified otherwise.`	98	`## Use system default unless explicitly specified otherwise.`
99	`$ENV{"R_DEFAULT_PACKAGES"} = "";`	99	`$ENV{"R_DEFAULT_PACKAGES"} = "";`
100		100
101	`### Configurable variables`	101	`### Configurable variables`
102	`my $R_check_use_install_log =`	102	`my $R_check_use_install_log =`
103	`&R_getenv("_R_CHECK_USE_INSTALL_LOG_", "FALSE");`	103	`&R_getenv("_R_CHECK_USE_INSTALL_LOG_", "FALSE");`
104	`my $R_check_subdirs_nocase =`	104	`my $R_check_subdirs_nocase =`
105	`&R_getenv("_R_CHECK_SUBDIRS_NOCASE_", "FALSE");`	105	`&R_getenv("_R_CHECK_SUBDIRS_NOCASE_", "FALSE");`
106	`my $R_check_all_non_ISO_C =`	106	`my $R_check_all_non_ISO_C =`
107	`&R_getenv("_R_CHECK_ALL_NON_ISO_C_", "FALSE");`	107	`&R_getenv("_R_CHECK_ALL_NON_ISO_C_", "FALSE");`
108	`my $R_check_weave_vignettes =`	108	`my $R_check_weave_vignettes =`
109	`&R_getenv("_R_CHECK_WEAVE_VIGNETTES_", "TRUE");`	109	`&R_getenv("_R_CHECK_WEAVE_VIGNETTES_", "TRUE");`
110		110
111	`## Maybe move basic configuration (and documentation) to`	111	`## Maybe move basic configuration (and documentation) to`
112	`## &file_path($R::Vars::R_HOME, "etc", "check.conf")`	112	`## &file_path($R::Vars::R_HOME, "etc", "check.conf")`
113	`## eventually ...`	113	`## eventually ...`
114	`for my $file ($opt_rcfile) {`	114	`for my $file ($opt_rcfile) {`
115	`if(-r $file) {`	115	`if(-r $file) {`
116	`open(FILE, "< $file")`	116	`open(FILE, "< $file")`
117	`or die "Error: cannot open file '$file' for reading\n";`	117	`or die "Error: cannot open file '$file' for reading\n";`
118	`my @lines = <FILE>;`	118	`my @lines = <FILE>;`
119	`close(FILE);`	119	`close(FILE);`
120	`eval("@lines");`	120	`eval("@lines");`
121	`die "Error: failed to eval config file '$file'\n$@\n" if ($@);`	121	`die "Error: failed to eval config file '$file'\n$@\n" if ($@);`
122	`## <NOTE>`	122	`## <NOTE>`
123	`## We prefer the above to the usual recommendation`	123	`## We prefer the above to the usual recommendation`
124	`## unless ($return = do($file)) {`	124	`## unless ($return = do($file)) {`
125	`## warn "couldn't parse $file: $@" if $@;`	125	`## warn "couldn't parse $file: $@" if $@;`
126	`## warn "couldn't do $file: $!" unless defined $return;`	126	`## warn "couldn't do $file: $!" unless defined $return;`
127	`## warn "couldn't run $file" unless $return;`	127	`## warn "couldn't run $file" unless $return;`
128	`## }`	128	`## }`
129	`## as do(FILE) cannot see lexicals in the enclosing scope.`	129	`## as do(FILE) cannot see lexicals in the enclosing scope.`
130	`## </NOTE>`	130	`## </NOTE>`
131	`}`	131	`}`
132	`}`	132	`}`
133		133
134	`$R_check_use_install_log =`	134	`$R_check_use_install_log =`
135	`&config_val_to_logical($R_check_use_install_log);`	135	`&config_val_to_logical($R_check_use_install_log);`
136	`$R_check_subdirs_nocase =`	136	`$R_check_subdirs_nocase =`
137	`&config_val_to_logical($R_check_subdirs_nocase);`	137	`&config_val_to_logical($R_check_subdirs_nocase);`
138	`$R_check_all_non_ISO_C =`	138	`$R_check_all_non_ISO_C =`
139	`&config_val_to_logical($R_check_all_non_ISO_C);`	139	`&config_val_to_logical($R_check_all_non_ISO_C);`
140	`$R_check_weave_vignettes =`	140	`$R_check_weave_vignettes =`
141	`&config_val_to_logical($R_check_weave_vignettes);`	141	`&config_val_to_logical($R_check_weave_vignettes);`
142		142
143	`my $startdir = R_cwd();`	143	`my $startdir = R_cwd();`
144	`$opt_outdir = $startdir unless $opt_outdir;`	144	`$opt_outdir = $startdir unless $opt_outdir;`
145	`chdir($opt_outdir)`	145	`chdir($opt_outdir)`
146	`or die "Error: cannot change to directory '$opt_outdir'\n";`	146	`or die "Error: cannot change to directory '$opt_outdir'\n";`
147	`my $outdir = R_cwd();`	147	`my $outdir = R_cwd();`
148	`chdir($startdir);`	148	`chdir($startdir);`
149		149
150	`my $R_LIBS = $ENV{'R_LIBS'};`	150	`my $R_LIBS = $ENV{'R_LIBS'};`
151	`my $library;`	151	`my $library;`
152	`if($opt_library) {`	152	`if($opt_library) {`
153	`chdir($opt_library)`	153	`chdir($opt_library)`
154	`or die "Error: cannot change to directory '$opt_library'\n";`	154	`or die "Error: cannot change to directory '$opt_library'\n";`
155	`$library = R_cwd();`	155	`$library = R_cwd();`
156	`$ENV{'R_LIBS'} = env_path($library, $R_LIBS);`	156	`$ENV{'R_LIBS'} = env_path($library, $R_LIBS);`
157		157
158	`chdir($startdir);`	158	`chdir($startdir);`
159	`}`	159	`}`
160		160
161	`my $tar = R_getenv("TAR", "tar");`	161	`my $tar = R_getenv("TAR", "tar");`
162	`my $gzip = R_getenv("R_GZIPCMD", "gzip");`	162	`my $gzip = R_getenv("R_GZIPCMD", "gzip");`
163		163
164	`my $R_opts = "--vanilla";`	164	`my $R_opts = "--vanilla";`
165		165
166	`if($opt_latex) {`	166	`if($opt_latex) {`
167	`my $log = new R::Logfile();`	167	`my $log = new R::Logfile();`
168	`$log->checking("for working latex");`	168	`$log->checking("for working latex");`
169	`open(TEXFILE,`	169	`open(TEXFILE,`
170	`"> " . &file_path(${R::Vars::TMPDIR}, "Rtextest$$.tex"))`	170	`"> " . &file_path(${R::Vars::TMPDIR}, "Rtextest$$.tex"))`
171	`or die "Error: cannot open file 'Rtextest$$.tex' for writing\n";`	171	`or die "Error: cannot open file 'Rtextest$$.tex' for writing\n";`
172	`print TEXFILE "\\documentclass\{article\}\\begin\{document\}" .`	172	`print TEXFILE "\\documentclass\{article\}\\begin\{document\}" .`
173	`"test\\end\{document\}\n";`	173	`"test\\end\{document\}\n";`
174	`close(TEXFILE);`	174	`close(TEXFILE);`
175	`chdir($R::Vars::TMPDIR);`	175	`chdir($R::Vars::TMPDIR);`
176	`if(R_system("${R::Vars::LATEX} Rtextest$$ > Rtextest$$.out")) {`	176	`if(R_system("${R::Vars::LATEX} Rtextest$$ > Rtextest$$.out")) {`
177	`$log->result("NO");`	177	`$log->result("NO");`
178	`$HAVE_LATEX = 0;`	178	`$HAVE_LATEX = 0;`
179	`} else {`	179	`} else {`
180	`$log->result("OK");`	180	`$log->result("OK");`
181	`$HAVE_LATEX = 1;`	181	`$HAVE_LATEX = 1;`
182	`}`	182	`}`
183	`unlink(<Rtextest$$.*>);`	183	`unlink(<Rtextest$$.*>);`
184	`chdir($startdir);`	184	`chdir($startdir);`
185	`$log->close();`	185	`$log->close();`
186	`}`	186	`}`
187		187
188	`## This is the main loop over all packages to be checked.`	188	`## This is the main loop over all packages to be checked.`
189	`(scalar(@ARGV) > 0) or die "Error: no packages were specified\n";`	189	`(scalar(@ARGV) > 0) or die "Error: no packages were specified\n";`
190	`foreach my $pkg (@ARGV) {`	190	`foreach my $pkg (@ARGV) {`
191	`## $pkg should be the path to the package (bundle) root source`	191	`## $pkg should be the path to the package (bundle) root source`
192	`## directory, either absolute or relative to $startdir.`	192	`## directory, either absolute or relative to $startdir.`
193	`## As from 2.1.0 it can also be a tarball`	193	`## As from 2.1.0 it can also be a tarball`
194		194
195	`## $pkgdir is the corresponding absolute path.`	195	`## $pkgdir is the corresponding absolute path.`
196	`## $pkgname is the name of the package (bundle).`	196	`## $pkgname is the name of the package (bundle).`
197	`chdir($startdir);`	197	`chdir($startdir);`
198	`$pkg =~ s+/$++; # strip any trailing '/'`	198	`$pkg =~ s+/$++; # strip any trailing '/'`
199	`my $pkgname = basename($pkg);`	199	`my $pkgname = basename($pkg);`
200		200
201	`## is this a tar archive?`	201	`## is this a tar archive?`
202	`my $istar = 0;`	202	`my $istar = 0;`
203	`if($pkgname =~ /\.tar\.gz$/ \|\| $pkgname =~ /\.tgz$/) {`	203	`if($pkgname =~ /\.tar\.gz$/ \|\| $pkgname =~ /\.tgz$/) {`
204	`$pkgname =~ s/\.tar\.gz$//;`	204	`$pkgname =~ s/\.tar\.gz$//;`
205	`$pkgname =~ s/\.tgz$//;`	205	`$pkgname =~ s/\.tgz$//;`
206	`$pkgname =~ s/_[0-9\.-]*$//;`	206	`$pkgname =~ s/_[0-9\.-]*$//;`
207	`$istar = 1;`	207	`$istar = 1;`
208	`}`	208	`}`
209		209
210	`my $pkgoutdir = &file_path($outdir, "$pkgname.Rcheck");`	210	`my $pkgoutdir = &file_path($outdir, "$pkgname.Rcheck");`
211	`rmtree($pkgoutdir) if ($opt_clean && (-d $pkgoutdir)) ;`	211	`rmtree($pkgoutdir) if ($opt_clean && (-d $pkgoutdir)) ;`
212	`if(!(-d $pkgoutdir)) {`	212	`if(!(-d $pkgoutdir)) {`
213	`mkdir($pkgoutdir, 0755)`	213	`mkdir($pkgoutdir, 0755)`
214	`or die("Error: cannot create directory '$pkgoutdir'\n");`	214	`or die("Error: cannot create directory '$pkgoutdir'\n");`
215	`}`	215	`}`
216		216
217	`if($istar) {`	217	`if($istar) {`
218	`my $dir = &file_path("$pkgoutdir", "00_pkg_src");`	218	`my $dir = &file_path("$pkgoutdir", "00_pkg_src");`
219	`mkdir($dir, 0755)`	219	`mkdir($dir, 0755)`
220	`or die("Error: cannot create directory '$dir'\n");`	220	`or die("Error: cannot create directory '$dir'\n");`
221	`if($WINDOWS) {`	221	`if($WINDOWS) {`
222	`## workaround for paths in Cygwin tar`	222	`## workaround for paths in Cygwin tar`
223	`$pkg =~ s+^([A-Za-x]):+/cygdrive/\1+;`	223	`$pkg =~ s+^([A-Za-x]):+/cygdrive/\1+;`
224	`}`	224	`}`
225	`if(R_system("$gzip -dc '$pkg' \| $tar -xf - -C $dir")) {`	225	`if(R_system("$gzip -dc '$pkg' \| $tar -xf - -C $dir")) {`
226	`die "Error: cannot untar $pkg\n";}`	226	`die "Error: cannot untar $pkg\n";}`
227	`$pkg = &file_path($dir, $pkgname);`	227	`$pkg = &file_path($dir, $pkgname);`
228	`}`	228	`}`
229		229
230	`$pkg =~ s/\/$//;`	230	`$pkg =~ s/\/$//;`
231	`(-d $pkg) or die "Error: package dir '$pkg' does not exist\n";`	231	`(-d $pkg) or die "Error: package dir '$pkg' does not exist\n";`
232	`chdir($pkg)`	232	`chdir($pkg)`
233	`or die "Error: cannot change to directory '$pkg'\n";`	233	`or die "Error: cannot change to directory '$pkg'\n";`
234	`my $pkgdir = R_cwd();`	234	`my $pkgdir = R_cwd();`
235	`## my $pkgname = basename($pkgdir);`	235	`## my $pkgname = basename($pkgdir);`
236	`chdir($startdir);`	236	`chdir($startdir);`
237		237
238	`$log = new R::Logfile(&file_path($pkgoutdir, "00check.log"));`	238	`$log = new R::Logfile(&file_path($pkgoutdir, "00check.log"));`
239	`$log->message("using log directory '$pkgoutdir'");`	239	`$log->message("using log directory '$pkgoutdir'");`
240	`my @out = R_runR("cat(R.version.string, '\n', sep='')",`	240	`my @out = R_runR("cat(R.version.string, '\n', sep='')",`
241	`"--slave --vanilla");`	241	`"--slave --vanilla");`
242	`$log->message("using @out");`	242	`$log->message("using @out");`
243		243
244	`if(!$opt_library) {`	244	`if(!$opt_library) {`
245	`$library = $pkgoutdir;`	245	`$library = $pkgoutdir;`
246	`$ENV{'R_LIBS'} = env_path($library, $R_LIBS);`	246	`$ENV{'R_LIBS'} = env_path($library, $R_LIBS);`
247	`}`	247	`}`
248	`if($WINDOWS) { ## need to avoid spaces in $library`	248	`if($WINDOWS) { ## need to avoid spaces in $library`
249	`$library = Win32::GetShortPathName($library) if $library =~ / /;`	249	`$library = Win32::GetShortPathName($library) if $library =~ / /;`
250	`}`	250	`}`
251		251
252	`my $description;`	252	`my $description;`
253	`my $is_base_pkg = 0;`	253	`my $is_base_pkg = 0;`
254	`my $is_bundle = 0;`	254	`my $is_bundle = 0;`
255	`my $package_or_bundle = "package";`	255	`my $package_or_bundle = "package";`
256	`my $package_or_bundle_name;`	256	`my $package_or_bundle_name;`
257	`## Package sources from the R distribution are special. They have a`	257	`## Package sources from the R distribution are special. They have a`
258	`## 'DESCRIPTION.in' file (instead of 'DESCRIPTION'), with Version`	258	`## 'DESCRIPTION.in' file (instead of 'DESCRIPTION'), with Version`
259	`## field containing '@VERSION@' for substitution by configure. We`	259	`## field containing '@VERSION@' for substitution by configure. We`
260	`## test for such packages by looking for 'DESCRIPTION.in' with`	260	`## test for such packages by looking for 'DESCRIPTION.in' with`
261	`## Priority 'base', and skip the installation test for such`	261	`## Priority 'base', and skip the installation test for such`
262	`## packages.`	262	`## packages.`
263	`if(-r &file_path($pkgdir, "DESCRIPTION.in")) {`	263	`if(-r &file_path($pkgdir, "DESCRIPTION.in")) {`
264	`$description =`	264	`$description =`
265	`new R::Dcf(&file_path($pkgdir, "DESCRIPTION.in"));`	265	`new R::Dcf(&file_path($pkgdir, "DESCRIPTION.in"));`
266	`if($description->{"Priority"} eq "base") {`	266	`if($description->{"Priority"} eq "base") {`
267	`$log->message("looks like '${pkgname}' is a base package");`	267	`$log->message("looks like '${pkgname}' is a base package");`
268	`$log->message("skipping installation test");`	268	`$log->message("skipping installation test");`
269	`$is_base_pkg = 1;`	269	`$is_base_pkg = 1;`
270	`}`	270	`}`
271	`}`	271	`}`
272		272
273	`if(!$is_base_pkg) {`	273	`if(!$is_base_pkg) {`
274	`$log->checking(join("",`	274	`$log->checking(join("",`
275	`("for file '",`	275	`("for file '",`
276	`&file_path($pkgname, "DESCRIPTION"),`	276	`&file_path($pkgname, "DESCRIPTION"),`
277	`"'")));`	277	`"'")));`
278	`if(-r &file_path($pkgdir, "DESCRIPTION")) {`	278	`if(-r &file_path($pkgdir, "DESCRIPTION")) {`
279	`$description =`	279	`$description =`
280	`new R::Dcf(&file_path($pkgdir, "DESCRIPTION"));`	280	`new R::Dcf(&file_path($pkgdir, "DESCRIPTION"));`
281	`$log->result("OK");`	281	`$log->result("OK");`
282	`}`	282	`}`
283	`else {`	283	`else {`
284	`$log->result("NO");`	284	`$log->result("NO");`
285	`exit(1);`	285	`exit(1);`
286	`}`	286	`}`
287	`if($description->{"Type"}) { # standard packages do not have this`	287	`if($description->{"Type"}) { # standard packages do not have this`
288	`$log->checking("extension type");`	288	`$log->checking("extension type");`
289	`$log->result($description->{"Type"});`	289	`$log->result($description->{"Type"});`
290	`if($description->{"Type"} ne "Package") {`	290	`if($description->{"Type"} ne "Package") {`
291	`$log->print("Only Type = Package extensions can be checked.\n");`	291	`$log->print("Only Type = Package extensions can be checked.\n");`
292	`exit(0);`	292	`exit(0);`
293	`}`	293	`}`
294	`}`	294	`}`
295		295
296	`if($description->{"Bundle"}) {`	296	`if($description->{"Bundle"}) {`
297	`$is_bundle = 1;`	297	`$is_bundle = 1;`
298	`$log->message("looks like '${pkgname}' is a package bundle");`	298	`$log->message("looks like '${pkgname}' is a package bundle");`
299	`$package_or_bundle = "bundle";`	299	`$package_or_bundle = "bundle";`
300	`$package_or_bundle_name = $description->{"Bundle"};`	300	`$package_or_bundle_name = $description->{"Bundle"};`
301	`}`	301	`}`
302	`else {`	302	`else {`
303	`$package_or_bundle_name = $description->{"Package"};`	303	`$package_or_bundle_name = $description->{"Package"};`
304	`}`	304	`}`
305	`$log->message("this is $package_or_bundle " .`	305	`$log->message("this is $package_or_bundle " .`
306	`"'$package_or_bundle_name' " .`	306	`"'$package_or_bundle_name' " .`
307	`"version '$description->{\"Version\"}'");`	307	`"version '$description->{\"Version\"}'");`
308	`## <NOTE>`	308	`## <NOTE>`
309	`## This check should be adequate, but would not catch a manually`	309	`## This check should be adequate, but would not catch a manually`
310	`## installed package, nor one installed prior to 1.4.0.`	310	`## installed package, nor one installed prior to 1.4.0.`
311	`## </NOTE>`	311	`## </NOTE>`
312	`$log->checking("if this is a source $package_or_bundle");`	312	`$log->checking("if this is a source $package_or_bundle");`
313	`if(defined($description->{"Built"})) {`	313	`if(defined($description->{"Built"})) {`
314	`$log->error();`	314	`$log->error();`
315	`$log->print("Only source packages can be checked.\n");`	315	`$log->print("Only source packages can be checked.\n");`
316	`exit(1);`	316	`exit(1);`
317	`}`	317	`}`
318	`elsif($opt_install !~ /^check/) {`	318	`elsif($opt_install !~ /^check/) {`
319	`## Check for package/bundle 'src' subdirectories with object`	319	`## Check for package/bundle 'src' subdirectories with object`
320	`## files (but not if installation was already performed).`	320	`## files (but not if installation was already performed).`
321	`my $any;`	321	`my $any;`
322	`my $pat = "(a\|o\|[ls][ao]\|sl\|obj)"; # Object file extensions.`	322	`my $pat = "(a\|o\|[ls][ao]\|sl\|obj)"; # Object file extensions.`
323	`my @dirs;`	323	`my @dirs;`
324	`if($in_bundle) {`	324	`if($in_bundle) {`
325	`foreach my $ppkg (split(/\s+/,`	325	`foreach my $ppkg (split(/\s+/,`
326	`description->{"Contains"})) {`	326	`description->{"Contains"})) {`
327	`push(@dirs, &file_path($ppkg, "src"));`	327	`push(@dirs, &file_path($ppkg, "src"));`
328	`}`	328	`}`
329	`}`	329	`}`
330	`else {`	330	`else {`
331	`@dirs = ("src");`	331	`@dirs = ("src");`
332	`}`	332	`}`
333	`foreach my $dir (@dirs) {`	333	`foreach my $dir (@dirs) {`
334	`if((-d &file_path($pkgdir, $dir))`	334	`if((-d &file_path($pkgdir, $dir))`
335	`&& &list_files_with_exts(&file_path($pkgdir, $dir),`	335	`&& &list_files_with_exts(&file_path($pkgdir, $dir),`
336	`$pat)) {`	336	`$pat)) {`
337	`$log->warning() unless $any;`	337	`$log->warning() unless $any;`
338	`$any++;`	338	`$any++;`
339	`$dir = &file_path($pkgname, $dir);`	339	`$dir = &file_path($pkgname, $dir);`
340	`$log->print("Subdirectory '$dir' " .`	340	`$log->print("Subdirectory '$dir' " .`
341	`"contains object files.\n");`	341	`"contains object files.\n");`
342	`}`	342	`}`
343	`}`	343	`}`
344	`$log->result("OK") unless $any;`	344	`$log->result("OK") unless $any;`
345	`}`	345	`}`
346	`else {`	346	`else {`
347	`$log->result("OK");`	347	`$log->result("OK");`
348	`}`	348	`}`
349		349
350	`## Option '--no-install' turns off installation and the tests`	350	`## Option '--no-install' turns off installation and the tests`
351	`## which require the package to be installed. When testing`	351	`## which require the package to be installed. When testing`
352	`## recommended packages bundled with R we can skip installation,`	352	`## recommended packages bundled with R we can skip installation,`
353	`## and do so if '--install=skip' was given. If command line`	353	`## and do so if '--install=skip' was given. If command line`
354	`## option '--install' is of the form 'check:FILE', it is assumed`	354	`## option '--install' is of the form 'check:FILE', it is assumed`
355	`## that installation was already performed with stdout/stderr to`	355	`## that installation was already performed with stdout/stderr to`
356	`## FILE, the contents of which need to be checked (without`	356	`## FILE, the contents of which need to be checked (without`
357	`## repeating the installation).`	357	`## repeating the installation).`
358	`## <NOTE>`	358	`## <NOTE>`
359	`## In this case, one also needs to specify where the package`	359	`## In this case, one also needs to specify where the package`
360	`## was installed to using command line option '--library'.`	360	`## was installed to using command line option '--library'.`
361	`## Perhaps we should check for that, although '--install=check'`	361	`## Perhaps we should check for that, although '--install=check'`
362	`## is really only meant for repository maintainers.`	362	`## is really only meant for repository maintainers.`
363	`## </NOTE>`	363	`## </NOTE>`
364	`if($opt_install) {`	364	`if($opt_install) {`
365	`if($opt_install eq "skip") {`	365	`if($opt_install eq "skip") {`
366	`$log->message("skipping installation test");`	366	`$log->message("skipping installation test");`
367	`}`	367	`}`
368	`else {`	368	`else {`
369	`my $use_install_log =`	369	`my $use_install_log =`
370	`(($opt_install =~ /^check/) \|\|`	370	`(($opt_install =~ /^check/) \|\|`
371	`$R_check_use_install_log \|\|`	371	`$R_check_use_install_log \|\|`
372	`!(-t STDIN && -t STDOUT));`	372	`!(-t STDIN && -t STDOUT));`
373	`my $INSTALL_opts = "";`	373	`my $INSTALL_opts = "";`
374	`$INSTALL_opts = "--fake" if($opt_install eq "fake");`	374	`$INSTALL_opts = "--fake" if($opt_install eq "fake");`
375	`my $cmd;`	375	`my $cmd;`
376	`if($WINDOWS) {`	376	`if($WINDOWS) {`
377	`$cmd = join(" ",`	377	`$cmd = join(" ",`
378	`("Rcmd.exe INSTALL -l",`	378	`("Rcmd.exe INSTALL -l",`
379	`&shell_quote_file_path($library),`	379	`&shell_quote_file_path($library),`
380	`"$INSTALL_opts",`	380	`"$INSTALL_opts",`
381	`&shell_quote_file_path($pkgdir)));`	381	`&shell_quote_file_path($pkgdir)));`
382	`} else {`	382	`} else {`
383	`$cmd = join(" ",`	383	`$cmd = join(" ",`
384	`(&shell_quote_file_path(${R::Vars::R_EXE}),`	384	`(&shell_quote_file_path(${R::Vars::R_EXE}),`
385	`"CMD INSTALL -l",`	385	`"CMD INSTALL -l",`
386	`&shell_quote_file_path($library),`	386	`&shell_quote_file_path($library),`
387	`"$INSTALL_opts",`	387	`"$INSTALL_opts",`
388	`&shell_quote_file_path($pkgdir)));`	388	`&shell_quote_file_path($pkgdir)));`
389	`}`	389	`}`
390	`if(!$use_install_log) {`	390	`if(!$use_install_log) {`
391	`## Case A: No redirection of stdout/stderr from`	391	`## Case A: No redirection of stdout/stderr from`
392	`## installation.`	392	`## installation.`
393	`print("\n");`	393	`print("\n");`
394	`if(R_system($cmd)) {`	394	`if(R_system($cmd)) {`
395	`$log->error();`	395	`$log->error();`
396	`$log->print("Installation failed.\n");`	396	`$log->print("Installation failed.\n");`
397	`exit(1);`	397	`exit(1);`
398	`}`	398	`}`
399	`print("\n");`	399	`print("\n");`
400	`}`	400	`}`
401	`else {`	401	`else {`
402	`## Case B. All output from installation redirected,`	402	`## Case B. All output from installation redirected,`
403	`## or already available in the log file.`	403	`## or already available in the log file.`
404	`$log->checking("whether $package_or_bundle " .`	404	`$log->checking("whether $package_or_bundle " .`
405	`"'$package_or_bundle_name' " .`	405	`"'$package_or_bundle_name' " .`
406	`"can be installed");`	406	`"can be installed");`
407	`my $out = &file_path($pkgoutdir, "00install.out");`	407	`my $out = &file_path($pkgoutdir, "00install.out");`
408	`my $install_error;`	408	`my $install_error;`
409	`my @lines;`	409	`my @lines;`
410	`if($opt_install =~ /^check/) {`	410	`if($opt_install =~ /^check/) {`
411	`copy(substr($opt_install, 6), $out);`	411	`copy(substr($opt_install, 6), $out);`
412	`$opt_install = "check";`	412	`$opt_install = "check";`
413	`@lines = &read_lines($out);`	413	`@lines = &read_lines($out);`
414	`$install_error =`	414	`$install_error =`
415	`($lines[$#lines] !~ /^\* DONE/);`	415	`($lines[$#lines] !~ /^\* DONE/);`
416	`}`	416	`}`
417	`else {`	417	`else {`
418	`$cmd .= " >" .`	418	`$cmd .= " >" .`
419	`&shell_quote_file_path($out) .`	419	`&shell_quote_file_path($out) .`
420	`" 2>&1";`	420	`" 2>&1";`
421	`$install_error = &R_system($cmd);`	421	`$install_error = &R_system($cmd);`
422	`}`	422	`}`
423	`if($install_error) {`	423	`if($install_error) {`
424	`$log->error();`	424	`$log->error();`
425	`$log->print("Installation failed.\n");`	425	`$log->print("Installation failed.\n");`
426	`$log->print("See '$out' for details.\n");`	426	`$log->print("See '$out' for details.\n");`
427	`exit(1);`	427	`exit(1);`
428	`}`	428	`}`
429	`## There could still be some important warnings that`	429	`## There could still be some important warnings that`
430	`## we'd like to report. For the time being, start`	430	`## we'd like to report. For the time being, start`
431	`## with compiler warnings about non ISO C code (Or`	431	`## with compiler warnings about non ISO C code (Or`
432	`## at least, what looks like it.) In theory, we`	432	`## at least, what looks like it.) In theory, we`
433	`## should only do this when using GCC ...`	433	`## should only do this when using GCC ...`
434	`@lines = &read_lines($out)`	434	`@lines = &read_lines($out)`
435	`unless($opt_install eq "check");`	435	`unless($opt_install eq "check");`
436	`my $warn_re =`	436	`my $warn_re =`
437	`"(" . join("\|", ("^WARNING:",`	437	`"(" . join("\|", ("^WARNING:",`
438	`"^Warning:",`	438	`"^Warning:",`
439	`": warning: .*ISO C",`	439	`": warning: .*ISO C",`
440	`"missing link\\(s\\):")) . ")";`	440	`"missing link\\(s\\):")) . ")";`
441	`@lines = grep(/$warn_re/, @lines);`	441	`@lines = grep(/$warn_re/, @lines);`
442	`## Ignore install time readLines() warnings about`	442	`## Ignore install time readLines() warnings about`
443	`## files with incomplete final lines. Most of these`	443	`## files with incomplete final lines. Most of these`
444	`## come from .install_package_indices(), and should be`	444	`## come from .install_package_indices(), and should be`
445	`## safe to ignore ...`	445	`## safe to ignore ...`
446	`$warn_re = "Warning: incomplete final line " .`	446	`$warn_re = "Warning: incomplete final line " .`
447	`"found by readLines";`	447	`"found by readLines";`
448	`@lines = grep(!/$warn_re/, @lines);`	448	`@lines = grep(!/$warn_re/, @lines);`
449	`## Package writers cannot really do anything about`	449	`## Package writers cannot really do anything about`
450	`## non ISO C code in system headers. Also, GCC`	450	`## non ISO C code in system headers. Also, GCC`
451	`## 3.4 or better warns about function pointers`	451	`## 3.4 or better warns about function pointers`
452	`## casts which are "needed" for dlsym(), but it`	452	`## casts which are "needed" for dlsym(), but it`
453	`## seems that all systems which have dlsym() also`	453	`## seems that all systems which have dlsym() also`
454	`## support the cast. Hence, try to ignore these by`	454	`## support the cast. Hence, try to ignore these by`
455	`## default, but make it possible to get all ISO C`	455	`## default, but make it possible to get all ISO C`
456	`## warnings via an environment variable.`	456	`## warnings via an environment variable.`
457	`if(!$R_check_all_non_ISO_C) {`	457	`if(!$R_check_all_non_ISO_C) {`
458	`@lines = grep(!/^ \/.: warning: .*ISO C/,`	458	`@lines = grep(!/^ \/.: warning: .*ISO C/,`
459	`@lines);`	459	`@lines);`
460	`$warn_re = "warning: ISO C forbids." .`	460	`$warn_re = "warning: ISO C forbids." .`
461	`"function pointer";`	461	`"function pointer";`
462	`@lines = grep(!/$warn_re/, @lines);`	462	`@lines = grep(!/$warn_re/, @lines);`
463	`}`	463	`}`
464	`if(scalar(@lines) > 0) {`	464	`if(scalar(@lines) > 0) {`
465	`$log->warning();`	465	`$log->warning();`
466	`$log->print("Found the following " .`	466	`$log->print("Found the following " .`
467	`"significant warnings:\n");`	467	`"significant warnings:\n");`
468	`$log->print(" " . join("\n ", @lines) . "\n");`	468	`$log->print(" " . join("\n ", @lines) . "\n");`
469	`}`	469	`}`
470	`else {`	470	`else {`
471	`$log->result("OK");`	471	`$log->result("OK");`
472	`}`	472	`}`
473	`}`	473	`}`
474	`}`	474	`}`
475	`}`	475	`}`
476		476
477	`}`	477	`}`
478		478
479	`if($is_bundle) {`	479	`if($is_bundle) {`
480	`my @bundlepkgs = split(/\s+/, $description->{"Contains"});`	480	`my @bundlepkgs = split(/\s+/, $description->{"Contains"});`
481	`foreach my $ppkg (@bundlepkgs) {`	481	`foreach my $ppkg (@bundlepkgs) {`
482	`$log->message("checking '$ppkg' in bundle '$pkgname'");`	482	`$log->message("checking '$ppkg' in bundle '$pkgname'");`
483	`$log->setstars("**");`	483	`$log->setstars("**");`
484	`chdir($startdir);`	484	`chdir($startdir);`
485	`check_pkg(&file_path($pkgdir, $ppkg), $pkgoutdir, $startdir,`	485	`check_pkg(&file_path($pkgdir, $ppkg), $pkgoutdir, $startdir,`
486	`$library, $is_bundle, $description, $log,`	486	`$library, $is_bundle, $description, $log,`
487	`$is_base_pkg);`	487	`$is_base_pkg);`
488	`$log->setstars("*");`	488	`$log->setstars("*");`
489	`}`	489	`}`
490	`}`	490	`}`
491	`else {`	491	`else {`
492	`chdir($startdir);`	492	`chdir($startdir);`
493	`check_pkg($pkgdir, $pkgoutdir, $startdir, $library,`	493	`check_pkg($pkgdir, $pkgoutdir, $startdir, $library,`
494	`$is_bundle, $description, $log, $is_base_pkg);`	494	`$is_bundle, $description, $log, $is_base_pkg);`
495	`}`	495	`}`
496		496
497	`if($log->{"warnings"}) {`	497	`if($log->{"warnings"}) {`
498	`print("\n") ;`	498	`print("\n") ;`
499	`$log->summary();`	499	`$log->summary();`
500	`}`	500	`}`

The R Project SVN R

(root)/trunk/src/scripts/check.in @ 34412 – Rev 34111 → 34311