{
	# misc. 3.1 convenience function tests. Many others are scattered 
	# around in their own test files.
	T
}
{
	# S.format. Take a file of expressions that are not in deparse
	# format, use S.format to turn it into deparse format. The file
	# contents are stored here as S objects so it's self-contained.

"old.text"<-
c("f(x)", "pi", "3", "c(\"a\", \"b\", \"c\")", "k <- c(\"a\", \"b\", \"c\")", 
	"names(y) <- names(x) <- nothing", "A %*% B", 
	"f(g(h(i))) <- sin(3) + cos(3) -f(1,2 ,4", 
	",3) + A%*%B - list(2,3,4) +", "\t 7 - {names(x) <- y; names(z)}", "", 
	"", "", "g(y) +\tsin(\t2)", "# a comment", 
	"yuck.fun<-function(x){ \t\tx + 1 + 3; sin(z) ", "\t}")

	old.file <- tempfile()
	write(old.text, file=old.file)
options(warn=-1)
	library(examples)
options(warn=1)
	new.file <- S.format(old.file)
	detach(length(search()))
	new.text.curr <- scan(file=new.file, what="", sep="\n")
	unlink(c(old.file, new.file))

"new.text.tgt"<-
c("f(x)", "pi", "3", "c(\"a\", \"b\", \"c\")", "k <- c(\"a\", \"b\", \"c\")", 
	"names(y) <- names(x) <- nothing", "A %*% B", 
	"f(g(h(i))) <- sin(3) + cos(3) - f(1, 2, 4, 3) + A %*% B - list(2, 3, 4) + 7 - ",
	"\t{", "\tnames(x) <- y", "\tnames(z)", "}", "g(y) + sin(2)", 
	"# a comment", "yuck.fun <- function(x)", "{", "\tx + 1 + 3", 
	"\tsin(z)", "}")

	all.equal(new.text.curr, new.text.tgt)
}
#{
#	# objdiff()
#	f1 <- function(x) { y <- x + 1; sqrt(y) }
#	f2 <- function(x) { y <- x + 2; sqrt(y) }
#	old.pager <- options(pager="cat")
#	cat("MUST see a diff. -------------------- vvv\n")
#       val <- objdiff(f1, f2, command="diff")  # dflt (diff -c) distracting
#	cat("MUST see a diff. -------------------- ^^^\n")
#       is.numeric(val)
#}
#{
	## objdiff again
##	cat("\nMUST see a diff. -------------------- vvv\n")
	#temp <- tempfile()
##	val <- objdiff(f1, f2, file=temp, command="diff")  
        #val <- objdiff(f1, f2, file=temp)
##	cat("MUST see a diff. -------------------- ^^^\n")
	#is.character(val)
#}
#{
#	unlink(temp)
#	options(old.pager)
#	T
#}
{
	# objcopy
	x <<- 1
# 	cat("Expect warnings 'assigning ... on database 0 masks'. vvv\n")
	objcopy("x", 0)
	objcopy("x", 0, "y")
# 	cat("Expect warnings 'assigning ... on database 0 masks'. ^^^\n")
	val <- get("x", where=0) == 1 && get("y", where=0) == 1
	remove(c("x", "y"), w=0)
	val
}
{ "start objects.summary() tests"; T}
{
	dir <- tempfile()
	unix(paste("mkdir", dir))
	attach(dir, pos = 1)
	data.restore("./loop.tests/statsci/ascii/obj_sum.data")
	detach(1)
	attach(dir, pos = 2)
	o <- objects.summary(whe = 2)
	T
}
class(o)[1] == "objects.summary"
all(dim(o) == c(29, 5))
all(names(o) == c("data.class", "storage.mode", "extent", "object.size", 
	"dataset.date"))
all(o.dc == o$data.class)
all(o.sm == o$storage.mode)
all(o.ext == unlist(o$extent))
if(platform() == "OSF1_DECALPHA") {
   # Object sizes are larger for the 64-bit Dec Alpha:
   all(unclass(o$object.size) == c(73, 73, 157, 6674, 8138, 394, 660, 1271,
      1503, 1164, 73, 65, 525, 1953, 433, 362, 268, 644, 857, 377, 297, 718,
      1573, 34319, 325, 1033, 1261, 81, 252))
} else all(o.osz == o$object.size)
all(o$dataset.date > 720314281)	# 10/28/92
# names= usage; also all.classes=T:
{ o2 <- objects.summary(c("a/b", "rr", "mat1", "obj.summ"), whe = 2, 
	all.cl = T); T }
all(dim(o2) == c(4, 5))
all(row.names(o2) == c("a/b", "rr", "mat1", "obj.summ"))
all(o2["obj.summ", "data.class"][[1]] == c("objects.summary", "data.frame"))
all(o2["mat1", "extent"][[1]] == c(2, 10, 5))
# selection:
all(row.names(objects.summary(whe = 2, pattern = "x\\.")) == c("x.anova", 
	"x.mat"))
row.names(objects.summary(whe = 2, pattern = "x\\.", stor = "list")) == 
	"x.anova"
all(row.names(objects.summary(whe = 2, mode = c("complex", "numeric"), data.cla
	 = c("matrix", "ordered"))) == c("ff", "zmat"))
# `what' restriction, pmatching:
all(names(objects.summary(c("e1", "e"), whe = 2, what = c("datas", "ext"))) == 
	c("dataset.date", "extent"))
# frame:
dim(objects.summary(frame = 1))[[1]] != 0
# order, pmatch:
#all.equal(objects.summary(whe = 2, order = c("stor", "data.cl")), o[order(o$
#	storage.mode, o$data.class),  ])
# reverse:
#all.equal(objects.summary(whe = 2, order = c("stor", "data.cl"), rev = T), o[
#	rev(order(o$storage.mode, o$data.class)),  ])
{
   # print.objects.summary.
   # Test print method with all.classes=T, extents with length > 1, and
   # a range of dataset dates spanning one year on either side of 10.28.92
   o3 <- o
   nobjs <- dim(o3)[1]
   D10.28.92 <- 720314281
   secs.per.yr <- 60 * 60 * 24 * 30 * 12
   set.seed(18)
   o3$dataset.date <- D10.28.92 + sample(secs.per.yr * 2, nobjs) - secs.per.yr	
   target <- paste("./loop.tests/statsci/ascii/objsum", sep="")
   old.dims <- options(width = 80, length = 48)
   results <- c()
   for(df in c(1)) {
      tgt <- switch(platform(),
         # 64-bit machines like DA need separate target:
         "OSF1_DECALPHA" = paste(target, df, ".64", sep = ""),
                           paste(target, df, sep = "")
      )
      curr <- tempfile()
      sink(curr)
      print(o3, date.format = df)
      sink()
      if(0 != unix(paste("cmp", tgt, curr), out = F)) {
         cat("\nDifference in printing detected, date.format =", df, 
            "\nLook at these files:\n", tgt, "\n", curr, "\n\n", file="|stderr")
         results <- c(results, F)
      } else {
         unlink(curr)
         results <- c(results, T)
      }
   }
   options(old.dims)
   all(results)
}
# Test invalid or empty `where' and `frame'. Behavior of objects() in these
# cases might change, in which objects.summary() should follow suit.  Also
# test case when database is empty or nothing is selected, and want ordering
# on more than one field. Bug 2148, that order(length-zero-vec, 
# length-zero-vec) is wrong, caused an error here.
# 
# empty database:
{ remove(objects(2), whe = 2); T }
dim(objects.summary(where = 2))[1] == 0	# data frame with 0 rows
dim(objects.summary(where = 2, ord = c("obj", "stor")))[1] == 0
{ assign("garbage", 1, where = 0);
  dim(objects.summary(where = 0, mode = "no.such.mode", 
	ord = c("obj", "stor")))[1] == 0}
is.null(objects.summary(where = 100))	# out-of-range where int
is.null(objects.summary(frame = 100))	# out-of-range frame
# empty frame
{ n <- new.frame(); T}
is.null(objects(frame = n))
is.null(objects.summary(frame = n))
{ clear.frame(n); T}
# check that args to objects() are eval'd in the right context. If this
# isn't true, f() generates an error. (Currently objects.summary() eval's
# and passes the constants on down.)
{
	f <- function() { .wh <- 0; objects.summary(where = .wh) }
	f()
	T
}
{ detach(2); unix(paste("rm -rf", dir)); T }
{ "end objects.summary() tests"; T}