* 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:
sg 2005-08-11 20:56:44 +00:00
parent 8a3268cddb
commit 1a8051f993
4 changed files with 127 additions and 25 deletions

View File

@ -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]);

View File

@ -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

View File

@ -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 =

View File

@ -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;