From dee4c4fc898d1cc2ee496fca6944684ac5fc967c Mon Sep 17 00:00:00 2001 From: Pascal Packaging Team Date: Thu, 30 Mar 2023 20:31:30 +0100 Subject: [PATCH] fix-FPCDIR-in-fpcmake This patch fixes evaluation of default value for FPCDIR. (Closes: bug#662814) This patch fixes evaluation of default value for FPCDIR. (Closes: bug#662814) Gbp-Pq: Name fix-FPCDIR-in-fpcmake.diff --- fpcsrc/utils/fpcm/fpcmmain.pp | 58 +++++++++++++++++++++++++++++++++-- 1 file changed, 56 insertions(+), 2 deletions(-) diff --git a/fpcsrc/utils/fpcm/fpcmmain.pp b/fpcsrc/utils/fpcm/fpcmmain.pp index 5517a32f..d9542e2c 100644 --- a/fpcsrc/utils/fpcm/fpcmmain.pp +++ b/fpcsrc/utils/fpcm/fpcmmain.pp @@ -321,6 +321,46 @@ implementation end; +{$ifdef UNIX} +{$ifndef NO_UNIX_UNIT} + function ReadLink(LinkName: ansistring; Depth: byte = 0): ansistring; + { + Read a link (where it points to) + @Param LinkName + @Param Depth + 0 means raw link value (could be relative path) + 1 means expanded full path and name to liked file + 2..255 follow links recursively up to Depth level + } + var + LinkedFileName: PChar; + i: cInt; + begin + GetMem(LinkedFileName, PATH_MAX + 1); + Result := ExpandFileName(LinkName); + repeat + i := fpReadLink(PChar(Result), LinkedFileName, PATH_MAX); + if i >= 0 then begin + LinkedFileName[i] := #0; + if Depth > 0 then begin + Result := ExpandFileName(FileSearch(LinkedFileName, PathSep + ExtractFileDir(Result))); + Dec(Depth); + end else begin + Result := LinkedFileName; + end; + end; + until (i <= 0) or (Depth <= 0); + if i < 0 then begin + if FpGetErrNo <> ESysEINVAL then begin + Result := ''; + end; + end; + FreeMem(LinkedFileName, PATH_MAX + 1); + end; +{$endif UNIX} +{$endif NO_UNIX_UNIT} + + function posidx(const substr,s : string;idx:integer):integer; var i,j : integer; @@ -1224,7 +1264,7 @@ implementation end; if FileExists('/usr/local/bin/ppc' + ppcSuffix[cpu]) then begin - s:=ExtractFilePath({$ifdef ver1_0}ReadLink{$else}fpReadlink{$endif}('/usr/local/bin/ppc' + ppcSuffix[cpu])); + s:=ExtractFilePath(ReadLink('/usr/local/bin/ppc' + ppcSuffix[cpu], 255)); if s<>'' then begin if s[length(s)]='/' then @@ -1236,7 +1276,21 @@ implementation begin if FileExists('/usr/bin/ppc' + ppcSuffix[cpu]) then begin - s:=ExtractFilePath({$ifdef ver1_0}ReadLink{$else}fpReadLink{$endif}('/usr/bin/ppc' + ppcSuffix[cpu])); + s:=ExtractFilePath(ReadLink('/usr/bin/ppc' + ppcSuffix[cpu], 255)); + if s<>'' then + begin + if s[length(s)]='/' then + delete(s,length(s),1); + hs:=SubstVariables('$(wildcard $(addprefix '+s+'/,Makefile.fpc))'); + end; + end; + end; + if hs='' then + begin + s:=ExtractFileName(s); + if DirectoryExists('/usr/share/fpcsrc/' + s) then + begin + s:=ReadLink('/usr/share/fpcsrc/' + s, 255); if s<>'' then begin if s[length(s)]='/' then -- 2.30.2