mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 09:28:19 +02:00
* pas2jni: Detect the default units path.
git-svn-id: trunk@32084 -
This commit is contained in:
yury
parent
ab4c8623ec
commit
9193954d1c
@ -36,9 +36,13 @@ type
|
||||
TPPUParser = class
|
||||
private
|
||||
FOnCheckItem: TOnCheckItem;
|
||||
FDefaultSearchPathAdded: boolean;
|
||||
function FindUnit(const AName: string): string;
|
||||
function ReadUnit(const AName: string): string;
|
||||
function InternalParse(const AUnitName: string): TUnitDef;
|
||||
procedure AddSearchPath(const ASearchPath: string);
|
||||
function ReadProcessOutput(const AExeName, AParams: string; var AOutput, AError: string): integer;
|
||||
procedure AddDefaultSearchPath(const ACPU, AOS: string);
|
||||
public
|
||||
SearchPath: TStringList;
|
||||
Units: TDef;
|
||||
@ -112,31 +116,9 @@ end;
|
||||
{ TPPUParser }
|
||||
|
||||
constructor TPPUParser.Create(const ASearchPath: string);
|
||||
var
|
||||
i, j: integer;
|
||||
s, d: string;
|
||||
sr: TSearchRec;
|
||||
begin
|
||||
SearchPath:=TStringList.Create;
|
||||
SearchPath.Delimiter:=';';
|
||||
SearchPath.DelimitedText:=ASearchPath;
|
||||
i:=0;
|
||||
while i < SearchPath.Count do begin
|
||||
s:=SearchPath[i];
|
||||
if (Pos('*', s) > 0) or (Pos('?', s) > 0) then begin
|
||||
d:=ExtractFilePath(s);
|
||||
j:=FindFirst(s, faDirectory, sr);
|
||||
while j = 0 do begin
|
||||
if (sr.Name <> '.') and (sr.Name <> '..') then
|
||||
SearchPath.Add(d + sr.Name);
|
||||
j:=FindNext(sr);
|
||||
end;
|
||||
FindClose(sr);
|
||||
SearchPath.Delete(i);
|
||||
end
|
||||
else
|
||||
Inc(i);
|
||||
end;
|
||||
AddSearchPath(ASearchPath);
|
||||
Units:=TDef.Create(nil, dtNone);
|
||||
end;
|
||||
|
||||
@ -171,68 +153,31 @@ begin
|
||||
end;
|
||||
|
||||
function TPPUParser.ReadUnit(const AName: string): string;
|
||||
|
||||
procedure _ReadOutput(o: TInputPipeStream; var s: string);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
with o do
|
||||
while NumBytesAvailable > 0 do begin
|
||||
i:=NumBytesAvailable;
|
||||
j:=Length(s);
|
||||
SetLength(s, j + i);
|
||||
ReadBuffer(s[j + 1], i);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
p: TProcess;
|
||||
s, un, err: ansistring;
|
||||
ec: integer;
|
||||
begin
|
||||
un:=FindUnit(AName);
|
||||
p:=TProcess.Create(nil);
|
||||
try
|
||||
if ppudumpprog = '' then begin
|
||||
ppudumpprog:='ppudump';
|
||||
// Check for ppudump in the same folder as pas2jni
|
||||
s:=ExtractFilePath(ParamStr(0));
|
||||
if s <> '' then begin
|
||||
s:=s + ppudumpprog + ExtractFileExt(ParamStr(0));
|
||||
if FileExists(s) then
|
||||
ppudumpprog:=s;
|
||||
end;
|
||||
if ppudumpprog = '' then begin
|
||||
ppudumpprog:='ppudump';
|
||||
// Check for ppudump in the same folder as pas2jni
|
||||
s:=ExtractFilePath(ParamStr(0));
|
||||
if s <> '' then begin
|
||||
s:=s + ppudumpprog + ExtractFileExt(ParamStr(0));
|
||||
if FileExists(s) then
|
||||
ppudumpprog:=s;
|
||||
end;
|
||||
p.Executable:=ppudumpprog;
|
||||
p.Parameters.Add('-Fj');
|
||||
p.Parameters.Add(un);
|
||||
p.Options:=[poUsePipes, poNoConsole];
|
||||
p.ShowWindow:=swoHIDE;
|
||||
p.StartupOptions:=[suoUseShowWindow];
|
||||
try
|
||||
p.Execute;
|
||||
except
|
||||
raise Exception.CreateFmt('Unable to run "%s".'+LineEnding+'%s', [p.Executable, Exception(ExceptObject).Message]);
|
||||
end;
|
||||
s:='';
|
||||
err:='';
|
||||
repeat
|
||||
_ReadOutput(p.Output, s);
|
||||
_ReadOutput(p.Stderr, err);
|
||||
until not p.Running and (p.Output.NumBytesAvailable = 0) and (p.Stderr.NumBytesAvailable = 0);
|
||||
ec:=p.ExitStatus;
|
||||
if Copy(s, 1, 1) <> '[' then begin
|
||||
ec:=-1;
|
||||
err:='Output of ppudump is not in JSON format.' + LineEnding + 'Probably old version of ppudump has been used.';
|
||||
end;
|
||||
if ec <> 0 then begin
|
||||
if err = '' then
|
||||
if Length(s) < 300 then
|
||||
err:=s;
|
||||
raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, ec, err]);
|
||||
end;
|
||||
finally
|
||||
p.Free;
|
||||
end;
|
||||
ec:=ReadProcessOutput(ppudumpprog, '-Fj' + LineEnding + un, s, err);
|
||||
if Copy(s, 1, 1) <> '[' then begin
|
||||
ec:=-1;
|
||||
err:='Output of ppudump is not in JSON format.' + LineEnding + 'Probably old version of ppudump has been used.';
|
||||
end;
|
||||
if ec <> 0 then begin
|
||||
if err = '' then
|
||||
if Length(s) < 300 then
|
||||
err:=s;
|
||||
raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, ec, err]);
|
||||
end;
|
||||
Result:=s;
|
||||
{$ifopt D+}
|
||||
@ -602,8 +547,16 @@ begin
|
||||
Result.PPUVer:=junit.Integers['Version'];
|
||||
Result.CPU:=junit.Strings['TargetCPU'];
|
||||
Result.OS:=junit.Strings['TargetOS'];
|
||||
j:=Length(Result.CPU);
|
||||
if AnsiLowerCase(Copy(Result.OS, Length(Result.OS) - j, j + 1)) = AnsiLowerCase('-' + Result.CPU) then
|
||||
Result.OS:=Copy(Result.OS, 1, Length(Result.OS) - j - 1);
|
||||
Result.IntfCRC:=junit.Strings['InterfaceCRC'];
|
||||
|
||||
if not FDefaultSearchPathAdded then begin
|
||||
FDefaultSearchPathAdded:=True;
|
||||
AddDefaultSearchPath(AnsiLowerCase(Result.CPU), AnsiLowerCase(Result.OS));
|
||||
end;
|
||||
|
||||
if junit.Find('Units') <> nil then
|
||||
with junit.Arrays['Units'] do begin
|
||||
SetLength(deref, Count);
|
||||
@ -641,5 +594,121 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPPUParser.AddSearchPath(const ASearchPath: string);
|
||||
var
|
||||
i, j: integer;
|
||||
s, d: string;
|
||||
sr: TSearchRec;
|
||||
sl: TStringList;
|
||||
begin
|
||||
sl:=TStringList.Create;
|
||||
try
|
||||
sl.Delimiter:=';';
|
||||
sl.DelimitedText:=ASearchPath;
|
||||
i:=0;
|
||||
while i < sl.Count do begin
|
||||
s:=sl[i];
|
||||
if (Pos('*', s) > 0) or (Pos('?', s) > 0) then begin
|
||||
d:=ExtractFilePath(s);
|
||||
j:=FindFirst(s, faDirectory, sr);
|
||||
while j = 0 do begin
|
||||
if (sr.Name <> '.') and (sr.Name <> '..') then
|
||||
sl.Add(d + sr.Name);
|
||||
j:=FindNext(sr);
|
||||
end;
|
||||
FindClose(sr);
|
||||
sl.Delete(i);
|
||||
end
|
||||
else
|
||||
Inc(i);
|
||||
end;
|
||||
SearchPath.AddStrings(sl);
|
||||
finally
|
||||
sl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPPUParser.ReadProcessOutput(const AExeName, AParams: string; var AOutput, AError: string): integer;
|
||||
|
||||
procedure _ReadOutput(o: TInputPipeStream; var s: string);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
with o do
|
||||
while NumBytesAvailable > 0 do begin
|
||||
i:=NumBytesAvailable;
|
||||
j:=Length(s);
|
||||
SetLength(s, j + i);
|
||||
ReadBuffer(s[j + 1], i);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
p: TProcess;
|
||||
begin
|
||||
AOutput:='';
|
||||
AError:='';
|
||||
p:=TProcess.Create(nil);
|
||||
try
|
||||
p.Executable:=AExeName;
|
||||
p.Parameters.Text:=AParams;
|
||||
p.Options:=[poUsePipes, poNoConsole];
|
||||
p.ShowWindow:=swoHIDE;
|
||||
p.StartupOptions:=[suoUseShowWindow];
|
||||
try
|
||||
p.Execute;
|
||||
except
|
||||
raise Exception.CreateFmt('Unable to run "%s".'+LineEnding+'%s', [p.Executable, Exception(ExceptObject).Message]);
|
||||
end;
|
||||
repeat
|
||||
_ReadOutput(p.Output, AOutput);
|
||||
_ReadOutput(p.Stderr, AError);
|
||||
until not p.Running and (p.Output.NumBytesAvailable = 0) and (p.Stderr.NumBytesAvailable = 0);
|
||||
Result:=p.ExitStatus;
|
||||
finally
|
||||
p.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPPUParser.AddDefaultSearchPath(const ACPU, AOS: string);
|
||||
var
|
||||
fpc, s, e: string;
|
||||
sl: TStringList;
|
||||
i, j: integer;
|
||||
begin
|
||||
try
|
||||
fpc:=ExtractFilePath(ppudumpprog) + 'fpc' + ExtractFileExt(ppudumpprog);
|
||||
if not FileExists(fpc) then
|
||||
exit;
|
||||
// Find the compiler binary
|
||||
if ReadProcessOutput(fpc, '-P' + ACPU + LineEnding + '-T' + AOS + LineEnding + '-PB', s, e) <> 0 then
|
||||
exit;
|
||||
fpc:=Trim(s);
|
||||
// Get units path from the compiler output
|
||||
ReadProcessOutput(fpc, '-P' + ACPU + LineEnding + '-T' + AOS + LineEnding + '-vt' + LineEnding + '.', s, e);
|
||||
sl:=TStringList.Create;
|
||||
try
|
||||
sl.Text:=s;
|
||||
s:='';
|
||||
for i:=0 to sl.Count - 1 do begin
|
||||
s:=sl[i];
|
||||
j:=Pos(':', s);
|
||||
if j > 0 then begin
|
||||
s:=Trim(Copy(s, j + 1, MaxInt));
|
||||
s:=ExcludeTrailingPathDelimiter(s);
|
||||
if (Copy(s, Length(s) - 3, 4) = DirectorySeparator + 'rtl') and DirectoryExists(s) then begin
|
||||
AddSearchPath(ExtractFilePath(s) + '*');
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
sl.Free;
|
||||
end;
|
||||
except
|
||||
// Ignore exceptions
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user