The R Project SVN R

Rev

Rev 89130 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 89130 Rev 89928
Line 742... Line 742...
742 
    } else return s;
 742 
    } else return s;
743 
}
 743 
}
744 
 
 744 
 
745 
static SEXP
 745 
static SEXP
746 
integerSubscript(SEXP s, R_xlen_t ns, R_xlen_t nx, R_xlen_t *stretch,
 746 
integerSubscript(SEXP s, R_xlen_t ns, R_xlen_t nx, R_xlen_t *stretch,
747 
		 SEXP call, SEXP x)
 747 
		 SEXP call, SEXP x, int dim)
748 
{
 748 
{
749 
    bool isna = false, neg = false,
 749 
    bool isna = false, neg = false,
750 
	canstretch = *stretch > 0;
 750 
	canstretch = *stretch > 0;
751 
    *stretch = 0;
 751 
    *stretch = 0;
752 
    int max = 0;
 752 
    int max = 0;
Line 763... Line 763...
763 
	    max = ii;
 763 
	    max = ii;
764 
    }
 764 
    }
765 
    if (max > nx) {
 765 
    if (max > nx) {
766 
	if(canstretch) *stretch = max;
 766 
	if(canstretch) *stretch = max;
767 
	else {
 767 
	else {
768 
	    ECALL_OutOfBounds(x, -1, max, call);
 768 
	    ECALL_OutOfBounds(x, dim, max, call);
769 
	}
 769 
	}
770 
    }
 770 
    }
771 
    if (neg) {
 771 
    if (neg) {
772 
	if (max == 0 && !isna) return negativeSubscript(s, ns, nx, call);
 772 
	if (max == 0 && !isna) return negativeSubscript(s, ns, nx, call);
773 
	else {
 773 
	else {
Line 997... Line 997...
997 
    case NILSXP:
 997 
    case NILSXP:
998 
	return allocVector(INTSXP, 0);
 998 
	return allocVector(INTSXP, 0);
999 
    case LGLSXP:
 999 
    case LGLSXP:
1000 
	return logicalSubscript(s, ns, nd, &stretch, call);
 1000 
	return logicalSubscript(s, ns, nd, &stretch, call);
1001 
    case INTSXP:
 1001 
    case INTSXP:
1002 
	return integerSubscript(s, ns, nd, &stretch, call, x);
 1002 
	return integerSubscript(s, ns, nd, &stretch, call, x, dim);
1003 
    case REALSXP:
 1003 
    case REALSXP:
1004 
	/* We don't yet allow subscripts > R_SHORT_LEN_MAX */
 1004 
	/* We don't yet allow subscripts > R_SHORT_LEN_MAX */
1005 
	PROTECT(tmp = coerceVector(s, INTSXP));
 1005 
	PROTECT(tmp = coerceVector(s, INTSXP));
1006 
	tmp = integerSubscript(tmp, ns, nd, &stretch, call, x);
 1006 
	tmp = integerSubscript(tmp, ns, nd, &stretch, call, x, dim);
1007 
	UNPROTECT(1);
 1007 
	UNPROTECT(1);
1008 
	return tmp;
 1008 
	return tmp;
1009 
    case STRSXP:
 1009 
    case STRSXP:
1010 
	dnames = getAttrib(x, R_DimNamesSymbol);
 1010 
	dnames = getAttrib(x, R_DimNamesSymbol);
1011 
	if (dnames == R_NilValue) {
 1011 
	if (dnames == R_NilValue) {
Line 1079... Line 1079...
1079 
	break;
 1079 
	break;
1080 
    case LGLSXP:
 1080 
    case LGLSXP:
1081 
	ans = logicalSubscript(s, ns, nx, stretch, call);
 1081 
	ans = logicalSubscript(s, ns, nx, stretch, call);
1082 
	break;
 1082 
	break;
1083 
    case INTSXP:
 1083 
    case INTSXP:
1084 
	ans = integerSubscript(s, ns, nx, stretch, call, x);
 1084 
	ans = integerSubscript(s, ns, nx, stretch, call, x, -1);
1085 
	break;
 1085 
	break;
1086 
    case REALSXP:
 1086 
    case REALSXP:
1087 
	ans = realSubscript(s, ns, nx, stretch, call, x);
 1087 
	ans = realSubscript(s, ns, nx, stretch, call, x);
1088 
	break;
 1088 
	break;
1089 
    case STRSXP:
 1089 
    case STRSXP: