Index: src/main/objects.c
===================================================================
--- src/main/objects.c	(revision 82792)
+++ src/main/objects.c	(working copy)
@@ -1052,10 +1052,10 @@
 int R_check_class_and_super(SEXP x, const char **valid, SEXP rho)
 {
     int ans;
-    SEXP cl = PROTECT(asChar(getAttrib(x, R_ClassSymbol)));
+    SEXP cl_ = getAttrib(x, R_ClassSymbol), cl = PROTECT(asChar(cl_));
     const char *class = CHAR(cl);
     for (ans = 0; ; ans++) {
-	if (!strlen(valid[ans])) // empty string
+	if (!strlen(valid[ans])) /* empty string */
 	    break;
 	if (!strcmp(class, valid[ans])) {
 	    UNPROTECT(1); /* cl */
@@ -1062,10 +1062,28 @@
 	    return ans;
 	}
     }
-    /* if not found directly, now search the non-virtual super classes :*/
+    /* if not found directly, then look for a match among the nonvirtual 
+       superclasses, possibly after finding the environment 'rho' in which
+       class(x) is defined */
     if(IS_S4_OBJECT(x)) {
-	/* now try the superclasses, i.e.,  try   is(x, "....");  superCl :=
-	   .selectSuperClasses(getClass("....")@contains, dropVirtual=TRUE)  */
+	int xprot = 0;
+	if (isNull(rho)) {
+	    SEXP pkg = getAttrib(cl_, R_PackageSymbol);
+	    if (!isNull(pkg)) {
+		static SEXP meth_classEnv = NULL;
+		if(!meth_classEnv)
+		    meth_classEnv = install(".classEnv");
+		/* FIXME: fails if 'methods' is not loaded */
+		SEXP clEnvCall = PROTECT(lang2(meth_classEnv, cl_));
+		rho = eval(clEnvCall, R_MethodsNamespace);
+		UNPROTECT(1); /* clEnvCall */
+		if(!isEnvironment(rho))
+		    error(_("could not find correct environment; "
+			    "please report!"));
+		PROTECT(rho);
+		xprot = 1;
+	    }
+	}
 	SEXP classExts, superCl, _call;
 	static SEXP s_contains = NULL, s_selectSuperCl = NULL;
 	if(!s_contains) {
@@ -1074,32 +1092,33 @@
 	}
 	SEXP classDef = PROTECT(R_getClassDef(class));
 	PROTECT(classExts = R_do_slot(classDef, s_contains));
-	/* .selectSuperClasses(getClassDef(class)@contains, dropVirtual = TRUE,
-	 *                     namesOnly = TRUE, directOnly = FALSE, simpleOnly = TRUE) :
+	/* .selectSuperClasses(getClassDef(class)@contains, 
+	 *                     dropVirtual = TRUE, namesOnly = TRUE, 
+	 *                     directOnly = FALSE, simpleOnly = TRUE):
 	 */
-	PROTECT(_call = lang6(s_selectSuperCl, classExts, ScalarLogical(1),
-			      ScalarLogical(1), ScalarLogical(0), ScalarLogical(1)));
+	PROTECT(_call = lang6(s_selectSuperCl, classExts,
+			      ScalarLogical(1), ScalarLogical(1),
+			      ScalarLogical(0), ScalarLogical(1)));
 	superCl = eval(_call, rho);
 	UNPROTECT(3); /* _call, classExts, classDef */
 	PROTECT(superCl);
-	for(int i=0; i < LENGTH(superCl); i++) {
+	for(int i = 0; i < LENGTH(superCl); i++) {
 	    const char *s_class = CHAR(STRING_ELT(superCl, i));
 	    for (ans = 0; ; ans++) {
 		if (!strlen(valid[ans]))
 		    break;
 		if (!strcmp(s_class, valid[ans])) {
-		    UNPROTECT(2); /* superCl, cl */
+		    UNPROTECT(2 + xprot); /* superCl, cl, (maybe) rho */
 		    return ans;
 		}
 	    }
 	}
-	UNPROTECT(1); /* superCl */
+	UNPROTECT(1 + xprot); /* superCl, (maybe) rho */
     }
     UNPROTECT(1); /* cl */
     return -1;
 }
 
-
 /**
  * Return the 0-based index of an is() match in a vector of class-name
  * strings terminated by an empty string.  Returns -1 for no match.
@@ -1113,25 +1132,7 @@
  */
 int R_check_class_etc(SEXP x, const char **valid)
 {
-    static SEXP meth_classEnv = NULL;
-    SEXP cl = getAttrib(x, R_ClassSymbol), rho = R_GlobalEnv, pkg;
-    if(!meth_classEnv)
-	meth_classEnv = install(".classEnv");
-
-    pkg = getAttrib(cl, R_PackageSymbol); /* ==R== packageSlot(class(x)) */
-    if(!isNull(pkg)) { /* find  rho := correct class Environment */
-	SEXP clEnvCall;
-	// FIXME: fails if 'methods' is not loaded.
-	PROTECT(clEnvCall = lang2(meth_classEnv, cl));
-	rho = eval(clEnvCall, R_MethodsNamespace);
-	UNPROTECT(1);
-	if(!isEnvironment(rho))
-	    error(_("could not find correct environment; please report!"));
-    }
-    PROTECT(rho);
-    int res = R_check_class_and_super(x, valid, rho);
-    UNPROTECT(1);
-    return res;
+    return R_check_class_and_super(x, valid, R_NilValue);
 }
 
 /* standardGeneric:  uses a pointer to R_standardGeneric, to be