X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Declare.xs;h=17a0cd306ca6e2db2e05e2ce8dd1ea9865880041;hb=04a8a223b0a8ab54b0b1cc648c2abe24036ea7b0;hp=ce8d01bc4d3874c582ee968bd971db0f051a6b82;hpb=923c07a823429898c1aa43e68027bcd30dd01f5e;p=p5sagit%2FDevel-Declare.git diff --git a/Declare.xs b/Declare.xs index ce8d01b..17a0cd3 100644 --- a/Declare.xs +++ b/Declare.xs @@ -87,9 +87,6 @@ void dd_linestr_callback (pTHX_ char* type, char* name, char* s) { char* linestr = SvPVX(PL_linestr); int offset = s - linestr; - char* new_linestr; - int count; - dSP; ENTER; @@ -101,16 +98,8 @@ void dd_linestr_callback (pTHX_ char* type, char* name, char* s) { XPUSHs(sv_2mortal(newSViv(offset))); PUTBACK; - count = call_pv("Devel::Declare::linestr_callback", G_SCALAR); - - SPAGAIN; - - if (count != 1) - Perl_croak(aTHX_ "linestr_callback didn't return a value, bailing out"); - - printf("linestr_callback returned: %s\n", POPp); + call_pv("Devel::Declare::linestr_callback", G_VOID|G_DISCARD); - PUTBACK; FREETMPS; LEAVE; } @@ -135,6 +124,18 @@ void dd_set_linestr(pTHX_ char* new_value) { PL_bufend = SvPVX(PL_linestr) + new_len; } +char* dd_get_lex_stuff(pTHX) { + return SvPVX(PL_lex_stuff); +} + +char* dd_clear_lex_stuff(pTHX) { + PL_lex_stuff = Nullsv; +} + +char* dd_get_curstash_name(pTHX) { + return HvNAME(PL_curstash); +} + char* dd_move_past_token (pTHX_ char* s) { /* @@ -149,6 +150,12 @@ char* dd_move_past_token (pTHX_ char* s) { return s; } +int dd_toke_move_past_token (pTHX_ int offset) { + char* base_s = SvPVX(PL_linestr) + offset; + char* s = dd_move_past_token(aTHX_ base_s); + return s - base_s; +} + int dd_toke_scan_word(pTHX_ int offset, int handle_package) { char tmpbuf[sizeof PL_tokenbuf]; char* base_s = SvPVX(PL_linestr) + offset; @@ -242,142 +249,8 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) { printf("PL_tokenbuf: %s\n", PL_tokenbuf); #endif - s = dd_move_past_token(aTHX_ s); - - DD_DEBUG_S - - if (dd_flags & DD_HANDLE_NAME) { - - /* find next word */ - - s = skipspace(s); - - DD_DEBUG_S + dd_linestr_callback(aTHX_ "rv2cv", GvNAME(kGVOP_gv), s); - /* kill the :: added in the ck_const */ - if (*s == ':') - *s++ = ' '; - if (*s == ':') - *s++ = ' '; - - /* arg 4 is allow_package */ - - s = scan_word(s, tmpbuf, sizeof tmpbuf, dd_flags & DD_HANDLE_PACKAGE, &len); - - DD_DEBUG_S - - if (len) { - strcpy(found_name, tmpbuf); -#ifdef DD_DEBUG - printf("Found %s\n", found_name); -#endif - } - } - - if (dd_flags & DD_HANDLE_PROTO) { - - s = skipspace(s); - - if (*s == '(') { /* found a prototype-ish thing */ - save_s = s; - s = scan_str(s, FALSE, FALSE); /* no keep_quoted, no keep_delims */ -#ifdef DD_HAS_TRAITS - { - char *traitstart = s = skipspace(s); - - while (*s && *s != '{') ++s; - if (*s) { - int tlen = s - traitstart; - Newx(found_traits, tlen+1, char); - Copy(traitstart, found_traits, tlen, char); - found_traits[tlen] = 0; -#ifdef DD_DEBUG - printf("found traits..... (%s)\n", found_traits); -#endif - } - } -#endif - - if (SvPOK(PL_lex_stuff)) { -#ifdef DD_DEBUG - printf("Found proto %s\n", SvPVX(PL_lex_stuff)); -#endif - found_proto = SvPVX(PL_lex_stuff); - if (len) /* foo name () => foo name X, only foo parsed so works */ - *save_s++ = ' '; - else /* foo () => foo =X, TOKEN('&') won't handle foo X */ - *save_s++ = '='; - *save_s++ = 'X'; - while (save_s < s) { - *save_s++ = ' '; - } -#ifdef DD_DEBUG - printf("Curbuf %s\n", PL_bufptr); -#endif - } - } - } - - if (!len) - found_name[0] = 0; - -#ifdef DD_DEBUG - printf("Calling init_declare\n"); -#endif - cb_args[0] = HvNAME(PL_curstash); - cb_args[1] = GvNAME(kGVOP_gv); - cb_args[2] = HvNAME(PL_curstash); - cb_args[3] = found_name; - cb_args[4] = found_proto; - cb_args[5] = found_traits; - cb_args[6] = NULL; - - if (len && found_proto) - in_declare = 2; - else if (len || found_proto) - in_declare = 1; - if (found_proto) - PL_lex_stuff = Nullsv; - s = skipspace(s); -#ifdef DD_DEBUG - printf("cur buf: %s\n", s); - printf("bufend at: %i\n", PL_bufend - s); - printf("linestr: %s\n", SvPVX(PL_linestr)); - printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); -#endif - - if (*s++ == '{') { - call_argv("Devel::Declare::init_declare", G_SCALAR, cb_args); - SPAGAIN; - retstr = POPpx; - PUTBACK; - if (retstr && strlen(retstr)) { - const char* old_start = SvPVX(PL_linestr); - int start_diff; - const int old_len = SvCUR(PL_linestr); -#ifdef DD_DEBUG - printf("Got string %s\n", retstr); -#endif - SvGROW(PL_linestr, (STRLEN)(old_len + strlen(retstr))); - if (start_diff = SvPVX(PL_linestr) - old_start) { - Perl_croak(aTHX_ "forced to realloc PL_linestr for line %s, bailing out before we crash harder", SvPVX(PL_linestr)); - } - memmove(s+strlen(retstr), s, (PL_bufend - s)+1); - memmove(s, retstr, strlen(retstr)); - SvCUR_set(PL_linestr, old_len + strlen(retstr)); - PL_bufend += strlen(retstr); -#ifdef DD_DEBUG - printf("cur buf: %s\n", s); - printf("PL_bufptr: %s\n", PL_bufptr); - printf("bufend at: %i\n", PL_bufend - s); - printf("linestr: %s\n", SvPVX(PL_linestr)); - printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr)); - printf("tokenbuf now: %s\n", PL_tokenbuf); -#endif - } - } else { - call_argv("Devel::Declare::init_declare", G_VOID|G_DISCARD, cb_args); - } return o; } @@ -427,9 +300,7 @@ STATIC OP *(*dd_old_ck_const)(pTHX_ OP*op); STATIC OP *dd_ck_const(pTHX_ OP *o) { int dd_flags; char* s; - char tmpbuf[sizeof PL_tokenbuf]; - char found_name[sizeof PL_tokenbuf]; - STRLEN len = 0; + char* name; o = dd_old_ck_const(aTHX_ o); /* let the original do its job */ @@ -437,61 +308,17 @@ STATIC OP *dd_ck_const(pTHX_ OP *o) { if (!SvPOK(cSVOPo->op_sv)) return o; - dd_flags = dd_is_declarator(aTHX_ SvPVX(cSVOPo->op_sv)); + name = SvPVX(cSVOPo->op_sv); + + dd_flags = dd_is_declarator(aTHX_ name); if (dd_flags == -1) return o; - if (!(dd_flags & DD_HANDLE_NAME)) - return o; /* if we're not handling name, method intuiting not an issue */ - -#ifdef DD_DEBUG - printf("Think I found a declarator %s\n", PL_tokenbuf); - printf("linestr: %s\n", SvPVX(PL_linestr)); -#endif - s = PL_bufptr; - s = dd_move_past_token(aTHX_ s); - - /* dd_linestr_callback(aTHX_ "const", SvPVX(cSVOPo->op_sv), s); */ - - DD_DEBUG_S - - /* find next word */ + dd_linestr_callback(aTHX_ "const", name, s); - s = skipspace(s); - - DD_DEBUG_S - - /* arg 4 is allow_package */ - - s = scan_word(s, tmpbuf, sizeof tmpbuf, dd_flags & DD_HANDLE_PACKAGE, &len); - - DD_DEBUG_S - - if (len) { - const char* old_start = SvPVX(PL_linestr); - int start_diff; - const int old_len = SvCUR(PL_linestr); - - strcpy(found_name, tmpbuf); -#ifdef DD_DEBUG - printf("Found %s\n", found_name); -#endif - - s -= len; - SvGROW(PL_linestr, (STRLEN)(old_len + 2)); - if (start_diff = SvPVX(PL_linestr) - old_start) { - Perl_croak(aTHX_ "forced to realloc PL_linestr for line %s, bailing out before we crash harder", SvPVX(PL_linestr)); - } - memmove(s+2, s, (PL_bufend - s)+1); - *s = ':'; - s++; - *s = ':'; - SvCUR_set(PL_linestr, old_len + 2); - PL_bufend += 2; - } return o; } @@ -526,6 +353,25 @@ set_linestr(char* new_value) CODE: dd_set_linestr(aTHX_ new_value); +char* +get_lex_stuff() + CODE: + RETVAL = dd_get_lex_stuff(aTHX); + OUTPUT: + RETVAL + +void +clear_lex_stuff() + CODE: + dd_clear_lex_stuff(aTHX); + +char* +get_curstash_name() + CODE: + RETVAL = dd_get_curstash_name(aTHX); + OUTPUT: + RETVAL + int toke_scan_word(int offset, int handle_package) CODE: @@ -534,6 +380,13 @@ toke_scan_word(int offset, int handle_package) RETVAL int +toke_move_past_token(int offset); + CODE: + RETVAL = dd_toke_move_past_token(aTHX_ offset); + OUTPUT: + RETVAL + +int toke_scan_str(int offset); CODE: RETVAL = dd_toke_scan_str(aTHX_ offset); @@ -546,3 +399,15 @@ toke_skipspace(int offset) RETVAL = dd_toke_skipspace(aTHX_ offset); OUTPUT: RETVAL + +int +get_in_declare() + CODE: + RETVAL = in_declare; + OUTPUT: + RETVAL + +void +set_in_declare(int value) + CODE: + in_declare = value;