paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applied patches by Vincent Snijders

Browse Source 
* 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:
sg 2005-08-11 20:56:44 +00:00
parent 8a3268cddb
commit 1a8051f993
4 changed files with 127 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
fcl/passrc/pparser.pp
View File

@ -85,7 +85,7 @@ uses Classes;
type
TDeclType = (declNone, declConst, declResourcestring, declType, declVar);
TDeclType = (declNone, declConst, declResourcestring, declType, declVar, declThreadvar);
TProcType = (ptProcedure, ptFunction, ptOperator);
@ -703,6 +703,8 @@ begin
CurBlock := declType;
tkVar:
CurBlock := declVar;
tkThreadVar:
CurBlock := declThreadVar;
tkProcedure:
begin
AddProcOrFunction(Section, ParseProcedureOrFunctionDecl(Section, ptProcedure));
@ -770,7 +772,7 @@ begin
Section.Types.Add(TypeEl);
end;
end;
declVar:
declVar, declThreadVar:
begin
List := TList.Create;
try
@ -1369,8 +1371,7 @@ begin
begin
ParseArgList(Element, Element.Args, tkBraceClose);
TPasFunctionType(Element).ResultEl.Name := ExpectIdentifier;
if CurToken <> tkColon then
ParseExc(SParserExpectedLBracketColon);
ExpectToken(tkColon);
if Assigned(Element) then // !!!
TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
else
@ -1387,7 +1388,8 @@ begin
UngetToken;
NextToken;
if CurToken = tkEqual then begin
if CurToken = tkEqual then
begin
// for example: const p: procedure = nil;
UngetToken;
exit;
@ -1407,6 +1409,10 @@ begin
begin
{ El['calling-conv'] := 'stdcall';}
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
begin
{ El['calling-conv'] := 'cdecl';}
@ -1416,6 +1422,12 @@ begin
repeat
NextToken
until CurToken = tkSemicolon;
end else if (CurToken = tkSquaredBraceOpen) then
begin
repeat
NextToken
until CurToken = tkSquaredBraceClose;
ExpectToken(tkSemicolon);
end else if Parent.InheritsFrom(TPasProcedure) and
(CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OVERLOAD') then
begin
@ -1554,6 +1566,7 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
ProcType: TProcType): TPasProcedure;
var
Name: String;
i: Integer;
begin
case ProcType of
ptFunction:
@ -1572,7 +1585,8 @@ begin
end;
ptOperator:
begin
Name := TokenInfos[CurToken];
NextToken;
Name := 'operator ' + TokenInfos[CurToken];
Result := TPasOperator(CreateElement(TPasOperator, Name, Parent));
Result.ProcType := Engine.CreateFunctionType('', '__INVALID__', Result,
True, Scanner.CurFilename, Scanner.CurRow);
@ -1580,6 +1594,20 @@ begin
end;
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;
@ -1646,9 +1674,10 @@ begin
Variant.Members.Free;
raise;
end;
ExpectToken(tkSemicolon);
NextToken;
if CurToken = tkEnd then
if CurToken = tkSemicolon then
NextToken;
if (CurToken = tkEnd) or (CurToken = tkBraceClose) then
break
else
UngetToken;
@ -1817,10 +1846,6 @@ begin
VarList := TList.Create;
try
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
begin
Element := TPasElement(VarList[i]);

28
fcl/passrc/pscanner.pp
View File

@ -61,6 +61,9 @@ type
tkDotDot, // '..'
tkAssign, // ':='
tkNotEqual, // '<>'
tkLessEqualThan, // '<='
tkGreaterEqualThan, // '>='
tkPower, // '**'
// Reserved words
tkabsolute,
tkand,
@ -118,6 +121,7 @@ type
tkshr,
// tkstring,
tkthen,
tkthreadvar,
tkto,
tktrue,
tktry,
@ -241,6 +245,9 @@ const
'..',
':=',
'<>',
'<=',
'>=',
'**',
// Reserved words
'absolute',
'and',
@ -298,6 +305,7 @@ const
'shr',
// 'string',
'then',
'threadvar',
'to',
'true',
'try',
@ -658,7 +666,12 @@ begin
'*':
begin
Inc(TokenStr);
Result := tkMul;
if TokenStr[0] = '*' then
begin
Inc(TokenStr);
Result := tkPower;
end else
Result := tkMul;
end;
'+':
begin
@ -764,7 +777,11 @@ begin
begin
Inc(TokenStr);
Result := tkNotEqual;
end else
end else if TokenStr[0] = '=' then
begin
Inc(TokenStr);
Result := tkLessEqualThan;
end else
Result := tkLessThan;
end;
'=':
@ -775,7 +792,12 @@ begin
'>':
begin
Inc(TokenStr);
Result := tkGreaterThan;
if TokenStr[0] = '=' then
begin
Inc(TokenStr);
Result := tkGreaterEqualThan;
end else
Result := tkGreaterThan;
end;
'@':
begin

1
utils/fpdoc/dglobals.pp
View File

@ -131,6 +131,7 @@ resourcestring
SNeedPackageName = 'No package name specified. Please specify one using the --package option.';
SDone = 'Done.';
SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
SErrCouldNotCreateFile = 'Could not create file "%s": %s';
Const
SVisibility: array[TPasMemberVisibility] of string =

74
utils/fpdoc/dw_html.pp
View File

@ -302,6 +302,7 @@ end;
function TLongNameFileAllocator.GetFilename(AElement: TPasElement;
ASubindex: Integer): String;
var
s: String;
i: Integer;
begin
if AElement.ClassType = TPasPackage then
@ -309,20 +310,68 @@ begin
else if AElement.ClassType = TPasModule then
Result := LowerCase(AElement.Name) + PathDelim + 'index'
else
begin
if AElement is TPasOperator then
begin
Result := LowerCase(AElement.PathName);
i := 1;
if (Length(Result)>0) and (Result[1]='#') then
Result := LowerCase(AElement.Parent.PathName) + '.op-';
s := Copy(AElement.Name, Pos(' ', AElement.Name) + 1, Length(AElement.Name));
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
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
Inc(i);
Result:=Copy(Result,i+1,Length(Result));
end;
Result := Copy(Result, i + 1, Length(Result));
end;
i := 1;
while (I<=Length(Result)) and (Result[i]<>'.') do
while (i <= Length(Result)) and (Result[i] <> '.') do
Inc(i);
If (I<=Length(Result)) and (I>0) then
Result[i]:= PathDelim;
if (i <= Length(Result)) and (i > 0) then
Result[i] := PathDelim;
end;
if ASubindex > 0 then
@ -610,8 +659,13 @@ begin
PageDoc := CreateHTMLPage(Element, SubpageIndex);
try
Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
CreatePath(Filename);
WriteHTMLFile(PageDoc, Filename);
try
CreatePath(Filename);
WriteHTMLFile(PageDoc, Filename);
except
on E: Exception do
WriteLn(Format(SErrCouldNotCreateFile, [FileName, e.Message]));
end;
finally
PageDoc.Free;
end;