* NeedTarget, SkipTarget, SkipCPU added

  * Retrieve compiler info in a single call for 1.1 compiler

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

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

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<i) and (s[j] in [#9,' ']) do
+   inc(j);
+  trimspace:=Copy(s,j,i-j+1);
+end;
+
+
+function IsInList(const entry,list:string):boolean;
+var
+  i,istart : longint;
+begin
+  IsInList:=false;
+  i:=0;
+  while (i<length(list)) do
+   begin
+     { Find list item }
+     istart:=i+1;
+     while (i<length(list)) and
+           (list[i+1]<>',') 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 GetCompilerVersion:boolean;
+begin
+  if CompilerVersion='' then
+    GetCompilerVersion:=GetCompilerInfo(compver)
+  else
+    GetCompilerVersion:=true;
+end;
+
+
 function GetCompilerCPU:boolean;
-var
-  t : text;
 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 CompilerCPU='' then
+    GetCompilerCPU:=GetCompilerInfo(compcpu)
   else
-   begin
-     Verbose(V_Debug,'Current Compiler CPU Target: '+CompilerCPU);
-     GetCompilerCPU:=true;
-   end;
+    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

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

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. 
+end.