fix(config): expand ~ in blaise.cfg unit-path / rtl-src values
A blaise.cfg value like `rtl-src=~/devel/blaise/compiler/src/main/pascal` was treated as RELATIVE (only a leading '/' counted as absolute) and prefixed with the config directory, and the `~` was never expanded — producing a bogus path like `/home/user/cwd/~/devel/...` and an "RTL source directory not found" error. Resolve config paths through a shared helper: a leading '~' or '~/' expands to $HOME (and is treated as absolute); a leading '/' is used as is; anything else is relative to the config file's directory. Applies to both unit-path= and rtl-src=. If $HOME is unset, '~' is left untouched rather than mis-resolved. Tests: TConfigTests.TestParseTildePath_ExpandsToHome and TestParseRtlSrcTilde_ExpandsToHome. Verified end-to-end: a blaise.cfg using `~/...` for unit-path + rtl-src compiles with no path flags from any CWD.
This commit is contained in:
parent
0824ed8a6b
commit
5e9ec4eeec
|
|
@ -53,6 +53,36 @@ begin
|
|||
Result := '';
|
||||
end;
|
||||
|
||||
{ Resolve a blaise.cfg path value. An absolute path (leading '/') is used as
|
||||
is; a leading '~' or '~/' expands to $HOME (so a config can name paths under
|
||||
the user's home directory); anything else is relative and resolved against
|
||||
ABaseDir (the config file's own directory). }
|
||||
function ResolveCfgPath(const AValue, ABaseDir: string): string;
|
||||
var
|
||||
Home: string;
|
||||
begin
|
||||
if Length(AValue) = 0 then
|
||||
Exit('');
|
||||
{ Home expansion: '~' alone, or a '~/...' prefix. }
|
||||
if (Copy(AValue, 0, 1) = '~') and
|
||||
((Length(AValue) = 1) or (Copy(AValue, 1, 1) = '/')) then
|
||||
begin
|
||||
Home := GetEnvironmentVariable('HOME');
|
||||
if Home <> '' then
|
||||
begin
|
||||
if Length(AValue) = 1 then
|
||||
Exit(Home);
|
||||
{ drop the '~', keep the rest (which starts with '/') }
|
||||
Exit(IncludeTrailingPathDelimiter(Home) + Copy(AValue, 2, Length(AValue)));
|
||||
end;
|
||||
{ No $HOME — leave '~' untouched rather than mis-resolving. }
|
||||
Exit(AValue);
|
||||
end;
|
||||
if Copy(AValue, 0, 1) = '/' then
|
||||
Exit(AValue);
|
||||
Result := IncludeTrailingPathDelimiter(ABaseDir) + AValue;
|
||||
end;
|
||||
|
||||
procedure ParseConfigLines(ALines: TStringList; const ABaseDir: string;
|
||||
APaths: TStringList; var ARtlSrc: string);
|
||||
var
|
||||
|
|
@ -75,17 +105,9 @@ begin
|
|||
Key := Trim(Copy(Line, 0, EqPos));
|
||||
Value := Trim(Copy(Line, EqPos + 1, Length(Line)));
|
||||
if SameText(Key, 'unit-path') then
|
||||
begin
|
||||
if (Length(Value) > 0) and (Copy(Value, 0, 1) <> '/') then
|
||||
Value := IncludeTrailingPathDelimiter(ABaseDir) + Value;
|
||||
APaths.Add(Value);
|
||||
end
|
||||
APaths.Add(ResolveCfgPath(Value, ABaseDir))
|
||||
else if SameText(Key, 'rtl-src') then
|
||||
begin
|
||||
if (Length(Value) > 0) and (Copy(Value, 0, 1) <> '/') then
|
||||
Value := IncludeTrailingPathDelimiter(ABaseDir) + Value;
|
||||
ARtlSrc := Value;
|
||||
end
|
||||
ARtlSrc := ResolveCfgPath(Value, ABaseDir)
|
||||
else
|
||||
; { silently skip unrecognised keys }
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -31,6 +31,8 @@ type
|
|||
procedure TestParseRtlSrc_Absolute_SetsValue;
|
||||
procedure TestParseRtlSrc_Relative_ResolvedAgainstBaseDir;
|
||||
procedure TestParseRtlSrc_Absent_LeavesSeedUnchanged;
|
||||
procedure TestParseTildePath_ExpandsToHome;
|
||||
procedure TestParseRtlSrcTilde_ExpandsToHome;
|
||||
procedure TestFindConfigFile_NextToBinary;
|
||||
end;
|
||||
|
||||
|
|
@ -289,6 +291,51 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure TConfigTests.TestParseTildePath_ExpandsToHome;
|
||||
var
|
||||
Lines, Paths: TStringList;
|
||||
Home: string;
|
||||
begin
|
||||
Home := GetEnvironmentVariable('HOME');
|
||||
if Home = '' then begin Ignore('no $HOME'); Exit end;
|
||||
Lines := TStringList.Create();
|
||||
Paths := TStringList.Create();
|
||||
try
|
||||
{ A '~/...' unit-path expands to $HOME/..., NOT resolved against the base. }
|
||||
Lines.Add('unit-path=~/devel/blaise/runtime');
|
||||
ParseConfigLines(Lines, '/some/base', Paths);
|
||||
AssertEquals('one path', 1, Paths.Count);
|
||||
AssertEquals('~ expanded to $HOME',
|
||||
IncludeTrailingPathDelimiter(Home) + 'devel/blaise/runtime',
|
||||
Paths.Strings[0]);
|
||||
finally
|
||||
Lines.Free();
|
||||
Paths.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TConfigTests.TestParseRtlSrcTilde_ExpandsToHome;
|
||||
var
|
||||
Lines, Paths: TStringList;
|
||||
Rtl, Home: string;
|
||||
begin
|
||||
Home := GetEnvironmentVariable('HOME');
|
||||
if Home = '' then begin Ignore('no $HOME'); Exit end;
|
||||
Lines := TStringList.Create();
|
||||
Paths := TStringList.Create();
|
||||
try
|
||||
Rtl := '';
|
||||
Lines.Add('rtl-src=~/devel/blaise/compiler/src/main/pascal');
|
||||
ParseConfigLines(Lines, '/some/base', Paths, Rtl);
|
||||
AssertEquals('~ in rtl-src expanded to $HOME',
|
||||
IncludeTrailingPathDelimiter(Home) + 'devel/blaise/compiler/src/main/pascal',
|
||||
Rtl);
|
||||
finally
|
||||
Lines.Free();
|
||||
Paths.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TConfigTests.TestFindConfigFile_NextToBinary;
|
||||
var
|
||||
CfgPath: string;
|
||||
|
|
|
|||
Loading…
Reference in a new issue