The R Project SVN R

Rev

Rev 27085 | Rev 29902 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 27085 Rev 28125
Line 748... Line 748...
748 
    igcase_opt = asLogical(CAR(args)); args = CDR(args);
 748 
    igcase_opt = asLogical(CAR(args)); args = CDR(args);
749 
    extended_opt = asLogical(CAR(args)); args = CDR(args);
 749 
    extended_opt = asLogical(CAR(args)); args = CDR(args);
750 
    if (igcase_opt == NA_INTEGER) igcase_opt = 0;
 750 
    if (igcase_opt == NA_INTEGER) igcase_opt = 0;
751 
    if (extended_opt == NA_INTEGER) extended_opt = 1;
 751 
    if (extended_opt == NA_INTEGER) extended_opt = 1;
752 
 
 752 
 
753 
    if (!isString(pat) || length(pat) < 1 ||
 753 
    if (length(pat) < 1 || length(rep) < 1)
754 
	!isString(rep) || length(rep) < 1 ||
 - 
 
755 
	!isString(vec))
 - 
 
756 
	errorcall(call, R_MSG_IA);
 754 
	errorcall(call, R_MSG_IA);
757 
 
 755 
 
- 
 
 756 
    if (!isString(pat)) PROTECT(pat = coerceVector(pat, STRSXP));
- 
 
 757 
    else PROTECT(pat);
- 
 
 758 
    if (!isString(rep)) PROTECT(rep = coerceVector(rep, STRSXP));
- 
 
 759 
    else PROTECT(rep);
- 
 
 760 
    if (!isString(vec)) PROTECT(vec = coerceVector(vec, STRSXP));
- 
 
 761 
    else PROTECT(vec);
- 
 
 762 
 
758 
    eflags = 0;
 763 
    eflags = 0;
759 
    if (extended_opt) eflags = eflags | REG_EXTENDED;
 764 
    if (extended_opt) eflags = eflags | REG_EXTENDED;
760 
    if (igcase_opt) eflags = eflags | REG_ICASE;
 765 
    if (igcase_opt) eflags = eflags | REG_ICASE;
761 
 
 766 
 
762 
    if (regcomp(&reg, CHAR(STRING_ELT(pat, 0)), eflags))
 767 
    if (regcomp(&reg, CHAR(STRING_ELT(pat, 0)), eflags))
Line 829... Line 834...
829 
		    *u++ = s[j];
 834 
		    *u++ = s[j];
830 
	    *u = '\0';
 835 
	    *u = '\0';
831 
	}
 836 
	}
832 
    }
 837 
    }
833 
    regfree(&reg);
 838 
    regfree(&reg);
834 
    UNPROTECT(1);
 839 
    UNPROTECT(4);
835 
    return ans;
 840 
    return ans;
836 
}
 841 
}
837 
 
 842 
 
838 
SEXP do_regexpr(SEXP call, SEXP op, SEXP args, SEXP env)
 843 
SEXP do_regexpr(SEXP call, SEXP op, SEXP args, SEXP env)
839 
{
 844 
{
Line 849... Line 854...
849 
    extended_opt = asLogical(CAR(args)); args = CDR(args);
 854 
    extended_opt = asLogical(CAR(args)); args = CDR(args);
850 
    if (extended_opt == NA_INTEGER) extended_opt = 1;
 855 
    if (extended_opt == NA_INTEGER) extended_opt = 1;
851 
    fixed_opt = asLogical(CAR(args));
 856 
    fixed_opt = asLogical(CAR(args));
852 
    if (fixed_opt == NA_INTEGER) fixed_opt = 0;
 857 
    if (fixed_opt == NA_INTEGER) fixed_opt = 0;
853 
 
 858 
 
854 
    if (!isString(pat) || length(pat) < 1 ||
 859 
    if (length(pat) < 1 || length(text) < 1 ||
855 
	!isString(text) || length(text) < 1 ||
 - 
 
856 
	STRING_ELT(pat,0) == NA_STRING)
 860 
	STRING_ELT(pat,0) == NA_STRING)
857 
	errorcall(call, R_MSG_IA);
 861 
	errorcall(call, R_MSG_IA);
858 
 
 862 
 
- 
 
 863 
    if (!isString(pat)) PROTECT(pat = coerceVector(pat, STRSXP));
- 
 
 864 
    else PROTECT(pat);
- 
 
 865 
    if (!isString(text)) PROTECT(text = coerceVector(text, STRSXP));
- 
 
 866 
    else PROTECT(text);
- 
 
 867 
 
859 
    eflags = extended_opt ? REG_EXTENDED : 0;
 868 
    eflags = extended_opt ? REG_EXTENDED : 0;
860 
 
 869 
 
861 
    if (!fixed_opt && regcomp(&reg, CHAR(STRING_ELT(pat, 0)), eflags))
 870 
    if (!fixed_opt && regcomp(&reg, CHAR(STRING_ELT(pat, 0)), eflags))
862 
	errorcall(call, "invalid regular expression");
 871 
	errorcall(call, "invalid regular expression");
863 
    if (fixed_opt) spat = CHAR(STRING_ELT(pat, 0));
 872 
    if (fixed_opt) spat = CHAR(STRING_ELT(pat, 0));
Line 883... Line 892...
883 
	    }
 892 
	    }
884 
	}
 893 
	}
885 
    }
 894 
    }
886 
    if (!fixed_opt) regfree(&reg);
 895 
    if (!fixed_opt) regfree(&reg);
887 
    setAttrib(ans, install("match.length"), matchlen);
 896 
    setAttrib(ans, install("match.length"), matchlen);
888 
    UNPROTECT(2);
 897 
    UNPROTECT(4);
889 
    return ans;
 898 
    return ans;
890 
}
 899 
}
891 
 
 900 
 
892 
SEXP
 901 
SEXP
893 
do_tolower(SEXP call, SEXP op, SEXP args, SEXP env)
 902 
do_tolower(SEXP call, SEXP op, SEXP args, SEXP env)