From: Pascal Packaging Team Date: Fri, 17 Mar 2023 12:45:28 +0000 (+0000) Subject: fix-FPCDIR-in-fpcmake X-Git-Tag: archive/raspbian/3.2.2+dfsg-20+rpi1^2^2~34 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=fb5463fb2dd3f14a05ace86411973bba764eb617;p=fpc.git 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 --- 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