From: Lukas Mai Date: Sat, 3 Nov 2012 22:42:35 +0000 (+0100) Subject: rework allocation system X-Git-Tag: v1.00_01~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e4648f19e7042e4c39dc87ec0263083436212bf0;p=p5sagit%2FFunction-Parameters.git rework allocation system Turns out both block_end and newATTRSUB 'LEAVE' scopes, which triggers destruction of things I expected to stay alive. Avoid further surprises by implementing our own destructor system on top of SAVEDESTRUCTOR. --- diff --git a/MANIFEST b/MANIFEST index 62ed081..622f678 100644 --- a/MANIFEST +++ b/MANIFEST @@ -62,6 +62,7 @@ t/foreign/signatures/basic.t t/foreign/signatures/eval.t t/foreign/signatures/proto.t t/foreign/signatures/weird.t +t/hueg.t t/imports.t t/invocant.t t/lexical.t diff --git a/Parameters.xs b/Parameters.xs index 286e79d..542b078 100644 --- a/Parameters.xs +++ b/Parameters.xs @@ -107,15 +107,88 @@ DEFSTRUCT(KWSpec) { static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); -static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) { +DEFSTRUCT(Resource) { + Resource *next; + void *data; + void (*destroy)(pTHX_ void *); +}; + +typedef Resource *Sentinel[1]; + +static void sentinel_clear_void(pTHX_ void *p) { + Resource **pp = p; + while (*pp) { + Resource *cur = *pp; + cur->destroy(aTHX_ cur->data); + cur->data = (void *)"no"; + cur->destroy = NULL; + *pp = cur->next; + Safefree(cur); + } +} + +static void sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) { + Resource *cur; + + Newx(cur, 1, Resource); + cur->data = data; + cur->destroy = destroy; + cur->next = *sen; + *sen = cur; +} + +static void my_sv_refcnt_dec_void(pTHX_ void *p) { + SV *sv = p; + SvREFCNT_dec(sv); +} + +static SV *sentinel_mortalize(Sentinel sen, SV *sv) { + sentinel_register(sen, sv, my_sv_refcnt_dec_void); + return sv; +} + +static void my_safefree(void *p) { + Safefree(p); +} + +#define SENTINEL_ALLOC(SEN, P, N, T) STMT_START { \ + Newx(P, N, T); \ + sentinel_register(SEN, P, my_safefree); \ +} STMT_END + +#define SENTINEL_MDUP(SEN, P, O, N, T) STMT_START { \ + void *const _sentinel_mdup_tmp_ = (P); \ + SENTINEL_ALLOC(SEN, P, N, T); \ + memcpy(P, _sentinel_mdup_tmp_, O * sizeof (T)); \ +} STMT_END + +#define SENTINEL_REALLOC(SEN, P, N, T) STMT_START { \ + assert((N) > 0); \ + if (!(P)) { \ + SENTINEL_ALLOC(SEN, P, N, T); \ + } else { \ + Resource **_sentinel_realloc_tmp_ = (SEN); \ + for (;;) { \ + assert(*_sentinel_realloc_tmp_ != NULL); \ + if ((*_sentinel_realloc_tmp_)->data == (P)) { \ + Renew((*_sentinel_realloc_tmp_)->data, N, T); \ + (P) = (*_sentinel_realloc_tmp_)->data; \ + break; \ + } \ + _sentinel_realloc_tmp_ = &(*_sentinel_realloc_tmp_)->next; \ + } \ + } \ +} STMT_END + +static int kw_flags(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len, KWSpec *spec) { HV *hints; SV *sv, **psv; const char *p, *kw_active; STRLEN kw_active_len; spec->flags = 0; - spec->shift = sv_2mortal(newSVpvs("")); - spec->attrs = sv_2mortal(newSVpvs("")); + spec->shift = sentinel_mortalize(sen, newSVpvs("")); + spec->attrs = sentinel_mortalize(sen, newSVpvs("")); if (!(hints = GvHV(PL_hintgv))) { return FALSE; @@ -144,7 +217,7 @@ static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) { const char *fk_ptr_; \ STRLEN fk_len_; \ SV *fk_sv_; \ - fk_sv_ = sv_2mortal(newSVpvs(HINTK_ ## NAME)); \ + fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \ sv_catpvn(fk_sv_, PTR, LEN); \ fk_ptr_ = SvPV(fk_sv_, fk_len_); \ if (!((X) = hv_fetch(hints, fk_ptr_, fk_len_, 0))) { \ @@ -214,10 +287,10 @@ static bool my_is_uni_xidcont(pTHX_ UV c) { return is_utf8_xidcont(tmpbuf); } -static SV *my_scan_word(pTHX_ bool allow_package) { +static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) { bool at_start, at_substart; I32 c; - SV *sv = sv_2mortal(newSVpvs("")); + SV *sv = sentinel_mortalize(sen, newSVpvs("")); if (lex_bufutf8()) { SvUTF8_on(sv); } @@ -263,14 +336,14 @@ static SV *my_scan_word(pTHX_ bool allow_package) { return SvCUR(sv) ? sv : NULL; } -static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) { +static SV *my_scan_parens_tail(pTHX_ Sentinel sen, bool keep_backslash) { I32 c, nesting; SV *sv; line_t start; start = CopLINE(PL_curcop); - sv = sv_2mortal(newSVpvs("")); + sv = sentinel_mortalize(sen, newSVpvs("")); if (lex_bufutf8()) { SvUTF8_on(sv); } @@ -307,7 +380,7 @@ static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) { return sv; } -static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) { +static void my_check_prototype(pTHX_ Sentinel sen, const SV *declarator, SV *proto) { char *start, *r, *w, *end; STRLEN len; @@ -331,7 +404,7 @@ static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) { /* check for bad characters */ if (strspn(start, "$@%*;[]&\\_+") != len) { - SV *dsv = newSVpvs_flags("", SVs_TEMP); + SV *dsv = sentinel_mortalize(sen, newSVpvs("")); warner( packWARN(WARN_ILLEGALPROTO), "Illegal character in prototype for %"SVf" : %s", @@ -608,6 +681,7 @@ enum { */ static PADOFFSET parse_param( pTHX_ + Sentinel sen, const SV *declarator, const KWSpec *spec, ParamSpec *param_spec, int *pflags, SV **pname, OP **pinit ) { @@ -641,7 +715,7 @@ static PADOFFSET parse_param( lex_read_unichar(0); lex_read_space(0); - if (!(name = my_scan_word(aTHX_ FALSE))) { + if (!(name = my_scan_word(aTHX_ sen, FALSE))) { croak("In %"SVf": missing identifier after '%c'", SVfARG(declarator), sigil); } sv_insert(name, 0, 0, &sigil, 1); @@ -712,7 +786,7 @@ static OP *mkconstpv(pTHX_ const char *p, size_t n) { #define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1) -static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) { +static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) { ParamSpec *param_spec; SV *declarator; I32 floor_ix; @@ -724,7 +798,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len unsigned builtin_attrs; I32 c; - declarator = sv_2mortal(newSVpvn(keyword_ptr, keyword_len)); + declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len)); lex_read_space(0); @@ -732,7 +806,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* function name */ saw_name = NULL; - if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ TRUE))) { + if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ sen, TRUE))) { if (PL_parser->expect != XSTATE) { /* bail out early so we don't predeclare $saw_name */ @@ -769,7 +843,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* initialize synthetic optree */ Newx(prelude_sentinel, 1, OP *); *prelude_sentinel = NULL; - SAVEDESTRUCTOR_X(free_ptr_op, prelude_sentinel); + sentinel_register(sen, prelude_sentinel, free_ptr_op); /* parameters */ param_spec = NULL; @@ -780,11 +854,11 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len Newx(init_sentinel, 1, OP *); *init_sentinel = NULL; - SAVEDESTRUCTOR_X(free_ptr_op, init_sentinel); + sentinel_register(sen, init_sentinel, free_ptr_op); Newx(param_spec, 1, ParamSpec); ps_init(param_spec); - SAVEDESTRUCTOR_X(ps_free_void, param_spec); + sentinel_register(sen, param_spec, ps_free_void); lex_read_unichar(0); lex_read_space(0); @@ -795,7 +869,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len char sigil; PADOFFSET padoff; - padoff = parse_param(aTHX_ declarator, spec, param_spec, &flags, &name, init_sentinel); + padoff = parse_param(aTHX_ sen, declarator, spec, param_spec, &flags, &name, init_sentinel); S_intro_my(aTHX); @@ -924,10 +998,10 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len c = ':'; } else { lex_read_unichar(0); - if (!(proto = my_scan_parens_tail(aTHX_ FALSE))) { + if (!(proto = my_scan_parens_tail(aTHX_ sen, FALSE))) { croak("In %"SVf": prototype not terminated", SVfARG(declarator)); } - my_check_prototype(aTHX_ declarator, proto); + my_check_prototype(aTHX_ sen, declarator, proto); lex_read_space(0); c = lex_peek_unichar(0); if (!(c == ':' || c == '{')) { @@ -940,7 +1014,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* attributes */ Newx(attrs_sentinel, 1, OP *); *attrs_sentinel = NULL; - SAVEDESTRUCTOR_X(free_ptr_op, attrs_sentinel); + sentinel_register(sen, attrs_sentinel, free_ptr_op); if (c == ':' || c == '{') /* '}' - hi, vim */ { @@ -958,7 +1032,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len for (;;) { SV *attr; - if (!(attr = my_scan_word(aTHX_ FALSE))) { + if (!(attr = my_scan_word(aTHX_ sen, FALSE))) { break; } @@ -976,7 +1050,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len } else { SV *sv; lex_read_unichar(0); - if (!(sv = my_scan_parens_tail(aTHX_ TRUE))) { + if (!(sv = my_scan_parens_tail(aTHX_ sen, TRUE))) { croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator)); } sv_catpvs(attr, "("); @@ -1483,16 +1557,21 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) { KWSpec spec; int ret; + Sentinel sen = { NULL }; + ENTER; SAVETMPS; - if (kw_flags(aTHX_ keyword_ptr, keyword_len, &spec)) { - ret = parse_fun(aTHX_ op_ptr, keyword_ptr, keyword_len, &spec); + SAVEDESTRUCTOR_X(sentinel_clear_void, sen); + + if (kw_flags(aTHX_ sen, keyword_ptr, keyword_len, &spec)) { + ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec); } else { ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr); } FREETMPS; + LEAVE; return ret; } diff --git a/t/hueg.t b/t/hueg.t new file mode 100644 index 0000000..b754987 --- /dev/null +++ b/t/hueg.t @@ -0,0 +1,315 @@ +#!perl +use warnings FATAL => 'all'; +use strict; + +use Test::More tests => 1; + +use Function::Parameters; + +fun yes_this_is_an_unusually_long_function_name_wouldnt_you_agree_with_me_there ( + $the_first_parameter_is_the_only_one_I_really_care_about_and_gets_a_very_special_name, + $stupid_prefix_0, + $stupid_prefix_1, + $stupid_prefix_2, + $stupid_prefix_3, + $stupid_prefix_4, + $stupid_prefix_5, + $stupid_prefix_6, + $stupid_prefix_7, + $stupid_prefix_8, + $stupid_prefix_9, + $stupid_prefix_10, + $stupid_prefix_11, + $stupid_prefix_12, + $stupid_prefix_13, + $stupid_prefix_14, + $stupid_prefix_15, + $stupid_prefix_16, + $stupid_prefix_17, + $stupid_prefix_18, + $stupid_prefix_19, + $stupid_prefix_20, + $stupid_prefix_21, + $stupid_prefix_22, + $stupid_prefix_23, + $stupid_prefix_24, + $stupid_prefix_25, + $stupid_prefix_26, + $stupid_prefix_27, + $stupid_prefix_28, + $stupid_prefix_29, + $stupid_prefix_30, + $stupid_prefix_31, + $stupid_prefix_32, + $stupid_prefix_33, + $stupid_prefix_34, + $stupid_prefix_35, + $stupid_prefix_36, + $stupid_prefix_37, + $stupid_prefix_38, + $stupid_prefix_39, + $stupid_prefix_40, + $stupid_prefix_41, + $stupid_prefix_42, + $stupid_prefix_43, + $stupid_prefix_44, + $stupid_prefix_45, + $stupid_prefix_46, + $stupid_prefix_47, + $stupid_prefix_48, + $stupid_prefix_49, + $stupid_prefix_50, + $stupid_prefix_51, + $stupid_prefix_52, + $stupid_prefix_53, + $stupid_prefix_54, + $stupid_prefix_55, + $stupid_prefix_56, + $stupid_prefix_57, + $stupid_prefix_58, + $stupid_prefix_59, + $stupid_prefix_60, + $stupid_prefix_61, + $stupid_prefix_62, + $stupid_prefix_63, + $stupid_prefix_64, + $stupid_prefix_65, + $stupid_prefix_66, + $stupid_prefix_67, + $stupid_prefix_68, + $stupid_prefix_69, + $stupid_prefix_70, + $stupid_prefix_71, + $stupid_prefix_72, + $stupid_prefix_73, + $stupid_prefix_74, + $stupid_prefix_75, + $stupid_prefix_76, + $stupid_prefix_77, + $stupid_prefix_78, + $stupid_prefix_79, + $stupid_prefix_80, + $stupid_prefix_81, + $stupid_prefix_82, + $stupid_prefix_83, + $stupid_prefix_84, + $stupid_prefix_85, + $stupid_prefix_86, + $stupid_prefix_87, + $stupid_prefix_88, + $stupid_prefix_89, + $stupid_prefix_90, + $stupid_prefix_91, + $stupid_prefix_92, + $stupid_prefix_93, + $stupid_prefix_94, + $stupid_prefix_95, + $stupid_prefix_96, + $stupid_prefix_97, + $stupid_prefix_98, + $stupid_prefix_99, + $stupid_prefix_100, + $stupid_prefix_101, + $stupid_prefix_102, + $stupid_prefix_103, + $stupid_prefix_104, + $stupid_prefix_105, + $stupid_prefix_106, + $stupid_prefix_107, + $stupid_prefix_108, + $stupid_prefix_109, + $stupid_prefix_110, + $stupid_prefix_111, + $stupid_prefix_112, + $stupid_prefix_113, + $stupid_prefix_114, + $stupid_prefix_115, + $stupid_prefix_116, + $stupid_prefix_117, + $stupid_prefix_118, + $stupid_prefix_119, + $stupid_prefix_120, + $stupid_prefix_121, + $stupid_prefix_122, + $stupid_prefix_123, + $stupid_prefix_124, + $stupid_prefix_125, + $stupid_prefix_126, + $stupid_prefix_127, + $stupid_prefix_128, + $stupid_prefix_129, + $stupid_prefix_130, + $stupid_prefix_131, + $stupid_prefix_132, + $stupid_prefix_133, + $stupid_prefix_134, + $stupid_prefix_135, + $stupid_prefix_136, + $stupid_prefix_137, + $stupid_prefix_138, + $stupid_prefix_139, + $stupid_prefix_140, + $stupid_prefix_141, + $stupid_prefix_142, + $stupid_prefix_143, + $stupid_prefix_144, + $stupid_prefix_145, + $stupid_prefix_146, + $stupid_prefix_147, + $stupid_prefix_148, + $stupid_prefix_149, + $stupid_prefix_150, + $stupid_prefix_151, + $stupid_prefix_152, + $stupid_prefix_153, + $stupid_prefix_154, + $stupid_prefix_155, + $stupid_prefix_156, + $stupid_prefix_157, + $stupid_prefix_158, + $stupid_prefix_159, + $stupid_prefix_160, + $stupid_prefix_161, + $stupid_prefix_162, + $stupid_prefix_163, + $stupid_prefix_164, + $stupid_prefix_165, + $stupid_prefix_166, + $stupid_prefix_167, + $stupid_prefix_168, + $stupid_prefix_169, + $stupid_prefix_170, + $stupid_prefix_171, + $stupid_prefix_172, + $stupid_prefix_173, + $stupid_prefix_174, + $stupid_prefix_175, + $stupid_prefix_176, + $stupid_prefix_177, + $stupid_prefix_178, + $stupid_prefix_179, + $stupid_prefix_180, + $stupid_prefix_181, + $stupid_prefix_182, + $stupid_prefix_183, + $stupid_prefix_184, + $stupid_prefix_185, + $stupid_prefix_186, + $stupid_prefix_187, + $stupid_prefix_188, + $stupid_prefix_189, + $stupid_prefix_190, + $stupid_prefix_191, + $stupid_prefix_192, + $stupid_prefix_193, + $stupid_prefix_194, + $stupid_prefix_195, + $stupid_prefix_196, + $stupid_prefix_197, + $stupid_prefix_198, + $stupid_prefix_199, + $stupid_prefix_200, + $stupid_prefix_201, + $stupid_prefix_202, + $stupid_prefix_203, + $stupid_prefix_204, + $stupid_prefix_205, + $stupid_prefix_206, + $stupid_prefix_207, + $stupid_prefix_208, + $stupid_prefix_209, + $stupid_prefix_210, + $stupid_prefix_211, + $stupid_prefix_212, + $stupid_prefix_213, + $stupid_prefix_214, + $stupid_prefix_215, + $stupid_prefix_216, + $stupid_prefix_217, + $stupid_prefix_218, + $stupid_prefix_219, + $stupid_prefix_220, + $stupid_prefix_221, + $stupid_prefix_222, + $stupid_prefix_223, + $stupid_prefix_224, + $stupid_prefix_225, + $stupid_prefix_226, + $stupid_prefix_227, + $stupid_prefix_228, + $stupid_prefix_229, + $stupid_prefix_230, + $stupid_prefix_231, + $stupid_prefix_232, + $stupid_prefix_233, + $stupid_prefix_234, + $stupid_prefix_235, + $stupid_prefix_236, + $stupid_prefix_237, + $stupid_prefix_238, + $stupid_prefix_239, + $stupid_prefix_240, + $stupid_prefix_241, + $stupid_prefix_242, + $stupid_prefix_243, + $stupid_prefix_244, + $stupid_prefix_245, + $stupid_prefix_246, + $stupid_prefix_247, + $stupid_prefix_248, + $stupid_prefix_249, + $stupid_prefix_250, + $stupid_prefix_251, + $stupid_prefix_252, + $stupid_prefix_253, + $stupid_prefix_254, + $stupid_prefix_255, + $stupid_prefix_256, + $stupid_prefix_257, + $stupid_prefix_258, + $stupid_prefix_259, + $stupid_prefix_260, + $stupid_prefix_261, + $stupid_prefix_262, + $stupid_prefix_263, + $stupid_prefix_264, + $stupid_prefix_265, + $stupid_prefix_266, + $stupid_prefix_267, + $stupid_prefix_268, + $stupid_prefix_269, + $stupid_prefix_270, + $stupid_prefix_271, + $stupid_prefix_272, + $stupid_prefix_273, + $stupid_prefix_274, + $stupid_prefix_275, + $stupid_prefix_276, + $stupid_prefix_277, + $stupid_prefix_278, + $stupid_prefix_279, + $stupid_prefix_280, + $stupid_prefix_281, + $stupid_prefix_282, + $stupid_prefix_283, + $stupid_prefix_284, + $stupid_prefix_285, + $stupid_prefix_286, + $stupid_prefix_287, + $stupid_prefix_288, + $stupid_prefix_289, + $stupid_prefix_290, + $stupid_prefix_291, + $stupid_prefix_292, + $stupid_prefix_293, + $stupid_prefix_294, + $stupid_prefix_295, + $stupid_prefix_296, + $stupid_prefix_297, + $stupid_prefix_298, + $stupid_prefix_299, +) { + $the_first_parameter_is_the_only_one_I_really_care_about_and_gets_a_very_special_name +} + +is yes_this_is_an_unusually_long_function_name_wouldnt_you_agree_with_me_there("all is well"), "all is well";