Quellcode-Bibliothek test.gi Sprache: unbekannt

#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Frank Lübeck.
##
## Copyright of GAP belongs to its developers, whose names are too numerous
## to list here. Please refer to the COPYRIGHT file for details.
##
## SPDX-License-Identifier: GPL-2.0-or-later
##
## This file contains functions for test files.
##

## FirstDiff := function(a, b)
## return First([1..Length(a)], i-> not IsBound(b[i]) or b[i] <> a[i]);
## end;

InstallGlobalFunction(ParseTestInput, function(str, ignorecomments, fnam)
 local lines, inp, pos, outp, ign, commands, i, skipstate, checkifelsefi, foundcmd, testError;
 lines := SplitString(str, "\n", "");
 inp := [];
 pos := [];
 outp := [];
 ign := [];
 commands := [];
 i := 1;
 testError := function(s)
 if IsStream(fnam) then
 ErrorNoReturn(s, " in test stream, line ", i);
 else
 ErrorNoReturn(s, " at ", fnam, ":", i);
 fi;
 end;
 checkifelsefi := l -> ForAny(["#@if","#@elif","#@else","#@fi"],
 x -> StartsWith(l, x));
 # Set to true if we find a #@if, #@elif, #@else or #@fi. Used to check these
 # do not occur in the middle of a single input/output test block.
 foundcmd := false;
 # skipstate represents the current status of '#@if/#@elif/#@else/#@fi'
 # 0: not in a '#@if'
 # 1: in the first #@if or #@elif with a true condition
 #-1: in an #@if or #@elif with a false condition before the first #@if or
 # @elif with a true condition
 # 2: in the #@else when all #@if and #@elif had a false condition
 #-2: in the #@else after an #@if or #@elif with a true condition
 #-3: in an #@elif after an #@if or #@elif with a true condition
 # The transition table can be written as
 # state | keyword | condition | new state
 # 0 | #@if | true | 1
 # 0 | #@if | false | -1
 # 1 | #@elif | true | -3
 # 1 | #@elif | false | -3
 # 1 | #@else | | -2
 # 1 | #@fi | | 0
 # -1 | #@elif | true | 1
 # -1 | #@elif | false | -1
 # -1 | #@else | | 2
 # -1 | #@fi | | 0
 # 2 | #@fi | | 0
 # -2 | #@fi | | 0
 # -3 | #@elif | true | -3
 # -3 | #@elif | false | -3
 # -3 | #@else | | -2
 # -3 | #@fi | | 0
 # Any other transition is a syntax error.
 # Code is executed whenever skipstate >= 0
 skipstate := 0;
 while i <= Length(lines) do
 if checkifelsefi(lines[i]) then
 foundcmd := true;
 Add(ign, i);
 if StartsWith(lines[i], "#@if") then
 if skipstate <> 0 then
 testError("Invalid test file: Nested #@if");
 fi;
 if EvalString(lines[i]{[5..Length(lines[i])]}) then
 skipstate := 1;
 else
 skipstate := -1;
 fi;
 elif StartsWith(lines[i], "#@elif") then
 if skipstate = 0 then
 testError("Invalid test file: #@elif without #@if");
 elif skipstate = 2 or skipstate = -2 then
 testError("Invalid test file: #@elif after #@else");
 elif skipstate = -1 then
 # No ifs or elifs were true, check condition
 if EvalString(lines[i]{[7..Length(lines[i])]}) then
 skipstate := 1;
 else
 skipstate := -1;
 fi;
 else
 # Some if or elif was true, dont evaluate elif
 skipstate := -3;
 fi;
 elif StartsWith(lines[i], "#@else") then
 if skipstate = 0 then
 testError("Invalid test file: #@else without #@if");
 elif skipstate = 2 or skipstate = -2 then
 testError("Invalid test file: two #@else");
 elif skipstate = -1 then
 # No ifs or elifs were true, evaluate else
 skipstate := 2;
 else
 # Some if or elif was true, dont evaluate else
 skipstate := -2;
 fi;
 else # Must be #@fi
 if skipstate = 0 then
 testError("Invalid test file: #@fi without #@if");
 fi;
 skipstate := 0;
 fi;

 i := i + 1;
 continue;
 fi;

 if skipstate < 0 then
 Add(ign, i);
 i := i + 1;
 continue;
 fi;

 if Length(outp) = 0 and Length(inp) = 0 and (Length(lines[i]) = 0 or lines[i][1] = '#') then
 if ignorecomments = true then
 # ignore comment lines and empty lines at beginning of file
 Add(ign, i);
 # execute `#@exec` immediately so `#@if` can depend on it
 if StartsWith(lines[i], "#@exec") then
 Read(InputTextString(Concatenation(lines[i]{[7..Length(lines[i])]}, ";\n")));
 elif Length(lines[i]) > 3 and lines[i]{[1..2]} = "#@" then
 Add(commands, lines[i]);
 fi;
 i := i+1;
 else
 Add(inp, "\n");
 Add(pos, i);
 i := i+1;
 while i <= Length(lines) and (Length(lines[i]) = 0 or (StartsWith(lines[i], "#") and not StartsWith(lines[i], "#@"))) do
 i := i+1;
 od;
 Add(outp, JoinStringsWithSeparator(lines{[1..i-1]}, "\n"));
 Add(outp[1], '\n');
 fi;
 elif Length(lines[i]) = 0 and ignorecomments = true and i < Length(lines)
 and StartsWith(lines[i+1], "#") then
 # ignore an empty line followed by comment lines
 Add(ign, i);
 i := i+1;
 while i <= Length(lines) and StartsWith(lines[i], "#") and
 not StartsWith(lines[i], "#@") do
 Add(ign, i);
 i := i+1;
 od;
 elif StartsWith(lines[i], "gap> ") then
 foundcmd := false;
 Add(outp, "");
 Add(inp, lines[i]{[6..Length(lines[i])]});
 Add(Last(inp), '\n');
 Add(pos, i);
 i := i+1;
 elif StartsWith(lines[i], "> ") then
 if foundcmd then
 testError("Invalid test file: #@ command found in the middle of a single test");
 fi;
 Append(Last(inp), lines[i]{[3..Length(lines[i])]});
 Add(Last(inp), '\n');
 i := i+1;
 elif StartsWith(lines[i], ">\t") then
 testError("Invalid test file: Continuation prompt '> ' followed by a tab, expected a regular space");
 elif Length(outp) > 0 then
 if foundcmd and not ForAll(lines[i], c -> c = ' ' or c = '\t') then
 testError("Invalid test file: #@ command found in the middle of a single test");
 fi;
 Append(Last(outp), lines[i]);
 Add(Last(outp), '\n');
 i := i+1;
 else
 testError("Invalid test file");
 i := i+1;
 fi;
 od;

 if skipstate <> 0 then
 testError("Invalid test file: Unterminated #@if");
 fi;

 Add(pos, ign);
 return rec( inp := inp, outp := outp, pos := pos, commands := commands );
end);

InstallGlobalFunction(ParseTestFile, function(arg)
 local fnam, ignorecomments, str;
 fnam := arg[1];
 if Length(arg) > 1 then
 ignorecomments := arg[2];
 else
 ignorecomments := true;
 fi;
 str := StringFile(fnam);
 if str = fail then
 ErrorNoReturn("Cannot read file ",fnam,"\n");
 fi;
 return ParseTestInput(str, ignorecomments, fnam);
end);

InstallGlobalFunction(RunTests, function(tests, inopts, fnam)
 local opts, breakOnError, alwaysPrintTracebackOnError, inp, outp,
 pos, cmp, times, ttime, nrlines, s, res, fres, t, f, i,
 localbag, failures, startsize, size;
 # don't enter break loop in case of error during test
 opts := rec( breakOnError := false, alwaysPrintTracebackOnError:= false,
 showProgress := "some", localdef := false );

 if not IS_OUTPUT_TTY() then
 opts.showProgress := false;
 fi;
 for f in RecNames(inopts) do
 opts.(f) := inopts.(f);
 od;

 # now start the work
 startsize := SizeScreen();
 SizeScreen([opts.width, startsize[2]]);

 # we collect outputs and add them to 'tests.cmp'
 # also collect timings and add them to 'tests.times'
 inp := tests.inp;
 outp := tests.outp;
 pos := tests.pos;
 cmp := [];
 times := [];
 tests.cmp := cmp;
 tests.times := times;
 failures := 0;

 if Length(inp) = 0 then
 return 0;
 fi;

 breakOnError := BreakOnError;
 BreakOnError := opts.breakOnError;
 alwaysPrintTracebackOnError:= AlwaysPrintTracebackOnError;
 AlwaysPrintTracebackOnError:= opts.alwaysPrintTracebackOnError;

 localbag := false;
 if opts.localdef <> false then
 # Create a local variables bag for the variables listed in
 # #@local (if it exists). We run the test in this context
 # so it does not create/overwrite global variables
 localbag := CREATE_LOCAL_VARIABLES_BAG(opts.localdef);
 fi;
 ttime := Runtime();
 nrlines := pos[Length(pos) - 1];
 for i in [1..Length(inp)] do
 if opts.showProgress = true then
 Print("# line ", pos[i], ", input:\n",inp[i]);
 elif opts.showProgress = "some" then
 Print("\r# line ", pos[i],
 " of ", nrlines,
 " (", Int(pos[i] / nrlines * 100), "%)",
 "\c");
 fi;
 s := InputTextString(inp[i]);
 res := "";
 fres := OutputTextString(res, false);
 t := Runtime();
 READ_STREAM_LOOP(s, fres, localbag);
 t := Runtime() - t;
 CloseStream(fres);
 CloseStream(s);
 # check whether the user aborted by pressing ctrl-C
 if StartsWith(res, "Error, user interrupt") then
 BreakOnError := breakOnError;
 AlwaysPrintTracebackOnError:= alwaysPrintTracebackOnError;
 Error("user interrupt");
 BreakOnError := opts.breakOnError;
 AlwaysPrintTracebackOnError:= opts.alwaysPrintTracebackOnError;
 fi;
 Add(cmp, res);
 Add(times, t);
 # check for and report differences
 if opts.compareFunction(opts.transformFunction(tests.outp[i]),
 opts.transformFunction(tests.cmp[i])) <> true then
 if opts.showProgress = "some" then
 Print("\r \c\r"); # clear the line
 fi;
 size := SizeScreen();
 SizeScreen(startsize);
 if not opts.ignoreSTOP_TEST or
 PositionSublist(tests.inp[i], "STOP_TEST") <> 1 then
 failures := failures + 1;
 opts.reportDiff(tests.inp[i], tests.outp[i], tests.cmp[i], fnam, tests.pos[i], tests.times[i]);
 else
 # print output of STOP_TEST
 Print(tests.cmp[i]);
 fi;
 SizeScreen(size);
 fi;
 od;
 if opts.showProgress = "some" then
 Print("\r \c\r"); # clear the line
 fi;
 # add total time to 'times'
 Add(times, Runtime() - ttime);
 # reset
 BreakOnError := breakOnError;
 AlwaysPrintTracebackOnError:= alwaysPrintTracebackOnError;
 SizeScreen(startsize);
 return failures;
end);

BindGlobal("TEST", AtomicRecord( rec(Timings := rec())));

TEST.transformFunctions := AtomicRecord(rec());
TEST.transformFunctions.removenl := function(a)
 a := ShallowCopy(a);
 while Length(a) > 0 and Last(a) = '\n' do
 Remove(a);
 od;
 return a;
end;
TEST.transformFunctions.removewhitespace := function(a)
 a := ReplacedString(ShallowCopy(a), "\\\n", "");
 RemoveCharacters(a, " \n\t\r");
 return a;
end;

TEST.compareFunctions := AtomicRecord(rec());
TEST.compareFunctions.uptonl := function(a, b)
 a := TEST.transformFunctions.removenl(a);
 b := TEST.transformFunctions.removenl(b);
 return a=b;
end;
TEST.compareFunctions.uptowhitespace := function(a, b)
 a := TEST.transformFunctions.removewhitespace(a);
 b := TEST.transformFunctions.removewhitespace(b);
 return a=b;
end;

##
## CREATE_LOCAL_VARIABLES_BAG(namelist)
##
## Given a (possibly empty) comma separated string 'namelist',
## create a local variable bag which contains the names in 'namelist'.
##
InstallGlobalFunction(CREATE_LOCAL_VARIABLES_BAG, function(namelist)
 local localvars, func;
 NormalizeWhitespace(namelist);
 if IsEmpty(namelist) then
 localvars := "";
 else
 localvars := Concatenation("local ", namelist, ";");
 fi;
 func := Concatenation("(function() ", localvars,
 "return GetCurrentLVars(); end)()");
 return EvalString(func);
end);

##
## <#GAPDoc Label="Test">
## <ManSection>
## <Func Name="Test" Arg='fname[, optrec]'/>
## <Returns><K>true</K> or <K>false</K>.</Returns>
## <Description>
## The argument <Arg>fname</Arg> must be the name of a file or an
## open input stream. The content of this file or stream should contain
## &GAP; input and output. The function <Ref Func="Test" /> runs the input
## lines, compares the actual output with the output stored in
## <Arg>fname</Arg> and reports differences. With an optional record as
## argument <Arg>optrec</Arg> details of this process can be adjusted.
## Note that the <C>rewriteToFile</C> option is especially useful for
## generating test files.
## 
## More precisely, the content of <Arg>fname</Arg> must have the following
## format. 
## Lines starting with <C>"gap> "</C> are considered as &GAP; input,
## they can be followed by lines starting with <C>"> "</C> if the input is
## continued over several lines. 
## To allow for comments in <Arg>fname</Arg> the following lines are ignored
## by default: lines at the beginning of <Arg>fname</Arg> that start with
## <C>"#"</C> or are empty, and one empty line together with one or more
## lines starting with <C>"#"</C>. 
## All other lines are considered as &GAP; output from the
## preceding &GAP; input.
## 
## Lines which begin "#@" define special configuration options for tests.
## The <C>#@local</C> and <C>#@exec</C> options can only be used before
## any &GAP; input, and the other commands can only be used between
## individual tests (just before a line starting <C>gap></C>, or at end
## of the file).
## Currently defined options are:
## <List>
## #@local identifierlist
## <Item>Run all the tests in the input as if it is in a function with local variable list
## <C>identifierlist</C>, which is a comma-separated list of
## identifiers. Multiple #@local lines may be used.
## These lines should <E>not</E> end with a comma or semicolon.
## If this option is used then an error will occur unless <E>all</E>
## the variables used are included in the local list.
## 
## As an example, the <Package>Utils</Package> package has a test file
## <C>tst/iterator.tst</C> which starts with the lines:
## <Log><![CDATA[
## #@local c3c3, cart, G, h, it1, it2, iter, iter0, iter4, iterL
## #@local L, n, pairs0, pairs4, pairsL, s3, s4
## ]]></Log>
## </Item>
## #@exec gapcode
## <Item>Execute the code <C>gapcode</C> before any test in the input is run.
## This allows defining global variables when using <C>#@local</C>.
## </Item>
## #@if EXPR ... {#@elif EXPR ...} [#@else ...] #@fi
## <Item>A <C>#@if</C> allows to conditionally skip parts of the test input depending on
## the value of a boolean expression. The exact behavior is done as follows:
## 
## If the first &GAP; expression <C>EXPR</C> evaluates to <K>true</K>, then the lines after
## the <C>#@if</C> are used until either a <C>#@elif</C>, <C>#@else</C> or <C>#@fi</C> is
## reached.
## If an <C>#@elif</C> is present, then the lines after <C>#@elif</C> are used if and
## only if its <C>EXPR</C> evaluates to <K>true</K> and all previous <C>#@if</C> and
## <C>#@elif</C> clauses had expressions evaluating to <K>false</K>. In this case
## the lines after <C>#@elif</C> are used until either a <C>#@elif</C>, <C>#@else</C> or
## <C>#@fi</C> is reached.
## If an <C>#@else</C> is present then the lines after the <C>#@else</C>
## are used if and only if <C>EXPR</C> evaluated to <K>false</K> in all <C>#@if</C> and
## <C>#@elif</C> clauses. Finally, once <C>#fi</C> is reached, evaluation continues
## normally.
## 
## Note that each <C>EXPR</C> is evaluated after all <C>#@exec</C> lines have been
## executed but before any tests are run. Thus, it cannot depend on test
## results or packages loaded in tests, but it can depend on packages loaded
## via <C>#@exec</C>.
## 
## In addition <C>#@if</C> clauses cannot be nested within each other.
## 
## As an example, the &GAP; test suite contains the test file
## <C>tst/testinstall/pperm.tst</C> which contains the lines:
## <Log><![CDATA[
## #@if GAPInfo.BytesPerVariable = 8
## gap> HASH_FUNC_FOR_PPERM(f, 10 ^ 6) in [260581, 402746];
## true
## #@else
## gap> HASH_FUNC_FOR_PPERM(f, 10 ^ 6);
## 953600
## #@fi
## ]]></Log>
## </Item>
## </List>
## By default the actual &GAP; output is compared exactly with the
## stored output, and if these are different some information about the
## differences is printed.
## 
## If any differences are found then <Ref Func="Test" /> returns <K>false</K>,
## otherwise <K>true</K>.
## 
## If the optional argument <Arg>optrec</Arg> is given it must be a record.
## The following components of <Arg>optrec</Arg> are recognized and can change
## the default behaviour of <Ref Func="Test" />:
## <List>
## <C>ignoreComments</C>
## <Item>If set to <K>false</K> then no lines in <Arg>fname</Arg>
## are ignored as explained above (default is <K>true</K>).</Item>
## <C>width</C>
## <Item>The screen width used for the new output (default is <C>80</C>).
## </Item>
## <C>compareFunction</C>
## <Item>This must be a function that gets two strings as input, the newly
## generated and the stored output of some &GAP; input. The function must
## return <K>true</K> or <K>false</K>, indicating if the strings should
## be considered equivalent or not. By default <Ref Oper="\=" /> is used.
## 
## Two strings are recognized as abbreviations in this component:
## <C>"uptowhitespace"</C> checks if the two strings become equal after
## removing all white space. And <C>"uptonl"</C> compares the string up
## to trailing newline characters.
## </Item>
## <C>transformFunction</C>
## <Item>This must be a function that gets one string as input, either the newly
## generated or the stored output of some &GAP; input. The function must
## return a new string which will be used to compare the actual and the expected
## output. By default <Ref Func="IdFunc" /> is used.
## 
## Two strings are recognized as abbreviations in this component:
## <C>"removewhitespace"</C> removes all white space.
## And <C>"removenl"</C> removes all trailing newline characters.
## </Item>
## <C>reportDiff</C>
## <Item>A function that gets six arguments and reports a difference in the
## output: the &GAP; input, the expected &GAP; output, the newly generated
## output, the name of tested file, the line number of the input, the
## time to run the input. (The default is demonstrated in the example
## below.)</Item>
## <C>rewriteToFile</C>
## <Item>If this is bound to a string it is considered as a file name
## and that file is written with the same input and comment lines as
## <Arg>fname</Arg> but the output substituted by the newly generated
## version; if it is bound to <K>true</K>, then this is treated as if
## it was bound to <Arg>fname</Arg> (default is <K>false</K>). This is
## especially useful for generating test files because it ensures that
## the test files are formatted exactly as <Ref Func="Test" /> expects
## them to be.
## </Item>
## <C>writeTimings</C>
## <Item>If this is bound to a string it is considered as a file name,
## that file is written and contains timing information for each input
## in <Arg>fname</Arg>. </Item>
## <C>compareTimings</C>
## <Item>If this is bound to a string it is considered as name of a file to
## which timing information was stored via <C>writeTimings</C> in a previous
## call. The new timings are compared to the stored ones.
## By default only commands which take more than a threshold of
## 100 milliseconds are considered, and only differences of more than 20% are
## considered significant. These defaults can be overwritten by assigning a
## list <C>[timingfile, threshold, percentage]</C> to this component.
## (The default of <C>compareTimings</C> is <K>false</K>.)</Item>
## <C>reportTimeDiff</C>
## <Item>This component can be used to overwrite the default function to
## display timing differences. It must be a function with 5 arguments:
## &GAP; input, name of test file, line number, stored time, new time.
## </Item>
## <C>ignoreSTOP_TEST</C>
## <Item>By default set to <K>true</K>, in that case the output of &GAP;
## input starting with <C>"STOP_TEST"</C> is not checked.</Item>
## 
## <C>showProgress</C>
## <Item>If this is <K>true</K> then &GAP; prints position information
## and the input line before it is processed; if set to <C>"some"</C>,
## then GAP shows the current line number of the test being processed;
## if set to <K>false</K>, no progress updates are displayed
## (default is <C>"some"</C> if GAP's output goes to a terminal, otherwise
## <K>false</K>). </Item>
## <C>subsWindowsLineBreaks</C>
## <Item>If this is <K>true</K> then &GAP; substitutes DOS/Windows style
## line breaks "\r\n" by UNIX style line breaks "\n" after reading the test
## file. (default is <K>true</K>).</Item>
## <C>returnNumFailures</C>
## <Item>If this is <K>true</K> then &GAP; returns the number of input
## lines of the test file which had differences in their output, instead
## of returning <K>true</K> or <K>false</K>.</Item>
## </List>
##
## <Log><![CDATA[
## gap> tnam := Filename(DirectoriesLibrary(), "../doc/ref/demo.tst");;
## gap> mask := function(str) return Concatenation("| ",
## > JoinStringsWithSeparator(SplitString(str, "\n", ""), "\n| "),
## > "\n"); end;;
## gap> Print(mask(StringFile(tnam)));
## | # this is a demo file for the 'Test' function
## | #
## | gap> g := Group((1,2), (1,2,3));
## | Group([ (1,2), (1,2,3) ])
## |
## | # another comment following an empty line
## | # the following fails:
## | gap> a := 13+29;
## | 41
## gap> ss := InputTextString(StringFile(tnam));;
## gap> Test(ss);
## ########> Diff in test stream, line 8:
## # Input is:
## a := 13+29;
## # Expected output:
## 41
## # But found:
## 42
## ########
## false
## gap> RewindStream(ss);
## true
## gap> dtmp := DirectoryTemporary();;
## gap> ftmp := Filename(dtmp,"demo.tst");;
## gap> Test(ss, rec(reportDiff := Ignore, rewriteToFile := ftmp));
## false
## gap> Test(ftmp);
## true
## gap> Print(mask(StringFile(ftmp)));
## | # this is a demo file for the 'Test' function
## | #
## | gap> g := Group((1,2), (1,2,3));
## | Group([ (1,2), (1,2,3) ])
## |
## | # another comment following an empty line
## | # the following fails:
## | gap> a := 13+29;
## | 42
## ]]></Log>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareGlobalName("TextAttr"); # from GAPDoc
DeclareGlobalName("DefaultReportDiffColors"); # initialized in Test() or by the user
BindGlobal("DefaultReportDiff", function(inp, expout, found, fnam, line, time)
 if UserPreference("UseColorsInTerminal") = true then
 Print(DefaultReportDiffColors.message);
 Print("########> Diff in ");
 if IsStream(fnam) then
 Print("test stream, line ",line,":");
 else
 Print(fnam,":",line);
 fi;
 Print(TextAttr.reset, "\n", DefaultReportDiffColors.message);
 Print("# Input is:", TextAttr.reset, "\n");
 Print(DefaultReportDiffColors.input);
 Print(inp);
 Print(TextAttr.reset, TextAttr.delline, DefaultReportDiffColors.message);
 Print("# Expected output:", TextAttr.reset, "\n");
 Print(DefaultReportDiffColors.expected);
 Print(expout);
 Print(TextAttr.reset, TextAttr.delline, DefaultReportDiffColors.message);
 Print("# But found:", TextAttr.reset, "\n");
 Print(DefaultReportDiffColors.actual);
 Print(found);
 Print(TextAttr.reset, TextAttr.delline, DefaultReportDiffColors.message);
 Print("########", TextAttr.reset, "\n");
 else
 Print("########> Diff in ");
 if IsStream(fnam) then
 Print("test stream, line ",line,":\n");
 else
 Print(fnam,":",line,"\n");
 fi;
 Print("# Input is:\n", inp);
 Print("# Expected output:\n", expout);
 Print("# But found:\n", found);
 Print("########\n"); fi;
end);

InstallGlobalFunction("Test", function(arg)
 local fnam, nopts, opts, full, pf, failures, lines, ign, new,
 cT, ok, oldtimes, thr, delta, len, c, i, j, d, localdef, line;

 # get arguments and set options
 fnam := arg[1];
 if Length(arg) > 1 and IsRecord(arg[2]) then
 nopts := arg[2];
 else
 nopts := rec();
 fi;
 if not IsBound(DefaultReportDiffColors) then
 BindGlobal("DefaultReportDiffColors", rec(
 message := TextAttr.4, # blue text
 input := "",
 expected := Concatenation(TextAttr.0, TextAttr.b2), # black text on green background
 actual := Concatenation(TextAttr.7, TextAttr.b1), # white text on red background
 ));
 fi;
 opts := rec(
 ignoreComments := true,
 isStream := IsStream(fnam),
 width := 80,
 ignoreSTOP_TEST := true,
 compareFunction := EQ,
 transformFunction := IdFunc,
 showProgress := "some",
 writeTimings := false,
 compareTimings := false,
 reportTimeDiff := function(inp, fnam, line, oldt, newt)
 local d;
 d := String(Int(100*(newt-oldt)/oldt));
 if d[1] <> '-' then
 d := Concatenation("+", d);
 fi;
 Print("########> Time diff in ");
 if IsStream(fnam) then
 Print("test stream, line ",line,":\n");
 else
 Print(fnam,":",line,"\n");
 fi;
 Print("# Input:\n", inp);
 Print("# Old time: ", oldt," New time: ", newt,
 " (", d, "%)\n");
 end,
 rewriteToFile := false,
 breakOnError := false,
 reportDiff := DefaultReportDiff,
 subsWindowsLineBreaks := true,
 returnNumFailures := false,
 localdef := false,
 );
 if not IS_OUTPUT_TTY() then
 opts.showProgress := false;
 fi;

 if IsHPCGAP then
 # HPCGAP's window size varies in different threads
 opts.transformFunction := "removewhitespace";
 # HPC-GAP's output is not compatible with changing lines
 opts.showProgress := false;
 fi;

 for c in RecNames(nopts) do
 opts.(c) := nopts.(c);
 od;
 # check shortcuts
 if IsString(opts.compareFunction) then
 if IsBound(TEST.compareFunctions.(opts.compareFunction)) then
 opts.compareFunction := TEST.compareFunctions.(opts.compareFunction);
 else
 Error("Unknown compareFunction '", opts.compareFunction, "'");
 fi;
 fi;
 if IsString(opts.transformFunction) then
 if IsBound(TEST.transformFunctions.(opts.transformFunction)) then
 opts.transformFunction := TEST.transformFunctions.(opts.transformFunction);
 else
 Error("Unknown transformFunction '", opts.transformFunction, "'");
 fi;
 fi;

 # remember the full input
 if not opts.isStream then
 full := StringFile(fnam);
 if full = fail then
 ErrorNoReturn("Cannot read file ",fnam,"\n");
 fi;
 else
 full := ReadAll(fnam);
 fi;
 # change Windows to UNIX line breaks
 if opts.subsWindowsLineBreaks = true then
 full := ReplacedString(full, "\r\n", "\n");
 fi;

 # split input into GAP input, GAP output and comments
 pf := ParseTestInput(full, opts.ignoreComments, fnam);

 # Warn if we have not found any tests in the file
 if IsEmpty(pf.inp) then
 Info(InfoWarning, 1, "Test: File does not contain any tests!");
 fi;
 for line in pf.commands do
 if StartsWith(line, "#@local") then
 line := line{[8..Length(line)]};
 if opts.localdef = false then
 opts.localdef := line;
 else
 opts.localdef := Concatenation(opts.localdef, ", ", line);
 fi;
 else
 ErrorNoReturn("Invalid #@ test option: ", line);
 fi;
 od;

 # run the GAP inputs and collect the outputs and the timings
 failures := RunTests(pf, opts, fnam);

 # maybe rewrite the input into a file
 if opts.rewriteToFile = true then
 opts.rewriteToFile := fnam;
 fi;
 if IsString(opts.rewriteToFile) then
 lines := SplitString(full, "\n", "");
 ign := Last(pf.pos);
 new := [];
 for i in ign do
 new[i] := lines[i];
 Add(new[i], '\n');
 od;
 for i in [1..Length(pf.inp)] do
 new[pf.pos[i]] := "";
 for j in [1 .. Number(pf.inp[i], c -> c = '\n') +
 Number(pf.outp[i], c -> c = '\n')] do
 if (j = 1 and StartsWith(lines[pf.pos[i] + j - 1], "gap> ")) or
 (j > 1 and StartsWith(lines[pf.pos[i] + j - 1], "> ")) then
 Append(new[pf.pos[i]], lines[pf.pos[i] + j - 1]);
 Add(new[pf.pos[i]], '\n');
 fi;
 od;
 if PositionSublist(pf.inp[i], "STOP_TEST") <> 1 then
 Append(new[pf.pos[i]], pf.cmp[i]);
 if pf.cmp[i] <> "" and Last(pf.cmp[i]) <> '\n' then
 Info(InfoWarning, 1, "An output in the .tst file does not end with a newline. GAP does not support this.");
 Info(InfoWarning, 1, "A newline will be inserted to make the file valid, but the test will fail.");
 Info(InfoWarning, 1, "The location of this problem is marked with '# Newline inserted here'.");
 Append(new[pf.pos[i]], "# Newline inserted here by 'rewriteToFile'\n");
 fi;
 fi;
 od;
 new := Concatenation(Compacted(new));
 FileString(opts.rewriteToFile, new);
 fi;

 # maybe store the timings into a file
 if IsString(opts.writeTimings) then
 PrintTo(opts.writeTimings, "TEST.Timings.(\"", opts.writeTimings,
 "\") := \n", pf.times, ";\n");
 fi;

 # maybe compare timings
 cT := opts.compareTimings;
 if IsList(cT) and IsString(cT[1]) then
 ok := READ(cT[1]);
 if not ok then
 Info(InfoWarning, 1, "Could not read timings from ", cT[1]);
 else
 oldtimes := TEST.Timings.(cT[1]);
 if Length(cT) > 1 and IsInt(cT[2]) then
 thr := cT[2];
 else
 thr := 100;
 fi;
 if Length(cT) > 2 and IsInt(cT[3]) then
 delta := cT[3];
 else
 delta := 10;
 fi;
 for i in [1..Length(pf.inp)] do
 if oldtimes[i] >= thr and
 AbsInt(oldtimes[i] - pf.times[i])/oldtimes[i] > delta/100 then
 opts.reportTimeDiff(pf.inp[i], fnam, pf.pos[i], oldtimes[i], pf.times[i]);
 fi;
 od;
 # compare total times
 len := Length(oldtimes);
 if oldtimes[len] >= thr and
 AbsInt(oldtimes[len] - pf.times[len])/oldtimes[len] > delta/100 then
 d := String(Int(100*(pf.times[len] - oldtimes[len])/oldtimes[len]));
 if d[1] <> '-' then
 d := Concatenation("+", d);
 fi;
 Print("########> Total time for ", fnam, ":\n");
 Print("# Old time: ", oldtimes[len]," New time: ", pf.times[len],
 " (", d, "%)\n");
 fi;
 fi;
 fi;

 # store internal test data in TEST, in old list format
 TEST.lastTestData := [pf.inp, pf.outp, pf.pos, pf.cmp, pf.times];
 # And also new record format
 TEST.lastTestDataRec := pf;

 # if requested, return number of failures
 if opts.returnNumFailures then
 return failures;
 fi;

 # return true/false
 return (failures = 0);
end);

## <#GAPDoc Label="TestDirectory">
## <ManSection>
## <Func Name="TestDirectory" Arg='inlist[, optrec]'/>
## <Returns><K>true</K> or <K>false</K>.</Returns>
## <Description>
## The argument <Arg>inlist</Arg> must be either a single filename
## or directory name, or a list of filenames and directories.
## The function <Ref Func="TestDirectory" /> will create a list of files
## to be tested by taking any files in <Arg>inlist</Arg>, and recursively searching
## any directories in <Arg>inlist</Arg> for files ending in <C>.tst</C>.
## Each of these files is then run through <Ref Func="Test" />, and the results
## printed, and <K>true</K> returned if all tests passed.
## 
## If the optional argument <Arg>optrec</Arg> is given it must be a record.
## Note that the <C>rewriteToFile</C> option is especially useful for
## generating test files.
## The following components of <Arg>optrec</Arg> are recognized and can change
## the default behaviour of <Ref Func="TestDirectory" />:
## <List>
## <C>testOptions</C>
## <Item>A record which will be passed on as the second argument of <Ref Func="Test" />
## if present.</Item>
## <C>earlyStop</C>
## <Item>If <K>true</K>, stop as soon as any <Ref Func="Test" /> fails (defaults to <K>false</K>).
## </Item>
## <C>showProgress</C>
## <Item>Print information about how tests are progressing (defaults to <C>"some"</C>
## if GAP's output goes to a terminal, otherwise <K>false</K>).
## </Item>
## <C>suppressStatusMessage</C>
## <Item>suppress displaying status messages <C>#I Errors detected while testing</C> and
## <C>#I No errors detected while testing</C> after the test (defaults to <K>false</K>).
## </Item>
## <C>rewriteToFile</C>
## <Item>If <K>true</K>, then rewrite each test file to disc, with the output substituted
## by the results of running the test (defaults to <K>false</K>).
## This is especially useful for generating test files because it ensures that
## the test files are formatted exactly as <Ref Func="Test" /> expects
## them to be.
## </Item>
## <C>exclude</C>
## <Item>A list of file and directory names which will be excluded from
## testing (defaults to <K>[]</K>).
## </Item>
## <C>exitGAP</C>
## <Item>Rather than returning <K>true</K> or <K>false</K>, exit GAP with the return value
## of GAP set to success or fail, depending on if all tests passed (defaults to <K>false</K>).
## </Item>
## </List>
##
## </Description>
## </ManSection>
## <#/GAPDoc>
InstallGlobalFunction( "TestDirectory", function(arg)
 local testTotalFailures, testFailedFiles, totalTime, totalMem, STOP_TEST_CPY,
 basedirs, nopts, opts, testOptions, earlyStop,
 showProgress, suppressStatusMessage, exitGAP, c, files,
 filetimes, filemems, recurseFiles, f, i, startTime,
 startMem, testResult, time, mem, startGcTime, gctime,
 totalGcTime, filegctimes;

 testTotalFailures := 0;
 testFailedFiles := 0;
 totalTime := 0;
 totalMem := 0;
 totalGcTime := 0;

 STOP_TEST_CPY := STOP_TEST;
 # wrap STOP_TEST_QUIET to drop the return value so it does not get printed below
 STOP_TEST := function(arg) CallFuncList( STOP_TEST_QUIET, arg ); end;

 if IsString(arg[1]) or IsDirectory(arg[1]) then
 basedirs := [arg[1]];
 else
 basedirs := arg[1];
 fi;

 if Length(arg) > 1 and IsRecord(arg[2]) then
 nopts := arg[2];
 else
 nopts := rec();
 fi;

 opts := rec(
 testOptions := rec(),
 earlyStop := false,
 showProgress := true,
 suppressStatusMessage := false,
 rewriteToFile := false,
 exclude := [],
 exitGAP := false,
 );

 for c in RecNames(nopts) do
 opts.(c) := nopts.(c);
 od;
 opts.exclude := Set(opts.exclude);
 opts.testOptions.returnNumFailures := true;

 if opts.exitGAP then
 GapExitCode(1);
 fi;

 files := [];
 filetimes := [];
 filemems := [];
 filegctimes := [];

 recurseFiles := function(dirs, prefix)
 local dircontents, testfiles, t, testrecs, shortName, recursedirs, d, subdirs;
 if Length(dirs) = 0 then return; fi;
 if prefix in opts.exclude then return; fi;
 dircontents := Union(List(dirs, DirectoryContents));
 testfiles := Filtered(dircontents, x -> EndsWith(x, ".tst"));
 testrecs := [];
 for t in testfiles do
 shortName := Concatenation(prefix, t);
 if shortName[1] = '/' then
 shortName := shortName{[2..Length(shortName)]};
 fi;
 if not shortName in opts.exclude then
 Add(testrecs, rec(name := Filename(dirs, t), shortName := shortName));
 fi;
 od;
 Append(files, testrecs);

 recursedirs := Difference(dircontents, testfiles);
 RemoveSet(recursedirs, ".");
 RemoveSet(recursedirs, "..");
 for d in recursedirs do
 subdirs := List(dirs, x -> Directory(Filename(x, d)));
 subdirs := Filtered(subdirs, IsDirectoryPath);
 recurseFiles(subdirs, Concatenation(prefix,d,"/"));
 od;
 end;

 files := [];
 for f in basedirs do
 if not IsString(f) and IsList(f) and ForAll(f, IsDirectoryPath) then
 recurseFiles(List(f, Directory), "");
 elif IsDirectoryPath(f) then
 recurseFiles( [ Directory(f) ], "" );
 else
 Add(files, rec(name := f, shortName := f));
 fi;
 od;

 SortBy(files, f -> [f.shortName, f.name]);

 if opts.showProgress then
 Print( "Architecture: ", GAPInfo.Architecture, "\n\n" );
 fi;

 for i in [1..Length(files)] do
 if opts.showProgress then
 Print("testing: ", files[i].name, "\n");
 fi;

 startTime := Runtime();
 startMem := TotalMemoryAllocated();
 startGcTime := TOTAL_GC_TIME();

 if opts.rewriteToFile then
 opts.testOptions.rewriteToFile := files[i].name;
 fi;
 testResult := Test(files[i].name, opts.testOptions);
 if (testResult <> 0) and opts.earlyStop then
 STOP_TEST := STOP_TEST_CPY;
 if not opts.suppressStatusMessage then
 # Do not change the next line - it is needed for testing scripts
 Print( "#I Errors detected while testing\n\n" );
 fi;
 if opts.exitGAP then
 QuitGap(1);
 fi;
 return false;
 fi;
 if testResult <> 0 then
 testFailedFiles := testFailedFiles + 1;
 fi;
 testTotalFailures := testTotalFailures + testResult;

 time := Runtime() - startTime;
 mem := TotalMemoryAllocated() - startMem;
 gctime := TOTAL_GC_TIME() - startGcTime;
 filetimes[i] := time;
 filemems[i] := mem;
 filegctimes[i] := gctime;
 totalTime := totalTime + time;
 totalMem := totalMem + mem;
 totalGcTime := totalGcTime + gctime;

 if opts.showProgress then
 Print( String( time, 8 ), " ms (",String(gctime)," ms GC) and ",
 StringOfMemoryAmount( mem ),
 " allocated for ", files[i].shortName, "\n" );
 fi;
 od;

 STOP_TEST := STOP_TEST_CPY;

 Print("-----------------------------------\n");
 Print( "total",
 String( totalTime, 10 ), " ms (",String( totalGcTime )," ms GC) and ",
 StringOfMemoryAmount( totalMem )," allocated\n" );
 Print( " ", String( testTotalFailures, 10 ), " failures in " );
 if testTotalFailures > 0 then
 Print( testFailedFiles, " of " );
 fi;
 Print( Length(files), " files\n\n" );

 if not opts.suppressStatusMessage then
 if testTotalFailures = 0 then
 # Do not change the next line - it is needed for testing scripts
 Print( "#I No errors detected while testing\n\n" );
 else
 # Do not change the next line - it is needed for testing scripts
 Print( "#I Errors detected while testing\n\n" );
 fi;
 fi;

 if opts.exitGAP then
 if testTotalFailures = 0 then
 QuitGap(0);
 else
 QuitGap(1);
 fi;
 fi;

 return testTotalFailures = 0;
end);

#############################################################################
##
## TestPackage( <pkgname> )
##
## <#GAPDoc Label="TestPackage">
## <ManSection>
## <Func Name="TestPackage" Arg='pkgname'/>
## <Description>
## It is recommended that a &GAP; package specifies a standard test in its
## <F>PackageInfo.g</F> file. If <A>pkgname</A> is a string with the name of
## a &GAP; package, then <C>TestPackage(pkgname)</C> will check if this
## package is loadable and has the standard test, and will run this test in
## the current &GAP; session.
##
## The output of the test depends on the particular package, and it also
## may depend on the current &GAP; session (loaded packages, state of the
## random sources, defined global variables etc.).
## </Description>
## </ManSection>
## <#/GAPDoc>
##
InstallGlobalFunction( "TestPackage", function(pkgname)
local testfile, str;
pkgname := LowercaseString(pkgname);
if not IsBound( GAPInfo.PackagesInfo.(pkgname) ) then
 Print("#I No package with the name ", pkgname, " is available\n");
 return fail;
elif LoadPackage( pkgname ) = fail then
 Print( "#I ", pkgname, " package cannot be loaded\n" );
 return fail;
elif not IsBound( GAPInfo.PackagesInfo.(pkgname)[1].TestFile ) then
 Print("#I No standard tests specified in ", pkgname, " package, version ",
 GAPInfo.PackagesInfo.(pkgname)[1].Version, "\n");
 # Since a TestFile is not required, technically we passed "all" tests
 return true;
else
 testfile := Filename( DirectoriesPackageLibrary( pkgname, "" ),
 GAPInfo.PackagesInfo.(pkgname)[1].TestFile );
 str:= StringFile( testfile );
 if not IsString( str ) then
 Print( "#I Test file `", testfile, "' for package `", pkgname,
 " version ", GAPInfo.PackagesInfo.(pkgname)[1].Version, " is not readable\n" );
 return fail;
 fi;
 if EndsWith(testfile,".tst") then
 if Test( testfile, rec(compareFunction := "uptowhitespace") ) then
 Print( "#I No errors detected while testing package ", pkgname,
 " version ", GAPInfo.PackagesInfo.(pkgname)[1].Version,
 "\n#I using the test file `", testfile, "'\n");
 return true;
 else
 Print( "#I Errors detected while testing package ", pkgname,
 " version ", GAPInfo.PackagesInfo.(pkgname)[1].Version,
 "\n#I using the test file `", testfile, "'\n");
 return false;
 fi;
 elif not READ( testfile ) then
 Print( "#I Test file `", testfile, "' for package `", pkgname,
 " version ", GAPInfo.PackagesInfo.(pkgname)[1].Version, " is not readable\n" );
 return fail;
 else
 # At this point, the READ succeeded, but we have no idea what the
 # outcome of that test was. Hopefully, that file printed a message of
 # its own and then terminated GAP with a suitable error code (e.g. by
 # using TestDirectory with exitGAP:=true); in that case we never get
 # here and all is fine.
 return fail;
 fi;
fi;
end);

Quellcode-Bibliothek test.gi Sprache: unbekannt

[ 0.71Quellennavigators Projekt ]