diff --git a/tests/utils/dbdigest.pp b/tests/utils/dbdigest.pp index 63713a18c3..c91a922098 100644 --- a/tests/utils/dbdigest.pp +++ b/tests/utils/dbdigest.pp @@ -38,6 +38,7 @@ Type stSkippingKnownBug, stSkippingCompilerVersionTooLow, stSkippingOtherCpu, + stSkippingOtherTarget, stskippingRunUnit, stskippingRunTest ); @@ -45,8 +46,8 @@ Type Const FirstStatus = stFailedToCompile; - LastStatus = stskippingRunTest; - + LastStatus = stskippingRunTest; + TestOK : Array[TTestStatus] of Boolean = ( False, // stFailedToCompile, True, // stSuccessCompilationFailed, @@ -60,6 +61,7 @@ Const False, // stSkippingKnownBug, False, // stSkippingCompilerVersionTooLow, False, // stSkippingOtherCpu, + False, // stSkippingOtherTarget, False, // stskippingRunUnit, False // stskippingRunTest ); @@ -77,6 +79,7 @@ Const True, // stSkippingKnownBug, True, // stSkippingCompilerVersionTooLow, True, // stSkippingOtherCpu, + True, // stSkippingOtherTarget, True, // stskippingRunUnit, True // stskippingRunTest ); @@ -94,6 +97,7 @@ Const False, // stSkippingKnownBug, False, // stSkippingCompilerVersionTooLow, False, // stSkippingOtherCpu, + False, // stSkippingOtherTarget, False, // stskippingRunUnit, False // stskippingRunTest ); @@ -111,6 +115,7 @@ Const skipping_known_bug , skipping_compiler_version_too_low , skipping_other_cpu , + skipping_other_target , skipping_run_unit , skipping_run_test ); @@ -120,26 +125,26 @@ Var UnknownLines, unexpected_run : Integer; next_should_be_run : boolean; - + var prevline : string; - + Procedure ExtractTestFileName(Var Line : string); Var I : integer; begin I:=Pos(' ',Line); - If (I<>0) then - Line:=Copy(Line,1,I-1); -end; + If (I<>0) then + Line:=Copy(Line,1,I-1); +end; Function Analyse(Var Line : string; Var Status : TTestStatus) : Boolean; Var TS : TTestStatus; Found : Boolean; - + begin TS:=FirstStatus; Result:=False; @@ -185,7 +190,7 @@ ConfigStrings : Array [TConfigOpt] of string = ( 'date' ); -ConfigOpts : Array[TConfigOpt] of char +ConfigOpts : Array[TConfigOpt] of char = ('d','h','u','p','l','o','c','v','t'); Var @@ -198,7 +203,7 @@ Var Password, LogFileName : String; TestDate : TDateTime; - + Procedure SetOpt (O : TConfigOpt; Value : string); begin @@ -209,7 +214,7 @@ begin coPassword : Password:=Value; coLogFile : LogFileName:=Value; coOS : TestOS:=Value; - coCPU : TestCPU:=Value; + coCPU : TestCPU:=Value; coVersion : TestVersion:=Value; coDate : TestDate:=StrToDate(Value); end; @@ -221,8 +226,8 @@ Var N : String; I : Integer; Found : Boolean; - co,o : TConfigOpt; - + co,o : TConfigOpt; + begin Verbose(V_DEBUG,'Processing option: '+S); I:=Pos('=',S); @@ -230,7 +235,7 @@ begin If Result then begin N:=Copy(S,1,I-1); - Delete(S,1,I); + Delete(S,1,I); For co:=coDatabaseName to coDate do begin Result:=CompareText(ConfigStrings[co],N)=0; @@ -240,10 +245,10 @@ begin Break; end; end; - end; - If Result then + end; + If Result then SetOpt(co,S) - else + else Verbose(V_ERROR,'Unknown option : '+S); end; @@ -253,7 +258,7 @@ Var F : Text; S : String; I : Integer; - + begin If Not FileExists(FN) Then Exit; @@ -271,10 +276,10 @@ begin I:=Pos('#',S); If I<>0 then S:=Copy(S,1,I-1); - If (S<>'') then + If (S<>'') then ProcessOption(S); end; - Close(F); + Close(F); end; Procedure ProcessCommandLine; @@ -284,7 +289,7 @@ Var O,V : String; c,co : TConfigOpt; Found : Boolean; - + begin I:=1; While I<=ParamCount do @@ -314,10 +319,10 @@ begin O:=Paramstr(I); SetOpt(c,o); end; - end; + end; Inc(I); end; -end; +end; Var TestCPUID : Integer; @@ -336,7 +341,7 @@ begin TestVersionID := GetVersionID(TestVersion); If TestVersionID=-1 then Verbose(V_Error,'NO ID for version "'+TestVersion+'" found.'); - If (Round(TestDate)=0) then + If (Round(TestDate)=0) then Testdate:=Date; end; @@ -347,7 +352,7 @@ begin If FileExists(FN) then Result:=GetFileContents(FN) else - Result:=''; + Result:=''; end; Procedure Processfile (FN: String); @@ -358,7 +363,7 @@ var TS : TTestStatus; ID : integer; Testlog : string; - + begin Assign(logfile,FN); {$i-} @@ -381,16 +386,16 @@ begin If Not (TestOK[TS] or TestSkipped[TS]) then TestLog:=GetLog(Line) else - TestLog:=''; + TestLog:=''; AddTestResult(ID,TestOSID,TestCPUID,TestVersionID,Ord(TS), TestOK[TS],TestSkipped[TS], TestLog, TestDate); - end; + end; end - end + end else - Inc(UnknownLines); + Inc(UnknownLines); end; close(logfile); end; @@ -405,13 +410,17 @@ begin GetIDs; ProcessFile(LogFileName) end - else + else Verbose(V_ERROR,'Missing log file name'); end. { $Log$ - Revision 1.3 2002-12-21 15:39:11 michael + Revision 1.4 2002-12-24 21:47:49 peter + * NeedTarget, SkipTarget, SkipCPU added + * Retrieve compiler info in a single call for 1.1 compiler + + Revision 1.3 2002/12/21 15:39:11 michael * Some verbosity changes Revision 1.2 2002/12/21 15:31:16 michael diff --git a/tests/utils/digest.pp b/tests/utils/digest.pp index cd7926c8bb..3948654355 100644 --- a/tests/utils/digest.pp +++ b/tests/utils/digest.pp @@ -34,6 +34,7 @@ const skipping_known_bug_count : longint = 0; skipping_compiler_version_too_low_count : longint = 0; skipping_other_cpu_count : longint = 0; + skipping_other_target_count : longint = 0; skipping_run_unit_count : longint = 0; skipping_run_test_count : longint = 0; unknown_lines : longint = 0; @@ -111,6 +112,10 @@ begin begin inc(skipping_other_cpu_count); end + else if pos(skipping_other_target,st)=1 then + begin + inc(skipping_other_target_count); + end else if pos(skipping_run_unit,st)=1 then begin inc(skipping_run_unit_count); @@ -180,7 +185,8 @@ begin +skipping_interactive_test_count +skipping_known_bug_count +skipping_compiler_version_too_low_count - +skipping_other_cpu_count; + +skipping_other_cpu_count + +skipping_other_target_count; { don't count these ones ... skipping_run_unit_count skipping_run_test_count } @@ -190,6 +196,7 @@ begin Writeln('Number of skipped known bug tests = ',skipping_known_bug_count); Writeln('Number of skipped compiler version too low tests = ',skipping_compiler_version_too_low_count); Writeln('Number of skipped tests for other cpus = ',skipping_other_cpu_count); + Writeln('Number of skipped tests for other targets = ',skipping_other_target_count); if unknown_lines>0 then Writeln('Number of unrecognized lines = ',unknown_lines); @@ -228,7 +235,11 @@ end. { $Log$ - Revision 1.2 2002-11-18 16:42:43 pierre + Revision 1.3 2002-12-24 21:47:49 peter + * NeedTarget, SkipTarget, SkipCPU added + * Retrieve compiler info in a single call for 1.1 compiler + + Revision 1.2 2002/11/18 16:42:43 pierre + KNOWNRUNERROR added Revision 1.1 2002/11/13 15:26:24 pierre diff --git a/tests/utils/dotest.pp b/tests/utils/dotest.pp index 563ddcc100..93ec0a1ca1 100644 --- a/tests/utils/dotest.pp +++ b/tests/utils/dotest.pp @@ -22,6 +22,9 @@ uses testu, redir; +type + tcompinfo = (compver,comptarget,compcpu); + const {$ifdef UNIX} ExeExt=''; @@ -29,11 +32,11 @@ const ExeExt='exe'; {$endif UNIX} - var Config : TConfig; CompilerBin : string; CompilerCPU : string; + CompilerTarget : string; CompilerVersion : string; PPFile : string; PPFileInfo : string; @@ -71,6 +74,7 @@ begin ToStr:=s; end; + function ToStrZero(l:longint;nbzero : byte):string; var s : string; @@ -82,6 +86,44 @@ begin end; +function trimspace(const s:string):string; +var + i,j : longint; +begin + i:=length(s); + while (i>0) and (s[i] in [#9,' ']) do + dec(i); + j:=1; + while (j',') do + inc(i); + if Upcase(entry)=Upcase(TrimSpace(Copy(list,istart,i-istart+1))) then + begin + IsInList:=true; + exit; + end; + { skip , } + inc(i); + end; +end; + + procedure SetPPFileInfo; Var info : searchrec; @@ -100,9 +142,6 @@ begin end; - - - function SplitPath(const s:string):string; var i : longint; @@ -267,9 +306,18 @@ begin delete(s,1,1); if GetEntry('OPT') then r.NeedOptions:=res + else + if GetEntry('TARGET') then + r.NeedTarget:=res + else + if GetEntry('SKIPTARGET') then + r.SkipTarget:=res else if GetEntry('CPU') then r.NeedCPU:=res + else + if GetEntry('SKIPCPU') then + r.SkipCPU:=res else if GetEntry('VERSION') then r.NeedVersion:=res @@ -334,49 +382,97 @@ begin end; -function GetCompilerVersion:boolean; +function GetCompilerInfo(c:tcompinfo):boolean; + + function GetToken(var s:string):string; + var + i : longint; + begin + i:=pos(' ',s); + if i=0 then + i:=length(s)+1; + GetToken:=Copy(s,1,i-1); + Delete(s,1,i); + end; + var - t : text; + t : text; + hs : string; begin - GetCompilerVersion:=false; - ExecuteRedir(CompilerBin,'-iV','','out',''); + GetCompilerInfo:=false; + { Try to get all information in one call, this is + supported in 1.1. Older compilers 1.0.x will only + return the first info } + case c of + compver : + hs:='-iVTPTO'; + compcpu : + hs:='-iTPTOV'; + comptarget : + hs:='-iTOTPV'; + end; + ExecuteRedir(CompilerBin,hs,'','out',''); assign(t,'out'); {$I-} reset(t); - readln(t,CompilerVersion); + readln(t,hs); close(t); erase(t); {$I+} if ioresult<>0 then - Verbose(V_Error,'Can''t get Compiler Version') + Verbose(V_Error,'Can''t get Compiler Info') else begin - Verbose(V_Debug,'Current Compiler Version: '+CompilerVersion); - GetCompilerVersion:=true; + Verbose(V_Debug,'Current Compiler Info: "'+hs+'"'); + case c of + compver : + begin + CompilerVersion:=GetToken(hs); + CompilerCPU:=GetToken(hs); + CompilerTarget:=GetToken(hs); + end; + compcpu : + begin + CompilerCPU:=GetToken(hs); + CompilerTarget:=GetToken(hs); + CompilerVersion:=GetToken(hs); + end; + comptarget : + begin + CompilerTarget:=GetToken(hs); + CompilerCPU:=GetToken(hs); + CompilerVersion:=GetToken(hs); + end; + end; + GetCompilerInfo:=true; end; end; -function GetCompilerCPU:boolean; -var - t : text; +function GetCompilerVersion:boolean; begin - GetCompilerCPU:=false; - ExecuteRedir(CompilerBin,'-iTP','','out',''); - assign(t,'out'); - {$I-} - reset(t); - readln(t,CompilerCPU); - close(t); - erase(t); - {$I+} - if ioresult<>0 then - Verbose(V_Error,'Can''t get Compiler CPU Target') + if CompilerVersion='' then + GetCompilerVersion:=GetCompilerInfo(compver) else - begin - Verbose(V_Debug,'Current Compiler CPU Target: '+CompilerCPU); - GetCompilerCPU:=true; - end; + GetCompilerVersion:=true; +end; + + +function GetCompilerCPU:boolean; +begin + if CompilerCPU='' then + GetCompilerCPU:=GetCompilerInfo(compcpu) + else + GetCompilerCPU:=true; +end; + + +function GetCompilerTarget:boolean; +begin + if CompilerTarget='' then + GetCompilerTarget:=GetCompilerInfo(comptarget) + else + GetCompilerTarget:=true; end; @@ -693,7 +789,7 @@ begin begin Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU); Res:=GetCompilerCPU; - if Upper(Config.NeedCPU)<>Upper(CompilerCPU) then + if not IsInList(CompilerCPU,Config.NeedCPU) then begin { avoid a second attempt by writing to elg file } AddLog(OutName,skipping_other_cpu+PPFileInfo); @@ -704,6 +800,57 @@ begin end; end; + if Res then + begin + if Config.SkipCPU<>'' then + begin + Verbose(V_Debug,'Skip compiler cpu: '+Config.NeedCPU); + Res:=GetCompilerCPU; + if IsInList(CompilerCPU,Config.SkipCPU) then + begin + { avoid a second attempt by writing to elg file } + AddLog(OutName,skipping_other_cpu+PPFileInfo); + AddLog(ResLogFile,skipping_other_cpu+PPFileInfo); + Verbose(V_Abort,'Compiler cpu in skipcpu '+CompilerCPU+' = '+Config.SkipCPU); + Res:=false; + end; + end; + end; + + if Res then + begin + if Config.NeedTarget<>'' then + begin + Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget); + Res:=GetCompilerTarget; + if not IsInList(CompilerTarget,Config.NeedTarget) then + begin + { avoid a second attempt by writing to elg file } + AddLog(OutName,skipping_other_target+PPFileInfo); + AddLog(ResLogFile,skipping_other_target+PPFileInfo); + Verbose(V_Abort,'Compiler target wrong '+CompilerTarget+' <> '+Config.NeedTarget); + Res:=false; + end; + end; + end; + + if Res then + begin + if Config.SkipTarget<>'' then + begin + Verbose(V_Debug,'Skip compiler target: '+Config.NeedTarget); + Res:=GetCompilerTarget; + if IsInList(CompilerTarget,Config.SkipTarget) then + begin + { avoid a second attempt by writing to elg file } + AddLog(OutName,skipping_other_target+PPFileInfo); + AddLog(ResLogFile,skipping_other_target+PPFileInfo); + Verbose(V_Abort,'Compiler target in skiptarget '+CompilerTarget+' = '+Config.SkipTarget); + Res:=false; + end; + end; + end; + if Res then begin Res:=RunCompiler; @@ -746,7 +893,11 @@ begin end. { $Log$ - Revision 1.23 2002-12-17 15:04:32 michael + Revision 1.24 2002-12-24 21:47:49 peter + * NeedTarget, SkipTarget, SkipCPU added + * Retrieve compiler info in a single call for 1.1 compiler + + Revision 1.23 2002/12/17 15:04:32 michael + Added dbdigest to store results in a database Revision 1.22 2002/12/15 13:30:46 peter diff --git a/tests/utils/teststr.pp b/tests/utils/teststr.pp index 12f31946f5..9688c23307 100644 --- a/tests/utils/teststr.pp +++ b/tests/utils/teststr.pp @@ -32,6 +32,7 @@ const skipping_known_bug = 'Skipping test because it is a known bug '; skipping_compiler_version_too_low = 'Skipping test because compiler version too low '; skipping_other_cpu = 'Skipping test because for other cpu '; + skipping_other_target = 'Skipping test because for other target '; skipping_run_unit = 'Skipping test run because it is a unit '; skipping_run_test = 'Skipping run test '; known_problem = ' known problem: '; @@ -45,7 +46,11 @@ end. { $Log$ - Revision 1.3 2002-11-18 16:42:43 pierre + Revision 1.4 2002-12-24 21:47:49 peter + * NeedTarget, SkipTarget, SkipCPU added + * Retrieve compiler info in a single call for 1.1 compiler + + Revision 1.3 2002/11/18 16:42:43 pierre + KNOWNRUNERROR added Revision 1.2 2002/11/13 15:26:24 pierre diff --git a/tests/utils/testu.pp b/tests/utils/testu.pp index 05b32219cc..d011fb2548 100644 --- a/tests/utils/testu.pp +++ b/tests/utils/testu.pp @@ -15,6 +15,9 @@ type TConfig = record NeedOptions, NeedCPU, + SkipCPU, + NeedTarget, + SkipTarget, NeedVersion, KnownRunNote : string; ResultCode : longint; @@ -32,7 +35,7 @@ type Const DoVerbose : boolean = false; - + procedure TrimB(var s:string); procedure TrimE(var s:string); function upper(const s : string) : string; @@ -82,7 +85,7 @@ end; function upper(const s : string) : string; var i,l : longint; - + begin L:=Length(S); SetLength(upper,l); @@ -229,7 +232,7 @@ Function GetFileContents (FN : String) : String; Var F : Text; S : String; - + begin Result:=''; Assign(F,FN); @@ -243,7 +246,7 @@ begin ReadLn(F,S); Result:=Result+S+LineEnding; end; - Close(F); + Close(F); end; -end. \ No newline at end of file +end.