From f4277ae783ded09d914930f7771ae8fdfeca0a2f Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Sat, 10 Oct 2026 13:19:21 +0200 Subject: [PATCH] doc-links(perl): POD L<> codes become MENTIONS edges, held until their audit A sub's POD section and the module's own POD (the File node's doc) name code with L<> codes: L, L, L, with a `text|` prefix or not. doclink_perl.c reads them the way perlpodspec and Pod::Simple do (verbatim paragraphs and data regions hold none, an L inside an L is no link, a URL is the core's href family) and writes each file's scope: its packages, its subs and its headings. Lines are exact: a sub's doc is matched against the file's sections, and the module doc's runs (extract_defs.c) are found again in the source in order; a module doc is POD from its start, so a run that begins with text is read too. doc_links_perl.c resolves them: - a module is the file that declares its package; of several, the one the library layout names (.../Name/Space.pm), else ambiguous. The target is the file's File node, as the field test's audited prototype has it (a Module node is missing where a same-named Folder holds its qualified name, lib/Mojo.pm next to lib/Mojo/). - L: the sub its heading names when the module's file defines that sub; any other section is a place in the module's documentation, the module. - L: a sub the heading names; a heading that names no sub is the page itself (local, neither edge nor row); a section the page has no heading for is missing. - a module the repository does not declare (CPAN, the core, a .pod page: discovery keeps no .pod file) and a man page are external; test code (t/, xt/, *.t, and cbm_is_test_file, which has no Perl rule) binds only from test code. There is no scope_delta hook yet: a change to a file's packages, subs or headings re-resolves every Perl reference. The family is held (ships=false) until its held-out audit passes; the suite ships it through the test seam. Tests (doc_mentions_perl): tokens with their lines, file-level and sub-level, each read once; every resolution rule; incremental equals full (a module doc edit and an added module-level reference repair the file, a heading change is a full run); 60 modules give the same edges and rows with one worker and several. Each rule red with it reverted (the module doc's line mapping, a module run read from its start, the missing section, the library layout). Mojolicious at 93f591742a7d (the family shipped, a measurement build) against the field test's prototype records of its .pm/.pl files: 950 (source, target) pairs both have; the 197 only the prototype has are all references within one file (570), which the core makes no edge of; 8 only here come from the extensionless scripts the prototype did not read. Every prototype row has its row here: external 102, missing 1, and the 172 targets in .pod pages external by the ruling for .pod pages. Signed-off-by: Martin Vogel --- Makefile.cbm | 4 +- internal/cbm/doclink.c | 6 + internal/cbm/doclink.h | 44 + internal/cbm/doclink_perl.c | 1677 +++++++++++++++++++++++++++++ src/pipeline/doc_links.c | 2 +- src/pipeline/doc_links.h | 1 + src/pipeline/doc_links_perl.c | 489 +++++++++ tests/test_doc_mentions_helpers.h | 2 +- tests/test_doc_mentions_perl.c | 292 +++++ tests/test_main.c | 2 + 10 files changed, 2516 insertions(+), 3 deletions(-) create mode 100644 internal/cbm/doclink_perl.c create mode 100644 src/pipeline/doc_links_perl.c create mode 100644 tests/test_doc_mentions_perl.c diff --git a/Makefile.cbm b/Makefile.cbm index 43999c35c..b8aa4f71e 100644 --- a/Makefile.cbm +++ b/Makefile.cbm @@ -389,6 +389,7 @@ EXTRACTION_SRCS = \ $(CBM_DIR)/doclink_go.c \ $(CBM_DIR)/doclink_jvm.c \ $(CBM_DIR)/doclink_rs.c \ + $(CBM_DIR)/doclink_perl.c \ $(CBM_DIR)/sql_values.c \ $(CBM_DIR)/helpers.c \ $(CBM_DIR)/cpp_branch_views.c \ @@ -518,6 +519,7 @@ PIPELINE_SRCS = \ src/pipeline/doc_links_go.c \ src/pipeline/doc_links_jvm.c \ src/pipeline/doc_links_rs.c \ + src/pipeline/doc_links_perl.c \ src/pipeline/doc_links_msbuild.c \ src/pipeline/pass_route_nodes.c \ src/pipeline/pass_enrichment.c \ @@ -780,7 +782,7 @@ TEST_DISCOVER_SRCS = \ TEST_GRAPH_BUFFER_SRCS = tests/test_graph_buffer.c -TEST_PIPELINE_SRCS = tests/test_registry.c tests/test_pipeline.c tests/test_pipeline_conventions.c tests/test_pipeline_frozen.c tests/test_importance.c tests/test_cross_repo.c tests/test_fqn.c tests/test_route_canon.c tests/test_path_alias.c tests/test_configlink.c tests/test_doclinks.c tests/test_doc_mentions.c tests/test_doc_links_md.c tests/test_doc_links_pdf.c tests/test_doc_links_rst.c tests/test_doc_links_adoc.c tests/test_doc_mentions_go.c tests/test_doc_mentions_jvm.c tests/test_doc_mentions_rs.c tests/test_infrascan.c tests/test_worker_pool.c tests/test_parallel.c tests/test_index_resilience.c tests/test_index_format.c tests/test_call_reference_contract.c tests/repro/repro_call_scope_usages.c tests/repro/repro_call_argument_usages.c tests/repro/repro_reference_precision.c tests/repro/repro_lexical_binding_precision.c tests/repro/repro_call_argument_matrix_a.c tests/repro/repro_call_argument_matrix_b.c tests/repro/repro_call_node_behaviors.c tests/repro/repro_language_registry.c tests/repro/repro_call_node_manifest.c tests/repro/repro_lsp_ordered_signatures.c tests/repro/repro_lsp_ordered_local.c tests/repro/repro_ts_overload_return_chains.c tests/repro/repro_harness_cleanup.c tests/repro/repro_runner_filter.c +TEST_PIPELINE_SRCS = tests/test_registry.c tests/test_pipeline.c tests/test_pipeline_conventions.c tests/test_pipeline_frozen.c tests/test_importance.c tests/test_cross_repo.c tests/test_fqn.c tests/test_route_canon.c tests/test_path_alias.c tests/test_configlink.c tests/test_doclinks.c tests/test_doc_mentions.c tests/test_doc_links_md.c tests/test_doc_links_pdf.c tests/test_doc_links_rst.c tests/test_doc_links_adoc.c tests/test_doc_mentions_go.c tests/test_doc_mentions_jvm.c tests/test_doc_mentions_rs.c tests/test_doc_mentions_perl.c tests/test_infrascan.c tests/test_worker_pool.c tests/test_parallel.c tests/test_index_resilience.c tests/test_index_format.c tests/test_call_reference_contract.c tests/repro/repro_call_scope_usages.c tests/repro/repro_call_argument_usages.c tests/repro/repro_reference_precision.c tests/repro/repro_lexical_binding_precision.c tests/repro/repro_call_argument_matrix_a.c tests/repro/repro_call_argument_matrix_b.c tests/repro/repro_call_node_behaviors.c tests/repro/repro_language_registry.c tests/repro/repro_call_node_manifest.c tests/repro/repro_lsp_ordered_signatures.c tests/repro/repro_lsp_ordered_local.c tests/repro/repro_ts_overload_return_chains.c tests/repro/repro_harness_cleanup.c tests/repro/repro_runner_filter.c TEST_WATCHER_SRCS = tests/test_watcher.c diff --git a/internal/cbm/doclink.c b/internal/cbm/doclink.c index 92892d6e3..4957e5489 100644 --- a/internal/cbm/doclink.c +++ b/internal/cbm/doclink.c @@ -211,6 +211,12 @@ static const doclink_lang_t DOCLINK_LANGS[] = { .scan_scope = cbm_doclink_rs_manifest_scan_scope, .scope_tag = CBM_DOCLINK_RS_SCOPE_TAG, .portable_scope = cbm_doclink_rs_portable_scope}, + /* Perl: POD L<> codes; the scope blob carries no lines, so it persists as + * it is */ + {.lang = CBM_LANG_PERL, + .parse_doc = cbm_doclink_perl_parse_doc, + .scan_scope = cbm_doclink_perl_scan_scope, + .scope_tag = CBM_DOCLINK_PERL_SCOPE_TAG}, }; static const doclink_lang_t *doclink_lang(CBMLanguage lang) { diff --git a/internal/cbm/doclink.h b/internal/cbm/doclink.h index 4a5127437..479d104ff 100644 --- a/internal/cbm/doclink.h +++ b/internal/cbm/doclink.h @@ -98,6 +98,8 @@ /* rust (doclink_rs.c): intra-doc links; held until their audit passes */ \ X(CBM_DOCLINK_RS_INTRA_DOC, CBM_LANG_RUST, "intra_doc", false, false, "MENTIONS") \ X(CBM_DOCLINK_RS_LINK_DEF, CBM_LANG_RUST, "link_def", false, false, "MENTIONS") \ + /* perl (doclink_perl.c): POD L<> codes; held until their audit passes */ \ + X(CBM_DOCLINK_PERL_POD_L, CBM_LANG_PERL, "pod_L", false, false, "MENTIONS") \ /* markdown (doclink_md.c): what a document's text names explicitly */ \ X(CBM_DOCLINK_MD_LINK, CBM_LANG_MARKDOWN, "link", false, true, "MENTIONS") \ X(CBM_DOCLINK_MD_PATH, CBM_LANG_MARKDOWN, "path", false, true, "MENTIONS") \ @@ -535,5 +537,47 @@ typedef enum { * are read. */ CBMDocLinkRsPathStatus cbm_doclink_rs_parse_path(const char *raw, size_t len, bool lenient, CBMDocLinkRsPath *out); +/* ── Perl POD (doclink_perl.c) ─────────────────────────────────────── */ + +void cbm_doclink_perl_parse_doc(CBMExtractCtx *ctx, const CBMDefinition *def, const char *doc, + uint32_t doc_line); +const char *cbm_doclink_perl_scan_scope(CBMExtractCtx *ctx); + +/* The Perl scope blob starts with this tag line. */ +#define CBM_DOCLINK_PERL_SCOPE_TAG "perl1" + +enum { + /* Longest L<> content kept as a token's raw text; a longer one is cut and + * marked malformed (its raw text then starts with `L<`). */ + CBM_DOCLINK_PERL_RAW_MAX = 512, + /* Buffer for a page name, a section text or a heading key. */ + CBM_DOCLINK_PERL_KEY_MAX = 256, +}; + +/* A POD text as it renders: formatting codes replaced by their content + * (X<> and Z<> by nothing, E<> by its character), white-space runs as one + * space, none at the ends. Headings and the section part of a link are + * compared in this form. Writes a NUL-terminated string into `out` (cut at + * cap - 1, never inside a UTF-8 character) and returns its length. */ +size_t cbm_doclink_perl_plain_text(const char *in, size_t len, char *out, size_t cap); + +typedef enum { + CBM_PERL_LINK_UNPARSEABLE = 0, /* malformed, nested L<>, or no page name */ + CBM_PERL_LINK_PAGE, /* L or L */ + CBM_PERL_LINK_SECTION, /* L, L<"section">: the same page */ + CBM_PERL_LINK_MAN, /* L: a man page */ +} CBMPerlLinkKind; + +/* One pod_L token's raw text, split the way perlpodspec splits it. */ +typedef struct { + CBMPerlLinkKind kind; + char page[CBM_DOCLINK_PERL_KEY_MAX]; /* "" for a section of the same page */ + char section[CBM_DOCLINK_PERL_KEY_MAX]; /* "" when only a page is named */ +} CBMPerlLink; + +/* Split a pod_L token's raw text: the first top-level `|` ends the link text, + * the first top-level `/` after it separates page and section, quotes around + * a section are dropped. False (kind UNPARSEABLE) for anything else. */ +bool cbm_doclink_perl_parse_link(const char *raw, CBMPerlLink *out); #endif /* CBM_DOCLINK_H */ diff --git a/internal/cbm/doclink_perl.c b/internal/cbm/doclink_perl.c new file mode 100644 index 000000000..42bdb72de --- /dev/null +++ b/internal/cbm/doclink_perl.c @@ -0,0 +1,1677 @@ +/* + * doclink_perl.c — Perl POD `L<>` references and the Perl doc-link scope. + * + * Tokens. A sub's stored doc is every POD section whose =headN / =item heading + * names it (extract_defs.c), verbatim and joined by a blank line. Its L<> + * formatting codes are the references, read the way perlpodspec and + * Pod::Simple read them: + * - a paragraph is a run of non-blank lines. Codes are looked for in ordinary + * paragraphs and in the text of =headN and =item. A verbatim paragraph + * (first byte a space or tab), a =for paragraph and a =begin .. =end + * region of a format without a leading colon are data and hold no code; + * - a code is a capital letter and `<`. `X<< text >>` (two or more brackets + * and whitespace) ends at whitespace and as many `>`. Codes nest; an L + * inside an L is not a link (perlpodspec: links must not nest); + * - an L<> whose target (what follows `text|`) matches `\w+:[^:\s]\S*` is a + * URL: the core's href family. Every other one is a pod_L token whose raw + * text is the code's content as written, white space squeezed. A code the + * paragraph ends before, and one longer than CBM_DOCLINK_PERL_RAW_MAX, + * keeps its opening `L<` in the raw text: nothing parses that, so the + * resolver records it as unparseable. + * A doc that does not start with a POD command is a `#` comment and has no + * formatting codes at all. + * + * Lines. The stored doc carries no position, and several sections can be + * joined in it, so every section of the file is found again here (the same + * paragraph, command and section rules as extract_defs.c) and the doc is + * matched against them byte for byte: a reference then gets the source line it + * is written on. A part of a doc that matches no section keeps the line the + * core passed (the definition's). That needs the file's sections once per + * file, and parse_doc is called per definition: the call for the file's first + * documented definition harvests the whole file, the later ones return. + * + * Scope blob (one record per line, tab-separated, first line "perl1"; no line + * numbers, so it is persisted as it is): + * E the tree has a parse error: which package a sub belongs to + * is not trusted + * P name a package, class or role the file declares; document + * order, each name once + * S pkg name a sub that has a definition, in definition order; pkg is + * the 0-based index of its P record, `-` before any package + * (main), `?` when it could not be placed + * H sub key a POD heading (=headN / =item): `key` is its text with + * formatting codes reduced to what they render + * (cbm_doclink_perl_plain_text) and an item's bullet + * dropped; `sub` is the identifier the heading names by + * extract_defs.c's rule, `-` when it names none + * Packages and the placement of subs come from the tree; the subs themselves + * from the file's definitions (so a sub listed here has a node); the headings + * from a line scan of the file, which is what perldoc reads. + */ +#include "doclink.h" + +#include "arena.h" +#include "foundation/constants.h" +#include "tree_sitter/api.h" + +#include +#include +#include +#include + +enum { + PL_CODE_DEPTH = 32, /* open formatting codes; deeper nesting is malformed */ + PL_INIT_CAP = 32, + PL_SB_INIT = 1024, + PL_ENT_MAX = 12, /* longest E<> body that is decoded */ + PL_MALFORMED = 2, /* strlen("L<"): what a malformed code's raw text starts with */ + PL_UTF8_CONT = 0x80, /* 10xxxxxx */ + PL_UTF8_CONT_MASK = 0xC0, + PL_UTF8_LEAD2 = 0xC0, + PL_UTF8_LEAD3 = 0xE0, + PL_UTF8_LEAD4 = 0xF0, + PL_UTF8_LEAD_END = 0xF8, + PL_ASCII_DEL = 0x7F, + PL_HEAD_WORD = 5, /* strlen("headN") */ + PL_NAME_MAX = 255, +}; + +/* ── Characters ──────────────────────────────────────────────────── */ + +static bool pl_blank(char c) { + return c == ' ' || c == '\t' || c == '\r'; +} + +static bool pl_space(char c) { + return c == ' ' || c == '\t' || c == '\r' || c == '\n' || c == '\f' || c == '\v'; +} + +static bool pl_word(char c) { + return isalnum((unsigned char)c) || c == '_'; +} + +static bool pl_upper(char c) { + return c >= 'A' && c <= 'Z'; +} + +/* A control byte that is not white space: never copied into a blob record or + * a raw text (a NUL would end either). */ +static bool pl_control(char c) { + unsigned char u = (unsigned char)c; + return (u < ' ' && !pl_space(c)) || u == PL_ASCII_DEL; +} + +static CBMArena *pl_scratch(CBMExtractCtx *ctx) { + return ctx->scratch ? ctx->scratch : ctx->arena; +} + +/* ── Paragraphs ──────────────────────────────────────────────────── */ + +/* Next paragraph (a maximal run of non-blank lines) of s[*pos, end): [*pb, + * *pe). The same rule as extract_defs.c's pod_next_para. */ +static bool pl_next_para(const char *s, size_t *pos, size_t end, size_t *pb, size_t *pe) { + size_t i = *pos; + bool in = false; + size_t start = 0; + while (i < end) { + const char *nl = (const char *)memchr(s + i, '\n', end - i); + size_t le = nl ? (size_t)(nl - s) : end; + bool blank = true; + for (size_t k = i; k < le && blank; k++) { + blank = pl_blank(s[k]); + } + if (!blank && !in) { + in = true; + start = i; + } + if (blank && in) { + *pb = start; + *pe = i; + *pos = i; + return true; + } + i = le < end ? le + SKIP_ONE : end; + } + *pos = end; + if (in) { + *pb = start; + *pe = end; + } + return in; +} + +/* True when the paragraph s[pb, pe) is a command (`=` and a letter). */ +static bool pl_is_command(const char *s, size_t pb, size_t pe) { + return pb + SKIP_ONE < pe && s[pb] == '=' && isalpha((unsigned char)s[pb + SKIP_ONE]); +} + +/* End of the command word that follows the `=` at s[pb]. */ +static size_t pl_command_word_end(const char *s, size_t pb, size_t pe) { + size_t wb = pb + SKIP_ONE; + while (wb < pe && pl_word(s[wb])) { + wb++; + } + return wb; +} + +static bool pl_word_is(const char *w, size_t n, const char *lit) { + return n == strlen(lit) && memcmp(w, lit, n) == 0; +} + +/* `headN`: the level, 0 for another word. */ +static int pl_head_level(const char *w, size_t n) { + static const char head[] = "head"; + size_t hl = sizeof(head) - SKIP_ONE; + if (n != PL_HEAD_WORD || memcmp(w, head, hl) != 0 || !isdigit((unsigned char)w[hl])) { + return 0; + } + return w[hl] - '0'; +} + +/* ── Formatting codes ────────────────────────────────────────────── */ + +typedef struct { + uint8_t width[PL_CODE_DEPTH]; /* brackets of each open code: 1 simple, more complex */ + int depth; + bool overflow; /* nested deeper than PL_CODE_DEPTH */ +} pl_codes_t; + +enum { PL_EV_TEXT = 0, PL_EV_OPEN, PL_EV_CLOSE }; + +/* A code opens at t[i]: push it and return where its content starts. */ +static size_t pl_code_open(pl_codes_t *st, const char *t, size_t i, size_t e, bool *pushed) { + size_t j = i + SKIP_ONE; + while (j < e && t[j] == '<') { + j++; + } + size_t brackets = j - i - SKIP_ONE; + size_t content = i + PAIR_LEN; + size_t width = SKIP_ONE; + if (brackets >= PAIR_LEN && j < e && pl_space(t[j])) { + while (j < e && pl_space(t[j])) { + j++; + } + content = j; + width = brackets > UINT8_MAX ? UINT8_MAX : brackets; + } + *pushed = st->depth < PL_CODE_DEPTH; + if (*pushed) { + st->width[st->depth++] = (uint8_t)width; + } else { + st->overflow = true; + } + return content; +} + +/* One lexing step at t[i], i < e (Pod::Simple's treelet tokens). + * PL_EV_OPEN a code opened at t[i]; its content starts at *next + * PL_EV_CLOSE the innermost code's content ended at i; *next follows its + * closing brackets + * PL_EV_TEXT t[i, *next) is literal */ +static int pl_code_step(pl_codes_t *st, const char *t, size_t i, size_t e, size_t *next) { + char c = t[i]; + if (pl_upper(c) && i + SKIP_ONE < e && t[i + SKIP_ONE] == '<') { + bool pushed = false; + *next = pl_code_open(st, t, i, e, &pushed); + return pushed ? PL_EV_OPEN : PL_EV_TEXT; + } + size_t need = st->depth > 0 ? st->width[st->depth - SKIP_ONE] : 0; + if (need == SKIP_ONE && c == '>') { + st->depth--; + *next = i + SKIP_ONE; + return PL_EV_CLOSE; + } + if (need > SKIP_ONE && pl_space(c)) { + size_t k = i; + while (k < e && pl_space(t[k])) { + k++; + } + size_t m = k; + while (m < e && t[m] == '>') { + m++; + } + if (m - k >= need) { + st->depth--; + *next = k + need; + return PL_EV_CLOSE; + } + *next = m; /* white space and too few brackets: literal */ + return PL_EV_TEXT; + } + *next = i + SKIP_ONE; + return PL_EV_TEXT; +} + +/* ── Bounded text output ─────────────────────────────────────────── */ + +typedef struct { + char *buf; + size_t cap; /* bytes of text that fit (the buffer holds one more) */ + size_t len; + bool space; /* a white-space run is pending */ + bool cut; /* something did not fit */ +} pl_out_t; + +/* Bytes of the UTF-8 character that `lead` starts; 1 for anything else. */ +static size_t pl_utf8_len(unsigned char lead) { + if (lead >= PL_UTF8_LEAD4 && lead < PL_UTF8_LEAD_END) { + return 4; + } + if (lead >= PL_UTF8_LEAD3 && lead < PL_UTF8_LEAD4) { + return 3; + } + if (lead >= PL_UTF8_LEAD2 && lead < PL_UTF8_LEAD3) { + return PAIR_LEN; + } + return SKIP_ONE; +} + +/* Append t[0, n): white-space runs become one space (none at the start), + * control bytes are dropped, and a character that does not fit whole ends + * the output. */ +static void pl_out_text(pl_out_t *o, const char *t, size_t n) { + for (size_t i = 0; i < n && !o->cut; i++) { + char c = t[i]; + if (pl_space(c)) { + o->space = o->len > 0; + continue; + } + if (pl_control(c)) { + continue; + } + size_t need = pl_utf8_len((unsigned char)c) + (o->space ? SKIP_ONE : 0); + if (o->len + need > o->cap) { + o->cut = true; + return; + } + if (o->space) { + o->buf[o->len++] = ' '; + o->space = false; + } + o->buf[o->len++] = c; + } +} + +static void pl_out_end(pl_out_t *o) { + o->buf[o->len] = '\0'; +} + +/* t[b, e) squeezed into out (cap + 1 bytes); *cut when it did not fit. */ +static size_t pl_squeeze(const char *t, size_t b, size_t e, char *out, size_t cap, bool *cut) { + pl_out_t o = {.buf = out, .cap = cap}; + pl_out_text(&o, t + b, e - b); + pl_out_end(&o); + *cut = o.cut; + return o.len; +} + +/* ── Plain text ──────────────────────────────────────────────────── */ + +/* Append the UTF-8 form of `cp`; false for what is no character. */ +static bool pl_out_codepoint(pl_out_t *o, unsigned long cp) { + enum { + CP_1 = 0x80, + CP_2 = 0x800, + CP_3 = 0x10000, + CP_MAX = 0x10FFFF, + CP_SURR_LO = 0xD800, + CP_SURR_HI = 0xDFFF, + SHIFT = 6, + LOW = 0x3F, + }; + if (cp == 0 || cp > CP_MAX || (cp >= CP_SURR_LO && cp <= CP_SURR_HI)) { + return false; + } + char u[4]; + size_t n = 0; + if (cp < CP_1) { + u[n++] = (char)cp; + } else if (cp < CP_2) { + u[n++] = (char)(PL_UTF8_LEAD2 | (cp >> SHIFT)); + u[n++] = (char)(PL_UTF8_CONT | (cp & LOW)); + } else if (cp < CP_3) { + u[n++] = (char)(PL_UTF8_LEAD3 | (cp >> (SHIFT + SHIFT))); + u[n++] = (char)(PL_UTF8_CONT | ((cp >> SHIFT) & LOW)); + u[n++] = (char)(PL_UTF8_CONT | (cp & LOW)); + } else { + u[n++] = (char)(PL_UTF8_LEAD4 | (cp >> (SHIFT + SHIFT + SHIFT))); + u[n++] = (char)(PL_UTF8_CONT | ((cp >> (SHIFT + SHIFT)) & LOW)); + u[n++] = (char)(PL_UTF8_CONT | ((cp >> SHIFT) & LOW)); + u[n++] = (char)(PL_UTF8_CONT | (cp & LOW)); + } + pl_out_text(o, u, n); + return true; +} + +/* The number an E<> body writes (decimal, 0x hex, 0 octal); false for a name. */ +static bool pl_entity_number(const char *e, size_t n, unsigned long *cp) { + enum { DEC = 10, HEX = 16, OCT = 8 }; + int base = DEC; + size_t i = 0; + if (n > PAIR_LEN && e[0] == '0' && (e[1] == 'x' || e[1] == 'X')) { + base = HEX; + i = PAIR_LEN; + } else if (n > SKIP_ONE && e[0] == '0') { + base = OCT; + i = SKIP_ONE; + } + unsigned long v = 0; + for (; i < n; i++) { + int d = isdigit((unsigned char)e[i]) ? e[i] - '0' + : isxdigit((unsigned char)e[i]) ? tolower((unsigned char)e[i]) - 'a' + DEC + : base; + if (d >= base) { + return false; + } + v = (v * (unsigned long)base) + (unsigned long)d; + } + *cp = v; + return n > 0; +} + +/* Append what E renders; an unknown body stays as written. */ +static void pl_out_entity(pl_out_t *o, const char *body, size_t n, bool closed) { + static const struct { + const char *name; + char ch; + } ents[] = {{"lt", '<'}, {"gt", '>'}, {"verbar", '|'}, + {"sol", '/'}, {"quot", '"'}, {"amp", '&'}}; + for (size_t i = 0; closed && i < sizeof(ents) / sizeof(ents[0]); i++) { + if (pl_word_is(body, n, ents[i].name)) { + pl_out_text(o, &ents[i].ch, SKIP_ONE); + return; + } + } + unsigned long cp = 0; + if (closed && pl_entity_number(body, n, &cp) && pl_out_codepoint(o, cp)) { + return; + } + pl_out_text(o, "E<", PL_MALFORMED); + pl_out_text(o, body, n); + if (closed) { + pl_out_text(o, ">", SKIP_ONE); + } +} + +size_t cbm_doclink_perl_plain_text(const char *in, size_t len, char *out, size_t cap) { + if (!out || cap == 0) { + return 0; + } + pl_out_t o = {.buf = out, .cap = cap - SKIP_ONE}; + pl_codes_t st = {.depth = 0}; + int drop_depth = 0; /* an X<> or Z<> is open at this depth: no text */ + int ent_depth = 0; /* an E<> is open at this depth */ + char ent[PL_ENT_MAX]; + size_t ent_len = 0; + size_t i = 0; + while (in && i < len && !st.overflow) { + size_t next = i; + int ev = pl_code_step(&st, in, i, len, &next); + if (ev == PL_EV_OPEN && drop_depth == 0 && ent_depth == 0) { + if (in[i] == 'X' || in[i] == 'Z') { + drop_depth = st.depth; + } else if (in[i] == 'E') { + ent_depth = st.depth; + ent_len = 0; + } + } else if (ev == PL_EV_CLOSE && drop_depth != 0) { + drop_depth = st.depth < drop_depth ? 0 : drop_depth; + } else if (ev == PL_EV_CLOSE && ent_depth != 0 && st.depth < ent_depth) { + pl_out_entity(&o, ent, ent_len, true); + ent_depth = 0; + } else if (ev == PL_EV_TEXT && drop_depth == 0 && ent_depth == 0) { + pl_out_text(&o, in + i, next - i); + } else if (ev == PL_EV_TEXT && drop_depth == 0) { + for (size_t k = i; k < next && ent_len < sizeof(ent); k++) { + ent[ent_len++] = in[k]; + } + } + i = next; + } + if (ent_depth != 0) { + pl_out_entity(&o, ent, ent_len, false); + } + if (in && i < len) { + pl_out_text(&o, in + i, len - i); /* nested too deep: the rest as written */ + } + pl_out_end(&o); + return o.len; +} + +/* ── Link grammar (perlpodspec; Pod::Simple's _treat_Ls) ─────────── */ + +typedef struct { + size_t bar; /* first top-level `|`; SIZE_MAX: none */ + size_t slash; /* first top-level `/` after it; SIZE_MAX: none */ + bool space; /* a top-level space in a link that has no `|` */ + bool well_formed; /* every code closes, none nests too deep, no L inside */ +} pl_shape_t; + +/* Where the top-level `|` and `/` of a link's content are. */ +static pl_shape_t pl_link_shape(const char *t, size_t n) { + pl_shape_t sh = {.bar = SIZE_MAX, .slash = SIZE_MAX, .well_formed = true}; + pl_codes_t st = {.depth = 0}; + size_t i = 0; + while (i < n && sh.well_formed) { + size_t next = i; + int ev = pl_code_step(&st, t, i, n, &next); + sh.well_formed = !st.overflow && !(ev == PL_EV_OPEN && t[i] == 'L'); + for (size_t k = i; ev == PL_EV_TEXT && st.depth == 0 && k < next; k++) { + if (t[k] == '|' && sh.bar == SIZE_MAX) { + sh.bar = k; + sh.slash = SIZE_MAX; /* the name and section follow the text */ + } else if (t[k] == '/' && sh.slash == SIZE_MAX) { + sh.slash = k; + } else if (t[k] == ' ' && sh.bar == SIZE_MAX) { + sh.space = true; + } + } + i = next; + } + sh.well_formed = sh.well_formed && st.depth == 0; + return sh; +} + +/* perlpodspec: a link whose target matches \A\w+:[^:\s]\S*\z is a URL. */ +static bool pl_is_url(const char *t, size_t n) { + size_t i = 0; + while (i < n && pl_word(t[i])) { + i++; + } + if (i == 0 || i + SKIP_ONE >= n || t[i] != ':' || t[i + SKIP_ONE] == ':') { + return false; + } + for (size_t k = i + SKIP_ONE; k < n; k++) { + if (pl_space(t[k])) { + return false; + } + } + return true; +} + +/* The start of t[b, e) after its leading spaces. */ +static size_t pl_lead_spaces_end(const char *t, size_t b, size_t e) { + while (b < e && t[b] == ' ') { + b++; + } + return b; +} + +/* The end of t[b, e) before its trailing spaces. */ +static size_t pl_trail_spaces_start(const char *t, size_t b, size_t e) { + while (e > b && t[e - SKIP_ONE] == ' ') { + e--; + } + return e; +} + +/* Trim t[*b, *e) and drop one pair of surrounding double quotes. */ +static void pl_trim(const char *t, size_t *b, size_t *e, bool *quoted) { + size_t lo = pl_lead_spaces_end(t, *b, *e); + size_t hi = pl_trail_spaces_start(t, lo, *e); + *quoted = hi - lo >= PAIR_LEN && t[lo] == '"' && t[hi - SKIP_ONE] == '"'; + *b = *quoted ? lo + SKIP_ONE : lo; + *e = *quoted ? hi - SKIP_ONE : hi; +} + +/* `name(3)`: a man page. */ +static bool pl_is_man_page(const char *p) { + size_t n = strlen(p); + if (n < 4 || p[n - SKIP_ONE] != ')') { + return false; + } + size_t open = n - SKIP_ONE; + while (open > 0 && p[open] != '(') { + open--; + } + if (open == 0 || open + SKIP_ONE == n - SKIP_ONE) { + return false; + } + for (size_t k = open + SKIP_ONE; k < n - SKIP_ONE; k++) { + if (!isalnum((unsigned char)p[k]) && p[k] != '-') { + return false; + } + } + return memchr(p, '/', open) == NULL; +} + +/* `Ident(::Ident)*`: a module name. */ +static bool pl_is_module_name(const char *p) { + if (!(isalpha((unsigned char)p[0]) || p[0] == '_')) { + return false; + } + for (size_t i = 0; p[i]; i++) { + if (pl_word(p[i])) { + continue; + } + if (p[i] != ':' || p[i + SKIP_ONE] != ':' || !pl_word(p[i + PAIR_LEN])) { + return false; + } + i++; + } + return true; +} + +bool cbm_doclink_perl_parse_link(const char *raw, CBMPerlLink *out) { + if (!out) { + return false; + } + memset(out, 0, sizeof(*out)); + out->kind = CBM_PERL_LINK_UNPARSEABLE; + size_t n = raw ? strlen(raw) : 0; + if (n == 0 || n > CBM_DOCLINK_PERL_RAW_MAX || (raw[0] == 'L' && raw[1] == '<')) { + return false; /* empty, or kept as written because it is malformed */ + } + pl_shape_t sh = pl_link_shape(raw, n); + if (!sh.well_formed) { + return false; + } + size_t nb = sh.bar == SIZE_MAX ? 0 : sh.bar + SKIP_ONE; + size_t ne = sh.slash == SIZE_MAX ? n : sh.slash; + size_t sb = sh.slash == SIZE_MAX ? n : sh.slash + SKIP_ONE; + size_t se = n; + bool name_quoted = false; + bool sec_quoted = false; + pl_trim(raw, &nb, &ne, &name_quoted); + pl_trim(raw, &sb, &se, &sec_quoted); + bool section_only = sh.slash == SIZE_MAX && (name_quoted || sh.space); + if (section_only) { /* L<"sec"> and the old L name a section */ + sb = nb; + se = ne; + ne = nb; + } else if (name_quoted) { + nb--; /* the quotes of a page name are part of it */ + ne++; + } + cbm_doclink_perl_plain_text(raw + nb, ne - nb, out->page, sizeof(out->page)); + cbm_doclink_perl_plain_text(raw + sb, se - sb, out->section, sizeof(out->section)); + if (!out->page[0]) { + out->kind = out->section[0] ? CBM_PERL_LINK_SECTION : CBM_PERL_LINK_UNPARSEABLE; + } else if (pl_is_man_page(out->page)) { + out->kind = CBM_PERL_LINK_MAN; + } else if (pl_is_module_name(out->page)) { + out->kind = CBM_PERL_LINK_PAGE; + } + return out->kind != CBM_PERL_LINK_UNPARSEABLE; +} + +/* ── Tokens ──────────────────────────────────────────────────────── */ + +typedef struct { + CBMExtractCtx *ctx; + const CBMDefinition *def; + const char *text; /* what is being read: the file, or a doc of unknown position */ + size_t line_pos; /* lines are counted from here ... */ + uint32_t line; /* ... which is on this line */ + bool fixed_line; /* every token gets `line` */ +} pl_emit_t; + +typedef struct { + size_t at; /* the code's letter */ + size_t cb; /* its content */ + size_t ce; + bool closed; /* false: the paragraph ended first */ +} pl_code_t; + +static uint32_t pl_line_at(pl_emit_t *em, size_t at) { + if (em->fixed_line) { + return em->line; + } + for (size_t k = em->line_pos; k < at; k++) { + em->line += em->text[k] == '\n'; + } + em->line_pos = at > em->line_pos ? at : em->line_pos; + return em->line; +} + +static void pl_push(pl_emit_t *em, const char *raw, size_t n, int syntax, uint32_t line) { + char *copy = cbm_arena_strndup(em->ctx->arena, raw, n); + if (!copy) { + return; + } + CBMDocLink link = { + .source_qn = em->def->qualified_name, + .raw = copy, + .line = line, + .def_line = em->def->start_line, + .syntax = (uint16_t)syntax, + }; + cbm_doclinks_push(&em->ctx->result->doc_links, em->ctx->arena, link); +} + +/* One L<> code of em->text -> one token (none for an empty code). */ +static void pl_emit_link(pl_emit_t *em, const pl_code_t *code) { + uint32_t line = pl_line_at(em, code->at); + char buf[PL_MALFORMED + CBM_DOCLINK_PERL_RAW_MAX + SKIP_ONE] = "L<"; + char *content = buf + PL_MALFORMED; + bool cut = false; + size_t n = pl_squeeze(em->text, code->cb, code->ce, content, CBM_DOCLINK_PERL_RAW_MAX, &cut); + if (!code->closed || cut) { + size_t keep = n > CBM_DOCLINK_PERL_RAW_MAX - PL_MALFORMED + ? CBM_DOCLINK_PERL_RAW_MAX - PL_MALFORMED + : n; + while (keep > 0 && ((unsigned char)content[keep] & PL_UTF8_CONT_MASK) == PL_UTF8_CONT) { + keep--; /* not in the middle of a character */ + } + pl_push(em, buf, PL_MALFORMED + keep, CBM_DOCLINK_PERL_POD_L, line); + return; + } + if (n == 0) { + return; /* Pod::Simple: "An empty L<>" is text */ + } + pl_shape_t sh = pl_link_shape(content, n); + size_t tb = sh.bar == SIZE_MAX ? 0 : sh.bar + SKIP_ONE; + while (tb < n && content[tb] == ' ') { + tb++; + } + if (sh.well_formed && pl_is_url(content + tb, n - tb)) { + pl_push(em, content + tb, n - tb, CBM_DOCLINK_HREF, line); + return; + } + pl_push(em, content, n, CBM_DOCLINK_PERL_POD_L, line); +} + +/* The L<> codes of one paragraph's text em->text[b, e). */ +static void pl_para_links(pl_emit_t *em, size_t b, size_t e) { + const char *t = em->text; + pl_codes_t st = {.depth = 0}; + pl_code_t link = {0}; + int link_depth = 0; /* stack depth of the open L; 0: none */ + bool harvest = false; /* the open L is a reference */ + size_t i = b; + while (i < e && !st.overflow) { + size_t next = i; + int ev = pl_code_step(&st, t, i, e, &next); + if (ev == PL_EV_OPEN && link_depth == 0 && t[i] == 'L') { + link_depth = st.depth; + harvest = !(i > b && pl_word(t[i - SKIP_ONE])); + link = (pl_code_t){.at = i, .cb = next, .ce = next, .closed = false}; + } else if (ev == PL_EV_CLOSE && link_depth != 0 && st.depth < link_depth) { + link.ce = i; + link.closed = true; + if (harvest) { + pl_emit_link(em, &link); + } + link_depth = 0; + } + i = next; + } + if (link_depth != 0 && harvest) { + link.ce = e; /* never closed, or nested too deep */ + pl_emit_link(em, &link); + } +} + +/* First byte after the white space that follows s[i]. */ +static size_t pl_skip_blank(const char *s, size_t i, size_t e) { + while (i < e && pl_space(s[i])) { + i++; + } + return i; +} + +/* The L<> codes of the POD text em->text[b, e): from its first command on, or + * from its start when `in_pod` (a run of the module doc, which is POD only). */ +static void pl_harvest_pod(pl_emit_t *em, size_t b, size_t e, bool in_pod) { + const char *t = em->text; + size_t pos = b; + size_t pb = 0; + size_t pe = 0; + int begin_depth = 0; /* open =begin regions */ + int data_from = 0; /* depth of the outermost data region; 0: none */ + while (pl_next_para(t, &pos, e, &pb, &pe)) { + bool cmd = pl_is_command(t, pb, pe); + if (!cmd) { + if (in_pod && data_from == 0 && t[pb] != ' ' && t[pb] != '\t') { + pl_para_links(em, pb, pe); + } + continue; + } + size_t wb = pl_command_word_end(t, pb, pe); + const char *w = t + pb + SKIP_ONE; + size_t wl = wb - pb - SKIP_ONE; + in_pod = !pl_word_is(w, wl, "cut"); + if (pl_word_is(w, wl, "begin")) { + size_t f = pl_skip_blank(t, wb, pe); + begin_depth++; + if (data_from == 0 && !(f < pe && t[f] == ':')) { + data_from = begin_depth; + } + } else if (pl_word_is(w, wl, "end") && begin_depth > 0) { + data_from = begin_depth == data_from ? 0 : data_from; + begin_depth--; + } else if (data_from == 0 && (pl_head_level(w, wl) > 0 || pl_word_is(w, wl, "item"))) { + pl_para_links(em, wb, pe); + } + } +} + +/* ── The file's POD sections ─────────────────────────────────────── */ + +enum { PL_HEAD = 1, PL_ITEM, PL_OVER, PL_BACK, PL_CUT, PL_OTHER }; + +typedef struct { + uint32_t sb; /* command paragraph */ + uint32_t eb; + uint32_t wb; /* end of the command word */ + uint8_t type; + uint8_t level; /* =headN: N; =item and =back: list depth */ +} pl_cmd_t; + +typedef struct { + uint32_t sb; /* the heading's command paragraph */ + uint32_t eb; /* section end, trailing white space trimmed */ + uint32_t hb; /* heading text */ + uint32_t he; + uint32_t line; /* 1-based line of sb */ + const char *name; /* the identifier the heading names; NULL: none */ + uint32_t name_len; + bool item; +} pl_sec_t; + +typedef struct { + CBMArena *a; + const char *src; + uint32_t len; + pl_sec_t *secs; + int nsecs; + int cap_secs; + pl_cmd_t *cmds; /* of the block being read */ + int ncmds; + int cap_cmds; + uint32_t line_pos; /* lines are counted from here ... */ + uint32_t line; /* ... which is on this line */ + bool failed; +} pl_scan_t; + +/* Room for one more element of `size` bytes in an arena array. */ +static void *pl_grow(pl_scan_t *s, void *items, int count, int *cap, size_t size) { + if (count < *cap) { + return items; + } + int ncap = *cap ? *cap * PAIR_LEN : PL_INIT_CAP; + void *grown = cbm_arena_alloc(s->a, (size_t)ncap * size); + if (!grown) { + s->failed = true; + return NULL; + } + if (count > 0) { + memcpy(grown, items, (size_t)count * size); + } + *cap = ncap; + return grown; +} + +/* Classify one command paragraph; `depth` is the =over nesting + * (extract_defs.c's pod_classify). */ +static pl_cmd_t pl_classify(const char *src, uint32_t sb, uint32_t eb, int *depth) { + uint32_t wb = (uint32_t)pl_command_word_end(src, sb, eb); + const char *w = src + sb + SKIP_ONE; + size_t wl = wb - sb - SKIP_ONE; + pl_cmd_t c = {sb, eb, wb, PL_OTHER, 0}; + if (pl_head_level(w, wl) > 0) { + c.type = PL_HEAD; + c.level = (uint8_t)pl_head_level(w, wl); + } else if (pl_word_is(w, wl, "item")) { + c.type = PL_ITEM; + c.level = (uint8_t)*depth; + } else if (pl_word_is(w, wl, "over")) { + c.type = PL_OVER; + (*depth)++; + } else if (pl_word_is(w, wl, "back")) { + c.type = PL_BACK; + c.level = (uint8_t)*depth; + if (*depth > 0) { + (*depth)--; + } + } else if (pl_word_is(w, wl, "cut")) { + c.type = PL_CUT; + } + return c; +} + +/* The command paragraphs of the POD block src[pb, pe) into s->cmds. */ +static void pl_block_commands(pl_scan_t *s, uint32_t pb, uint32_t pe) { + s->ncmds = 0; + int depth = 0; + size_t pos = pb; + size_t sb = 0; + size_t eb = 0; + while (!s->failed && pl_next_para(s->src, &pos, pe, &sb, &eb)) { + if (!pl_is_command(s->src, sb, eb)) { + continue; + } + pl_cmd_t *cmds = (pl_cmd_t *)pl_grow(s, s->cmds, s->ncmds, &s->cap_cmds, sizeof(pl_cmd_t)); + if (!cmds) { + return; + } + s->cmds = cmds; + s->cmds[s->ncmds++] = pl_classify(s->src, (uint32_t)sb, (uint32_t)eb, &depth); + } +} + +/* End byte of the section that cmds[ci] (a =head or =item) opens + * (extract_defs.c's pod_section_end). */ +static uint32_t pl_section_end(const pl_cmd_t *cmds, int n, int ci, uint32_t pe) { + const pl_cmd_t *c = &cmds[ci]; + for (int j = ci + SKIP_ONE; j < n; j++) { + const pl_cmd_t *d = &cmds[j]; + if (d->type == PL_CUT) { + return d->sb; + } + if (d->type == PL_HEAD && (c->type == PL_ITEM || d->level <= c->level)) { + return d->sb; + } + if (c->type == PL_ITEM && (d->type == PL_ITEM || d->type == PL_BACK) && + d->level == c->level) { + return d->sb; + } + } + return pe; +} + +/* A heading's text with formatting codes removed and newlines and tabs as + * spaces (extract_defs.c's pod_plain_heading, byte for byte: the name it + * yields decides which sub a section is stored on). */ +static char *pl_plain_heading(CBMArena *a, const char *src, uint32_t b, uint32_t e) { + char *buf = (char *)cbm_arena_alloc(a, (size_t)(e - b) + SKIP_ONE); + if (!buf) { + return NULL; + } + size_t w = 0; + for (uint32_t i = b; i < e; i++) { + char c = src[i]; + if (pl_upper(c) && i + SKIP_ONE < e && src[i + SKIP_ONE] == '<') { + uint32_t j = i + SKIP_ONE; + while (j < e && src[j] == '<') { + j++; + } + if (j - i > PAIR_LEN && j < e && (src[j] == ' ' || src[j] == '\t')) { + j++; /* X<< text >> */ + } + i = j - SKIP_ONE; + continue; + } + if (c == '>' && !(w > 0 && buf[w - SKIP_ONE] == '-')) { + continue; + } + buf[w++] = (c == '\n' || c == '\r' || c == '\t') ? ' ' : c; + } + buf[w] = '\0'; + return buf; +} + +static const char *pl_skip_spaces(const char *p) { + while (*p == ' ') { + p++; + } + return p; +} + +/* The sub a heading names: after a list bullet ("*", "1."), a `$obj->` + * receiver and a sigil, the identifier that follows; its length, 0 for none + * (extract_defs.c's pod_heading_name). */ +static size_t pl_heading_name(CBMArena *a, const char *src, uint32_t b, uint32_t e, + const char **name) { + const char *buf = pl_plain_heading(a, src, b, e); + if (!buf) { + return 0; + } + const char *p = pl_skip_spaces(buf); + if (*p == '*') { + p++; + } else if (isdigit((unsigned char)*p)) { + while (isdigit((unsigned char)*p)) { + p++; + } + if (*p == '.') { + p++; + } + } + p = pl_skip_spaces(p); + if (*p == '$') { + const char *q = p + SKIP_ONE; + while (pl_word(*q)) { + q++; + } + q = pl_skip_spaces(q); + if (q > p + SKIP_ONE && q[0] == '-' && q[SKIP_ONE] == '>') { + p = pl_skip_spaces(q + PAIR_LEN); + } + } + if (*p == '$' || *p == '@' || *p == '%' || *p == '&') { + p++; + } + if (!(isalpha((unsigned char)*p) || *p == '_')) { + return 0; + } + const char *s = p; + while (pl_word(*p)) { + p++; + } + *name = s; + return (size_t)(p - s); +} + +static uint32_t pl_trim_end(const char *src, uint32_t sb, uint32_t eb) { + while (eb > sb && pl_space(src[eb - SKIP_ONE])) { + eb--; + } + return eb; +} + +/* The 1-based line of src[at]; `at` never decreases between calls. */ +static uint32_t pl_scan_line(pl_scan_t *s, uint32_t at) { + for (uint32_t k = s->line_pos; k < at; k++) { + s->line += s->src[k] == '\n'; + } + s->line_pos = at > s->line_pos ? at : s->line_pos; + return s->line; +} + +/* The =head / =item sections of the POD block src[pb, pe). */ +static void pl_block_sections(pl_scan_t *s, uint32_t pb, uint32_t pe) { + pl_block_commands(s, pb, pe); + for (int ci = 0; ci < s->ncmds && !s->failed; ci++) { + const pl_cmd_t *c = &s->cmds[ci]; + if (c->type != PL_HEAD && c->type != PL_ITEM) { + continue; + } + pl_sec_t *secs = (pl_sec_t *)pl_grow(s, s->secs, s->nsecs, &s->cap_secs, sizeof(pl_sec_t)); + if (!secs) { + return; + } + s->secs = secs; + pl_sec_t sec = {.sb = c->sb, .hb = c->wb, .he = c->eb, .item = c->type == PL_ITEM}; + sec.eb = pl_trim_end(s->src, c->sb, pl_section_end(s->cmds, s->ncmds, ci, pe)); + sec.line = pl_scan_line(s, c->sb); + sec.name_len = (uint32_t)pl_heading_name(s->a, s->src, c->wb, c->eb, &sec.name); + s->secs[s->nsecs++] = sec; + } +} + +/* True when the line src[i, le) is the `=cut` that ends a POD block. */ +static bool pl_is_cut_line(const char *src, uint32_t i, uint32_t le) { + static const char cut[] = "=cut"; + uint32_t n = (uint32_t)(sizeof(cut) - SKIP_ONE); + return le - i >= n && memcmp(src + i, cut, n) == 0 && (le - i == n || !pl_word(src[i + n])); +} + +/* Every POD section of the file. A block runs from a line that starts with + * `=` and a letter through the next line that starts with `=cut`, or to the + * end of the file: what perl skips and perldoc reads. */ +static void pl_scan_file(pl_scan_t *s) { + bool in_pod = false; + uint32_t pb = 0; + uint32_t i = 0; + while (i < s->len && !s->failed) { + const char *nl = (const char *)memchr(s->src + i, '\n', s->len - i); + uint32_t le = nl ? (uint32_t)(nl - s->src) : s->len; + if (!in_pod && pl_is_command(s->src, i, le)) { + in_pod = true; + pb = i; + } + if (in_pod && pl_is_cut_line(s->src, i, le)) { + pl_block_sections(s, pb, le); + in_pod = false; + } + i = le < s->len ? le + SKIP_ONE : s->len; + } + if (in_pod && !s->failed) { + pl_block_sections(s, pb, s->len); + } +} + +static void pl_scan_init(pl_scan_t *s, CBMExtractCtx *ctx) { + memset(s, 0, sizeof(*s)); + s->a = pl_scratch(ctx); + s->src = ctx->source; + s->len = (ctx->source && ctx->source_len > 0) ? (uint32_t)ctx->source_len : 0; + s->line = SKIP_ONE; +} + +/* ── Docs -> tokens ──────────────────────────────────────────────── */ + +typedef struct { + const char *name; + uint32_t len; + int sec; +} pl_named_t; + +static int pl_name_cmp(const char *a, size_t al, const char *b, size_t bl) { + int c = memcmp(a, b, al < bl ? al : bl); + if (c != 0) { + return c; + } + return (al > bl) - (al < bl); +} + +static int pl_named_cmp(const void *a, const void *b) { + const pl_named_t *x = (const pl_named_t *)a; + const pl_named_t *y = (const pl_named_t *)b; + int c = pl_name_cmp(x->name, x->len, y->name, y->len); + return c != 0 ? c : (x->sec > y->sec) - (x->sec < y->sec); +} + +/* The sections that name something, sorted by name and then by position. */ +static pl_named_t *pl_named_sections(const pl_scan_t *s, int *count) { + *count = 0; + pl_named_t *named = + (pl_named_t *)cbm_arena_alloc(s->a, (size_t)(s->nsecs + SKIP_ONE) * sizeof(*named)); + if (!named) { + return NULL; + } + int n = 0; + for (int i = 0; i < s->nsecs; i++) { + if (s->secs[i].name_len > 0) { + named[n++] = (pl_named_t){s->secs[i].name, s->secs[i].name_len, i}; + } + } + qsort(named, (size_t)n, sizeof(*named), pl_named_cmp); + *count = n; + return named; +} + +/* Index of the first section named `name`, or `count`. */ +static int pl_named_first(const pl_named_t *named, int count, const char *name) { + size_t nl = strlen(name); + int lo = 0; + int hi = count; + while (lo < hi) { + int mid = lo + ((hi - lo) / PAIR_LEN); + if (pl_name_cmp(named[mid].name, named[mid].len, name, nl) < 0) { + lo = mid + SKIP_ONE; + } else { + hi = mid; + } + } + return lo; +} + +/* True when doc[o, dl) starts with the section `sec`, alone or followed by the + * blank line that joins it to the next one. */ +static bool pl_piece_is(const pl_scan_t *s, const pl_sec_t *sec, const char *doc, size_t o, + size_t dl) { + size_t n = sec->eb - sec->sb; + if (n == 0 || n > dl - o || memcmp(doc + o, s->src + sec->sb, n) != 0) { + return false; + } + return o + n == dl || + (dl - o - n >= PAIR_LEN && doc[o + n] == '\n' && doc[o + n + SKIP_ONE] == '\n'); +} + +/* One definition's doc -> tokens: every piece of it that is a section of the + * file is read where it stands, so its references carry their own lines. */ +static void pl_harvest_def(CBMExtractCtx *ctx, const pl_scan_t *s, const pl_named_t *named, + int count, const CBMDefinition *def, uint32_t fallback_line) { + const char *doc = def->docstring; + size_t dl = strlen(doc); + if (!pl_is_command(doc, 0, dl)) { + return; /* a `#` comment: no formatting codes */ + } + size_t nl = strlen(def->name); + size_t o = 0; + int cand = named ? pl_named_first(named, count, def->name) : count; + for (; o < dl && cand < count && + pl_name_cmp(named[cand].name, named[cand].len, def->name, nl) == 0; + cand++) { + const pl_sec_t *sec = &s->secs[named[cand].sec]; + if (!pl_piece_is(s, sec, doc, o, dl)) { + continue; /* a section the doc does not hold */ + } + pl_emit_t em = { + .ctx = ctx, .def = def, .text = s->src, .line_pos = sec->sb, .line = sec->line}; + pl_harvest_pod(&em, sec->sb, sec->eb, false); + o += sec->eb - sec->sb; + o += o < dl ? PAIR_LEN : 0; + } + if (o < dl) { /* text whose place in the file is not known */ + pl_emit_t em = { + .ctx = ctx, .def = def, .text = doc, .line = fallback_line, .fixed_line = true}; + pl_harvest_pod(&em, o, dl, false); + } +} + +/* The core's filter: a definition whose doc is harvested. */ +static bool pl_documented(const CBMDefinition *d) { + return d->docstring && d->docstring[0] && d->qualified_name && d->name; +} + +typedef struct { + const char *qn; + int idx; +} pl_docdef_t; + +static int pl_docdef_cmp(const void *a, const void *b) { + const pl_docdef_t *x = (const pl_docdef_t *)a; + const pl_docdef_t *y = (const pl_docdef_t *)b; + int c = strcmp(x->qn, y->qn); + return c != 0 ? c : (x->idx > y->idx) - (x->idx < y->idx); +} + +/* twin[i]: definition i repeats the qualified name AND the doc of an earlier + * one (the same sub name in two packages of a file is one node with one doc): + * its references are the earlier one's. NULL when there is nothing to mark. */ +static bool *pl_twins(CBMExtractCtx *ctx) { + const CBMDefArray *defs = &ctx->result->defs; + CBMArena *a = pl_scratch(ctx); + pl_docdef_t *docs = (pl_docdef_t *)cbm_arena_alloc(a, (size_t)defs->count * sizeof(*docs)); + bool *twin = (bool *)cbm_arena_calloc(a, (size_t)defs->count * sizeof(bool)); + if (!docs || !twin) { + return NULL; + } + int n = 0; + for (int i = 0; i < defs->count; i++) { + if (pl_documented(&defs->items[i])) { + docs[n++] = (pl_docdef_t){defs->items[i].qualified_name, i}; + } + } + qsort(docs, (size_t)n, sizeof(*docs), pl_docdef_cmp); + int first = 0; + for (int i = SKIP_ONE; i < n; i++) { + if (strcmp(docs[i].qn, docs[first].qn) != 0) { + first = i; + } else { + twin[docs[i].idx] = strcmp(defs->items[docs[i].idx].docstring, + defs->items[docs[first].idx].docstring) == 0; + } + } + return twin; +} + +/* Every documented definition of the file -> tokens, in definition order. */ +static void pl_harvest_file(CBMExtractCtx *ctx) { + pl_scan_t s; + pl_scan_init(&s, ctx); + pl_scan_file(&s); + int count = 0; + pl_named_t *named = s.failed ? NULL : pl_named_sections(&s, &count); + const bool *twin = pl_twins(ctx); + const CBMDefArray *defs = &ctx->result->defs; + for (int i = 0; i < defs->count; i++) { + const CBMDefinition *d = &defs->items[i]; + if (pl_documented(d) && !(twin && twin[i])) { + pl_harvest_def(ctx, &s, named, named ? count : 0, d, d->start_line); + } + } +} + +/* First position >= from of `needle` (n bytes) in src[0, len); SIZE_MAX: none. */ +static size_t pl_find(const char *src, size_t from, size_t len, const char *needle, size_t n) { + if (n == 0 || n > len) { + return SIZE_MAX; + } + for (size_t i = from; i + n <= len; i++) { + const char *hit = (const char *)memchr(src + i, needle[0], len - n + SKIP_ONE - i); + if (!hit) { + return SIZE_MAX; + } + i = (size_t)(hit - src); + if (memcmp(src + i, needle, n) == 0) { + return i; + } + } + return SIZE_MAX; +} + +/* The module doc (the core's File stand-in): runs of the file's POD joined by + * a blank line (extract_defs.c, doc_perl_module), each found again in the + * source after the one before, so that a reference gets the line it is written + * on. Text that is not found keeps the doc's first line. */ +static void pl_harvest_module(CBMExtractCtx *ctx, const CBMDefinition *def, const char *doc, + uint32_t doc_line) { + const char *src = ctx->source; + size_t sl = ctx->source_len > 0 ? (size_t)ctx->source_len : 0; + size_t dl = strlen(doc); + size_t o = 0; + size_t at = 0; + size_t line_pos = 0; + uint32_t line = SKIP_ONE; + while (src && o < dl) { + size_t le = o; + while (le < dl && doc[le] != '\n') { + le++; + } + size_t p = pl_find(src, at, sl, doc + o, le - o); + if (p == SIZE_MAX) { + break; + } + size_t k = 0; + while (o + k < dl && p + k < sl && doc[o + k] == src[p + k]) { + k++; + } + for (; line_pos < p; line_pos++) { + line += src[line_pos] == '\n' ? SKIP_ONE : 0; + } + pl_emit_t em = {.ctx = ctx, .def = def, .text = src, .line_pos = p, .line = line}; + pl_harvest_pod(&em, p, p + k, true); + o += k; + at = p + k; + while (o < dl && doc[o] == '\n') { + o++; /* the blank line that joins two runs */ + } + } + if (o < dl) { + pl_emit_t em = {.ctx = ctx, .def = def, .text = doc, .line = doc_line, .fixed_line = true}; + pl_harvest_pod(&em, o, dl, true); + } +} + +/* Index of `def` in the file's definitions; -1 when it is not one of them. */ +static int pl_def_index(const CBMDefArray *defs, const CBMDefinition *def) { + uintptr_t base = (uintptr_t)defs->items; + uintptr_t p = (uintptr_t)def; + if (!defs->items || defs->count <= 0 || p < base) { + return CBM_NOT_FOUND; + } + uintptr_t off = p - base; + if (off % sizeof(CBMDefinition) != 0 || off / sizeof(CBMDefinition) >= (uintptr_t)defs->count) { + return CBM_NOT_FOUND; + } + return (int)(off / sizeof(CBMDefinition)); +} + +void cbm_doclink_perl_parse_doc(CBMExtractCtx *ctx, const CBMDefinition *def, const char *doc, + uint32_t doc_line) { + if (!ctx || !ctx->result || !def || !doc || !def->qualified_name) { + return; + } + if (def->label && strcmp(def->label, "File") == 0) { + pl_harvest_module(ctx, def, doc, doc_line); /* the file's module doc */ + return; + } + const CBMDefArray *defs = &ctx->result->defs; + int idx = pl_def_index(defs, def); + if (idx < 0 || doc != def->docstring) { + /* a doc that is not a listed definition's own: nothing says where in + * the file it stands, so its references get the line the core passed */ + if (pl_is_command(doc, 0, strlen(doc))) { + pl_emit_t em = { + .ctx = ctx, .def = def, .text = doc, .line = doc_line, .fixed_line = true}; + pl_harvest_pod(&em, 0, strlen(doc), false); + } + return; + } + for (int i = idx - SKIP_ONE; i >= 0; i--) { + if (pl_documented(&defs->items[i])) { + return; /* harvested with the file's first documented definition */ + } + } + pl_harvest_file(ctx); +} + +/* ── Scope blob ──────────────────────────────────────────────────── */ + +typedef struct { + CBMArena *a; + char *buf; + size_t len; + size_t cap; + bool failed; +} pl_sb_t; + +static void pl_sb_put(pl_sb_t *sb, const char *s, size_t n) { + if (sb->failed) { + return; + } + if (sb->len + n + SKIP_ONE > sb->cap) { + size_t ncap = sb->cap ? sb->cap : PL_SB_INIT; + while (ncap < sb->len + n + SKIP_ONE) { + ncap *= PAIR_LEN; + } + char *grown = (char *)cbm_arena_alloc(sb->a, ncap); + if (!grown) { + sb->failed = true; + return; + } + if (sb->len > 0) { + memcpy(grown, sb->buf, sb->len); + } + sb->buf = grown; + sb->cap = ncap; + } + memcpy(sb->buf + sb->len, s, n); + sb->len += n; + sb->buf[sb->len] = '\0'; +} + +static void pl_sb_puts(pl_sb_t *sb, const char *s) { + pl_sb_put(sb, s, strlen(s)); +} + +enum { PL_PKG_MAIN = -1, PL_PKG_UNKNOWN = -2 }; + +typedef struct { + const char *name; /* in the source */ + uint32_t len; + int order; /* declaration order in the file */ + int index; /* of its P record; set by pl_number_packages */ +} pl_pkg_t; + +typedef struct { + const char *name; /* in the source */ + uint32_t len; + uint32_t line; + int pkg; /* declaration (pl_pkg_t.order) it stands in, or PL_PKG_* */ +} pl_subdecl_t; + +typedef struct { + pl_scan_t *s; /* arena and growth */ + pl_pkg_t *pkgs; + int npkgs; + int cap_pkgs; + pl_subdecl_t *subs; + int nsubs; + int cap_subs; + int *saved; /* the package in force outside each open block */ + int nsaved; + int cap_saved; + int current; /* declaration in force, or PL_PKG_* */ + int pending_block; /* declaration whose block comes next, or PL_PKG_UNKNOWN */ + bool pending; +} pl_walk_t; + +static bool pl_kind(TSNode n, const char *kind) { + return strcmp(ts_node_type(n), kind) == 0; +} + +/* A package or sub name as a blob field: word characters, `:` and `'`. */ +static bool pl_name_ok(const char *p, size_t n) { + if (n == 0 || n > PL_NAME_MAX) { + return false; + } + for (size_t i = 0; i < n; i++) { + if (!pl_word(p[i]) && p[i] != ':' && p[i] != '\'') { + return false; + } + } + return true; +} + +/* The source text of a declaration's `name` field. */ +static bool pl_decl_name(const pl_walk_t *w, TSNode decl, const char **name, uint32_t *len) { + static const char field[] = "name"; + TSNode n = ts_node_child_by_field_name(decl, field, (uint32_t)(sizeof(field) - SKIP_ONE)); + if (ts_node_is_null(n)) { + return false; + } + uint32_t b = ts_node_start_byte(n); + uint32_t e = ts_node_end_byte(n); + if (e <= b || e > w->s->len) { + return false; + } + *name = w->s->src + b; + *len = e - b; + return pl_name_ok(*name, *len); +} + +static bool pl_has_block(TSNode decl) { + uint32_t n = ts_node_child_count(decl); + for (uint32_t i = 0; i < n; i++) { + if (pl_kind(ts_node_child(decl, i), "block")) { + return true; + } + } + return false; +} + +/* `package NAME;` sets the package to the end of the enclosing block; + * `package NAME { .. }` sets it inside its own block only. */ +static void pl_walk_package(pl_walk_t *w, TSNode decl) { + const char *name = NULL; + uint32_t len = 0; + int id = PL_PKG_UNKNOWN; + if (pl_decl_name(w, decl, &name, &len)) { + pl_pkg_t *pkgs = + (pl_pkg_t *)pl_grow(w->s, w->pkgs, w->npkgs, &w->cap_pkgs, sizeof(pl_pkg_t)); + if (!pkgs) { + return; + } + w->pkgs = pkgs; + id = w->npkgs; + w->pkgs[w->npkgs++] = (pl_pkg_t){.name = name, .len = len, .order = id}; + } + if (pl_has_block(decl)) { + w->pending = true; + w->pending_block = id; + } else { + w->current = id; + } +} + +static void pl_walk_sub(pl_walk_t *w, TSNode decl) { + const char *name = NULL; + uint32_t len = 0; + if (!pl_decl_name(w, decl, &name, &len)) { + return; + } + pl_subdecl_t *subs = + (pl_subdecl_t *)pl_grow(w->s, w->subs, w->nsubs, &w->cap_subs, sizeof(pl_subdecl_t)); + if (!subs) { + return; + } + w->subs = subs; + w->subs[w->nsubs++] = (pl_subdecl_t){.name = name, + .len = len, + .line = ts_node_start_point(decl).row + TS_LINE_OFFSET, + .pkg = w->current}; +} + +static bool pl_is_scope(TSNode n) { + return pl_kind(n, "block") || pl_kind(n, "block_statement"); +} + +/* Enter a node; false when its children are not walked (a sub's body and an + * expression hold no declaration this blob lists). */ +static bool pl_walk_enter(pl_walk_t *w, TSNode n) { + if (pl_kind(n, "subroutine_declaration_statement")) { + pl_walk_sub(w, n); + return false; + } + if (pl_kind(n, "expression_statement") || pl_kind(n, "pod") || + pl_kind(n, "method_declaration_statement")) { + return false; + } + if (pl_kind(n, "package_statement") || pl_kind(n, "class_statement") || + pl_kind(n, "role_statement")) { + pl_walk_package(w, n); + return true; + } + if (pl_is_scope(n)) { + int *saved = (int *)pl_grow(w->s, w->saved, w->nsaved, &w->cap_saved, sizeof(int)); + if (!saved) { + return false; + } + w->saved = saved; + w->saved[w->nsaved++] = w->current; + if (w->pending) { + w->current = w->pending_block; + w->pending = false; + } + } + return true; +} + +static void pl_walk_leave(pl_walk_t *w, TSNode n) { + if (pl_is_scope(n) && w->nsaved > 0) { + w->current = w->saved[--w->nsaved]; + } +} + +/* Packages and subs of the tree, with the package each sub stands in. An + * iterative walk: the nesting depth is the input's. */ +static void pl_walk_tree(pl_walk_t *w, TSNode root) { + TSTreeCursor cur = ts_tree_cursor_new(root); + bool more = true; + while (more && !w->s->failed) { + TSNode n = ts_tree_cursor_current_node(&cur); + bool entered = pl_walk_enter(w, n); + if (entered && ts_tree_cursor_goto_first_child(&cur)) { + continue; + } + if (entered) { + pl_walk_leave(w, n); + } + while (more && !ts_tree_cursor_goto_next_sibling(&cur)) { + more = ts_tree_cursor_goto_parent(&cur); + if (more) { + pl_walk_leave(w, ts_tree_cursor_current_node(&cur)); + } + } + } + ts_tree_cursor_delete(&cur); +} + +static int pl_pkg_name_cmp(const void *a, const void *b) { + const pl_pkg_t *x = (const pl_pkg_t *)a; + const pl_pkg_t *y = (const pl_pkg_t *)b; + int c = pl_name_cmp(x->name, x->len, y->name, y->len); + return c != 0 ? c : (x->order > y->order) - (x->order < y->order); +} + +static int pl_pkg_order_cmp(const void *a, const void *b) { + const pl_pkg_t *x = (const pl_pkg_t *)a; + const pl_pkg_t *y = (const pl_pkg_t *)b; + return (x->order > y->order) - (x->order < y->order); +} + +/* Give every declaration the index of its name's P record (names in order of + * their first declaration) and write the P records. */ +static void pl_number_packages(pl_walk_t *w, pl_sb_t *sb) { + qsort(w->pkgs, (size_t)w->npkgs, sizeof(pl_pkg_t), pl_pkg_name_cmp); + for (int i = 0; i < w->npkgs; i++) { /* index = order of the name's first declaration */ + bool repeat = + i > 0 && pl_name_cmp(w->pkgs[i].name, w->pkgs[i].len, w->pkgs[i - SKIP_ONE].name, + w->pkgs[i - SKIP_ONE].len) == 0; + w->pkgs[i].index = repeat ? w->pkgs[i - SKIP_ONE].index : w->pkgs[i].order; + } + qsort(w->pkgs, (size_t)w->npkgs, sizeof(pl_pkg_t), pl_pkg_order_cmp); + int records = 0; + for (int i = 0; i < w->npkgs; i++) { + pl_pkg_t *p = &w->pkgs[i]; + if (p->index != p->order) { + p->index = w->pkgs[p->index].index; /* its first declaration's record */ + continue; + } + p->index = records++; + pl_sb_puts(sb, "P\t"); + pl_sb_put(sb, p->name, p->len); + pl_sb_puts(sb, "\n"); + } +} + +static int pl_subdecl_cmp(const void *a, const void *b) { + const pl_subdecl_t *x = (const pl_subdecl_t *)a; + const pl_subdecl_t *y = (const pl_subdecl_t *)b; + if (x->line != y->line) { + return x->line < y->line ? -1 : 1; + } + return pl_name_cmp(x->name, x->len, y->name, y->len); +} + +/* One S record per sub definition of the file, with the package the tree + * places it in. */ +static void pl_put_subs(CBMExtractCtx *ctx, pl_walk_t *w, pl_sb_t *sb) { + qsort(w->subs, (size_t)w->nsubs, sizeof(pl_subdecl_t), pl_subdecl_cmp); + const CBMDefArray *defs = &ctx->result->defs; + for (int i = 0; i < defs->count; i++) { + const CBMDefinition *d = &defs->items[i]; + if (!d->name || !d->label || strcmp(d->label, "Function") != 0 || + !pl_name_ok(d->name, strlen(d->name))) { + continue; + } + pl_subdecl_t key = { + .name = d->name, .len = (uint32_t)strlen(d->name), .line = d->start_line}; + const pl_subdecl_t *hit = + w->nsubs > 0 ? (const pl_subdecl_t *)bsearch(&key, w->subs, (size_t)w->nsubs, + sizeof(pl_subdecl_t), pl_subdecl_cmp) + : NULL; + int pkg = hit ? hit->pkg : PL_PKG_UNKNOWN; + char field[CBM_SZ_32]; + if (pkg >= 0) { + snprintf(field, sizeof(field), "S\t%d\t", w->pkgs[pkg].index); + } else { + snprintf(field, sizeof(field), "S\t%s\t", pkg == PL_PKG_MAIN ? "-" : "?"); + } + pl_sb_puts(sb, field); + pl_sb_puts(sb, d->name); + pl_sb_puts(sb, "\n"); + } +} + +static void pl_put_heading(pl_sb_t *sb, const pl_sec_t *sec, const char *key) { + if (!key[0]) { + return; + } + pl_sb_puts(sb, "H\t"); + if (sec->name_len > 0) { + pl_sb_put(sb, sec->name, sec->name_len); + } else { + pl_sb_puts(sb, "-"); + } + pl_sb_puts(sb, "\t"); + pl_sb_puts(sb, key); + pl_sb_puts(sb, "\n"); +} + +/* The text after an =item's bullet (`*`) or number (`1.`), or NULL when the + * item has neither. */ +static const char *pl_after_bullet(const char *key) { + const char *p = key; + if (*p == '*') { + p++; + } else { + while (isdigit((unsigned char)*p)) { + p++; + } + if (p == key) { + return NULL; + } + p += *p == '.'; + } + return (*p == ' ' || *p == '\0') ? pl_skip_spaces(p) : NULL; +} + +/* One H record per heading. Pod::Simple reads `=item * text` and `=item 1. + * text` as a bullet and its text when the list is a bullet or numbered list, + * and as the whole text otherwise; which kind a list is depends on its first + * item, so a numbered text is recorded both ways. */ +static void pl_put_headings(const pl_scan_t *s, pl_sb_t *sb) { + for (int i = 0; i < s->nsecs; i++) { + const pl_sec_t *sec = &s->secs[i]; + char key[CBM_DOCLINK_PERL_KEY_MAX]; + cbm_doclink_perl_plain_text(s->src + sec->hb, sec->he - sec->hb, key, sizeof(key)); + const char *rest = sec->item ? pl_after_bullet(key) : NULL; + if (!rest) { + pl_put_heading(sb, sec, key); + } else if (key[0] == '*') { + pl_put_heading(sb, sec, rest); + } else if (rest[0]) { + pl_put_heading(sb, sec, key); + pl_put_heading(sb, sec, rest); + } + } +} + +const char *cbm_doclink_perl_scan_scope(CBMExtractCtx *ctx) { + if (!ctx || !ctx->result || ts_node_is_null(ctx->root)) { + return NULL; + } + pl_scan_t s; + pl_scan_init(&s, ctx); + pl_sb_t sb = {.a = ctx->arena}; + pl_sb_puts(&sb, CBM_DOCLINK_PERL_SCOPE_TAG "\n"); + if (ts_node_has_error(ctx->root)) { + pl_sb_puts(&sb, "E\n"); + } + pl_walk_t w = {.s = &s, .current = PL_PKG_MAIN, .pending_block = PL_PKG_UNKNOWN}; + pl_walk_tree(&w, ctx->root); + pl_number_packages(&w, &sb); + pl_put_subs(ctx, &w, &sb); + pl_scan_file(&s); + pl_put_headings(&s, &sb); + if (s.failed || sb.failed || !sb.buf) { + return NULL; + } + return sb.buf; +} diff --git a/src/pipeline/doc_links.c b/src/pipeline/doc_links.c index a365ddf41..c912ac9e0 100644 --- a/src/pipeline/doc_links.c +++ b/src/pipeline/doc_links.c @@ -47,7 +47,7 @@ const char *cbm_doclink_reason_name(int reason) { static const cbm_doclink_resolver_t *const DOCLINK_RESOLVERS[] = { &cbm_doclink_cs_resolver, &cbm_doclink_md_resolver, &cbm_doclink_pdf_resolver, &cbm_doclink_rst_resolver, &cbm_doclink_adoc_resolver, &cbm_doclink_go_resolver, - &cbm_doclink_jvm_resolver, &cbm_doclink_rs_resolver, + &cbm_doclink_jvm_resolver, &cbm_doclink_rs_resolver, &cbm_doclink_perl_resolver, }; enum { DOCLINK_RESOLVER_COUNT = sizeof(DOCLINK_RESOLVERS) / sizeof(DOCLINK_RESOLVERS[0]) }; diff --git a/src/pipeline/doc_links.h b/src/pipeline/doc_links.h index a85e3d512..e0ca5820f 100644 --- a/src/pipeline/doc_links.h +++ b/src/pipeline/doc_links.h @@ -298,6 +298,7 @@ bool cbm_doclinks_binds_lines(CBMLanguage lang); extern const cbm_doclink_resolver_t cbm_doclink_go_resolver; extern const cbm_doclink_resolver_t cbm_doclink_jvm_resolver; extern const cbm_doclink_resolver_t cbm_doclink_rs_resolver; +extern const cbm_doclink_resolver_t cbm_doclink_perl_resolver; /* True when `rel_path` is a scope input of some language (scope_input). */ bool cbm_doclinks_is_scope_input(const char *rel_path); diff --git a/src/pipeline/doc_links_perl.c b/src/pipeline/doc_links_perl.c new file mode 100644 index 000000000..8736ce506 --- /dev/null +++ b/src/pipeline/doc_links_perl.c @@ -0,0 +1,489 @@ +/* + * doc_links_perl.c — resolving Perl POD L<> references (doclink_perl.c). + * + * A page is a module. L binds the module whose file declares + * `package Mojo::Base;` (the scope blob's P records). When several files + * declare it, the one the library layout names (…/Mojo/Base.pm) is the + * module; more than one such file, or none among several, is ambiguous. A page + * the repository does not declare (CPAN, the Perl core, a .pod page: + * discovery keeps no .pod file, so nothing can say it is in the repository) + * is external, and so is a man page (L). + * + * The target of a module is its File node: a POD page is the file it is + * written in (the field test's audited rule). Its Module node would do for + * most, but not where a same-named Folder holds the module's qualified name + * (lib/Mojo.pm next to lib/Mojo/). + * + * A section, L: when a heading of the module's file reads + * `section` (POD text as it renders, cbm_doclink_perl_plain_text) and names a + * sub that has a definition in that file, the target is the sub; headings + * that name two subs are ambiguous. A section that names no sub is a place in + * the module's documentation: the target is the module. L is the + * same page: a sub its heading names binds; a heading that names no sub is a + * place in the source's own page, no reference worth an edge or a row + * (local); a section the page has no heading for is missing (doc rot). + * + * Test code (t/, xt/, *.t, and cbm_is_test_file) is bound only from test code. + * Every edge is exact: a module name and a heading are spelled out in full. + * + * The scope blob carries no lines (doclink_perl.c), and without a scope_delta + * hook every change of a blob is a full re-resolution: a change that adds or + * drops a package, a sub or a heading; an edit inside a sub changes no blob. + */ +#include "pipeline/doc_links.h" +#include "pipeline/pipeline_internal.h" /* cbm_pipeline_file_node */ +#include "cbm.h" +#include "doclink.h" +#include "helpers.h" /* cbm_fqn_module_source_lang, cbm_is_test_file */ +#include "foundation/arena.h" +#include "foundation/constants.h" +#include "foundation/hash_table.h" +#include "foundation/log.h" +#include "foundation/mem_core.h" +#include "graph_buffer/graph_buffer.h" + +#include +#include +#include +#include +#include +#include + +/* ── The index ───────────────────────────────────────────────────── */ + +typedef struct { + const char *sub; /* the sub the heading names; NULL: none */ + const char *key; /* the heading as it renders */ +} pr_head_t; + +typedef struct { + const char *path; /* rel_path */ + const char *module_qn; /* the file's module qualified name */ + bool test; + int nsubs; + const char **subs; /* subs with a definition in the file */ + int nheads; + pr_head_t *heads; +} pr_file_t; + +typedef struct { + const char *name; + int file; +} pr_decl_t; + +typedef struct { + int first; /* into decls */ + int count; +} pr_range_t; + +typedef struct { + CBMArena arena; + const char *project; + pr_file_t *files; + int nfiles; + int *run_to_file; /* run_file -> files index, -1: none */ + int run_count; + pr_decl_t *decls; /* every package declaration, by name, then path */ + int ndecls; + CBMHashTable *pkg; /* package name -> pr_range_t */ + bool oom; +} pr_index_t; + +static bool pr_test_path(const char *path) { + if (cbm_is_test_file(path, CBM_LANG_PERL)) { + return true; + } + size_t n = strlen(path); + if (n >= PAIR_LEN && strcmp(path + n - PAIR_LEN, ".t") == 0) { + return true; + } + return strncmp(path, "t/", PAIR_LEN) == 0 || strncmp(path, "xt/", CBM_SZ_3) == 0 || + strstr(path, "/t/") != NULL || strstr(path, "/xt/") != NULL; +} + +/* One record line of a blob: its fields, split at tabs (at most `cap`). */ +static int pr_fields(const char *b, const char *e, const char **f, size_t *fl, int cap) { + int n = 0; + const char *s = b; + for (const char *p = b; p <= e && n < cap; p++) { + if (p == e || *p == '\t') { + f[n] = s; + fl[n] = (size_t)(p - s); + n++; + s = p + SKIP_ONE; + } + } + return n; +} + +enum { PR_MAX_FIELDS = 4, PR_F_TAG = 0, PR_F_A = 1, PR_F_B = 2 }; + +static const char *pr_copy(pr_index_t *ix, const char *s, size_t n) { + char *c = cbm_arena_strndup(&ix->arena, s, n); + ix->oom = ix->oom || !c; + return c; +} + +/* Count, then fill: the records of one file's blob. */ +static void pr_read_blob(pr_index_t *ix, int fi, const char *blob, bool fill) { + pr_file_t *f = &ix->files[fi]; + int np = 0; + int ns = 0; + int nh = 0; + const char *line = strchr(blob, '\n'); /* the tag line */ + while (line && !ix->oom) { + const char *b = line + SKIP_ONE; + const char *e = strchr(b, '\n'); + if (!e) { + e = b + strlen(b); + } + const char *fld[PR_MAX_FIELDS]; + size_t fln[PR_MAX_FIELDS]; + int n = pr_fields(b, e, fld, fln, PR_MAX_FIELDS); + if (n >= PAIR_LEN && fln[PR_F_TAG] == SKIP_ONE) { + char tag = fld[PR_F_TAG][0]; + if (tag == 'P') { + if (fill) { + ix->decls[ix->ndecls++] = + (pr_decl_t){pr_copy(ix, fld[PR_F_A], fln[PR_F_A]), fi}; + } + np++; + } else if (tag == 'S' && n >= CBM_SZ_3) { + if (fill) { + f->subs[f->nsubs++] = pr_copy(ix, fld[PR_F_B], fln[PR_F_B]); + } + ns++; + } else if (tag == 'H' && n >= CBM_SZ_3) { + if (fill) { + bool none = fln[PR_F_A] == SKIP_ONE && fld[PR_F_A][0] == '-'; + f->heads[f->nheads++] = (pr_head_t){ + none ? NULL : pr_copy(ix, fld[PR_F_A], fln[PR_F_A]), + pr_copy(ix, fld[PR_F_B], fln[PR_F_B]), + }; + } + nh++; + } + } + line = *e ? e : NULL; + } + if (!fill) { + ix->ndecls += np; + f->subs = + ns ? (const char **)cbm_arena_alloc(&ix->arena, (size_t)ns * sizeof(char *)) : NULL; + f->heads = + nh ? (pr_head_t *)cbm_arena_alloc(&ix->arena, (size_t)nh * sizeof(pr_head_t)) : NULL; + ix->oom = ix->oom || (ns && !f->subs) || (nh && !f->heads); + } +} + +static int pr_decl_cmp(const void *a, const void *b) { + const pr_decl_t *x = (const pr_decl_t *)a; + const pr_decl_t *y = (const pr_decl_t *)b; + int c = strcmp(x->name, y->name); + return c != 0 ? c : (x->file > y->file) - (x->file < y->file); +} + +static void pr_destroy(void *index) { + pr_index_t *ix = (pr_index_t *)index; + if (!ix) { + return; + } + cbm_ht_free(ix->pkg); + cbm_free(CBM_MEM_CLASS_OTHER, ix->run_to_file); + cbm_arena_destroy(&ix->arena); + cbm_free(CBM_MEM_CLASS_OTHER, ix); +} + +static bool pr_index_files(pr_index_t *ix, const cbm_doclink_build_in_t *in) { + ix->nfiles = in->file_count; + ix->files = + in->file_count + ? (pr_file_t *)cbm_arena_calloc(&ix->arena, (size_t)in->file_count * sizeof(pr_file_t)) + : NULL; + ix->run_count = in->run_file_count; + ix->run_to_file = (int *)cbm_calloc(CBM_MEM_CLASS_OTHER, + (size_t)(in->run_file_count + SKIP_ONE) * sizeof(int)); + if ((in->file_count && !ix->files) || !ix->run_to_file) { + return false; + } + for (int r = 0; r < in->run_file_count; r++) { + ix->run_to_file[r] = CBM_NOT_FOUND; + } + for (int i = 0; i < in->file_count && !ix->oom; i++) { + const cbm_doclink_file_t *src = &in->files[i]; + pr_file_t *f = &ix->files[i]; + f->path = src->rel_path; /* valid until destroy */ + f->module_qn = + cbm_fqn_module_source_lang(&ix->arena, ix->project, src->rel_path, CBM_LANG_PERL); + f->test = pr_test_path(src->rel_path); + ix->oom = ix->oom || !f->module_qn; + if (src->run_file >= 0 && src->run_file < in->run_file_count) { + ix->run_to_file[src->run_file] = i; + } + if (src->scope) { + pr_read_blob(ix, i, src->scope, false); + } + } + return !ix->oom; +} + +static bool pr_index_packages(pr_index_t *ix, const cbm_doclink_build_in_t *in) { + int total = ix->ndecls; + ix->ndecls = 0; + ix->decls = + total ? (pr_decl_t *)cbm_arena_alloc(&ix->arena, (size_t)total * sizeof(pr_decl_t)) : NULL; + if (total && !ix->decls) { + return false; + } + for (int i = 0; i < in->file_count && !ix->oom; i++) { + if (in->files[i].scope) { + pr_read_blob(ix, i, in->files[i].scope, true); + } + } + if (ix->oom) { + return false; + } + qsort(ix->decls, (size_t)ix->ndecls, sizeof(pr_decl_t), pr_decl_cmp); + ix->pkg = cbm_ht_create_in(CBM_MEM_CLASS_OTHER, (uint32_t)(ix->ndecls + SKIP_ONE)); + if (!ix->pkg) { + return false; + } + for (int i = 0; i < ix->ndecls;) { + int j = i; + while (j < ix->ndecls && strcmp(ix->decls[j].name, ix->decls[i].name) == 0) { + j++; + } + pr_range_t *r = (pr_range_t *)cbm_arena_alloc(&ix->arena, sizeof(pr_range_t)); + if (!r) { + return false; + } + *r = (pr_range_t){i, j - i}; + cbm_ht_set(ix->pkg, ix->decls[i].name, r); + i = j; + } + return true; +} + +static void *pr_build(const cbm_doclink_build_in_t *in) { + pr_index_t *ix = (pr_index_t *)cbm_calloc(CBM_MEM_CLASS_OTHER, sizeof(*ix)); + if (!ix) { + return NULL; + } + cbm_arena_init(&ix->arena); + ix->project = in->ctx->project_name; + if (!pr_index_files(ix, in) || !pr_index_packages(ix, in)) { + cbm_log_error("doc_links.perl.error", "step", "index", "reason", "alloc"); + pr_destroy(ix); + return NULL; + } + char b[PAIR_LEN][CBM_SZ_32]; + snprintf(b[0], sizeof(b[0]), "%d", ix->nfiles); + snprintf(b[SKIP_ONE], sizeof(b[SKIP_ONE]), "%u", cbm_ht_count(ix->pkg)); + cbm_log_info("doc_links.perl.index", "files", b[0], "packages", b[SKIP_ONE]); + return ix; +} + +/* ── Resolution ──────────────────────────────────────────────────── */ + +typedef struct { + const pr_index_t *ix; + const cbm_gbuf_t *g; + const pr_file_t *src; + cbm_doclink_outcome_t *out; +} pr_ctx_t; + +static void pr_row(const pr_ctx_t *c, int reason) { + c->out->kind = CBM_DOCLINK_UNRESOLVED; + c->out->reason = reason; +} + +static void pr_edge(const pr_ctx_t *c, const pr_file_t *f, const cbm_gbuf_node_t *node) { + if (!node) { + pr_row(c, CBM_DOCLINK_REASON_GRAPH_GAP); + return; + } + if (f->test && !c->src->test) { + pr_row(c, CBM_DOCLINK_REASON_TEST_ONLY); + return; + } + c->out->kind = CBM_DOCLINK_EDGE; + c->out->target = node; + c->out->exact = true; +} + +static bool pr_node_is(const cbm_gbuf_node_t *n, const pr_file_t *f, const char *label) { + return n && n->label && n->file_path && strcmp(n->label, label) == 0 && + strcmp(n->file_path, f->path) == 0; +} + +/* The module's node: its File node. */ +static const cbm_gbuf_node_t *pr_module_node(const pr_ctx_t *c, const pr_file_t *f) { + return cbm_pipeline_file_node(c->g, c->ix->project, f->path); +} + +/* The node of sub `name` of file f; NULL when it has none of its own. */ +static const cbm_gbuf_node_t *pr_sub_node(const pr_ctx_t *c, const pr_file_t *f, const char *name) { + size_t ql = strlen(f->module_qn); + size_t nl = strlen(name); + char stack[CBM_SZ_512]; + char *qn = ql + nl + PAIR_LEN <= sizeof(stack) + ? stack + : (char *)cbm_alloc(CBM_MEM_CLASS_OTHER, ql + nl + PAIR_LEN); + if (!qn) { + return NULL; + } + memcpy(qn, f->module_qn, ql); + qn[ql] = '.'; + memcpy(qn + ql + SKIP_ONE, name, nl + SKIP_ONE); + const cbm_gbuf_node_t *n = cbm_gbuf_find_by_qn(c->g, qn); + if (qn != stack) { + cbm_free(CBM_MEM_CLASS_OTHER, qn); + } + return (pr_node_is(n, f, "Function") || pr_node_is(n, f, "Method")) ? n : NULL; +} + +static bool pr_has_sub(const pr_file_t *f, const char *name) { + for (int i = 0; i < f->nsubs; i++) { + if (strcmp(f->subs[i], name) == 0) { + return true; + } + } + return false; +} + +/* The one sub a heading `key` of file f names (it has a definition there): + * 1 found, 0 none, 2 several. */ +static int pr_heading_sub(const pr_file_t *f, const char *key, const char **sub) { + *sub = NULL; + for (int i = 0; i < f->nheads; i++) { + const pr_head_t *h = &f->heads[i]; + if (!h->sub || strcmp(h->key, key) != 0 || !pr_has_sub(f, h->sub)) { + continue; + } + if (*sub && strcmp(*sub, h->sub) != 0) { + return PAIR_LEN; + } + *sub = h->sub; + } + return *sub ? SKIP_ONE : 0; +} + +static bool pr_has_heading(const pr_file_t *f, const char *key) { + for (int i = 0; i < f->nheads; i++) { + if (strcmp(f->heads[i].key, key) == 0) { + return true; + } + } + return false; +} + +static void pr_section(const pr_ctx_t *c, const pr_file_t *f, const char *section, bool same_page) { + char key[CBM_DOCLINK_PERL_KEY_MAX]; + cbm_doclink_perl_plain_text(section, strlen(section), key, sizeof(key)); + const char *sub = NULL; + int found = pr_heading_sub(f, key, &sub); + if (found > SKIP_ONE) { + pr_row(c, CBM_DOCLINK_REASON_AMBIGUOUS); + } else if (found == SKIP_ONE) { + pr_edge(c, f, pr_sub_node(c, f, sub)); + } else if (same_page && pr_has_heading(f, key)) { + c->out->kind = CBM_DOCLINK_LOCAL; /* a place in the source's own page */ + } else if (same_page) { + pr_row(c, CBM_DOCLINK_REASON_MISSING); /* a section the page does not have */ + } else { + pr_edge(c, f, pr_module_node(c, f)); + } +} + +/* True when `path` is the file the library layout gives module `page`. */ +static bool pr_layout_names(const char *path, const char *page) { + char want[CBM_DOCLINK_PERL_KEY_MAX + CBM_SZ_8]; + size_t w = 0; + for (const char *p = page; *p && w + CBM_SZ_4 < sizeof(want); p++) { + if (p[0] == ':' && p[SKIP_ONE] == ':') { + want[w++] = '/'; + p++; + } else { + want[w++] = *p; + } + } + memcpy(want + w, ".pm", CBM_SZ_4); + w += CBM_SZ_3; + size_t n = strlen(path); + return n >= w && strcmp(path + n - w, want) == 0 && (n == w || path[n - w - SKIP_ONE] == '/'); +} + +/* The file of module `page`: NULL with *ambiguous false when the repository + * declares no such package. */ +static const pr_file_t *pr_page_file(const pr_index_t *ix, const char *page, bool *ambiguous) { + *ambiguous = false; + const pr_range_t *r = (const pr_range_t *)cbm_ht_get(ix->pkg, page); + if (!r || r->count == 0) { + return NULL; + } + if (r->count == SKIP_ONE) { + return &ix->files[ix->decls[r->first].file]; + } + const pr_file_t *hit = NULL; + for (int i = r->first; i < r->first + r->count; i++) { + const pr_file_t *f = &ix->files[ix->decls[i].file]; + if (f == hit || !pr_layout_names(f->path, page)) { + continue; + } + if (hit) { + *ambiguous = true; + return NULL; + } + hit = f; + } + *ambiguous = hit == NULL; + return hit; +} + +static void pr_resolve(const void *index, void *state, int run_file, const CBMDocLink *link, + const cbm_gbuf_t *graph, cbm_doclink_outcome_t *out) { + (void)state; /* Perl keeps no per-file working state */ + const pr_index_t *ix = (const pr_index_t *)index; + out->kind = CBM_DOCLINK_UNRESOLVED; + out->reason = CBM_DOCLINK_REASON_MISSING; + out->target = NULL; + out->exact = false; + if (!ix || !link->raw || run_file < 0 || run_file >= ix->run_count || + ix->run_to_file[run_file] < 0) { + return; + } + pr_ctx_t c = {.ix = ix, .g = graph, .src = &ix->files[ix->run_to_file[run_file]], .out = out}; + CBMPerlLink pl; + if (!cbm_doclink_perl_parse_link(link->raw, &pl)) { + pr_row(&c, CBM_DOCLINK_REASON_UNPARSEABLE); + return; + } + if (pl.kind == CBM_PERL_LINK_MAN) { + pr_row(&c, CBM_DOCLINK_REASON_EXTERNAL); + return; + } + if (pl.kind == CBM_PERL_LINK_SECTION) { + pr_section(&c, c.src, pl.section, true); + return; + } + bool ambiguous = false; + const pr_file_t *f = pr_page_file(ix, pl.page, &ambiguous); + if (!f) { + pr_row(&c, ambiguous ? CBM_DOCLINK_REASON_AMBIGUOUS : CBM_DOCLINK_REASON_EXTERNAL); + return; + } + if (pl.section[0]) { + pr_section(&c, f, pl.section, false); + return; + } + pr_edge(&c, f, pr_module_node(&c, f)); +} + +const cbm_doclink_resolver_t cbm_doclink_perl_resolver = { + .langs = {CBM_LANG_PERL}, + .lang_count = 1, + .scope_tag = CBM_DOCLINK_PERL_SCOPE_TAG, + .build = pr_build, + .destroy = pr_destroy, + .resolve = pr_resolve, +}; diff --git a/tests/test_doc_mentions_helpers.h b/tests/test_doc_mentions_helpers.h index e37ee9368..f0e2312e1 100644 --- a/tests/test_doc_mentions_helpers.h +++ b/tests/test_doc_mentions_helpers.h @@ -439,7 +439,7 @@ static const int DM_HELD_FAMILIES[] = { CBM_DOCLINK_JAVA_VALUE, CBM_DOCLINK_KT_KDOC_LINK, CBM_DOCLINK_KT_SEE, CBM_DOCLINK_KT_THROWS, CBM_DOCLINK_KT_SAMPLE, CBM_DOCLINK_RS_INTRA_DOC, - CBM_DOCLINK_RS_LINK_DEF, + CBM_DOCLINK_RS_LINK_DEF, CBM_DOCLINK_PERL_POD_L, }; static inline void dm_ship_held_families(void) { diff --git a/tests/test_doc_mentions_perl.c b/tests/test_doc_mentions_perl.c new file mode 100644 index 000000000..177d4a9d5 --- /dev/null +++ b/tests/test_doc_mentions_perl.c @@ -0,0 +1,292 @@ +/* + * test_doc_mentions_perl.c -- Perl POD L<> codes as doc-comment references. + * + * A sub's doc is the POD section that names it; the file's module doc (its + * File node's docstring) is the POD no sub holds. The L<> codes of both are + * the references: module-level ones come from the File node. + */ +#include "../src/foundation/compat.h" +#include "test_framework.h" +#include "test_helpers.h" +#include "test_doc_mentions_helpers.h" + +#include "cbm.h" +#include "doclink.h" + +#include +#include + +/* ── extraction ──────────────────────────────────────────────────── */ + +static const char *const PL_KNOB = + "package Knob;\n" /* 1 */ + "\n" /* 2 */ + "=head1 NAME\n" /* 3 */ + "\n" /* 4 */ + "Knob - see L and L.\n" /* 5 */ + "\n" /* 6 */ + "=cut\n" /* 7 */ + "\n" /* 8 */ + "sub turn { return 1; }\n" /* 9 */ + "1;\n" /* 10 */ + "__END__\n" /* 11 */ + "\n" /* 12 */ + "=head1 METHODS\n" /* 13 */ + "\n" /* 14 */ + "Methods, see L and L.\n" /* 15 */ + "\n" /* 16 */ + "=head2 turn\n" /* 17 */ + "\n" /* 18 */ + "Turns, like L.\n" /* 19 */ + "\n" /* 20 */ + "=head2 spin\n" /* 21 */ + "\n" /* 22 */ + "About L and L.\n" /* 23 */ + "\n" /* 24 */ + "=cut\n"; /* 25 */ + +/* The one token `raw`: its line, whether it is the file's, its family. */ +static bool pl_token_is(const CBMFileResult *r, const char *raw, uint32_t line, bool file, + int syntax) { + if (dm_count_tokens(r, raw) != 1) { + printf(" token %s: %d found\n", raw, dm_count_tokens(r, raw)); + return false; + } + const CBMDocLink *t = dm_find_token(r, raw); + bool is_file = (t->flags & CBM_DOCLINK_FLAG_FILE) != 0; + if (t->line != line || is_file != file || t->syntax != syntax) { + printf(" token %s: line %u file %d syntax %d\n", raw, t->line, is_file, t->syntax); + return false; + } + return true; +} + +TEST(doc_mentions_perl_tokens) { + CBMFileResult *r = dm_extract(PL_KNOB, CBM_LANG_PERL, "lib/Knob.pm"); + ASSERT_NOT_NULL(r); + /* the module doc's references come from the file, each on its own line */ + ASSERT_TRUE(pl_token_is(r, "Dial", 5, true, CBM_DOCLINK_PERL_POD_L)); + ASSERT_TRUE(pl_token_is(r, "the knob|Knob::Turn/turning", 5, true, CBM_DOCLINK_PERL_POD_L)); + ASSERT_TRUE(pl_token_is(r, "/turn", 15, true, CBM_DOCLINK_PERL_POD_L)); + ASSERT_TRUE(pl_token_is(r, "https://example.org/k", 15, true, CBM_DOCLINK_HREF)); + ASSERT_TRUE(pl_token_is(r, "perlfunc/open", 23, true, CBM_DOCLINK_PERL_POD_L)); + ASSERT_TRUE(pl_token_is(r, "crontab(5)", 23, true, CBM_DOCLINK_PERL_POD_L)); + /* a sub's section is the sub's, and only the sub's */ + ASSERT_TRUE(pl_token_is(r, "Knob::Spin", 19, false, CBM_DOCLINK_PERL_POD_L)); + const CBMDocLink *t = dm_find_token(r, "Knob::Spin"); + ASSERT_NOT_NULL(strstr(t->source_qn, "turn")); + ASSERT_EQ(r->doc_links.count, 7); + cbm_free_result(r); + PASS(); +} + +/* ── resolution ──────────────────────────────────────────────────── */ + +static void pl_write_repo(const char *repo) { + th_write_file(TH_PATH(repo, "lib/Knob.pm"), + "package Knob;\n" + "\n" + "=head1 NAME\n" + "\n" + "Knob - L, L, L.\n" + "\n" + "=head1 SEE ALSO\n" + "\n" + "L, L, L, L, L, L,\n" + "L.\n" + "\n" + "=head1 NOTES\n" + "\n" + "Nothing.\n" + "\n" + "=cut\n" + "\n" + "sub turn { return 1; }\n" + "\n" + "=head2 turn\n" + "\n" + "Turns, see L.\n" + "\n" + "=cut\n" + "\n" + "1;\n"); + th_write_file(TH_PATH(repo, "lib/Knob/Dial.pm"), "package Knob::Dial;\n" + "\n" + "=head1 OVERVIEW\n" + "\n" + "The dial of L.\n" + "\n" + "=cut\n" + "\n" + "sub spin { return 2; }\n" + "\n" + "=head2 spin\n" + "\n" + "Spins.\n" + "\n" + "=cut\n" + "\n" + "1;\n"); + /* a second declaration of Knob::Dial, not where the library layout puts it */ + th_write_file(TH_PATH(repo, "lib/Extra.pm"), "package Knob::Dial;\nsub extra { 3 }\n1;\n"); + /* Dup twice, neither at its layout path */ + th_write_file(TH_PATH(repo, "lib/A.pm"), "package Dup;\nsub a { 1 }\n1;\n"); + th_write_file(TH_PATH(repo, "lib/B.pm"), "package Dup;\nsub b { 1 }\n1;\n"); + th_write_file(TH_PATH(repo, "t/lib/TestHelper.pm"), + "package TestHelper;\nsub help { 1 }\n1;\n"); +} + +static bool pl_edge(const char *db, const char *src, const char *tgt) { + char props[512]; + int n = 0; + dm_edge(db, src, tgt, props, sizeof(props), &n); + if (n != 1 || !strstr(props, "\"tier\":\"exact\"")) { + printf(" edge %s -> %s: %d found %s\n", src, tgt, n, props); + return false; + } + return true; +} + +static bool pl_row(const char *db, const char *rel, const char *raw, const char *reason) { + char got[64]; + dm_row(db, rel, raw, got, sizeof(got), NULL, 0); + if (strcmp(got, reason) != 0) { + printf(" row %s [%s]: \"%s\", expected \"%s\"\n", rel, raw, got, reason); + return false; + } + return true; +} + +TEST(doc_mentions_perl_resolution) { + char tmp[256]; + snprintf(tmp, sizeof(tmp), "/tmp/cbm_dlperl_XXXXXX"); + ASSERT_NOT_NULL(cbm_mkdtemp(tmp)); + char repo[512]; + char db[512]; + snprintf(repo, sizeof(repo), "%s/repo", tmp); + snprintf(db, sizeof(db), "%s/g.db", tmp); + pl_write_repo(repo); + ASSERT_EQ(dm_index(repo, db, NULL), 0); + const char *knob = "lib/Knob.pm"; + /* a module the library layout names, though another file declares it too */ + ASSERT_TRUE(pl_edge(db, "lib.Knob.pm.__file__", "lib.Knob.Dial.pm.__file__")); + /* a section whose heading names a sub of the module: the sub */ + ASSERT_TRUE(pl_edge(db, "lib.Knob.pm.__file__", "lib.Knob.Dial.spin")); + ASSERT_TRUE(pl_edge(db, "lib.Knob.turn", "lib.Knob.Dial.spin")); + /* the same page: a sub binds, a section that names none is local */ + ASSERT_TRUE(pl_edge(db, "lib.Knob.pm.__file__", "lib.Knob.turn")); + ASSERT_TRUE(pl_row(db, knob, "/NOTES", "")); + /* ... and one the page has no heading for is doc rot */ + ASSERT_TRUE(pl_row(db, knob, "/GONE", "missing")); + /* outside the repository, a man page, test code, two declarations */ + ASSERT_TRUE(pl_row(db, knob, "Mojo::Base", "external")); + ASSERT_TRUE(pl_row(db, knob, "crontab(5)", "external")); + ASSERT_TRUE(pl_row(db, knob, "TestHelper", "test_only_target")); + ASSERT_TRUE(pl_row(db, knob, "Dup", "ambiguous")); + /* the page is the file, also where a Folder holds lib/Knob.pm's module name */ + ASSERT_TRUE(pl_edge(db, "lib.Knob.Dial.pm.__file__", "lib.Knob.pm.__file__")); + th_cleanup(tmp); + PASS(); +} + +/* ── incremental == full; one worker == several ──────────────────── */ + +#define PL_INC_DIAL \ + "package Knob::Dial;\n\n=head1 OVERVIEW\n\nThe dial.\n\n=cut\n\nsub spin { 2 }\n\n" \ + "=head2 spin\n\nSpins.\n\n=cut\n\n1;\n" + +TEST(doc_mentions_perl_incremental_equals_full) { + char tmp[256]; + snprintf(tmp, sizeof(tmp), "/tmp/cbm_dlperl_inc_XXXXXX"); + ASSERT_NOT_NULL(cbm_mkdtemp(tmp)); + char repo[512]; + char inc_db[512]; + char full_db[512]; + snprintf(repo, sizeof(repo), "%s/repo", tmp); + snprintf(inc_db, sizeof(inc_db), "%s/inc.db", tmp); + snprintf(full_db, sizeof(full_db), "%s/full.db", tmp); + th_write_file(TH_PATH(repo, "lib/Knob.pm"), + "package Knob;\n\n=head1 NAME\n\nKnob - see L.\n\n=cut\n\n" + "sub turn { 1 }\n1;\n"); + th_write_file(TH_PATH(repo, "lib/Knob/Dial.pm"), PL_INC_DIAL); + ASSERT_EQ(dm_index(repo, inc_db, NULL), 0); + ASSERT_TRUE(pl_edge(inc_db, "lib.Knob.pm.__file__", "lib.Knob.Dial.spin")); + + /* the module doc's text changes: the file is repaired alone */ + th_write_file( + TH_PATH(repo, "lib/Knob.pm"), + "package Knob;\n\n=head1 NAME\n\nKnob, a knob - see L.\n\n=cut\n\n" + "sub turn { 1 }\n1;\n"); + ASSERT_EQ( + dm_step(repo, inc_db, full_db, "module doc edit", CBM_INCREMENTAL_ROUTE_CLOSURE_REPAIR), 0); + ASSERT_TRUE(pl_edge(inc_db, "lib.Knob.pm.__file__", "lib.Knob.Dial.spin")); + + /* a reference added to the module doc: an edge from the File node */ + th_write_file(TH_PATH(repo, "lib/Knob.pm"), + "package Knob;\n\n=head1 NAME\n\nKnob, a knob - see L and\n" + "L.\n\n=cut\n\nsub turn { 1 }\n1;\n"); + ASSERT_EQ( + dm_step(repo, inc_db, full_db, "module doc link", CBM_INCREMENTAL_ROUTE_CLOSURE_REPAIR), 0); + ASSERT_TRUE(pl_edge(inc_db, "lib.Knob.pm.__file__", "lib.Knob.Dial.pm.__file__")); + + /* a new heading changes the file's scope blob: without a scope_delta hook + * that is a full run */ + th_write_file(TH_PATH(repo, "lib/Knob.pm"), + "package Knob;\n\n=head1 NAME\n\nKnob, a knob - see L and\n" + "L.\n\n=head1 SEE ALSO\n\nL\n\n=cut\n\n" + "sub turn { 1 }\n1;\n"); + ASSERT_EQ(dm_step(repo, inc_db, full_db, "heading added", CBM_INCREMENTAL_ROUTE_FORCED_FULL), + 0); + + /* the heading that named the sub goes: another file's section reference + * now names a place in the module's documentation, the module */ + th_write_file( + TH_PATH(repo, "lib/Knob/Dial.pm"), + "package Knob::Dial;\n\n=head1 OVERVIEW\n\nThe dial.\n\n=cut\n\nsub spin { 2 }\n1;\n"); + ASSERT_EQ(dm_step(repo, inc_db, full_db, "heading removed", CBM_INCREMENTAL_ROUTE_FORCED_FULL), + 0); + char props[512]; + int n = 0; + dm_edge(inc_db, "lib.Knob.pm.__file__", "lib.Knob.Dial.spin", props, sizeof(props), &n); + ASSERT_EQ(n, 0); + th_cleanup(tmp); + PASS(); +} + +TEST(doc_mentions_perl_workers_agree) { + char tmp[256]; + snprintf(tmp, sizeof(tmp), "/tmp/cbm_dlperl_par_XXXXXX"); + ASSERT_NOT_NULL(cbm_mkdtemp(tmp)); + char repo[512]; + char par_db[512]; + char seq_db[512]; + snprintf(repo, sizeof(repo), "%s/repo", tmp); + snprintf(par_db, sizeof(par_db), "%s/par.db", tmp); + snprintf(seq_db, sizeof(seq_db), "%s/seq.db", tmp); + enum { MODULES = 60 }; /* past the parallel threshold */ + for (int i = 0; i < MODULES; i++) { + char rel[64]; + char src[1024]; + int next = (i + 1) % MODULES; + snprintf(rel, sizeof(rel), "lib/Par/M%02d.pm", i); + snprintf(src, sizeof(src), + "package Par::M%02d;\n\n=head1 NAME\n\nPar::M%02d - see L,\n" + "L, L, L and L.\n\n=cut\n\n" + "sub run%02d { %d }\n\n=head2 run%02d\n\nRuns; also L.\n\n" + "=cut\n\n1;\n", + i, i, next, next, next, i, i, i, i, next); + th_write_file(TH_PATH(repo, rel), src); + } + ASSERT_EQ(dm_workers_agree(repo, par_db, seq_db), 0); + ASSERT_TRUE(pl_edge(par_db, "lib.Par.M00.pm.__file__", "lib.Par.M01.run01")); + th_cleanup(tmp); + PASS(); +} + +SUITE(doc_mentions_perl) { + dm_ship_held_families(); + RUN_TEST(doc_mentions_perl_tokens); + RUN_TEST(doc_mentions_perl_resolution); + RUN_TEST(doc_mentions_perl_incremental_equals_full); + RUN_TEST(doc_mentions_perl_workers_agree); +} diff --git a/tests/test_main.c b/tests/test_main.c index ae29520be..8c2c814d1 100644 --- a/tests/test_main.c +++ b/tests/test_main.c @@ -1828,6 +1828,7 @@ extern void suite_doc_links_adoc(void); extern void suite_doc_mentions_go(void); extern void suite_doc_mentions_jvm(void); extern void suite_doc_mentions_rs(void); +extern void suite_doc_mentions_perl(void); extern void suite_infrascan(void); extern void suite_cli(void); extern void suite_agent_clients(void); @@ -2302,6 +2303,7 @@ int main(int argc, char **argv) { RUN_SELECTED_SUITE(doc_mentions_go); RUN_SELECTED_SUITE(doc_mentions_jvm); RUN_SELECTED_SUITE(doc_mentions_rs); + RUN_SELECTED_SUITE(doc_mentions_perl); /* Infrastructure scanning */ RUN_SELECTED_SUITE(infrascan);