From e91f0e950d63df1236d6719a12c2ccda6a4d8c7a Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Mon, 14 Sep 2026 16:20:10 +0200 Subject: [PATCH 1/2] tools: compile a project through one function The sheet tw prints for a scanned project was assembled inside the CLI, so the sweep measuring that sheet against Tailwind rebuilt only half of it: the utilities from an empty class list and the splice, never the classes a project's own declarations route. A case whose markup carries a class could not be measured. Tw_tools.Project.stylesheet is that assembly now, and the CLI calls it; what it prints is unchanged byte for byte. --- bin/main.ml | 87 +------------------------------------------ lib/tools/project.ml | 81 ++++++++++++++++++++++++++++++++++++++++ lib/tools/project.mli | 17 +++++++++ 3 files changed, 100 insertions(+), 85 deletions(-) create mode 100644 lib/tools/project.ml create mode 100644 lib/tools/project.mli diff --git a/bin/main.ml b/bin/main.ml index 7b3759fa..c802d512 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -233,97 +233,14 @@ let print_stats ~quiet ~candidate_count ~known_count = Fmt.epr "Candidate tokens scanned: %d@." candidate_count; Fmt.epr "Successfully parsed: %d@." known_count) -(* [prose] comes from @tailwindcss/typography, which Tailwind only applies when - the entrypoint asks for it. A project that styles [.prose] itself, as - tailwindcss.com does, gets the plugin's whole stylesheet on top otherwise. *) -let declares_plugin css name = - match css with - | None -> false - | Some css -> Re.execp (Re.compile (Re.str ("@tailwindcss/" ^ name))) css - -let is_prose_class cls = - cls = "prose" - || String.starts_with ~prefix:"prose-" cls - || - (* variants keep the utility at the end: [lg:prose-sm] *) - match String.rindex_opt cls ':' with - | Some i -> - let bare = String.sub cls (i + 1) (String.length cls - i - 1) in - bare = "prose" || String.starts_with ~prefix:"prose-" bare - | None -> false - -let parse_known_candidates ?(theme = Tw.Scheme.default) ?input_css candidates = - let typography = declares_plugin input_css "typography" in - List.filter_map - (fun cls -> - if (not typography) && is_prose_class cls then None - else - match Tw.of_string ~theme cls with - | Ok style -> ( - (* A handler may accept a class at parse yet raise when it renders - an arbitrary value it cannot serialise, as the docs' - [prop-[]] placeholders do. Such a class produces no rule, - so drop it rather than let it abort the whole sheet. *) - match Tw.to_css ~theme [ style ] with - | (_ : Css.t) -> Some (cls, style) - | exception - (Invalid_argument _ | Failure _ | Cascade.Error.Parse_error _) - -> - None) - | Error _ -> None) - candidates - let scanned_classes paths = collect_files paths |> List.concat_map Tw_tools.Source_scan.candidates_from_file |> List.sort_uniq String.compare -(* The whole sheet tw generates for a scanned project: the built-in utilities, - the classes the project's own [@utility] and [@custom-variant] declarations - route, and the entrypoint all of it is spliced into. A comparison against the - real Tailwind has to be made against this, not against the built-in utilities - alone: Tailwind reads the same entrypoint, so every declared utility would - otherwise read as a rule tw failed to emit. *) let native_stylesheet ~(opts : gen_opts) ~include_base all_classes = - let defs = Entrypoint.entry_variant_defs opts.input_css_path in - let udefs = Entrypoint.entry_utility_defs opts.input_css_path in - let routed, normal = - List.partition (Entrypoint.is_custom_routed ~defs ~udefs) all_classes - in - let known = - parse_known_candidates ~theme:opts.theme ?input_css:opts.input_css normal - in - let routed_count, routed_extra, routed_stmts = - Entrypoint.custom_routed_utilities ~theme:opts.theme ~defs ~udefs routed - in - (* Routed custom variants no longer pass through the typed modifier parser, - but the sorter still needs their exact names so a declaration such as - [not-dark] is not mistaken for the built-in [not-] compound slot. Dummy - selector values are sufficient here: routed candidates already carry the - expanded author CSS in [extra], and only the registered names are read. *) - let sort_theme = - let custom = Tw.Scheme.{ values = [ ("", "&") ]; template = "{}" } in - let custom_variants = - List.fold_left - (fun variants (name, _) -> - if List.mem_assoc name variants then variants - else (name, custom) :: variants) - opts.theme.custom_variants defs - in - { opts.theme with custom_variants } - in - let stylesheet = - Tw.to_css ~theme:sort_theme ~base:include_base ~extra:routed_extra - (List.map snd known) - in - let stylesheet = Entrypoint.place_routed routed_stmts stylesheet in - let stylesheet = - match opts.input_css_path with - | Some path -> - Entrypoint.splice_into_entrypoint ~theme:opts.theme ~path stylesheet - | None -> stylesheet - in - (List.length known + routed_count, stylesheet) + Tw_tools.Project.stylesheet ~theme:opts.theme ?entrypoint:opts.input_css_path + ~base:include_base all_classes let diff_files paths ~(opts : gen_opts) = try diff --git a/lib/tools/project.ml b/lib/tools/project.ml new file mode 100644 index 00000000..3ef1ab3d --- /dev/null +++ b/lib/tools/project.ml @@ -0,0 +1,81 @@ +(* [prose] comes from @tailwindcss/typography, which Tailwind only applies when + the entrypoint asks for it. A project that styles [.prose] itself, as + tailwindcss.com does, gets the plugin's whole stylesheet on top otherwise. *) +let declares_plugin css name = + match css with + | None -> false + | Some css -> Re.execp (Re.compile (Re.str ("@tailwindcss/" ^ name))) css + +let is_prose_class cls = + cls = "prose" + || String.starts_with ~prefix:"prose-" cls + || + (* variants keep the utility at the end: [lg:prose-sm] *) + match String.rindex_opt cls ':' with + | Some i -> + let bare = String.sub cls (i + 1) (String.length cls - i - 1) in + bare = "prose" || String.starts_with ~prefix:"prose-" bare + | None -> false + +let parse_known_candidates ~theme ?input_css candidates = + let typography = declares_plugin input_css "typography" in + List.filter_map + (fun cls -> + if (not typography) && is_prose_class cls then None + else + match Tw.of_string ~theme cls with + | Ok style -> ( + (* A handler may accept a class at parse yet raise when it renders + an arbitrary value it cannot serialise, as the docs' + [prop-[]] placeholders do. Such a class produces no rule, + so drop it rather than let it abort the whole sheet. *) + match Tw.to_css ~theme [ style ] with + | (_ : Cascade.Css.t) -> Some (cls, style) + | exception + (Invalid_argument _ | Failure _ | Cascade.Error.Parse_error _) + -> + None) + | Error _ -> None) + candidates + +(* A comparison against the real Tailwind has to be made against the whole of + this, not against the built-in utilities alone: Tailwind reads the same + entrypoint, so every declared utility would otherwise read as a rule tw + failed to emit. *) +let stylesheet ~theme ?entrypoint ~base classes = + let input_css = Option.map Entrypoint.read_file entrypoint in + let defs = Entrypoint.entry_variant_defs entrypoint in + let udefs = Entrypoint.entry_utility_defs entrypoint in + let routed, normal = + List.partition (Entrypoint.is_custom_routed ~defs ~udefs) classes + in + let known = parse_known_candidates ~theme ?input_css normal in + let routed_count, routed_extra, routed_stmts = + Entrypoint.custom_routed_utilities ~theme ~defs ~udefs routed + in + (* Routed custom variants no longer pass through the typed modifier parser, + but the sorter still needs their exact names so a declaration such as + [not-dark] is not mistaken for the built-in [not-] compound slot. Dummy + selector values are sufficient here: routed candidates already carry the + expanded author CSS in [extra], and only the registered names are read. *) + let sort_theme = + let custom = Tw.Scheme.{ values = [ ("", "&") ]; template = "{}" } in + let custom_variants = + List.fold_left + (fun variants (name, _) -> + if List.mem_assoc name variants then variants + else (name, custom) :: variants) + theme.Tw.Scheme.custom_variants defs + in + { theme with custom_variants } + in + let sheet = + Tw.to_css ~theme:sort_theme ~base ~extra:routed_extra (List.map snd known) + in + let sheet = Entrypoint.place_routed routed_stmts sheet in + let sheet = + match entrypoint with + | Some path -> Entrypoint.splice_into_entrypoint ~theme ~path sheet + | None -> sheet + in + (List.length known + routed_count, sheet) diff --git a/lib/tools/project.mli b/lib/tools/project.mli new file mode 100644 index 00000000..d173c9a7 --- /dev/null +++ b/lib/tools/project.mli @@ -0,0 +1,17 @@ +(** The stylesheet [tw] generates for a whole project. + + One function, so the CLI and anything measuring the CLI against Tailwind + compile a project the same way rather than two ways that drift. *) + +val stylesheet : + theme:Tw.Scheme.t -> + ?entrypoint:string -> + base:bool -> + string list -> + int * Cascade.Css.t +(** [stylesheet ~theme ?entrypoint ~base classes] is the sheet for a project + whose markup carries [classes], with how many of them produced a rule: the + built-in utilities, the classes the entrypoint's own [@utility] and + [@custom-variant] declarations route, and the entrypoint at path + [entrypoint] all of it is spliced into. The base layer is included when + [base]. A class no handler reads is left out rather than raising. *) From 5944ffc8b0b2c12a19bf94e6babc102a05aee1f1 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Mon, 14 Sep 2026 16:20:12 +0200 Subject: [PATCH 2/2] test: give every dialect directive a case and a verdict The sweep was written from the bugs already found, and it stayed green while more were reported in idioms it did not contain: a list its author wrote can only hold what its author already knew. The inventory comes from the oracle now. Every at-keyword the pinned bundle handles beyond CSS's own, and every value function it defines, must have a case, so one nobody thought to cover, or one a Tailwind upgrade adds, fails here. A case declares parity or a divergence with its reason, and a divergence that starts matching fails as well, so a gap that gets fixed reports itself. Cases compile through Tw_tools.Project, which lets them carry markup classes. --- test/tools/test_entrypoint.ml | 375 ++++++++++++++++++++++++++++------ 1 file changed, 310 insertions(+), 65 deletions(-) diff --git a/test/tools/test_entrypoint.ml b/test/tools/test_entrypoint.ml index 9912cb39..bcf92c5e 100644 --- a/test/tools/test_entrypoint.ml +++ b/test/tools/test_entrypoint.ml @@ -700,8 +700,9 @@ let test_apply_keeps_the_keyframes () = check bool "the @keyframes the animation names survives" true (Astring.String.is_infix ~affix:"@keyframes spin" css) -(* A sweep over the author-CSS dialect, each idiom measured against the pinned - CLI rather than against an expectation written here. +(* A sweep over Tailwind's CSS dialect: each case is an entrypoint, compiled by + tw the way the [tw] CLI compiles a project and by the pinned CLI, and the two + sheets compared whole. Every defect found in this area since the corpus went in has been invisible to the markup sweeps: the utility rules were byte-identical and only the @@ -709,81 +710,323 @@ let test_apply_keeps_the_keyframes () = browser dropped the declaration. A class list cannot reach any of it, so the entrypoint is the unit under test. - Adding a line here is how the next one gets found. The entrypoint fences its - own sources, so the generated sheet is empty and what is compared is the - author's CSS and the theme layer it pulls in. *) + A case declares what the CLI says about it: parity, or a divergence with the + reason it is one. Either verdict can fail. A divergence that starts matching + fails as surely as a parity case that stops, so a gap that gets fixed reports + itself rather than going quiet, and the change that fixes it moves the case + to parity. *) +type verdict = Parity | Diverges of string + +type case = { + name : string; + entry : string; + classes : string list; + (** The markup's classes. tw is handed them; the CLI reads them from an + [@source inline] the sweep appends to the entrypoint. *) + files : (string * string) list; + (** Files the entrypoint reads, written beside it. *) + verdict : verdict; +} + +let case ?(classes = []) ?(files = []) ?why name entry = + let verdict = match why with None -> Parity | Some why -> Diverges why in + { name; entry; classes; files; verdict } + +(* An entrypoint that imports all of Tailwind and fences its sources, so nothing + is scanned and what is generated is what the case asks for. *) +let fenced body = + String.concat "" [ "@import \"tailwindcss\" source(none);\n"; body; "\n" ] + let cases = [ - ("apply-plain", ".btn { @apply p-4 rounded-lg; }"); - ("apply-colour", ".btn { @apply bg-blue-500 text-white; }"); - ("apply-important", ".btn { @apply bg-blue-500!; }"); - ("apply-namespaced", ".btn { @apply blur-sm ease-in-out tracking-wide; }"); - ("apply-animation", ".btn { @apply animate-spin; }"); - ("apply-nested", ".btn { &:hover { @apply underline; } }"); - ("apply-in-layer", "@layer components { .btn { @apply p-4; } }"); - ("utility-apply", "@utility card { @apply rounded-lg; }"); - ("spacing-fn", ".btn { padding: --spacing(4); }"); - ("spacing-fn-fraction", ".btn { margin: --spacing(2.5); }"); - ("alpha-fn", ".btn { color: --alpha(var(--color-red-500) / 50%); }"); - ("theme-fn", ".btn { color: theme(--color-red-500); }"); - ("theme-fn-v3", ".btn { color: theme(colors.red.500); }"); - ( "theme-in-media", - "@media (width >= theme(--breakpoint-md)) { .btn { display: flex; } }" ); - ( "theme-block", - "@theme { --color-brand: #1da1f2; } .btn { color: var(--color-brand); }" - ); - ( "theme-keyframes", - "@theme { --animate-wiggle: wiggle 1s; @keyframes wiggle { to { \ - transform: rotate(3deg); } } } .btn { animation: var(--animate-wiggle); \ - }" ); - ( "custom-variant", - "@custom-variant dark (&:where(.dark, .dark *)); .btn { @apply p-4; }" ); - ("variant-at-rule", ".btn { @variant dark { color: white; } }"); - ( "colour-mix-author", - "@theme { --color-brand: #1da1f2; } .btn { color: color-mix(in oklab, \ - var(--color-brand) 25%, transparent); }" ); + case "apply-plain" (fenced ".btn { @apply p-4 rounded-lg; }"); + case "apply-colour" (fenced ".btn { @apply bg-blue-500 text-white; }"); + case "apply-important" (fenced ".btn { @apply bg-blue-500!; }"); + case "apply-namespaced" + (fenced ".btn { @apply blur-sm ease-in-out tracking-wide; }"); + case "apply-animation" (fenced ".btn { @apply animate-spin; }"); + case "apply-nested" (fenced ".btn { &:hover { @apply underline; } }"); + case "apply-in-layer" (fenced "@layer components { .btn { @apply p-4; } }"); + case "utility-apply" (fenced "@utility card { @apply rounded-lg; }"); + case "apply-declared-utility" + ~why: + "an @apply naming a utility the same file declares finds none, so the \ + rule loses the declarations" + (fenced "@utility card { tab-size: 8; } .btn { @apply card; }"); + case "utility-functional" + ~classes:[ "foo-2"; "foo-2/3"; "foo-2/[7]" ] + (fenced + "@utility foo-* { z-index: --value(integer); order: \ + --modifier(integer, [integer]); }"); + case "spacing-fn" (fenced ".btn { padding: --spacing(4); }"); + case "spacing-fn-fraction" (fenced ".btn { margin: --spacing(2.5); }"); + case "alpha-fn" + (fenced ".btn { color: --alpha(var(--color-red-500) / 50%); }"); + case "theme-fn" (fenced ".btn { color: theme(--color-red-500); }"); + case "theme-fn-dashed" + ~why:"--theme() passes through unexpanded, which no browser reads" + (fenced ".btn { color: --theme(--color-red-500); }"); + case "theme-fn-v3" (fenced ".btn { color: theme(colors.red.500); }"); + case "theme-in-media" + (fenced + "@media (width >= theme(--breakpoint-md)) { .btn { display: flex; } }"); + case "theme-block" + (fenced + "@theme { --color-brand: #1da1f2; } .btn { color: var(--color-brand); \ + }"); + case "theme-inline" + (fenced + "@theme inline { --color-brand: #1da1f2; } .btn { color: \ + var(--color-brand); }"); + case "theme-reference" + ~why:"a reference token author CSS reads is declared, where none may be" + (fenced + "@theme reference { --color-brand: #1da1f2; } .btn { color: \ + var(--color-brand); }"); + case "theme-default" + (fenced + "@theme default { --color-brand: #1da1f2; } .btn { color: \ + var(--color-brand); }"); + case "theme-static" ~why:"the block's tokens are not declared" + (fenced "@theme static { --color-brand: #1da1f2; }"); + case "theme-keyframes" + (fenced + "@theme { --animate-wiggle: wiggle 1s; @keyframes wiggle { to { \ + transform: rotate(3deg); } } } .btn { animation: \ + var(--animate-wiggle); }"); + case "custom-variant" + (fenced + "@custom-variant dark (&:where(.dark, .dark *)); .btn { @apply p-4; }"); + case "custom-variant-slot" + (fenced + "@custom-variant hocus { &:hover, &:focus { @slot; } } .btn { \ + @variant hocus { color: red; } }"); + case "variant-at-rule" (fenced ".btn { @variant dark { color: white; } }"); + case "colour-mix-author" + (fenced + "@theme { --color-brand: #1da1f2; } .btn { color: color-mix(in oklab, \ + var(--color-brand) 25%, transparent); }"); + case "property-author" + ~why:"an author @property gets no @supports initial-value fallback" + (fenced + "@property --my-x { syntax: \"\"; inherits: false; \ + initial-value: 0px; } .a { --my-x: 2px; }"); + case "plugin-typography" + ~why: + "@apply prose swaps the plugin's inner .prose for the applying class \ + too" + (fenced "@plugin \"@tailwindcss/typography\"; .btn { @apply prose; }"); + case "config-js" + ~files: + [ + ( "sweep-config.js", + "module.exports = { theme: { extend: { colors: { brand: '#1da1f2' \ + } } } };\n" ); + ] + ~why: + "tw does not evaluate a JavaScript config, so a colour it adds \ + resolves to nothing" + (fenced + "@config \"./sweep-config.js\"; .btn { color: theme(colors.brand); }"); + case "import-important" + ~classes:[ "p-4"; "hover:underline" ] + ~why:"the option is read by nothing, so no utility is important" + "@import \"tailwindcss\" important source(none);\n"; + case "import-prefix" ~classes:[ "tw:p-4" ] + "@import \"tailwindcss\" prefix(tw) source(none);\n"; + case "import-theme-static" + ~why: + "the static theme leaves out the --text-*--line-height tokens and the \ + keyframes" + "@import \"tailwindcss\" theme(static) source(none);\n"; + case "reference" + ~why: + "tw emits the theme layer a reference exists to leave out, and each \ + var() loses its fallback" + "@reference \"tailwindcss\";\n\ + .btn { @apply rounded-lg bg-blue-600 p-4; }\n"; + case "source-inline" + ~why: + "the safelist is read by nothing, so none of its classes is generated" + (fenced "@source inline(\"underline hover:bg-red-500\");"); + case "source-not-inline" ~classes:[ "p-4"; "m-2" ] + ~why: + "the exclusion is read by nothing, so the class it names is generated" + (fenced "@source not inline(\"m-2\");"); + case "tailwind-utilities" ~classes:[ "p-4" ] + ~why: + "tw emits the whole sheet where the file asks for the theme and the \ + utilities alone" + "@import \"tailwindcss/theme.css\" layer(theme);\n\ + @tailwind utilities source(none);\n"; + case "sub-imports" ~classes:[ "p-4" ] + ~why: + "tw emits the whole sheet where the file asks for the theme and the \ + utilities alone" + "@import \"tailwindcss/theme.css\" layer(theme);\n\ + @import \"tailwindcss/utilities.css\" layer(utilities) source(none);\n"; + case "transition-discrete" ~classes:[ "transition-discrete" ] + ~why:"two --default-transition-* tokens are declared that nothing reads" + (fenced ""); ] -let entrypoint body = - String.concat "" [ "@import \"tailwindcss\" source(none);\n"; body; "\n" ] +let write_file path contents = + let oc = open_out path in + Fun.protect + ~finally:(fun () -> close_out_noerr oc) + (fun () -> output_string oc contents) -let compare_with_cli (name, body) = +let inline_source = function + | [] -> "" + | classes -> + String.concat "" + [ "@source inline(\""; String.concat " " classes; "\");\n" ] + +(* The sheet the [tw] CLI prints for the project, rendered the way the sweep has + always rendered it. *) +let tw_sheet ~path classes = + let theme = + Tw_tools.Entrypoint.theme_of_css (Tw_tools.Entrypoint.read_file path) + in + let _, sheet = + Tw_tools.Project.stylesheet ~theme ~entrypoint:path ~base:true classes + in + let rename_custom_property = Tw.theme_token_rename ~theme in + Cascade.Css.optimize sheet + |> Cascade.Css.to_string ~minify:true ?rename_custom_property + +let matches_cli case = (* Beside the other entrypoints these tests write, so the CLI resolves [@import "tailwindcss"] against the project's own node_modules. *) - let path = "sweep-" ^ name ^ ".css" in + let path = "sweep-" ^ case.name ^ ".css" in + let written = path :: List.map fst case.files in Fun.protect - ~finally:(fun () -> Sys.remove path) + ~finally:(fun () -> + List.iter (fun p -> if Sys.file_exists p then Sys.remove p) written) (fun () -> - let oc = open_out path in - Fun.protect - ~finally:(fun () -> close_out_noerr oc) - (fun () -> output_string oc (entrypoint body)); - let css = Tw_tools.Entrypoint.read_file path in - let theme = Tw_tools.Entrypoint.theme_of_css css in - (* The CLI emits preflight from the same [@import], so the generated half - carries the base layer too. Nothing is scanned: the entrypoint pins - [source(none)], so what is compared is the author's CSS and the theme - layer it pulls in. *) - let generated = Tw.to_css ~theme ~base:true [] in - let tw = - Tw_tools.Entrypoint.splice_into_entrypoint ~theme ~path generated - |> Cascade.Css.optimize - |> Cascade.Css.to_string ~minify:true - in + List.iter (fun (p, contents) -> write_file p contents) case.files; + write_file path (case.entry ^ inline_source case.classes); + let tw = tw_sheet ~path case.classes in let cli = Tw_tools.Tailwind_gen.generate_entrypoint ~minify:true path in - let diff = Tw_tools.Parity_compare.diff ~mode:`Canonical cli tw in - match diff.Cascade_diff.Css_compare.result with - | Cascade_diff.Css_compare.No_diff -> None - | _ -> Some name) + match (Tw_tools.Parity_compare.diff ~mode:`Canonical cli tw).result with + | Cascade_diff.Css_compare.No_diff -> true + | _ -> false) + +let misjudged case = + match (case.verdict, matches_cli case) with + | Parity, true | Diverges _, false -> None + | Parity, false -> Some (case.name ^ " diverges from the CLI") + | Diverges why, true -> + Some + (String.concat "" + [ + case.name; + " matches the CLI now, so move it to parity (it diverged because "; + why; + ")"; + ]) -let test_author_css_sweep () = +let test_dialect_sweep () = Test_helpers.require_tailwind_cli (); - match List.filter_map compare_with_cli cases with + match List.filter_map misjudged cases with | [] -> () - | diverging -> - Alcotest.failf "%d of %d author-CSS idioms diverge from the CLI: %s" - (List.length diverging) (List.length cases) - (String.concat ", " diverging) + | wrong -> Alcotest.fail (String.concat "; " wrong) + +(* The inventory is read off the pinned bundle rather than written from memory: + a list its author wrote can only hold what its author already knew. The + bundle quotes every at-keyword it handles, CSS's own included, and keys its + value functions by name, so what is left once CSS's at-rules are set aside is + the dialect. A directive a Tailwind upgrade adds then fails here until a case + covers it. *) +let css_at_rules = + [ + "@charset"; + "@container"; + "@custom-media"; + "@keyframes"; + "@layer"; + "@media"; + "@namespace"; + "@page"; + "@property"; + "@starting-style"; + "@supports"; + "@view-transition"; + (* Not at-rules: the bundle quotes the [@min-*] and [@max-*] container + variant roots the same way. *) + "@max"; + "@min"; + ] + +let quoted_at_keyword_re = + Re.compile + (Re.seq + [ + Re.char '"'; + Re.group + (Re.seq + [ Re.char '@'; Re.rep1 (Re.alt [ Re.rg 'a' 'z'; Re.char '-' ]) ]); + Re.char '"'; + ]) + +let value_function_key_re = + Re.compile + (Re.seq + [ + Re.char '"'; + Re.group (Re.seq [ Re.str "--"; Re.rep1 (Re.rg 'a' 'z') ]); + Re.str "\":"; + ]) + +let rec dir_above name dir = + let candidate = Filename.concat dir name in + if Sys.file_exists candidate then Some candidate + else + let parent = Filename.dirname dir in + if String.equal parent dir then None else dir_above name parent + +let bundle_sources () = + match dir_above "node_modules/tailwindcss/dist" (Sys.getcwd ()) with + | None -> + Test_helpers.require_tailwind_cli (); + Alcotest.fail "the CLI runs but its bundle is not under node_modules" + | Some dist -> + Sys.readdir dist |> Array.to_list + |> List.filter (fun f -> Filename.check_suffix f ".mjs") + |> List.map (fun f -> + Tw_tools.Entrypoint.read_file (Filename.concat dist f)) + +let uses_at_keyword keyword entry = + Re.execp + (Re.compile + (Re.seq [ Re.str keyword; Re.alt [ Re.set " ;{(\"'\n"; Re.eos ] ])) + entry + +let uses_function name entry = Astring.String.is_infix ~affix:(name ^ "(") entry + +let test_dialect_surface_is_covered () = + let bundle = bundle_sources () in + let named re = + List.concat_map + (fun src -> List.map (fun g -> Re.Group.get g 1) (Re.all re src)) + bundle + |> List.sort_uniq String.compare + in + let entries = List.map (fun case -> case.entry) cases in + let uncovered uses names = + List.filter + (fun name -> not (List.exists (fun entry -> uses name entry) entries)) + names + in + let directives = + List.filter + (fun name -> not (List.mem name css_at_rules)) + (named quoted_at_keyword_re) + in + check string_list "every directive the bundle handles has a case" [] + (uncovered uses_at_keyword directives); + check string_list "every value function the bundle defines has a case" [] + (uncovered uses_function (named value_function_key_re)) let tests = [ @@ -827,7 +1070,9 @@ let tests = test_apply_declares_every_token_it_reads; test_case "@apply keeps the keyframes" `Quick test_apply_keeps_the_keyframes; test_case "prefix() on the import" `Quick test_import_prefix; - test_case "author CSS sweep against the CLI" `Slow test_author_css_sweep; + test_case "dialect sweep against the CLI" `Slow test_dialect_sweep; + test_case "dialect surface is covered" `Quick + test_dialect_surface_is_covered; test_case "author CSS declares every token it reads" `Quick test_author_css_declares_every_token_it_reads; ]