stopifnot <- function(...)
{
    penv <- parent.frame()
    cl <- match.call(envir = penv)[-1]
    Dparse <- function(call, cutoff = 60L) {
	ch <- deparse(call, width.cutoff = cutoff)
	if(length(ch) > 1L) paste(ch[1L], "....") else ch
    }
    head <- function(x, n = 6L) ## basically utils:::head.default()
	x[seq_len(if(n < 0L) max(length(x) + n, 0L) else min(n, length(x)))]
    abbrev <- function(ae, n = 3L)
	paste(c(head(ae, n), if(length(ae) > n) "...."), collapse="\n  ")
    benv <- baseenv()
    for (i in seq_along(cl)) {
	cl.i <- cl[[i]]
	## r <- eval(cl.i, envir = penv, enclos = benv)
	##      ---- but with correct warn/err messages:
	r <- withCallingHandlers(
	    tryCatch(eval(cl.i, envir = penv, enclos = benv),
		     error = function(e) { e$call <- cl.i; stop(e) }),
	    warning = function(w) { w$call <- cl.i; w })
	if (!(is.logical(r) && !anyNA(r) && all(r))) {
	    msg <- ## special case for decently written 'all.equal(*)':
		if(is.call(cl.i) && identical(cl.i[[1]], quote(all.equal)) &&
		   (is.null(ni <- names(cl.i)) || length(cl.i) == 3L ||
		    length(cl.i <- cl.i[!nzchar(ni)]) == 3L))

		    sprintf(gettext("%s and %s are not equal:\n  %s"),
			    Dparse(cl.i[[2]]),
			    Dparse(cl.i[[3]]), abbrev(r))
		else
		    sprintf(ngettext(length(r),
				     "%s is not TRUE",
				     "%s are not all TRUE"),
			    Dparse(cl.i))

	    stop(msg, call. = FALSE, domain = NA)
	}
    }
    invisible()
}
