mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-22 21:29:28 +02:00
* Lowercase CompilerCPU and CompilerTarget
at startup to avoid need of constant use of lowercase function. + Added RemoteShell, RemoteShellBase and RemoteShellNeedsExport to be able to set LD_LIBRARY_PATH on remote connections. (Other checks might be necessary to avoid use of wrong environment settings for other shells). + TargetIsUnix: New variable, based on UNIX presence within target_info.extadefines field. + SpliTFileBase: New function returning only base part. + LibraryExists: New function to see if a library was created, Library name is also constructed based on target_info fields. * ExecuteRemote,ExecuteEmulated: moved to global scope to allow use at start to check type of shell used. * RunExecutable: Adapted to set env. varaible LD_LIBRARY_PATH for remote connections. + MaybeCopyFiles: New function to separate file copy operations. + SetRemoteConfiguration: New function to set RemoteShellXXX variables. * RunTest: Use LibraryExists to avoid running a library and possibly copy library to remote. git-svn-id: trunk@19331 -
This commit is contained in:
parent
a0e7196ae9
commit
24d489f7f7
@ -65,6 +65,8 @@ var
|
|||||||
TestOutputDir,
|
TestOutputDir,
|
||||||
OutputDir : string;
|
OutputDir : string;
|
||||||
CompilerBin,
|
CompilerBin,
|
||||||
|
{ CompilerCPU and CompilerTarget are lowercased at start
|
||||||
|
to avoid need to call lowercase again and again ... }
|
||||||
CompilerCPU,
|
CompilerCPU,
|
||||||
CompilerTarget,
|
CompilerTarget,
|
||||||
CompilerVersion,
|
CompilerVersion,
|
||||||
@ -91,6 +93,9 @@ const
|
|||||||
RemoteAddr : string = '';
|
RemoteAddr : string = '';
|
||||||
RemotePath : string = '/tmp';
|
RemotePath : string = '/tmp';
|
||||||
RemotePara : string = '';
|
RemotePara : string = '';
|
||||||
|
RemoteShell : string = '';
|
||||||
|
RemoteShellBase : string = '';
|
||||||
|
RemoteShellNeedsExport : boolean = false;
|
||||||
rshprog : string = 'rsh';
|
rshprog : string = 'rsh';
|
||||||
rcpprog : string = 'rcp';
|
rcpprog : string = 'rcp';
|
||||||
rquote : char = '''';
|
rquote : char = '''';
|
||||||
@ -102,6 +107,7 @@ const
|
|||||||
TargetHasDosStyleDirectories : boolean = false;
|
TargetHasDosStyleDirectories : boolean = false;
|
||||||
TargetAmigaLike : boolean = false;
|
TargetAmigaLike : boolean = false;
|
||||||
TargetIsMacOS : boolean = false;
|
TargetIsMacOS : boolean = false;
|
||||||
|
TargetIsUnix : boolean = false;
|
||||||
|
|
||||||
{ extracted from rtl/macos/macutils.inc }
|
{ extracted from rtl/macos/macutils.inc }
|
||||||
|
|
||||||
@ -266,6 +272,16 @@ begin
|
|||||||
SplitFileName:=n+e;
|
SplitFileName:=n+e;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Function SplitFileBase(const s:string):string;
|
||||||
|
var
|
||||||
|
p : dirstr;
|
||||||
|
n : namestr;
|
||||||
|
e : extstr;
|
||||||
|
begin
|
||||||
|
FSplit(s,p,n,e);
|
||||||
|
SplitFileBase:=n;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ForceExtension(Const HStr,ext:String):String;
|
function ForceExtension(Const HStr,ext:String):String;
|
||||||
{
|
{
|
||||||
@ -489,6 +505,8 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
function GetCompilerVersion:boolean;
|
function GetCompilerVersion:boolean;
|
||||||
|
const
|
||||||
|
CompilerVersionDebugWritten : boolean = false;
|
||||||
begin
|
begin
|
||||||
if CompilerVersion='' then
|
if CompilerVersion='' then
|
||||||
begin
|
begin
|
||||||
@ -497,36 +515,49 @@ begin
|
|||||||
end
|
end
|
||||||
else
|
else
|
||||||
GetCompilerVersion:=true;
|
GetCompilerVersion:=true;
|
||||||
if GetCompilerVersion then
|
if GetCompilerVersion and not CompilerVersionDebugWritten then
|
||||||
Verbose(V_Debug,'Compiler Version: "'+CompilerVersion+'"');
|
begin
|
||||||
|
Verbose(V_Debug,'Compiler Version: "'+CompilerVersion+'"');
|
||||||
|
CompilerVersionDebugWritten:=true;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function GetCompilerCPU:boolean;
|
function GetCompilerCPU:boolean;
|
||||||
|
const
|
||||||
|
CompilerCPUDebugWritten : boolean = false;
|
||||||
begin
|
begin
|
||||||
if CompilerCPU='' then
|
if CompilerCPU='' then
|
||||||
begin
|
begin
|
||||||
GetCompilerCPU:=GetCompilerInfo(compcpu);
|
GetCompilerCPU:=GetCompilerInfo(compcpu);
|
||||||
CompilerCPU:=DefaultCompilerCPU;
|
CompilerCPU:=lowercase(DefaultCompilerCPU);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
GetCompilerCPU:=true;
|
GetCompilerCPU:=true;
|
||||||
if GetCompilerCPU then
|
if GetCompilerCPU and not CompilerCPUDebugWritten then
|
||||||
Verbose(V_Debug,'Compiler CPU: "'+CompilerCPU+'"');
|
begin
|
||||||
|
Verbose(V_Debug,'Compiler CPU: "'+CompilerCPU+'"');
|
||||||
|
CompilerCPUDebugWritten:=true;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function GetCompilerTarget:boolean;
|
function GetCompilerTarget:boolean;
|
||||||
|
const
|
||||||
|
CompilerTargetDebugWritten : boolean = false;
|
||||||
begin
|
begin
|
||||||
if CompilerTarget='' then
|
if CompilerTarget='' then
|
||||||
begin
|
begin
|
||||||
GetCompilerTarget:=GetCompilerInfo(comptarget);
|
GetCompilerTarget:=GetCompilerInfo(comptarget);
|
||||||
CompilerTarget:=DefaultCompilerTarget;
|
CompilerTarget:=lowercase(DefaultCompilerTarget);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
GetCompilerTarget:=true;
|
GetCompilerTarget:=true;
|
||||||
if GetCompilerTarget then
|
if GetCompilerTarget and not CompilerTargetDebugWritten then
|
||||||
Verbose(V_Debug,'Compiler Target: "'+CompilerTarget+'"');
|
begin
|
||||||
|
Verbose(V_Debug,'Compiler Target: "'+CompilerTarget+'"');
|
||||||
|
CompilerTargetDebugWritten:=true;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -548,7 +579,7 @@ var
|
|||||||
begin
|
begin
|
||||||
{ Call this first to ensure that CompilerTarget is not empty }
|
{ Call this first to ensure that CompilerTarget is not empty }
|
||||||
res:=GetCompilerTarget;
|
res:=GetCompilerTarget;
|
||||||
LTarget := lowercase(CompilerTarget);
|
LTarget := CompilerTarget;
|
||||||
TargetHasDosStyleDirectories :=
|
TargetHasDosStyleDirectories :=
|
||||||
(LTarget='emx') or
|
(LTarget='emx') or
|
||||||
(LTarget='go32v2') or
|
(LTarget='go32v2') or
|
||||||
@ -564,6 +595,20 @@ begin
|
|||||||
(LTarget='morphos');
|
(LTarget='morphos');
|
||||||
TargetIsMacOS:=
|
TargetIsMacOS:=
|
||||||
(LTarget='macos');
|
(LTarget='macos');
|
||||||
|
{ Base on whether UNIX is defined as default macro
|
||||||
|
in extradefines in systesms/i_XXX.pas units }
|
||||||
|
TargetIsUnix:=
|
||||||
|
(LTarget='linux') or
|
||||||
|
(LTarget='linux6432') or
|
||||||
|
(LTarget='freebsd') or
|
||||||
|
(LTarget='openbsd') or
|
||||||
|
(LTarget='netbsd') or
|
||||||
|
(LTarget='beos') or
|
||||||
|
(LTarget='haiku') or
|
||||||
|
(LTarget='solaris') or
|
||||||
|
(LTarget='iphonesim') or
|
||||||
|
(LTarget='darwin');
|
||||||
|
|
||||||
{ Set ExeExt for CompilerTarget.
|
{ Set ExeExt for CompilerTarget.
|
||||||
This list has been set up 2011-06 using the information in
|
This list has been set up 2011-06 using the information in
|
||||||
compiler/system/i_XXX.pas units.
|
compiler/system/i_XXX.pas units.
|
||||||
@ -595,7 +640,7 @@ var
|
|||||||
begin
|
begin
|
||||||
{ Call this first to ensure that CompilerTarget is not empty }
|
{ Call this first to ensure that CompilerTarget is not empty }
|
||||||
res:=GetCompilerTarget;
|
res:=GetCompilerTarget;
|
||||||
LTarget := lowercase(CompilerTarget);
|
LTarget := CompilerTarget;
|
||||||
UseOSOnly:= (LTarget='emx') or
|
UseOSOnly:= (LTarget='emx') or
|
||||||
(LTarget='go32v2') or
|
(LTarget='go32v2') or
|
||||||
(LTarget='os2');
|
(LTarget='os2');
|
||||||
@ -609,7 +654,7 @@ var
|
|||||||
begin
|
begin
|
||||||
{ Call this first to ensure that CompilerTarget is not empty }
|
{ Call this first to ensure that CompilerTarget is not empty }
|
||||||
res:=GetCompilerTarget;
|
res:=GetCompilerTarget;
|
||||||
LTarget := lowercase(CompilerTarget);
|
LTarget := CompilerTarget;
|
||||||
{ Feel free to add other targets here }
|
{ Feel free to add other targets here }
|
||||||
if (LTarget='go32v2') then
|
if (LTarget='go32v2') then
|
||||||
TargetCanCompileLibraries:=false;
|
TargetCanCompileLibraries:=false;
|
||||||
@ -626,12 +671,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TestOutputFileName(Const s,ext:String):String;
|
function TestOutputFileName(Const pref,base,ext:String):String;
|
||||||
begin
|
begin
|
||||||
{$ifndef macos}
|
{$ifndef macos}
|
||||||
TestOutputFileName:=TestOutputDir+'/'+ForceExtension(SplitFileName(s),ext);
|
TestOutputFileName:=TestOutputDir+'/'+ForceExtension(pref+SplitFileName(base),ext);
|
||||||
{$else macos}
|
{$else macos}
|
||||||
TestOutputFileName:=ConcatMacPath(TestOutputDir,ForceExtension(SplitFileName(s),ext));
|
TestOutputFileName:=ConcatMacPath(TestOutputDir,ForceExtension(pref+SplitFileName(base),ext));
|
||||||
{$endif macos}
|
{$endif macos}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -675,20 +720,21 @@ begin
|
|||||||
RunCompiler:=false;
|
RunCompiler:=false;
|
||||||
args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
|
args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
|
||||||
args:=args+' -FE'+TestOutputDir;
|
args:=args+' -FE'+TestOutputDir;
|
||||||
{$ifdef macos}
|
if TargetIsMacOS then
|
||||||
args:=args+' -WT '; {tests should be compiled as MPWTool}
|
args:=args+' -WT '; {tests should be compiled as MPWTool}
|
||||||
{$endif macos}
|
|
||||||
if ExtraCompilerOpts<>'' then
|
if ExtraCompilerOpts<>'' then
|
||||||
args:=args+ExtraCompilerOpts;
|
args:=args+ExtraCompilerOpts;
|
||||||
{$ifdef unix}
|
if TargetIsUnix then
|
||||||
{ Add runtime library path to current dir to find .so files }
|
begin
|
||||||
if Config.NeedLibrary then
|
{ Add runtime library path to current dir to find .so files }
|
||||||
{$ifndef darwin}
|
if Config.NeedLibrary then
|
||||||
args:=args+' -Fl'+TestOutputDir+' ''-k-rpath .''';
|
begin
|
||||||
{$else darwin}
|
if CompilerTarget<>'darwin' then
|
||||||
args:=args+' -Fl'+TestOutputDir;
|
args:=args+' -Fl'+TestOutputDir+' ''-k-rpath .'''
|
||||||
{$endif darwin}
|
else
|
||||||
{$endif unix}
|
args:=args+' -Fl'+TestOutputDir;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
if Config.NeedOptions<>'' then
|
if Config.NeedOptions<>'' then
|
||||||
args:=args+' '+Config.NeedOptions;
|
args:=args+' '+Config.NeedOptions;
|
||||||
wpoargs:='';
|
wpoargs:='';
|
||||||
@ -703,9 +749,9 @@ begin
|
|||||||
begin
|
begin
|
||||||
if (passes>1) then
|
if (passes>1) then
|
||||||
begin
|
begin
|
||||||
wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName(PPFile[current],'wp'+tostr(passnr));
|
wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
|
||||||
if (passnr>1) then
|
if (passnr>1) then
|
||||||
wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName(PPFile[current],'wp'+tostr(passnr-1));
|
wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1));
|
||||||
end;
|
end;
|
||||||
Verbose(V_Debug,'Executing '+compilerbin+' '+args+wpoargs);
|
Verbose(V_Debug,'Executing '+compilerbin+' '+args+wpoargs);
|
||||||
{ also get the output from as and ld that writes to stderr sometimes }
|
{ also get the output from as and ld that writes to stderr sometimes }
|
||||||
@ -847,75 +893,178 @@ begin
|
|||||||
begin
|
begin
|
||||||
delete(s,1,i+14-1);
|
delete(s,1,i+14-1);
|
||||||
val(s,ExecuteResult,code);
|
val(s,ExecuteResult,code);
|
||||||
if code=0 then;
|
if code=0 then
|
||||||
CheckTestExitCode:=true;
|
CheckTestExitCode:=true;
|
||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
close(t);
|
close(t);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function LibraryExists(const PPFile : string; var FileName : string) : boolean;
|
||||||
|
begin
|
||||||
|
{ Check if a dynamic library XXX was created }
|
||||||
|
{ Windows XXX.dll style }
|
||||||
|
FileName:=TestOutputFilename('',PPFile,'dll');
|
||||||
|
if FileExists(FileName) then
|
||||||
|
begin
|
||||||
|
LibraryExists:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Linux libXXX.so style }
|
||||||
|
FileName:=TestOutputFilename('lib',PPFile,'so');
|
||||||
|
if FileExists(FileName) then
|
||||||
|
begin
|
||||||
|
LibraryExists:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Darwin libXXX.dylib style }
|
||||||
|
FileName:=TestOutputFilename('lib',PPFile,'dylib');
|
||||||
|
if FileExists(FileName) then
|
||||||
|
begin
|
||||||
|
LibraryExists:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ MacOS LibXXX style }
|
||||||
|
FileName:=TestOutputFilename('Lib',PPFile,'');
|
||||||
|
if FileExists(FileName) then
|
||||||
|
begin
|
||||||
|
LibraryExists:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Netware wlic XXX.nlm style }
|
||||||
|
FileName:=TestOutputFilename('',PPFile,'nlm');
|
||||||
|
if FileExists(FileName) then
|
||||||
|
begin
|
||||||
|
LibraryExists:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Amiga XXX.library style }
|
||||||
|
FileName:=TestOutputFilename('',PPFile,'library');
|
||||||
|
if FileExists(FileName) then
|
||||||
|
begin
|
||||||
|
LibraryExists:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
LibraryExists:=false;
|
||||||
|
end;
|
||||||
|
function ExecuteRemote(const prog,args:string;var StartTicks,EndTicks : int64):boolean;
|
||||||
|
const
|
||||||
|
MaxTrials = 5;
|
||||||
|
var
|
||||||
|
Trials : longint;
|
||||||
|
Res : boolean;
|
||||||
|
begin
|
||||||
|
Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
|
||||||
|
StartTicks:=GetMicroSTicks;
|
||||||
|
Res:=false;
|
||||||
|
Trials:=0;
|
||||||
|
While (Trials<MaxTrials) and not Res do
|
||||||
|
begin
|
||||||
|
inc(Trials);
|
||||||
|
Res:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
|
||||||
|
if not Res then
|
||||||
|
Verbose(V_Debug,'Call to '+prog+' failed: '+
|
||||||
|
'IOStatus='+ToStr(IOStatus)+
|
||||||
|
' RedirErrorOut='+ToStr(RedirErrorOut)+
|
||||||
|
' RedirErrorIn='+ToStr(RedirErrorIn)+
|
||||||
|
' RedirErrorError='+ToStr(RedirErrorError)+
|
||||||
|
' ExecuteResult='+ToStr(ExecuteResult));
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Trials>1 then
|
||||||
|
Verbose(V_Debug,'Done in '+tostr(trials)+' trials');
|
||||||
|
EndTicks:=GetMicroSTicks;
|
||||||
|
ExecuteRemote:=res;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ExecuteEmulated(const prog,args,FullExeLogFile:string;var StartTicks,EndTicks : int64):boolean;
|
||||||
|
begin
|
||||||
|
Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
|
||||||
|
StartTicks:=GetMicroSTicks;
|
||||||
|
ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
|
||||||
|
EndTicks:=GetMicroSTicks;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function MaybeCopyFiles(const FileToCopy : string) : boolean;
|
||||||
|
var
|
||||||
|
TestRemoteExe,
|
||||||
|
s : string;
|
||||||
|
pref : string;
|
||||||
|
LocalFile, RemoteFile: string;
|
||||||
|
LocalPath: string;
|
||||||
|
index : integer;
|
||||||
|
execres : boolean;
|
||||||
|
EndTicks,
|
||||||
|
StartTicks : int64;
|
||||||
|
begin
|
||||||
|
if RemoteAddr='' then
|
||||||
|
begin
|
||||||
|
exit(false);
|
||||||
|
end;
|
||||||
|
execres:=true;
|
||||||
|
{ We don't want to create subdirs, remove paths from the test }
|
||||||
|
TestRemoteExe:=RemotePath+'/'+SplitFileName(FileToCopy);
|
||||||
|
if deBefore in DelExecutable then
|
||||||
|
ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe,
|
||||||
|
StartTicks,EndTicks);
|
||||||
|
execres:=ExecuteRemote(rcpprog,RemotePara+' '+FileToCopy+' '+
|
||||||
|
RemoteAddr+':'+TestRemoteExe,StartTicks,EndTicks);
|
||||||
|
if not execres then
|
||||||
|
begin
|
||||||
|
Verbose(V_normal, 'Could not copy executable '+FileToCopy);
|
||||||
|
exit(execres);
|
||||||
|
end;
|
||||||
|
s:=Config.Files;
|
||||||
|
if length(s) > 0 then
|
||||||
|
begin
|
||||||
|
LocalPath:=SplitPath(PPFile[current]);
|
||||||
|
if Length(LocalPath) > 0 then
|
||||||
|
LocalPath:=LocalPath+'/';
|
||||||
|
repeat
|
||||||
|
index:=pos(' ',s);
|
||||||
|
if index=0 then
|
||||||
|
LocalFile:=s
|
||||||
|
else
|
||||||
|
LocalFile:=copy(s,1,index-1);
|
||||||
|
RemoteFile:=RemotePath+'/'+SplitFileName(LocalFile);
|
||||||
|
LocalFile:=LocalPath+LocalFile;
|
||||||
|
if DoVerbose and (rcpprog='pscp') then
|
||||||
|
pref:='-v '
|
||||||
|
else
|
||||||
|
pref:='';
|
||||||
|
execres:=ExecuteRemote(rcpprog,pref+RemotePara+' '+LocalFile+' '+
|
||||||
|
RemoteAddr+':'+RemoteFile,StartTicks,EndTicks);
|
||||||
|
if not execres then
|
||||||
|
begin
|
||||||
|
Verbose(V_normal, 'Could not copy required file '+LocalFile);
|
||||||
|
exit(false);
|
||||||
|
end;
|
||||||
|
if index=0 then
|
||||||
|
break;
|
||||||
|
s:=copy(s,index+1,length(s)-index);
|
||||||
|
until false;
|
||||||
|
end;
|
||||||
|
MaybeCopyFiles:=execres;
|
||||||
|
end;
|
||||||
|
|
||||||
function RunExecutable:boolean;
|
function RunExecutable:boolean;
|
||||||
const
|
const
|
||||||
MaxTrials = 5;
|
|
||||||
{$ifdef unix}
|
{$ifdef unix}
|
||||||
CurrDir = './';
|
CurrDir = './';
|
||||||
{$else}
|
{$else}
|
||||||
CurrDir = '';
|
CurrDir = '';
|
||||||
{$endif}
|
{$endif}
|
||||||
var
|
var
|
||||||
s,
|
OldDir, s,
|
||||||
OldDir,
|
execcmd,
|
||||||
FullExeLogFile,
|
FullExeLogFile,
|
||||||
TestRemoteExe,
|
TestRemoteExe,
|
||||||
TestExe : string;
|
TestExe : string;
|
||||||
LocalFile, RemoteFile: string;
|
|
||||||
LocalPath: string;
|
|
||||||
execcmd,
|
|
||||||
pref : string;
|
|
||||||
execres : boolean;
|
execres : boolean;
|
||||||
index : integer;
|
|
||||||
EndTicks,
|
EndTicks,
|
||||||
StartTicks : int64;
|
StartTicks : int64;
|
||||||
function ExecuteRemote(const prog,args:string):boolean;
|
|
||||||
var
|
|
||||||
Trials : longint;
|
|
||||||
Res : boolean;
|
|
||||||
begin
|
|
||||||
Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
|
|
||||||
StartTicks:=GetMicroSTicks;
|
|
||||||
Res:=false;
|
|
||||||
Trials:=0;
|
|
||||||
While (Trials<MaxTrials) and not Res do
|
|
||||||
begin
|
|
||||||
inc(Trials);
|
|
||||||
Res:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
|
|
||||||
if not Res then
|
|
||||||
Verbose(V_Debug,'Call to '+prog+' failed: '+
|
|
||||||
'IOStatus='+ToStr(IOStatus)+
|
|
||||||
' RedirErrorOut='+ToStr(RedirErrorOut)+
|
|
||||||
' RedirErrorIn='+ToStr(RedirErrorIn)+
|
|
||||||
' RedirErrorError='+ToStr(RedirErrorError)+
|
|
||||||
' ExecuteResult='+ToStr(ExecuteResult));
|
|
||||||
end;
|
|
||||||
|
|
||||||
if Trials>1 then
|
|
||||||
Verbose(V_Debug,'Done in '+tostr(trials)+' trials');
|
|
||||||
EndTicks:=GetMicroSTicks;
|
|
||||||
ExecuteRemote:=res;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function ExecuteEmulated(const prog,args:string):boolean;
|
|
||||||
begin
|
|
||||||
Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
|
|
||||||
StartTicks:=GetMicroSTicks;
|
|
||||||
ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
|
|
||||||
EndTicks:=GetMicroSTicks;
|
|
||||||
end;
|
|
||||||
|
|
||||||
label
|
|
||||||
done;
|
|
||||||
begin
|
begin
|
||||||
RunExecutable:=false;
|
RunExecutable:=false;
|
||||||
execres:=true;
|
execres:=true;
|
||||||
@ -933,52 +1082,15 @@ begin
|
|||||||
{$I+}
|
{$I+}
|
||||||
ioresult;
|
ioresult;
|
||||||
s:=CurrDir+SplitFileName(TestExe);
|
s:=CurrDir+SplitFileName(TestExe);
|
||||||
execres:=ExecuteEmulated(EmulatorName,s);
|
execres:=ExecuteEmulated(EmulatorName,s,FullExeLogFile,StartTicks,EndTicks);
|
||||||
{$I-}
|
{$I-}
|
||||||
ChDir(OldDir);
|
ChDir(OldDir);
|
||||||
{$I+}
|
{$I+}
|
||||||
end
|
end
|
||||||
else if RemoteAddr<>'' then
|
else if RemoteAddr<>'' then
|
||||||
begin
|
begin
|
||||||
{ We don't want to create subdirs, remove paths from the test }
|
execres:=MaybeCopyFiles(TestExe);
|
||||||
TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
|
TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
|
||||||
if deBefore in DelExecutable then
|
|
||||||
ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe);
|
|
||||||
execres:=ExecuteRemote(rcpprog,RemotePara+' '+TestExe+' '+RemoteAddr+':'+TestRemoteExe);
|
|
||||||
if not execres then
|
|
||||||
begin
|
|
||||||
Verbose(V_normal, 'Could not copy executable '+TestExe);
|
|
||||||
goto done;
|
|
||||||
end;
|
|
||||||
s:=Config.Files;
|
|
||||||
if length(s) > 0 then
|
|
||||||
begin
|
|
||||||
LocalPath:=SplitPath(PPFile[current]);
|
|
||||||
if Length(LocalPath) > 0 then
|
|
||||||
LocalPath:=LocalPath+'/';
|
|
||||||
repeat
|
|
||||||
index:=pos(' ',s);
|
|
||||||
if index=0 then
|
|
||||||
LocalFile:=s
|
|
||||||
else
|
|
||||||
LocalFile:=copy(s,1,index-1);
|
|
||||||
RemoteFile:=RemotePath+'/'+SplitFileName(LocalFile);
|
|
||||||
LocalFile:=LocalPath+LocalFile;
|
|
||||||
if DoVerbose and (rcpprog='pscp') then
|
|
||||||
pref:='-v '
|
|
||||||
else
|
|
||||||
pref:='';
|
|
||||||
execres:=ExecuteRemote(rcpprog,pref+RemotePara+' '+LocalFile+' '+RemoteAddr+':'+RemoteFile);
|
|
||||||
if not execres then
|
|
||||||
begin
|
|
||||||
Verbose(V_normal, 'Could not copy required file '+LocalFile);
|
|
||||||
goto done;
|
|
||||||
end;
|
|
||||||
if index=0 then
|
|
||||||
break;
|
|
||||||
s:=copy(s,index+1,length(s)-index);
|
|
||||||
until false;
|
|
||||||
end;
|
|
||||||
{ rsh doesn't pass the exitcode, use a second command to print the exitcode
|
{ rsh doesn't pass the exitcode, use a second command to print the exitcode
|
||||||
on the remoteshell to stdout }
|
on the remoteshell to stdout }
|
||||||
if DoVerbose and (rshprog='plink') then
|
if DoVerbose and (rshprog='plink') then
|
||||||
@ -988,6 +1100,19 @@ begin
|
|||||||
execcmd:=execcmd+RemotePara+' '+RemoteAddr+' '+rquote+
|
execcmd:=execcmd+RemotePara+' '+RemoteAddr+' '+rquote+
|
||||||
'chmod 755 '+TestRemoteExe+
|
'chmod 755 '+TestRemoteExe+
|
||||||
' ; cd '+RemotePath+' ; ';
|
' ; cd '+RemotePath+' ; ';
|
||||||
|
{ Using -rpath . at compile time does not seem
|
||||||
|
to work for programs copied over to remote machine,
|
||||||
|
at least not for FreeBSD.
|
||||||
|
Does this work for all shells? }
|
||||||
|
if Config.NeedLibrary then
|
||||||
|
begin
|
||||||
|
if RemoteShellNeedsExport then
|
||||||
|
execcmd:=execcmd+' LD_LIBRARY_PATH=.; export LD_LIBRARY_PATH;'
|
||||||
|
else
|
||||||
|
execcmd:=execcmd+' setenv LD_LIBRARY_PATH=.; ';
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
if UseTimeout then
|
if UseTimeout then
|
||||||
begin
|
begin
|
||||||
execcmd:=execcmd+'timeout -9 ';
|
execcmd:=execcmd+'timeout -9 ';
|
||||||
@ -1007,9 +1132,10 @@ begin
|
|||||||
not Config.NeededAfter then
|
not Config.NeededAfter then
|
||||||
execcmd:=execcmd+' ; rm -f '+TestRemoteExe;
|
execcmd:=execcmd+' ; rm -f '+TestRemoteExe;
|
||||||
execcmd:=execcmd+rquote;
|
execcmd:=execcmd+rquote;
|
||||||
execres:=ExecuteRemote(rshprog,execcmd);
|
execres:=ExecuteRemote(rshprog,execcmd,StartTicks,EndTicks);
|
||||||
{ Check for TestExitCode error in output, sets ExecuteResult }
|
{ Check for TestExitCode error in output, sets ExecuteResult }
|
||||||
CheckTestExitCode(EXELogFile);
|
if not CheckTestExitCode(EXELogFile) then
|
||||||
|
Verbose(V_Debug,'Failed to check exit code for '+execcmd);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
@ -1041,7 +1167,6 @@ begin
|
|||||||
begin
|
begin
|
||||||
Verbose(V_Normal,'Execution took '+ToStr(EndTicks-StartTicks)+' us');
|
Verbose(V_Normal,'Execution took '+ToStr(EndTicks-StartTicks)+' us');
|
||||||
end;
|
end;
|
||||||
done:
|
|
||||||
if (not execres) and (ExecuteResult=0) then
|
if (not execres) and (ExecuteResult=0) then
|
||||||
begin
|
begin
|
||||||
AddLog(FailLogFile,TestName);
|
AddLog(FailLogFile,TestName);
|
||||||
@ -1103,6 +1228,37 @@ done:
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Try to collect information concerning the remote configuration
|
||||||
|
Currently only records RemoteShell name and sets
|
||||||
|
RemoteShellNeedsExport boolean variable }
|
||||||
|
procedure SetRemoteConfiguration;
|
||||||
|
var
|
||||||
|
f : text;
|
||||||
|
StartTicks,EndTicks : int64;
|
||||||
|
begin
|
||||||
|
if RemoteAddr='' then
|
||||||
|
exit;
|
||||||
|
ExeLogFile:='__remote.tmp';
|
||||||
|
ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+
|
||||||
|
' "echo SHELL=${SHELL}"',StartTicks,EndTicks);
|
||||||
|
Assign(f,ExeLogFile);
|
||||||
|
Reset(f);
|
||||||
|
While not eof(f) do
|
||||||
|
begin
|
||||||
|
Readln(f,RemoteShellBase);
|
||||||
|
if pos('SHELL=',RemoteShellBase)>0 then
|
||||||
|
begin
|
||||||
|
RemoteShell:=TrimSpace(Copy(RemoteShellBase,pos('SHELL=',RemoteShellBase)+6,
|
||||||
|
length(RemoteShellBase)));
|
||||||
|
Verbose(V_Debug,'Remote shell is "'+RemoteShell+'"');
|
||||||
|
RemoteShellBase:=SplitFileBase(RemoteShell);
|
||||||
|
if (RemoteShellBase='bash') or (RemoteShellBase='sh') then
|
||||||
|
RemoteShellNeedsExport:=true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Close(f);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure getargs;
|
procedure getargs;
|
||||||
|
|
||||||
procedure helpscreen;
|
procedure helpscreen;
|
||||||
@ -1285,7 +1441,7 @@ end;
|
|||||||
|
|
||||||
procedure RunTest;
|
procedure RunTest;
|
||||||
var
|
var
|
||||||
PPDir : string;
|
PPDir,LibraryName : string;
|
||||||
Res : boolean;
|
Res : boolean;
|
||||||
begin
|
begin
|
||||||
Res:=GetConfig(PPFile[current],Config);
|
Res:=GetConfig(PPFile[current],Config);
|
||||||
@ -1328,8 +1484,8 @@ begin
|
|||||||
else
|
else
|
||||||
TestOutputDir:=OutputDir;
|
TestOutputDir:=OutputDir;
|
||||||
{ Per test logfiles }
|
{ Per test logfiles }
|
||||||
CompilerLogFile:=TestOutputFileName(SplitFileName(PPFile[current]),'log');
|
CompilerLogFile:=TestOutputFileName('',SplitFileName(PPFile[current]),'log');
|
||||||
ExeLogFile:=TestOutputFileName(SplitFileName(PPFile[current]),'elg');
|
ExeLogFile:=TestOutputFileName('',SplitFileName(PPFile[current]),'elg');
|
||||||
Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile);
|
Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile);
|
||||||
Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile);
|
Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile);
|
||||||
end;
|
end;
|
||||||
@ -1516,6 +1672,8 @@ begin
|
|||||||
AddLog(EXELogFile,skipping_run_test+PPFileInfo[current]);
|
AddLog(EXELogFile,skipping_run_test+PPFileInfo[current]);
|
||||||
AddLog(ResLogFile,skipping_run_test+PPFileInfo[current]);
|
AddLog(ResLogFile,skipping_run_test+PPFileInfo[current]);
|
||||||
Verbose(V_Debug,skipping_run_test);
|
Verbose(V_Debug,skipping_run_test);
|
||||||
|
if LibraryExists(PPFile[current],LibraryName) then
|
||||||
|
MaybeCopyFiles(LibraryName);
|
||||||
end
|
end
|
||||||
else if Config.IsKnownRunError and (not DoKnown) then
|
else if Config.IsKnownRunError and (not DoKnown) then
|
||||||
begin
|
begin
|
||||||
@ -1528,16 +1686,21 @@ begin
|
|||||||
begin
|
begin
|
||||||
if DoExecute then
|
if DoExecute then
|
||||||
begin
|
begin
|
||||||
if FileExists(TestOutputFilename(PPFile[current],'ppu')) or
|
if FileExists(TestOutputFilename('',PPFile[current],'ppu')) or
|
||||||
FileExists(TestOutputFilename(PPFile[current],'ppo')) or
|
FileExists(TestOutputFilename('',PPFile[current],'ppo')) or
|
||||||
FileExists(TestOutputFilename(PPFile[current],'ppw')) then
|
FileExists(TestOutputFilename('',PPFile[current],'ppw')) then
|
||||||
begin
|
begin
|
||||||
AddLog(ExeLogFile,skipping_run_unit+PPFileInfo[current]);
|
AddLog(ExeLogFile,skipping_run_unit+PPFileInfo[current]);
|
||||||
AddLog(ResLogFile,skipping_run_unit+PPFileInfo[current]);
|
AddLog(ResLogFile,skipping_run_unit+PPFileInfo[current]);
|
||||||
Verbose(V_Debug,'Unit found, skipping run test')
|
Verbose(V_Debug,'Unit found, skipping run test')
|
||||||
end
|
end
|
||||||
|
else if LibraryExists(PPFile[current],LibraryName) then
|
||||||
|
begin
|
||||||
|
Verbose(V_Debug,'Library found, skipping run test');
|
||||||
|
MaybeCopyFiles(LibraryName);
|
||||||
|
end
|
||||||
else
|
else
|
||||||
Res:=RunExecutable;
|
Res:=RunExecutable;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1553,6 +1716,7 @@ begin
|
|||||||
GetArgs;
|
GetArgs;
|
||||||
SetTargetDirectoriesStyle;
|
SetTargetDirectoriesStyle;
|
||||||
SetTargetCanCompileLibraries;
|
SetTargetCanCompileLibraries;
|
||||||
|
SetRemoteConfiguration;
|
||||||
{$ifdef LIMIT83fs}
|
{$ifdef LIMIT83fs}
|
||||||
UseOSOnly:=true;
|
UseOSOnly:=true;
|
||||||
{$else not LIMIT83fs}
|
{$else not LIMIT83fs}
|
||||||
|
Loading…
Reference in New Issue
Block a user