mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 18:29:09 +02:00
* Applied patches by Vincent Snijders
* Fixed handling of nested variant records * Improved operator support (<= and >= were missing) * Operator support in output: Better names * HTML writer generates working filenames for operator pages git-svn-id: trunk@849 -
This commit is contained in:
parent
8a3268cddb
commit
1a8051f993
@ -85,7 +85,7 @@ uses Classes;
|
|||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
TDeclType = (declNone, declConst, declResourcestring, declType, declVar);
|
TDeclType = (declNone, declConst, declResourcestring, declType, declVar, declThreadvar);
|
||||||
|
|
||||||
TProcType = (ptProcedure, ptFunction, ptOperator);
|
TProcType = (ptProcedure, ptFunction, ptOperator);
|
||||||
|
|
||||||
@ -703,6 +703,8 @@ begin
|
|||||||
CurBlock := declType;
|
CurBlock := declType;
|
||||||
tkVar:
|
tkVar:
|
||||||
CurBlock := declVar;
|
CurBlock := declVar;
|
||||||
|
tkThreadVar:
|
||||||
|
CurBlock := declThreadVar;
|
||||||
tkProcedure:
|
tkProcedure:
|
||||||
begin
|
begin
|
||||||
AddProcOrFunction(Section, ParseProcedureOrFunctionDecl(Section, ptProcedure));
|
AddProcOrFunction(Section, ParseProcedureOrFunctionDecl(Section, ptProcedure));
|
||||||
@ -770,7 +772,7 @@ begin
|
|||||||
Section.Types.Add(TypeEl);
|
Section.Types.Add(TypeEl);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
declVar:
|
declVar, declThreadVar:
|
||||||
begin
|
begin
|
||||||
List := TList.Create;
|
List := TList.Create;
|
||||||
try
|
try
|
||||||
@ -1369,8 +1371,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
ParseArgList(Element, Element.Args, tkBraceClose);
|
ParseArgList(Element, Element.Args, tkBraceClose);
|
||||||
TPasFunctionType(Element).ResultEl.Name := ExpectIdentifier;
|
TPasFunctionType(Element).ResultEl.Name := ExpectIdentifier;
|
||||||
if CurToken <> tkColon then
|
ExpectToken(tkColon);
|
||||||
ParseExc(SParserExpectedLBracketColon);
|
|
||||||
if Assigned(Element) then // !!!
|
if Assigned(Element) then // !!!
|
||||||
TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
|
TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
|
||||||
else
|
else
|
||||||
@ -1387,7 +1388,8 @@ begin
|
|||||||
UngetToken;
|
UngetToken;
|
||||||
|
|
||||||
NextToken;
|
NextToken;
|
||||||
if CurToken = tkEqual then begin
|
if CurToken = tkEqual then
|
||||||
|
begin
|
||||||
// for example: const p: procedure = nil;
|
// for example: const p: procedure = nil;
|
||||||
UngetToken;
|
UngetToken;
|
||||||
exit;
|
exit;
|
||||||
@ -1407,6 +1409,10 @@ begin
|
|||||||
begin
|
begin
|
||||||
{ El['calling-conv'] := 'stdcall';}
|
{ El['calling-conv'] := 'stdcall';}
|
||||||
ExpectToken(tkSemicolon);
|
ExpectToken(tkSemicolon);
|
||||||
|
end else if (CurToken = tkInline) then
|
||||||
|
begin
|
||||||
|
{ TPasProcedure(Parent).IsInline := True;}
|
||||||
|
ExpectToken(tkSemicolon);
|
||||||
end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'DEPRECATED') then
|
end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'DEPRECATED') then
|
||||||
begin
|
begin
|
||||||
{ El['calling-conv'] := 'cdecl';}
|
{ El['calling-conv'] := 'cdecl';}
|
||||||
@ -1416,6 +1422,12 @@ begin
|
|||||||
repeat
|
repeat
|
||||||
NextToken
|
NextToken
|
||||||
until CurToken = tkSemicolon;
|
until CurToken = tkSemicolon;
|
||||||
|
end else if (CurToken = tkSquaredBraceOpen) then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
NextToken
|
||||||
|
until CurToken = tkSquaredBraceClose;
|
||||||
|
ExpectToken(tkSemicolon);
|
||||||
end else if Parent.InheritsFrom(TPasProcedure) and
|
end else if Parent.InheritsFrom(TPasProcedure) and
|
||||||
(CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OVERLOAD') then
|
(CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OVERLOAD') then
|
||||||
begin
|
begin
|
||||||
@ -1554,6 +1566,7 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
|
|||||||
ProcType: TProcType): TPasProcedure;
|
ProcType: TProcType): TPasProcedure;
|
||||||
var
|
var
|
||||||
Name: String;
|
Name: String;
|
||||||
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
case ProcType of
|
case ProcType of
|
||||||
ptFunction:
|
ptFunction:
|
||||||
@ -1572,7 +1585,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
ptOperator:
|
ptOperator:
|
||||||
begin
|
begin
|
||||||
Name := TokenInfos[CurToken];
|
NextToken;
|
||||||
|
Name := 'operator ' + TokenInfos[CurToken];
|
||||||
Result := TPasOperator(CreateElement(TPasOperator, Name, Parent));
|
Result := TPasOperator(CreateElement(TPasOperator, Name, Parent));
|
||||||
Result.ProcType := Engine.CreateFunctionType('', '__INVALID__', Result,
|
Result.ProcType := Engine.CreateFunctionType('', '__INVALID__', Result,
|
||||||
True, Scanner.CurFilename, Scanner.CurRow);
|
True, Scanner.CurFilename, Scanner.CurRow);
|
||||||
@ -1580,6 +1594,20 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
|
ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
|
||||||
|
|
||||||
|
if ProcType = ptOperator then
|
||||||
|
begin
|
||||||
|
Result.Name := Result.Name + '(';
|
||||||
|
for i := 0 to Result.ProcType.Args.Count - 1 do
|
||||||
|
begin
|
||||||
|
if i > 0 then
|
||||||
|
Result.Name := Result.Name + ', ';
|
||||||
|
Result.Name := Result.Name +
|
||||||
|
TPasArgument(Result.ProcType.Args[i]).ArgType.Name;
|
||||||
|
end;
|
||||||
|
Result.Name := Result.Name + '): ' +
|
||||||
|
TPasFunctionType(Result.ProcType).ResultEl.ResultType.Name;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -1646,9 +1674,10 @@ begin
|
|||||||
Variant.Members.Free;
|
Variant.Members.Free;
|
||||||
raise;
|
raise;
|
||||||
end;
|
end;
|
||||||
ExpectToken(tkSemicolon);
|
|
||||||
NextToken;
|
NextToken;
|
||||||
if CurToken = tkEnd then
|
if CurToken = tkSemicolon then
|
||||||
|
NextToken;
|
||||||
|
if (CurToken = tkEnd) or (CurToken = tkBraceClose) then
|
||||||
break
|
break
|
||||||
else
|
else
|
||||||
UngetToken;
|
UngetToken;
|
||||||
@ -1817,10 +1846,6 @@ begin
|
|||||||
VarList := TList.Create;
|
VarList := TList.Create;
|
||||||
try
|
try
|
||||||
ParseInlineVarDecl(Result, VarList, CurVisibility, False);
|
ParseInlineVarDecl(Result, VarList, CurVisibility, False);
|
||||||
NextToken;
|
|
||||||
// Records may be terminated with end, no semicolon
|
|
||||||
if (CurToken <> tkEnd) and (CurToken <> tkSemicolon) then
|
|
||||||
ParseExc(SParserExpectedSemiColonEnd);
|
|
||||||
for i := 0 to VarList.Count - 1 do
|
for i := 0 to VarList.Count - 1 do
|
||||||
begin
|
begin
|
||||||
Element := TPasElement(VarList[i]);
|
Element := TPasElement(VarList[i]);
|
||||||
|
@ -61,6 +61,9 @@ type
|
|||||||
tkDotDot, // '..'
|
tkDotDot, // '..'
|
||||||
tkAssign, // ':='
|
tkAssign, // ':='
|
||||||
tkNotEqual, // '<>'
|
tkNotEqual, // '<>'
|
||||||
|
tkLessEqualThan, // '<='
|
||||||
|
tkGreaterEqualThan, // '>='
|
||||||
|
tkPower, // '**'
|
||||||
// Reserved words
|
// Reserved words
|
||||||
tkabsolute,
|
tkabsolute,
|
||||||
tkand,
|
tkand,
|
||||||
@ -118,6 +121,7 @@ type
|
|||||||
tkshr,
|
tkshr,
|
||||||
// tkstring,
|
// tkstring,
|
||||||
tkthen,
|
tkthen,
|
||||||
|
tkthreadvar,
|
||||||
tkto,
|
tkto,
|
||||||
tktrue,
|
tktrue,
|
||||||
tktry,
|
tktry,
|
||||||
@ -241,6 +245,9 @@ const
|
|||||||
'..',
|
'..',
|
||||||
':=',
|
':=',
|
||||||
'<>',
|
'<>',
|
||||||
|
'<=',
|
||||||
|
'>=',
|
||||||
|
'**',
|
||||||
// Reserved words
|
// Reserved words
|
||||||
'absolute',
|
'absolute',
|
||||||
'and',
|
'and',
|
||||||
@ -298,6 +305,7 @@ const
|
|||||||
'shr',
|
'shr',
|
||||||
// 'string',
|
// 'string',
|
||||||
'then',
|
'then',
|
||||||
|
'threadvar',
|
||||||
'to',
|
'to',
|
||||||
'true',
|
'true',
|
||||||
'try',
|
'try',
|
||||||
@ -658,7 +666,12 @@ begin
|
|||||||
'*':
|
'*':
|
||||||
begin
|
begin
|
||||||
Inc(TokenStr);
|
Inc(TokenStr);
|
||||||
Result := tkMul;
|
if TokenStr[0] = '*' then
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkPower;
|
||||||
|
end else
|
||||||
|
Result := tkMul;
|
||||||
end;
|
end;
|
||||||
'+':
|
'+':
|
||||||
begin
|
begin
|
||||||
@ -764,7 +777,11 @@ begin
|
|||||||
begin
|
begin
|
||||||
Inc(TokenStr);
|
Inc(TokenStr);
|
||||||
Result := tkNotEqual;
|
Result := tkNotEqual;
|
||||||
end else
|
end else if TokenStr[0] = '=' then
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkLessEqualThan;
|
||||||
|
end else
|
||||||
Result := tkLessThan;
|
Result := tkLessThan;
|
||||||
end;
|
end;
|
||||||
'=':
|
'=':
|
||||||
@ -775,7 +792,12 @@ begin
|
|||||||
'>':
|
'>':
|
||||||
begin
|
begin
|
||||||
Inc(TokenStr);
|
Inc(TokenStr);
|
||||||
Result := tkGreaterThan;
|
if TokenStr[0] = '=' then
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkGreaterEqualThan;
|
||||||
|
end else
|
||||||
|
Result := tkGreaterThan;
|
||||||
end;
|
end;
|
||||||
'@':
|
'@':
|
||||||
begin
|
begin
|
||||||
|
@ -131,6 +131,7 @@ resourcestring
|
|||||||
SNeedPackageName = 'No package name specified. Please specify one using the --package option.';
|
SNeedPackageName = 'No package name specified. Please specify one using the --package option.';
|
||||||
SDone = 'Done.';
|
SDone = 'Done.';
|
||||||
SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
|
SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
|
||||||
|
SErrCouldNotCreateFile = 'Could not create file "%s": %s';
|
||||||
|
|
||||||
Const
|
Const
|
||||||
SVisibility: array[TPasMemberVisibility] of string =
|
SVisibility: array[TPasMemberVisibility] of string =
|
||||||
|
@ -302,6 +302,7 @@ end;
|
|||||||
function TLongNameFileAllocator.GetFilename(AElement: TPasElement;
|
function TLongNameFileAllocator.GetFilename(AElement: TPasElement;
|
||||||
ASubindex: Integer): String;
|
ASubindex: Integer): String;
|
||||||
var
|
var
|
||||||
|
s: String;
|
||||||
i: Integer;
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
if AElement.ClassType = TPasPackage then
|
if AElement.ClassType = TPasPackage then
|
||||||
@ -309,20 +310,68 @@ begin
|
|||||||
else if AElement.ClassType = TPasModule then
|
else if AElement.ClassType = TPasModule then
|
||||||
Result := LowerCase(AElement.Name) + PathDelim + 'index'
|
Result := LowerCase(AElement.Name) + PathDelim + 'index'
|
||||||
else
|
else
|
||||||
|
begin
|
||||||
|
if AElement is TPasOperator then
|
||||||
begin
|
begin
|
||||||
Result := LowerCase(AElement.PathName);
|
Result := LowerCase(AElement.Parent.PathName) + '.op-';
|
||||||
i := 1;
|
s := Copy(AElement.Name, Pos(' ', AElement.Name) + 1, Length(AElement.Name));
|
||||||
if (Length(Result)>0) and (Result[1]='#') then
|
s := Copy(s, 1, Pos('(', s) - 1);
|
||||||
|
if s = ':=' then
|
||||||
|
s := 'assign'
|
||||||
|
else if s = '+' then
|
||||||
|
s := 'add'
|
||||||
|
else if s = '-' then
|
||||||
|
s := 'sub'
|
||||||
|
else if s = '*' then
|
||||||
|
s := 'mul'
|
||||||
|
else if s = '/' then
|
||||||
|
s := 'div'
|
||||||
|
else if s = '**' then
|
||||||
|
s := 'power'
|
||||||
|
else if s = '=' then
|
||||||
|
s := 'equal'
|
||||||
|
else if s = '<>' then
|
||||||
|
s := 'unequal'
|
||||||
|
else if s = '<' then
|
||||||
|
s := 'less'
|
||||||
|
else if s = '<=' then
|
||||||
|
s := 'lessequal'
|
||||||
|
else if s = '>' then
|
||||||
|
s := 'greater'
|
||||||
|
else if s = '>=' then
|
||||||
|
s := 'greaterthan';
|
||||||
|
Result := Result + s + '-';
|
||||||
|
s := '';
|
||||||
|
i := 1;
|
||||||
|
while AElement.Name[i] <> '(' do
|
||||||
|
Inc(i);
|
||||||
|
Inc(i);
|
||||||
|
while AElement.Name[i] <> ')' do
|
||||||
begin
|
begin
|
||||||
|
if AElement.Name[i] = ',' then
|
||||||
|
begin
|
||||||
|
s := s + '-';
|
||||||
|
Inc(i);
|
||||||
|
end else
|
||||||
|
s := s + AElement.Name[i];
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
Result := Result + LowerCase(s) + '-' + LowerCase(Copy(AElement.Name,
|
||||||
|
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
|
while Result[i] <> '.' do
|
||||||
Inc(i);
|
Inc(i);
|
||||||
Result:=Copy(Result,i+1,Length(Result));
|
Result := Copy(Result, i + 1, Length(Result));
|
||||||
end;
|
end;
|
||||||
i := 1;
|
i := 1;
|
||||||
while (I<=Length(Result)) and (Result[i]<>'.') do
|
while (i <= Length(Result)) and (Result[i] <> '.') do
|
||||||
Inc(i);
|
Inc(i);
|
||||||
If (I<=Length(Result)) and (I>0) then
|
if (i <= Length(Result)) and (i > 0) then
|
||||||
Result[i]:= PathDelim;
|
Result[i] := PathDelim;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if ASubindex > 0 then
|
if ASubindex > 0 then
|
||||||
@ -610,8 +659,13 @@ begin
|
|||||||
PageDoc := CreateHTMLPage(Element, SubpageIndex);
|
PageDoc := CreateHTMLPage(Element, SubpageIndex);
|
||||||
try
|
try
|
||||||
Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
|
Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
|
||||||
CreatePath(Filename);
|
try
|
||||||
WriteHTMLFile(PageDoc, Filename);
|
CreatePath(Filename);
|
||||||
|
WriteHTMLFile(PageDoc, Filename);
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
WriteLn(Format(SErrCouldNotCreateFile, [FileName, e.Message]));
|
||||||
|
end;
|
||||||
finally
|
finally
|
||||||
PageDoc.Free;
|
PageDoc.Free;
|
||||||
end;
|
end;
|
||||||
|
Loading…
Reference in New Issue
Block a user