浏览代码

+ Support !ENV_VAR option and separate ExeExt for target from SrcExeExt for cross-testing

git-svn-id: trunk@17696 -
pierre 14 年之前
父节点
当前提交
9f919b942a
共有 1 个文件被更改,包括 150 次插入99 次删除
  1. 150 99
      tests/utils/dotest.pp

+ 150 - 99
tests/utils/dotest.pp

@@ -44,14 +44,15 @@ const
   ObjExt='o';
   ObjExt='o';
   PPUExt='ppu';
   PPUExt='ppu';
 {$ifdef UNIX}
 {$ifdef UNIX}
-  ExeExt='';
+  SrcExeExt='';
 {$else UNIX}
 {$else UNIX}
 {$ifdef MACOS}
 {$ifdef MACOS}
-  ExeExt='';
+  SrcExeExt='';
 {$else MACOS}
 {$else MACOS}
-  ExeExt='exe';
+  SrcExeExt='.exe';
 {$endif MACOS}
 {$endif MACOS}
 {$endif UNIX}
 {$endif UNIX}
+  ExeExt : string = '';
   DefaultTimeout=60;
   DefaultTimeout=60;
 
 
 var
 var
@@ -82,7 +83,7 @@ const
   DoKnown : boolean = false;
   DoKnown : boolean = false;
   DoAll : boolean = false;
   DoAll : boolean = false;
   DoUsual : boolean = true;
   DoUsual : boolean = true;
-  TargetDir : string = '';
+  { TargetDir : string = ''; unused }
   BenchmarkInfo : boolean = false;
   BenchmarkInfo : boolean = false;
   ExtraCompilerOpts : string = '';
   ExtraCompilerOpts : string = '';
   DelExecutable : TDelExecutables = [];
   DelExecutable : TDelExecutables = [];
@@ -109,16 +110,39 @@ var
 begin
 begin
   LTarget := lowercase(CompilerTarget);
   LTarget := lowercase(CompilerTarget);
   TargetHasDosStyleDirectories :=
   TargetHasDosStyleDirectories :=
+    (LTarget='emx') or
     (LTarget='go32v2') or
     (LTarget='go32v2') or
-    (LTarget='win32') or
-    (LTarget='win64') or
+    (LTarget='nativent') or
+    (LTarget='os2') or
+    (LTarget='symbian') or
     (LTarget='watcom') or
     (LTarget='watcom') or
-    (LTarget='os2');
+    (LTarget='wdosx') or
+    (LTarget='win32') or
+    (LTarget='win64');
   TargetAmigaLike:=
   TargetAmigaLike:=
     (LTarget='amiga') or
     (LTarget='amiga') or
     (LTarget='morphos');
     (LTarget='morphos');
   TargetIsMacOS:=
   TargetIsMacOS:=
     (LTarget='macos');
     (LTarget='macos');
+  { Set ExeExt for CompilerTarget.
+    This list has been set up 2011-06 using the information in
+    compiler/system/i_XXX.pas units.
+    We should update this list when adding new targets PM }
+  if (TargetHasDosStyleDirectories) then
+    ExeExt:='.exe'
+  else if LTarget='atari' then
+    ExeExt:='.tpp'
+  else if LTarget='gba' then
+    ExeExt:='.gba'
+  else if LTarget='nds' then
+    ExeExt:='.bin'
+  else if (LTarget='netware') or (LTarget='netwlibc') then
+    ExeExt:='.nlm'
+  else if LTarget='wii' then
+    ExeExt:='.dol'
+  else if LTarget='wince' then
+    ExeExt:='.exe';
+
 end;
 end;
 
 
 { extracted from rtl/macos/macutils.inc }
 { extracted from rtl/macos/macutils.inc }
@@ -298,7 +322,12 @@ begin
   if j=0 then
   if j=0 then
    j:=length(Hstr)+1;
    j:=length(Hstr)+1;
   if Ext<>'' then
   if Ext<>'' then
-   ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext
+   begin
+     if Ext[1]='.' then
+       ForceExtension:=Copy(Hstr,1,j-1)+Ext
+     else
+       ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext
+   end
   else
   else
    ForceExtension:=Copy(Hstr,1,j-1);
    ForceExtension:=Copy(Hstr,1,j-1);
 end;
 end;
@@ -804,7 +833,7 @@ var
   TestRemoteExe,
   TestRemoteExe,
   TestExe  : string;
   TestExe  : string;
   LocalFile, RemoteFile: string;
   LocalFile, RemoteFile: string;
-  LocalPath, LTarget : string;
+  LocalPath: string;
   execcmd,
   execcmd,
   pref     : string;
   pref     : string;
   execres  : boolean;
   execres  : boolean;
@@ -843,19 +872,9 @@ label
 begin
 begin
   RunExecutable:=false;
   RunExecutable:=false;
   execres:=true;
   execres:=true;
-  { when remote testing, leave extension away,
-    but not for go32v2, win32 or win64 as cygwin ssh
-    will remove the .exe in that case }
-  LTarget := lowercase(CompilerTarget);
 
 
-  if (RemoteAddr='') or
-     (rcpprog='pscp') or
-     (LTarget='go32v2') or
-     (LTarget='win32') or
-     (LTarget='win64') then
-    TestExe:=OutputFileName(PPFile[current],ExeExt)
-  else
-    TestExe:=OutputFileName(PPFile[current],'');
+  TestExe:=OutputFileName(PPFile[current],ExeExt);
+
   if EmulatorName<>'' then
   if EmulatorName<>'' then
     begin
     begin
       { Get full name out log file, because we change the directory during
       { Get full name out log file, because we change the directory during
@@ -1039,15 +1058,15 @@ end;
 
 
 procedure getargs;
 procedure getargs;
 var
 var
-  ch   : char;
   para : string;
   para : string;
-  i,j  : longint;
+  i  : longint;
 
 
   procedure helpscreen;
   procedure helpscreen;
   begin
   begin
     writeln('dotest [Options] <File>');
     writeln('dotest [Options] <File>');
     writeln;
     writeln;
     writeln('Options can be:');
     writeln('Options can be:');
+    writeln('  !ENV_NAME     parse environment variable ENV_NAME for options');
     writeln('  -A            include ALL tests');
     writeln('  -A            include ALL tests');
     writeln('  -B            delete executable before remote upload');
     writeln('  -B            delete executable before remote upload');
     writeln('  -C<compiler>  set compiler to use');
     writeln('  -C<compiler>  set compiler to use');
@@ -1072,104 +1091,136 @@ var
     halt(1);
     halt(1);
   end;
   end;
 
 
-begin
-  if exeext<>'' then
-    CompilerBin:='ppc386.'+exeext
-  else
-    CompilerBin:='ppc386';
-  for i:=1 to paramcount do
-   begin
-     para:=Paramstr(i);
-     if (para[1]='-') then
-      begin
-        ch:=Upcase(para[2]);
-        delete(para,1,2);
-        case ch of
-         'A' :
-           begin
-             DoGraph:=true;
-             DoInteractive:=true;
-             DoKnown:=true;
-             DoAll:=true;
-           end;
+  procedure interpret_option (arg : string);
+  var
+    ch : char;
+    j : longint;
+  begin
+    ch:=Upcase(para[2]);
+    delete(para,1,2);
+    case ch of
+     'A' :
+       begin
+         DoGraph:=true;
+         DoInteractive:=true;
+         DoKnown:=true;
+         DoAll:=true;
+       end;
 
 
-         'B' : Include(DelExecutable,deBefore);
+     'B' : Include(DelExecutable,deBefore);
 
 
-         'C' : CompilerBin:=Para;
+     'C' : CompilerBin:=Para;
 
 
-         'D' : BenchMarkInfo:=true;
+     'D' : BenchMarkInfo:=true;
 
 
-         'E' : DoExecute:=true;
+     'E' : DoExecute:=true;
 
 
-         'G' : begin
-                 DoGraph:=true;
-                 if para='-' then
-                   DoUsual:=false;
-               end;
+     'G' : begin
+             DoGraph:=true;
+             if para='-' then
+               DoUsual:=false;
+           end;
 
 
-         'I' : begin
-                 DoInteractive:=true;
-                 if para='-' then
-                   DoUsual:=false;
-               end;
+     'I' : begin
+             DoInteractive:=true;
+             if para='-' then
+               DoUsual:=false;
+           end;
 
 
-         'K' : begin
-                 DoKnown:=true;
-                 if para='-' then
-                   DoUsual:=false;
-               end;
+     'K' : begin
+             DoKnown:=true;
+             if para='-' then
+               DoUsual:=false;
+           end;
 
 
-         'M' : EmulatorName:=Para;
+     'M' : EmulatorName:=Para;
 
 
-         'O' : UseTimeout:=true;
+     'O' : UseTimeout:=true;
 
 
-         'P' : RemotePath:=Para;
+     'P' : RemotePath:=Para;
 
 
-         'R' : RemoteAddr:=Para;
+     'R' : RemoteAddr:=Para;
 
 
-         'S' :
-           begin
-             rshprog:='ssh';
-             rcpprog:='scp';
-           end;
+     'S' :
+       begin
+         rshprog:='ssh';
+         rcpprog:='scp';
+       end;
 
 
-         'T' :
+     'T' :
+       begin
+         j:=Pos('-',Para);
+         if j>0 then
            begin
            begin
-             j:=Pos('-',Para);
-             if j>0 then
-               begin
-                 CompilerCPU:=Copy(Para,1,j-1);
-                 CompilerTarget:=Copy(Para,j+1,length(para));
-               end
-             else
-               CompilerTarget:=Para
-           end;
+             CompilerCPU:=Copy(Para,1,j-1);
+             CompilerTarget:=Copy(Para,j+1,length(para));
+           end
+         else
+           CompilerTarget:=Para
+       end;
 
 
-         'U' :
-           RemotePara:=RemotePara+' '+Para;
+     'U' :
+       RemotePara:=RemotePara+' '+Para;
 
 
-         'V' : DoVerbose:=true;
+     'V' : DoVerbose:=true;
 
 
-         'W' :
-           begin
-             rshprog:='plink';
-             rcpprog:='pscp';
-             rquote:='"';
-           end;
+     'W' :
+       begin
+         rshprog:='plink';
+         rcpprog:='pscp';
+         rquote:='"';
+       end;
 
 
-         'X' : UseComSpec:=false;
+     'X' : UseComSpec:=false;
 
 
-         'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
+     'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
 
 
-         'Z' : Include(DelExecutable,deAfter);
-        end;
-     end
-    else
+     'Z' : Include(DelExecutable,deAfter);
+    end;
+ end;
+
+ procedure interpret_env(arg : string);
+ var
+   para : string;
+   pspace : longint;
+ begin
+   { Get rid of leading '!' }
+   delete(arg,1,1);
+   arg:=getenv(arg);
+   while (length(arg)>0) do
      begin
      begin
-       PPFile.Insert(current,ForceExtension(Para,'pp'));
-       inc(current);
+       while (length(arg)>0) and (arg[1]=' ') do
+         delete(arg,1,1);
+       pspace:=pos(' ',arg);
+       if pspace=0 then
+         pspace:=length(arg)+1;
+       para:=copy(arg,1,pspace-1);
+       if (length(para)>0) and (para[1]='-') then
+         interpret_option (para)
+       else
+         begin
+           PPFile.Insert(current,ForceExtension(Para,'pp'));
+           inc(current);
+         end;
+       delete(arg,1,pspace);
      end;
      end;
-    end;
+ end;
+
+begin
+  CompilerBin:='ppc386'+srcexeext;
+  for i:=1 to paramcount do
+   begin
+     para:=Paramstr(i);
+     if (para[1]='-') then
+      interpret_option(para)
+     else if (para[1]='!') then
+       interpret_env(para)
+     else
+       begin
+         PPFile.Insert(current,ForceExtension(Para,'pp'));
+         inc(current);
+       end;
+   end;
   if current=0 then
   if current=0 then
     HelpScreen;
     HelpScreen;
   { disable graph,interactive when running remote }
   { disable graph,interactive when running remote }