Atlanta workshop test-suite overhaul

M2/Macaulay2/m2/testaudit.m2

@@ -0,0 +1,289 @@
+CommentReport = symbol CommentReport
+SpeedReport = symbol SpeedReport
+
+testAudit = method(Options => {CommentReport => false, SpeedReport => false})
+
+--------------------------------------------------------------------------------
+-- Helpers
+--------------------------------------------------------------------------------
+
+testInputs = method()
+
+testInputs Package := pkg -> tests pkg
+
+testInputs String := pkgname -> testInputs needsPackage(pkgname, LoadDocumentation => true)
+
+
+testCodeString = method()
+
+testCodeStringFromInputs := inputs -> (
+    demark(newline, apply(toList(0..#inputs-1), i -> inputs#i#"code"))
+)
+
+testCodeString Package := pkg -> testCodeStringFromInputs testInputs pkg
+
+testCodeString String := pkgname -> testCodeString needsPackage(pkgname, LoadDocumentation => true)
+
+
+packageSourceString = method()
+
+packageSourceString Package := pkg -> try get pkg#"source file" else ""
+
+packageSourceString String := pkgname -> packageSourceString needsPackage(pkgname, LoadDocumentation => true)
+
+
+exportedSymbols = method()
+
+exportedSymbols Package := pkg -> sort toList pkg#"exported symbols"
+
+exportedSymbols String := pkgname -> exportedSymbols needsPackage(pkgname, LoadDocumentation => true)
+
+
+exportedValue := s -> try value s else null
+
+className := x -> toString class x
+
+isExportedFunction := s -> (
+    v := exportedValue s;
+    member(className v, {"MethodFunction", "MethodFunctionWithOptions", "FunctionClosure", "Function"})
+)
+
+isExportedType := s -> (
+    v := exportedValue s;
+    className v === "Type"
+)
+
+optionNamesForSymbol := s -> (
+    v := exportedValue s;
+    try sort apply(toList keys options v, toString) else {}
+)
+
+methodStringsForSymbol := s -> (
+    v := exportedValue s;
+    try sort apply(toList methods v, toString) else {}
+)
+
+wordMatch := (name, code) -> match("\\b" | toString name | "\\b", code)
+
+countLinesMatching := (pat, code) -> #select(lines code, line -> match(pat, line))
+
+shortList := (L, n) -> (
+    if #L === 0 then ""
+    else if #L <= n then demark(", ", L)
+    else demark(", ", take(L, n)) | ", ..."
+)
+
+lineNumbers := n -> if n === 0 then {} else toList(0..n-1)
+
+snippet := (s, n) -> (
+    t := replace("^ *| *$", "", s);
+    if length t <= n then t else substring(0, n, t) | "..."
+)
+
+auditListLines := (label, L) -> (
+    {"- " | label | " (" | toString(#L) | "):"} |
+    (if #L === 0 then {"    none"} else apply(L, item -> "    - " | item)) |
+    {""}
+)
+
+printAuditList := (label, L) -> (
+    scan(auditListLines(label, L), print);
+)
+
+sourceLinesBeforeEnd := filename -> (
+    srcLines := lines get filename;
+    endLines := select(lineNumbers(#srcLines), i -> match("^ *end *$", srcLines#i));
+    if #endLines === 0 then srcLines else take(srcLines, first endLines)
+)
+
+sourceLineMatches := (pkg, pat) -> (
+    filename := try pkg#"source file" else "";
+    if filename === "" or not fileExists filename then {}
+    else (
+        srcLines := sourceLinesBeforeEnd filename;
+        apply(select(lineNumbers(#srcLines), i -> match(pat, srcLines#i)), i ->
+            snippet(srcLines#i, 72) | " (source: " | filename | ":" | toString(i + 1) | ")")
+    )
+)
+
+blockCommentLineMatches := (pkg, pat) -> (
+    filename := try pkg#"source file" else "";
+    if filename === "" or not fileExists filename then {}
+    else (
+        srcLines := sourceLinesBeforeEnd filename;
+        inBlock := false;
+        matches := {};
+        scan(lineNumbers(#srcLines), i -> (
+            line := srcLines#i;
+            startsBlock := match("-\\*", line);
+            endsBlock := match("\\*-", line);
+            wasInBlock := inBlock;
+
+            if startsBlock then inBlock = true;
+            if (wasInBlock or startsBlock) and match(pat, line) then (
+                matches = append(matches, snippet(line, 72) | " (source: " | filename | ":" | toString(i + 1) | ")")
+            );
+            if endsBlock then inBlock = false;
+        ));
+        matches
+    )
+)
+
+silencedTestMatches := pkg -> unique(sourceLineMatches(pkg, "^ *--+ *TEST *///") | blockCommentLineMatches(pkg, "TEST *///"))
+
+styleOfTests := inputs -> (
+    locs := apply(toList(0..#inputs-1), i -> toString locate inputs#i);
+    if any(locs, loc -> match("/tests/", loc)) then "auxiliary file(s)"
+    else "interspersed"
+)
+
+testSourceLines := inputs -> (
+    files := unique apply(toList(0..#inputs-1), i -> (locate inputs#i)#0);
+    {"test sources:"} |
+    (if #files === 0
+     then {"    none"}
+     else apply(files, file -> "    - " | file))
+)
+
+containsAll := (code, names) -> all(names, name -> wordMatch(name, code))
+
+typeNamesInMethodString := meth -> (
+    parts := separate(",", replace("^\\([^,]*,?|\\)$", "", meth));
+    select(apply(parts, s -> replace("^ *| *$", "", s)), s -> s =!= "")
+)
+
+isMethodTested := (meth, code) -> (
+    pieces := separate(",", replace("^\\(|\\)$", "", meth));
+    if #pieces === 0 then false
+    else (
+        functionName := replace("^ *| *$", "", first pieces);
+        wordMatch(functionName, code) and containsAll(code, typeNamesInMethodString meth)
+    )
+)
+
+--------------------------------------------------------------------------------
+-- Comment report
+--------------------------------------------------------------------------------
+
+commentLinesIn := code -> select(lines code, line -> match("^ *--", line) and not match("^ *-- test source:", line))
+
+headerCommentLinesBefore := testInput -> (
+    loc := locate testInput;
+    filename := loc#0;
+    startLine := loc#1;
+    if not fileExists filename then {}
+    else (
+        srcLines := lines get filename;
+        i := startLine - 2;
+        comments := {};
+        while i >= 0 and match("^ *--", srcLines#i) do (
+            comments = prepend(srcLines#i, comments);
+            i = i - 1;
+        );
+        comments
+    )
+)
+
+commentSectionLines := (label, comments) -> (
+    if #comments === 0 then {}
+    else {label | ":"} | apply(comments, c -> "    " | c)
+)
+
+commentReportLines := inputs -> (
+    {"", "Comments:"} | flatten apply(toList(0..#inputs-1), i -> (
+        code := inputs#i#"code";
+        headerComments := headerCommentLinesBefore inputs#i;
+        inTestComments := commentLinesIn code;
+
+        if #headerComments > 0 or #inTestComments > 0
+        then {"", "TEST " | toString i | " -- source: " | toString locate inputs#i, "------------------------------------------------------------------------"} |
+            commentSectionLines("Header comments", headerComments) |
+            commentSectionLines("In-test comments", inTestComments)
+        else {}
+    ))
+)
+
+printCommentReport := inputs -> (
+    scan(commentReportLines inputs, print);
+)
+
+--------------------------------------------------------------------------------
+-- Speed report
+--------------------------------------------------------------------------------
+
+timeString := seconds -> toString seconds | "s"
+
+speedReportLines := (pkg, inputs) -> (
+    timings := apply(toList(0..#inputs-1), i -> (
+        result := try (
+            t := elapsedTiming check(i, pkg);
+            {i, t#0, toString locate inputs#i, true}
+        ) else {i, null, toString locate inputs#i, false};
+        result
+    ));
+    successful := select(timings, row -> row#3);
+    totalTime := sum apply(successful, row -> row#1);
+
+    {"", "Speed Report:", ""} |
+    apply(timings, row -> (
+        if row#3
+        then "    - TEST " | toString(row#0) | ": " | timeString(row#1) | " (" | row#2 | ")"
+        else "    - TEST " | toString(row#0) | ": failed while timing (" | row#2 | ")"
+    )) |
+    {"", "    total timed tests: " | toString(#successful) | "/" | toString(#timings),
+     "    total time: " | timeString totalTime}
+)
+
+--------------------------------------------------------------------------------
+-- Main audit
+--------------------------------------------------------------------------------
+
+testAudit Package := opts -> pkg -> (
+    inputs := testInputs pkg;
+    code := testCodeStringFromInputs inputs;
+    sourceCode := packageSourceString pkg;
+    syms := exportedSymbols pkg;
+
+    funcs := select(syms, isExportedFunction);
+    types := select(syms, isExportedType);
+    others := select(syms, s -> not isExportedFunction s and not isExportedType s);
+
+    untestedFunctions := select(apply(funcs, toString), name -> not wordMatch(name, code));
+
+    optionPairs := flatten apply(funcs, f -> apply(optionNamesForSymbol f, opt -> {toString f, opt}));
+    untestedOptions := select(optionPairs, pair -> (
+        opt := pair#1;
+        not wordMatch(opt, code)
+    ));
+    untestedOptionLabels := apply(untestedOptions, pair -> pair#0 | ": " | pair#1);
+
+    methodPairs := flatten apply(funcs, f -> methodStringsForSymbol f);
+    untestedMethods := select(methodPairs, meth -> not isMethodTested(meth, code));
+
+    silencedTests := silencedTestMatches pkg;
+    fixmeTodos := sourceLineMatches(pkg, "FIXME|TODO|fixme|todo");
+
+    reportLines := {
+        "exported: " | toString(#funcs) | " functions, " | toString(#types) | " types, " | toString(#others) | " other symbols",
+        "n_tests: " | toString(#inputs),
+        "style: " | styleOfTests inputs,
+        ""} |
+        testSourceLines inputs |
+        {"",
+        "Report:",
+        ""
+        } |
+        auditListLines("untested functions", untestedFunctions) |
+        auditListLines("untested options", untestedOptionLabels) |
+        auditListLines("untested methods", untestedMethods) |
+        auditListLines("silenced tests", silencedTests) |
+        auditListLines("FIXME/TODO markers", fixmeTodos) |
+        (if opts.SpeedReport then speedReportLines(pkg, inputs) else {}) |
+        (if opts.CommentReport then commentReportLines inputs else {});
+
+    report := demark(newline, reportLines);
+    print report;
+    report
+)
+
+testAudit String := opts -> pkgname -> testAudit(needsPackage(pkgname, LoadDocumentation => true), opts)

M2/Macaulay2/packages/=distributed-packages

@@ -295,3 +295,4 @@ MRDI
 EliminationTemplates
 WittVectors
 Padic
+TestAudit

M2/Macaulay2/packages/A1BrouwerDegrees.m2

@@ -858,3 +858,83 @@ H = makeHyperbolicUnstableForm GF(27);
 assert(isIsomorphicForm(alpha, H));
 assert(isIsomorphicForm(beta, H));
 ///
+
+--The following tests were added during M2-GT 2026
+-- Test 44. getRank test
+
+TEST ///
+-- Rank equals the matrix size, regardless of the entries.
+alpha = makeGWClass matrix(QQ, {{1/1, 0, 0}, {0, -2, 0}, {0, 0, 5}});
+assert(getRank alpha == 3);
+
+beta = makeGWClass matrix(RR, {{1.0, 0}, {0, -1.0}});
+assert(getRank beta == 2);
+
+gamma = makeGWClass matrix(CC, {{1*ii, 0, 0, 0}, {0, -2, 0, 0}, {0, 0, 3, 0}, {0, 0, 0, 5}});
+assert(getRank gamma == 4);
+
+delta = makeGWClass matrix(GF(7), {{1, 0}, {0, 3}});
+assert(getRank delta == 2);
+
+-- getRank on a form built by makeDiagonalForm
+epsilon = makeDiagonalForm(QQ, (2, -3, 5, -7));
+assert(getRank epsilon == 4);
+
+-- getRank on the hyperbolic plane
+H = makeHyperbolicForm QQ;
+assert(getRank H == 2);
+///
+
+--Test 45. getAnisotropicDimension over QQ
+TEST ///
+-- Hyperbolic plane: anisotropic dimension 0
+H = makeHyperbolicForm QQ;
+assert(getAnisotropicDimension H == 0);
+
+-- <1,1> is anisotropic over QQ (no rational solution to x^2 + y^2 = 0)
+twoPos = makeDiagonalForm(QQ, (1, 1));
+assert(getAnisotropicDimension twoPos == 2);
+
+-- <1,-1> is isomorphic to H, so anisotropic dimension 0
+hyp = makeDiagonalForm(QQ, (1, -1));
+assert(getAnisotropicDimension hyp == 0);
+
+-- <1,1,1,1> over QQ: by the four-square theorem this is not hyperbolic in GW(QQ)
+-- Its Witt index is 0 (no isotropic vector over QQ for the positive-definite form)
+fourPos = makeDiagonalForm(QQ, (1, 1, 1, 1));
+assert(getAnisotropicDimension fourPos == 4);
+
+-- Consistency: anisotropic dimension + 2 * Witt index == rank
+M = makeGWClass matrix(QQ, {{1/1, 0, 0}, {0, -2, 0}, {0, 0, 3}});
+assert(getAnisotropicDimension M + 2 * getWittIndex M == getRank M);
+///
+
+-- Test 46 getAnisotropicDimensionQQp
+TEST ///
+-- <1,1> at p=2: 1+1=2 is not a norm from QQ_2*, so the form is anisotropic
+twoPos = makeDiagonalForm(QQ, (1, 1));
+assert(getAnisotropicDimensionQQp(twoPos, 2) == 2);
+
+-- <1,-1> is the hyperbolic plane, always isotropic: anisotropic part is trivial
+hyp = makeDiagonalForm(QQ, (1, -1));
+assert(getAnisotropicDimensionQQp(hyp, 3) == 0);
+///
+
+
+-- Test 47 getAnisotropicPart
+TEST ///
+-- Anisotropic part of the hyperbolic plane is the zero form (empty diagonal).
+H = makeHyperbolicForm QQ;
+aH = getAnisotropicPart H;
+assert(getRank aH == 0);
+
+-- Anisotropic part of <1,1> over QQ is <1,1> itself (the form is anisotropic).
+twoPos = makeDiagonalForm(QQ, (1, 1));
+aTwo = getAnisotropicPart twoPos;
+assert(isIsomorphicForm(aTwo, twoPos));
+
+-- Anisotropic part of 2H = <1,-1,1,-1> is the zero form.
+twoH = makeDiagonalForm(QQ, (1, -1, 1, -1));
+aTwoH = getAnisotropicPart twoH;
+assert(getRank aTwoH == 0);
+///