mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 18:21:00 +02:00
* Patch from Anton to support dotted unit names (Bug ID 22919)
git-svn-id: trunk@23225 -
This commit is contained in:
parent
8b4603ed51
commit
0dd6c1454e
@ -26,7 +26,8 @@ resourcestring
|
||||
ARecordConst: TMethod=(Code:nil;Data:nil);
|
||||
ASetConst=[true,false];
|
||||
ADeprecatedConst=1 deprecated;
|
||||
|
||||
ADeprecatedConst2 = 2 deprecated 'use another const';
|
||||
|
||||
Type
|
||||
TLineEndStr = string [3];
|
||||
|
||||
@ -41,6 +42,7 @@ resourcestring
|
||||
x,Y : Integer deprecated
|
||||
end;
|
||||
TAnEnumType=(one,two,three);
|
||||
arangetypealias = type 0..$FF;
|
||||
TASetType=set of TAnEnumType;
|
||||
TIntegerSet = Set of 0..SizeOf(Integer)*8-1;
|
||||
TAnArrayType=Array[1..10] of Integer;
|
||||
@ -52,7 +54,6 @@ resourcestring
|
||||
TDays = set of TDay;
|
||||
TMyInteger = Integer;
|
||||
ADouble = type double;
|
||||
arangetypealias = type 0..$FF;
|
||||
TARecordType=record
|
||||
X,Y: Integer;
|
||||
Z: String;
|
||||
@ -101,6 +102,9 @@ TYPE
|
||||
|
||||
|
||||
TNotifyEvent = Procedure (Sender : TObject) of object;
|
||||
|
||||
TNestedProcedure = Procedure (Sender : TObject) is nested;
|
||||
|
||||
TNotifyEvent2 = Function (Sender : TObject) : Integer of object;
|
||||
|
||||
|
||||
@ -236,6 +240,11 @@ var
|
||||
Procedure externallibnameProc; external 'alibrary' name 'aname';
|
||||
Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword];
|
||||
|
||||
{$define extdecl:=cdecl}
|
||||
Type
|
||||
FontEnumProc = function (var ELogFont:TEnumLogFont; var Metric:TNewTextMetric;
|
||||
FontType:longint; Data:LParam):longint; extdecl;
|
||||
|
||||
|
||||
Type
|
||||
generic TFPGListEnumerator<T> = class(TObject)
|
||||
|
@ -791,7 +791,7 @@ Var
|
||||
begin
|
||||
Name := CurTokenString;
|
||||
NextToken;
|
||||
if CurToken=tkDot then
|
||||
while CurToken=tkDot do
|
||||
begin
|
||||
ExpectIdentifier;
|
||||
Name := Name+'.'+CurTokenString;
|
||||
@ -1646,9 +1646,20 @@ end;
|
||||
|
||||
// Starts after the "unit" token
|
||||
procedure TPasParser.ParseUnit(var Module: TPasModule);
|
||||
var
|
||||
AUnitName: String;
|
||||
begin
|
||||
Module := nil;
|
||||
Module := TPasModule(CreateElement(TPasModule, ExpectIdentifier,
|
||||
AUnitName := ExpectIdentifier;
|
||||
NextToken;
|
||||
while CurToken = tkDot do
|
||||
begin
|
||||
ExpectIdentifier;
|
||||
AUnitName := AUnitName + '.' + CurTokenString;
|
||||
NextToken;
|
||||
end;
|
||||
UngetToken;
|
||||
Module := TPasModule(CreateElement(TPasModule, AUnitName,
|
||||
Engine.Package));
|
||||
FCurModule:=Module;
|
||||
try
|
||||
@ -2102,8 +2113,14 @@ begin
|
||||
Element:=CheckUnit('System'); // system always implicitely first.
|
||||
Repeat
|
||||
AUnitName := ExpectIdentifier;
|
||||
Element :=CheckUnit(AUnitName);
|
||||
NextToken;
|
||||
while CurToken = tkDot do
|
||||
begin
|
||||
ExpectIdentifier;
|
||||
AUnitName := AUnitName + '.' + CurTokenString;
|
||||
NextToken;
|
||||
end;
|
||||
Element := CheckUnit(AUnitName);
|
||||
if (CurToken=tkin) then
|
||||
begin
|
||||
ExpectToken(tkString);
|
||||
|
@ -402,7 +402,7 @@ end;
|
||||
|
||||
function TLinkNode.FindChild(const APathName: String): TLinkNode;
|
||||
var
|
||||
DotPos: Integer;
|
||||
NameLen: Integer;
|
||||
ChildName: String;
|
||||
Child: TLinkNode;
|
||||
begin
|
||||
@ -410,23 +410,22 @@ begin
|
||||
Result := Self
|
||||
else
|
||||
begin
|
||||
DotPos := Pos('.', APathName);
|
||||
if DotPos = 0 then
|
||||
ChildName := APathName
|
||||
else
|
||||
ChildName := Copy(APathName, 1, DotPos - 1);
|
||||
Child := FirstChild;
|
||||
while Assigned(Child) do
|
||||
begin
|
||||
if CompareText(Child.Name, ChildName) = 0 then
|
||||
begin
|
||||
if DotPos = 0 then
|
||||
Result := Child
|
||||
else
|
||||
NameLen := Length(Child.Name);
|
||||
if CompareText(Child.Name, Copy(APathName, 1, NameLen)) = 0 then
|
||||
if NameLen = Length(APathName) then
|
||||
begin
|
||||
Result := Child;
|
||||
Exit
|
||||
end else
|
||||
if APathName[NameLen + 1] = '.' then
|
||||
begin
|
||||
Result := Child.FindChild(
|
||||
Copy(APathName, DotPos + 1, Length(APathName)));
|
||||
exit;
|
||||
end;
|
||||
Copy(APathName, NameLen + 2, Length(APathName)));
|
||||
Exit;
|
||||
end;
|
||||
Child := Child.NextSibling;
|
||||
end;
|
||||
Result := nil;
|
||||
@ -435,7 +434,7 @@ end;
|
||||
|
||||
function TLinkNode.CreateChildren(const APathName, ALinkTo: String): TLinkNode;
|
||||
var
|
||||
DotPos: Integer;
|
||||
NameLen: Integer;
|
||||
ChildName: String;
|
||||
Child, LastChild: TLinkNode;
|
||||
begin
|
||||
@ -443,31 +442,33 @@ begin
|
||||
Result := Self
|
||||
else
|
||||
begin
|
||||
DotPos := Pos('.', APathName);
|
||||
if DotPos = 0 then
|
||||
ChildName := APathName
|
||||
else
|
||||
ChildName := Copy(APathName, 1, DotPos - 1);
|
||||
Child := FirstChild;
|
||||
LastChild := nil;
|
||||
while Assigned(Child) do
|
||||
begin
|
||||
if CompareText(Child.Name, ChildName) = 0 then
|
||||
begin
|
||||
if DotPos = 0 then
|
||||
Result := Child
|
||||
else
|
||||
Result := Child.CreateChildren(
|
||||
Copy(APathName, DotPos + 1, Length(APathName)), ALinkTo);
|
||||
if CompareText(Child.Name, ChildName) = 0 then
|
||||
begin
|
||||
NameLen := Length(Child.Name);
|
||||
if CompareText(Child.Name, Copy(APathName, 1, NameLen)) = 0 then
|
||||
if NameLen = Length(APathName) then
|
||||
begin
|
||||
Result := Child;
|
||||
Exit
|
||||
end
|
||||
else
|
||||
if APathName[NameLen + 1] = '.' then
|
||||
Result := Child
|
||||
else
|
||||
Result := Child.CreateChildren(
|
||||
Copy(APathName, NameLen + 2, Length(APathName)), ALinkTo);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
LastChild := Child;
|
||||
Child := Child.NextSibling;
|
||||
end;
|
||||
end;
|
||||
{ No child found, let's create one if we are at the end of the path }
|
||||
if DotPos > 0 then
|
||||
Raise Exception.CreateFmt('Link path does not exist: %s',[APathName]);
|
||||
Result := TLinkNode.Create(ChildName, ALinkTo);
|
||||
{ If APathName contains dots we will regard it as a dotted unit name }
|
||||
Result := TLinkNode.Create(APathName, ALinkTo);
|
||||
if Assigned(LastChild) then
|
||||
LastChild.FNextSibling := Result
|
||||
else
|
||||
|
@ -406,14 +406,14 @@ begin
|
||||
Pos('):', AElement.Name) + 3, Length(AElement.Name)));
|
||||
end else
|
||||
Result := LowerCase(AElement.PathName);
|
||||
i := 1;
|
||||
if (Length(Result) > 0) and (Result[1] = '#') then
|
||||
begin
|
||||
while Result[i] <> '.' do
|
||||
Inc(i);
|
||||
Result := Copy(Result, i + 1, Length(Result));
|
||||
end;
|
||||
i := 1;
|
||||
// searching for TPasModule - it is on the 2nd level
|
||||
if Assigned(AElement.Parent) then
|
||||
while Assigned(AElement.Parent.Parent) do
|
||||
AElement := AElement.Parent;
|
||||
// cut off Package Name
|
||||
Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
|
||||
// to skip dots in unit name
|
||||
i := Length(AElement.Name);
|
||||
while (i <= Length(Result)) and (Result[i] <> '.') do
|
||||
Inc(i);
|
||||
if (i <= Length(Result)) and (i > 0) then
|
||||
|
Loading…
Reference in New Issue
Block a user