* pas2jni: Detect the default units path.

git-svn-id: trunk@32084 -

utils/pas2jni/ppuparser.pas

@@ -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.