mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 18:02:22 +02:00
* Added $IFxxx support
* Lots of small fixes
This commit is contained in:
sg
parent
870e9ca269
commit
dcb9c790bd
@ -74,7 +74,7 @@ type
|
||||
|
||||
|
||||
function ParseSource(AEngine: TPasTreeContainer;
|
||||
const FPCCommandLine: String): TPasModule;
|
||||
const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
|
||||
|
||||
|
||||
implementation
|
||||
@ -100,9 +100,8 @@ type
|
||||
function GetCurColumn: Integer;
|
||||
procedure ParseExc(const Msg: String);
|
||||
public
|
||||
constructor Create(AFileResolver: TFileResolver; AEngine: TPasTreeContainer;
|
||||
const AFilename: String);
|
||||
destructor Destroy; override;
|
||||
constructor Create(AScanner: TPascalScanner; AFileResolver: TFileResolver;
|
||||
AEngine: TPasTreeContainer);
|
||||
function CurTokenName: String;
|
||||
function CurTokenText: String;
|
||||
procedure NextToken;
|
||||
@ -190,19 +189,13 @@ begin
|
||||
Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
|
||||
end;
|
||||
|
||||
constructor TPasParser.Create(AFileResolver: TFileResolver;
|
||||
AEngine: TPasTreeContainer; const AFilename: String);
|
||||
constructor TPasParser.Create(AScanner: TPascalScanner;
|
||||
AFileResolver: TFileResolver; AEngine: TPasTreeContainer);
|
||||
begin
|
||||
inherited Create;
|
||||
FScanner := AScanner;
|
||||
FFileResolver := AFileResolver;
|
||||
FEngine := AEngine;
|
||||
FScanner := TPascalScanner.Create(FileResolver, AFilename);
|
||||
end;
|
||||
|
||||
destructor TPasParser.Destroy;
|
||||
begin
|
||||
Scanner.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TPasParser.CurTokenName: String;
|
||||
@ -243,10 +236,16 @@ begin
|
||||
Dec(FTokenBufferIndex);
|
||||
end;
|
||||
// Fetch new token
|
||||
repeat
|
||||
FCurToken := Scanner.FetchToken;
|
||||
try
|
||||
repeat
|
||||
FCurToken := Scanner.FetchToken;
|
||||
//WriteLn('Token: ', TokenInfos[CurToken], ' ', Scanner.CurTokenString);
|
||||
until not (FCurToken in [tkWhitespace, tkComment]);
|
||||
until not (FCurToken in [tkWhitespace, tkComment]);
|
||||
except
|
||||
on e: EScannerError do
|
||||
raise EParserError.Create(e.Message,
|
||||
Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
|
||||
end;
|
||||
FCurTokenString := Scanner.CurTokenString;
|
||||
FTokenBuffer[FTokenBufferSize] := FCurToken;
|
||||
FTokenStringBuffer[FTokenBufferSize] := FCurTokenString;
|
||||
@ -279,6 +278,20 @@ begin
|
||||
end;
|
||||
|
||||
function TPasParser.ParseType(Parent: TPasElement): TPasType;
|
||||
|
||||
procedure ParseRange;
|
||||
begin
|
||||
Result := TPasRangeType(Engine.CreateElement(TPasRangeType, '', Parent));
|
||||
try
|
||||
TPasRangeType(Result).RangeStart := ParseExpression;
|
||||
ExpectToken(tkDotDot);
|
||||
TPasRangeType(Result).RangeEnd := ParseExpression;
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
TypeToken: TToken;
|
||||
Name, s: String;
|
||||
@ -364,6 +377,13 @@ begin
|
||||
ParseExc(SParserExpectedCommaRBracket);
|
||||
end;
|
||||
end;
|
||||
tkSet:
|
||||
begin
|
||||
Result := TPasSetType(
|
||||
Engine.CreateElement(TPasSetType, '', Parent));
|
||||
ExpectToken(tkOf);
|
||||
TPasSetType(Result).EnumType := ParseType(Result);
|
||||
end;
|
||||
tkRecord:
|
||||
begin
|
||||
Result := TPasRecordType(
|
||||
@ -371,9 +391,12 @@ begin
|
||||
ParseRecordDecl(TPasRecordType(Result));
|
||||
UngetToken;
|
||||
end;
|
||||
|
||||
else
|
||||
ParseExc(SParserTypeSyntaxError);
|
||||
begin
|
||||
UngetToken;
|
||||
ParseRange;
|
||||
end;
|
||||
// ParseExc(SParserTypeSyntaxError);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -677,7 +700,13 @@ begin
|
||||
begin
|
||||
List := TList.Create;
|
||||
try
|
||||
ParseVarDecl(Section, List);
|
||||
try
|
||||
ParseVarDecl(Section, List);
|
||||
except
|
||||
for i := 0 to List.Count - 1 do
|
||||
TPasVariable(List[i]).Release;
|
||||
raise;
|
||||
end;
|
||||
for i := 0 to List.Count - 1 do
|
||||
begin
|
||||
VarEl := TPasVariable(List[i]);
|
||||
@ -729,15 +758,20 @@ function TPasParser.ParseConstDecl(Parent: TPasElement): TPasConst;
|
||||
begin
|
||||
Result := TPasConst(Engine.CreateElement(TPasConst, CurTokenString, Parent));
|
||||
|
||||
NextToken;
|
||||
if CurToken = tkColon then
|
||||
Result.VarType := ParseType(nil)
|
||||
else
|
||||
UngetToken;
|
||||
try
|
||||
NextToken;
|
||||
if CurToken = tkColon then
|
||||
Result.VarType := ParseType(nil)
|
||||
else
|
||||
UngetToken;
|
||||
|
||||
ExpectToken(tkEqual);
|
||||
Result.Value := ParseExpression;
|
||||
ExpectToken(tkSemicolon);
|
||||
ExpectToken(tkEqual);
|
||||
Result.Value := ParseExpression;
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Starts after the variable name
|
||||
@ -745,10 +779,15 @@ function TPasParser.ParseResourcestringDecl(Parent: TPasElement): TPasResString;
|
||||
begin
|
||||
Result := TPasResString(
|
||||
Engine.CreateElement(TPasResString, CurTokenString, Parent));
|
||||
ExpectToken(tkEqual);
|
||||
ExpectToken(tkString);
|
||||
Result.Value := CurTokenString;
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
ExpectToken(tkEqual);
|
||||
ExpectToken(tkString);
|
||||
Result.Value := CurTokenString;
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Starts after the type name
|
||||
@ -759,10 +798,15 @@ var
|
||||
procedure ParseRange;
|
||||
begin
|
||||
Result := TPasRangeType(Engine.CreateElement(TPasRangeType, TypeName, Parent));
|
||||
TPasRangeType(Result).RangeStart := ParseExpression;
|
||||
ExpectToken(tkDotDot);
|
||||
TPasRangeType(Result).RangeEnd := ParseExpression;
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
TPasRangeType(Result).RangeStart := ParseExpression;
|
||||
ExpectToken(tkDotDot);
|
||||
TPasRangeType(Result).RangeEnd := ParseExpression;
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -776,15 +820,25 @@ begin
|
||||
begin
|
||||
Result := TPasRecordType(
|
||||
Engine.CreateElement(TPasRecordType, TypeName, Parent));
|
||||
ParseRecordDecl(TPasRecordType(Result));
|
||||
try
|
||||
ParseRecordDecl(TPasRecordType(Result));
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkPacked:
|
||||
begin
|
||||
Result := TPasRecordType(
|
||||
Engine.CreateElement(TPasRecordType, TypeName, Parent));
|
||||
TPasRecordType(Result).IsPacked := True;
|
||||
ExpectToken(tkRecord);
|
||||
ParseRecordDecl(TPasRecordType(Result));
|
||||
try
|
||||
TPasRecordType(Result).IsPacked := True;
|
||||
ExpectToken(tkRecord);
|
||||
ParseRecordDecl(TPasRecordType(Result));
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkObject:
|
||||
Result := ParseClassDecl(Parent, TypeName, okObject);
|
||||
@ -796,20 +850,52 @@ begin
|
||||
begin
|
||||
Result := TPasPointerType(
|
||||
Engine.CreateElement(TPasPointerType, TypeName, Parent));
|
||||
TPasPointerType(Result).DestType := ParseType(nil);
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
TPasPointerType(Result).DestType := ParseType(nil);
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkIdentifier:
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkDot then
|
||||
begin
|
||||
// !!!: Store the full identifier
|
||||
ExpectIdentifier;
|
||||
NextToken;
|
||||
end;
|
||||
|
||||
if CurToken = tkSemicolon then
|
||||
begin
|
||||
UngetToken;
|
||||
UngetToken;
|
||||
Result := TPasAliasType(
|
||||
Engine.CreateElement(TPasAliasType, TypeName, Parent));
|
||||
TPasAliasType(Result).DestType := ParseType(nil);
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
TPasAliasType(Result).DestType := ParseType(nil);
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end else if CurToken = tkSquaredBraceOpen then
|
||||
begin
|
||||
// !!!: Check for string type and store string length somewhere
|
||||
Result := TPasAliasType(
|
||||
Engine.CreateElement(TPasAliasType, TypeName, Parent));
|
||||
try
|
||||
TPasAliasType(Result).DestType :=
|
||||
TPasUnresolvedTypeRef.Create(CurTokenString, Parent);
|
||||
ParseExpression;
|
||||
ExpectToken(tkSquaredBraceClose);
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
UngetToken;
|
||||
@ -829,54 +915,84 @@ begin
|
||||
begin
|
||||
Result := TPasArrayType(
|
||||
Engine.CreateElement(TPasArrayType, TypeName, Parent));
|
||||
ParseArrayType(TPasArrayType(Result));
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
ParseArrayType(TPasArrayType(Result));
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkSet:
|
||||
begin
|
||||
Result := TPasSetType(
|
||||
Engine.CreateElement(TPasSetType, TypeName, Parent));
|
||||
ExpectToken(tkOf);
|
||||
TPasSetType(Result).EnumType := ParseType(Result);
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
ExpectToken(tkOf);
|
||||
TPasSetType(Result).EnumType := ParseType(Result);
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkBraceOpen:
|
||||
begin
|
||||
Result := TPasEnumType(
|
||||
Engine.CreateElement(TPasEnumType, TypeName, Parent));
|
||||
while True do
|
||||
begin
|
||||
NextToken;
|
||||
EnumValue := TPasEnumValue(
|
||||
Engine.CreateElement(TPasEnumValue, CurTokenString, Result));
|
||||
TPasEnumType(Result).Values.Add(EnumValue);
|
||||
NextToken;
|
||||
if CurToken = tkBraceClose then
|
||||
break
|
||||
else if CurToken <> tkComma then
|
||||
ParseExc(SParserExpectedCommaRBracket);
|
||||
end;
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
while True do
|
||||
begin
|
||||
NextToken;
|
||||
EnumValue := TPasEnumValue(
|
||||
Engine.CreateElement(TPasEnumValue, CurTokenString, Result));
|
||||
TPasEnumType(Result).Values.Add(EnumValue);
|
||||
NextToken;
|
||||
if CurToken = tkBraceClose then
|
||||
break
|
||||
else if CurToken <> tkComma then
|
||||
ParseExc(SParserExpectedCommaRBracket);
|
||||
end;
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkProcedure:
|
||||
begin
|
||||
Result := TPasProcedureType(
|
||||
Engine.CreateElement(TPasProcedureType, TypeName, Parent));
|
||||
ParseProcedureOrFunctionHeader(Result,
|
||||
TPasProcedureType(Result), False, True);
|
||||
try
|
||||
ParseProcedureOrFunctionHeader(Result,
|
||||
TPasProcedureType(Result), False, True);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkFunction:
|
||||
begin
|
||||
Result := Engine.CreateFunctionType(TypeName, Parent, False);
|
||||
ParseProcedureOrFunctionHeader(Result,
|
||||
TPasFunctionType(Result), True, True);
|
||||
try
|
||||
ParseProcedureOrFunctionHeader(Result,
|
||||
TPasFunctionType(Result), True, True);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
tkType:
|
||||
begin
|
||||
Result := TPasTypeAliasType(
|
||||
Engine.CreateElement(TPasTypeAliasType, TypeName, Parent));
|
||||
TPasTypeAliasType(Result).DestType := ParseType(nil);
|
||||
ExpectToken(tkSemicolon);
|
||||
try
|
||||
TPasTypeAliasType(Result).DestType := ParseType(nil);
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
@ -889,13 +1005,12 @@ end;
|
||||
// Starts after the variable name
|
||||
|
||||
procedure TPasParser.ParseInlineVarDecl(Parent: TPasElement; VarList: TList);
|
||||
|
||||
begin
|
||||
ParseInlineVarDecl(Parent,Varlist,visDefault);
|
||||
ParseInlineVarDecl(Parent, Varlist, visDefault);
|
||||
end;
|
||||
|
||||
procedure TPasParser.ParseInlineVarDecl(Parent: TPasElement; VarList: TList;
|
||||
AVisibility : TPasMemberVisibility);
|
||||
AVisibility: TPasMemberVisibility);
|
||||
var
|
||||
VarNames: TStringList;
|
||||
i: Integer;
|
||||
@ -914,7 +1029,9 @@ begin
|
||||
ParseExc(SParserExpectedCommaColon);
|
||||
ExpectIdentifier;
|
||||
end;
|
||||
VarType := ParseType(nil);
|
||||
|
||||
VarType := ParseComplexType;
|
||||
|
||||
for i := 0 to VarNames.Count - 1 do
|
||||
begin
|
||||
VarEl := TPasVariable(
|
||||
@ -1358,152 +1475,160 @@ begin
|
||||
|
||||
Result := TPasClassType(
|
||||
Engine.CreateElement(TPasClassType, AClassName, Parent));
|
||||
TPasClassType(Result).ObjKind := AObjKind;
|
||||
|
||||
if CurToken = tkBraceOpen then
|
||||
begin
|
||||
TPasClassType(Result).AncestorType := ParseType(nil);
|
||||
while True do
|
||||
try
|
||||
TPasClassType(Result).ObjKind := AObjKind;
|
||||
|
||||
// Parse ancestor list
|
||||
if CurToken = tkBraceOpen then
|
||||
begin
|
||||
TPasClassType(Result).AncestorType := ParseType(nil);
|
||||
while True do
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkBraceClose then
|
||||
break;
|
||||
UngetToken;
|
||||
ExpectToken(tkComma);
|
||||
ExpectIdentifier;
|
||||
// !!!: Store interface name
|
||||
end;
|
||||
NextToken;
|
||||
if CurToken = tkBraceClose then
|
||||
break;
|
||||
UngetToken;
|
||||
ExpectToken(tkComma);
|
||||
ExpectIdentifier;
|
||||
// !!!: Store interface name
|
||||
end;
|
||||
NextToken;
|
||||
end;
|
||||
|
||||
if CurToken <> tkSemicolon then
|
||||
begin
|
||||
CurVisibility := visDefault;
|
||||
while CurToken <> tkEnd do
|
||||
if CurToken <> tkSemicolon then
|
||||
begin
|
||||
case CurToken of
|
||||
tkIdentifier:
|
||||
begin
|
||||
s := LowerCase(CurTokenString);
|
||||
if s = 'private' then
|
||||
CurVisibility := visPrivate
|
||||
else if s = 'protected' then
|
||||
CurVisibility := visProtected
|
||||
else if s = 'public' then
|
||||
CurVisibility := visPublic
|
||||
else if s = 'published' then
|
||||
CurVisibility := visPublished
|
||||
else if s = 'automated' then
|
||||
CurVisibility := visAutomated
|
||||
else
|
||||
CurVisibility := visDefault;
|
||||
while CurToken <> tkEnd do
|
||||
begin
|
||||
case CurToken of
|
||||
tkIdentifier:
|
||||
begin
|
||||
VarList := TList.Create;
|
||||
try
|
||||
ParseInlineVarDecl(Result, VarList, CurVisibility);
|
||||
for i := 0 to VarList.Count - 1 do
|
||||
begin
|
||||
Element := TPasElement(VarList[i]);
|
||||
Element.Visibility := CurVisibility;
|
||||
TPasClassType(Result).Members.Add(Element);
|
||||
end;
|
||||
finally
|
||||
VarList.Free;
|
||||
s := LowerCase(CurTokenString);
|
||||
if s = 'private' then
|
||||
CurVisibility := visPrivate
|
||||
else if s = 'protected' then
|
||||
CurVisibility := visProtected
|
||||
else if s = 'public' then
|
||||
CurVisibility := visPublic
|
||||
else if s = 'published' then
|
||||
CurVisibility := visPublished
|
||||
else if s = 'automated' then
|
||||
CurVisibility := visAutomated
|
||||
else
|
||||
begin
|
||||
VarList := TList.Create;
|
||||
try
|
||||
ParseInlineVarDecl(Result, VarList, CurVisibility);
|
||||
for i := 0 to VarList.Count - 1 do
|
||||
begin
|
||||
Element := TPasElement(VarList[i]);
|
||||
Element.Visibility := CurVisibility;
|
||||
TPasClassType(Result).Members.Add(Element);
|
||||
end;
|
||||
finally
|
||||
VarList.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
tkProcedure:
|
||||
ProcessMethod('procedure', False);
|
||||
tkFunction:
|
||||
ProcessMethod('function', True);
|
||||
tkConstructor:
|
||||
ProcessMethod('constructor', False);
|
||||
tkDestructor:
|
||||
ProcessMethod('destructor', False);
|
||||
tkProperty:
|
||||
begin
|
||||
ExpectIdentifier;
|
||||
Element := Engine.CreateElement(TPasProperty,
|
||||
CurTokenString, Result, CurVisibility);
|
||||
TPasClassType(Result).Members.Add(Element);
|
||||
NextToken;
|
||||
// !!!: Parse array properties correctly
|
||||
if CurToken = tkSquaredBraceOpen then
|
||||
tkProcedure:
|
||||
ProcessMethod('procedure', False);
|
||||
tkFunction:
|
||||
ProcessMethod('function', True);
|
||||
tkConstructor:
|
||||
ProcessMethod('constructor', False);
|
||||
tkDestructor:
|
||||
ProcessMethod('destructor', False);
|
||||
tkProperty:
|
||||
begin
|
||||
ParseArgList(Element, TPasProperty(Element).Args, tkSquaredBraceClose);
|
||||
ExpectIdentifier;
|
||||
Element := Engine.CreateElement(TPasProperty,
|
||||
CurTokenString, Result, CurVisibility);
|
||||
TPasClassType(Result).Members.Add(Element);
|
||||
NextToken;
|
||||
end;
|
||||
|
||||
if CurToken = tkColon then
|
||||
begin
|
||||
TPasProperty(Element).VarType := ParseType(Element);
|
||||
NextToken;
|
||||
if CurToken <> tkSemicolon then
|
||||
// !!!: Parse array properties correctly
|
||||
if CurToken = tkSquaredBraceOpen then
|
||||
begin
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'READ') then
|
||||
TPasProperty(Element).ReadAccessorName := GetAccessorName
|
||||
else
|
||||
UngetToken;
|
||||
ParseArgList(Element, TPasProperty(Element).Args, tkSquaredBraceClose);
|
||||
NextToken;
|
||||
end;
|
||||
|
||||
NextToken;
|
||||
if CurToken <> tkSemicolon then
|
||||
begin
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'WRITE') then
|
||||
TPasProperty(Element).WriteAccessorName := GetAccessorName
|
||||
else
|
||||
if CurToken = tkColon then
|
||||
begin
|
||||
TPasProperty(Element).VarType := ParseType(Element);
|
||||
NextToken;
|
||||
if CurToken <> tkSemicolon then
|
||||
begin
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'READ') then
|
||||
TPasProperty(Element).ReadAccessorName := GetAccessorName
|
||||
else
|
||||
UngetToken;
|
||||
|
||||
NextToken;
|
||||
if CurToken <> tkSemicolon then
|
||||
begin
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'STORED') then
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkTrue then
|
||||
TPasProperty(Element).StoredAccessorName := 'True'
|
||||
else if CurToken = tkFalse then
|
||||
TPasProperty(Element).StoredAccessorName := 'False'
|
||||
else if CurToken = tkIdentifier then
|
||||
TPasProperty(Element).StoredAccessorName := CurTokenString
|
||||
else
|
||||
ParseExc(SParserSyntaxError);
|
||||
end else
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'WRITE') then
|
||||
TPasProperty(Element).WriteAccessorName := GetAccessorName
|
||||
else
|
||||
UngetToken;
|
||||
|
||||
NextToken;
|
||||
if CurToken <> tkSemicolon then
|
||||
begin
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'STORED') then
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkTrue then
|
||||
TPasProperty(Element).StoredAccessorName := 'True'
|
||||
else if CurToken = tkFalse then
|
||||
TPasProperty(Element).StoredAccessorName := 'False'
|
||||
else if CurToken = tkIdentifier then
|
||||
TPasProperty(Element).StoredAccessorName := CurTokenString
|
||||
else
|
||||
ParseExc(SParserSyntaxError);
|
||||
end else
|
||||
UngetToken;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
NextToken;
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEFAULT') then
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkSemicolon then
|
||||
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEFAULT') then
|
||||
begin
|
||||
TPasProperty(Element).IsDefault := True;
|
||||
UngetToken;
|
||||
NextToken;
|
||||
if CurToken = tkSemicolon then
|
||||
begin
|
||||
TPasProperty(Element).IsDefault := True;
|
||||
UngetToken;
|
||||
end else
|
||||
begin
|
||||
UngetToken;
|
||||
TPasProperty(Element).DefaultValue := ParseExpression;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
UngetToken;
|
||||
TPasProperty(Element).DefaultValue := ParseExpression;
|
||||
end;
|
||||
end else
|
||||
UngetToken;
|
||||
end;
|
||||
UngetToken;
|
||||
end;
|
||||
end;
|
||||
NextToken;
|
||||
end;
|
||||
NextToken;
|
||||
// Eat semicolon after class...end
|
||||
ExpectToken(tkSemicolon);
|
||||
end;
|
||||
// Eat semicolon after class...end
|
||||
ExpectToken(tkSemicolon);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function ParseSource(AEngine: TPasTreeContainer;
|
||||
const FPCCommandLine: String): TPasModule;
|
||||
const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
|
||||
var
|
||||
FileResolver: TFileResolver;
|
||||
Parser: TPasParser;
|
||||
Start, CurPos: PChar;
|
||||
Filename: String;
|
||||
Scanner: TPascalScanner;
|
||||
|
||||
procedure ProcessCmdLinePart;
|
||||
var
|
||||
@ -1518,9 +1643,13 @@ var
|
||||
exit;
|
||||
if s[1] = '-' then
|
||||
begin
|
||||
if s[2] = 'F' then
|
||||
if s[3] = 'i' then
|
||||
FileResolver.AddIncludePath(Copy(s, 4, Length(s)));
|
||||
case s[2] of
|
||||
'd':
|
||||
Scanner.Defines.Append(UpperCase(Copy(s, 3, Length(s))));
|
||||
'F':
|
||||
if s[3] = 'i' then
|
||||
FileResolver.AddIncludePath(Copy(s, 4, Length(s)));
|
||||
end;
|
||||
end else
|
||||
if Filename <> '' then
|
||||
raise Exception.Create(SErrMultipleSourceFiles)
|
||||
@ -1528,9 +1657,41 @@ var
|
||||
Filename := s;
|
||||
end;
|
||||
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
FileResolver := TFileResolver.Create;
|
||||
FileResolver := nil;
|
||||
Scanner := nil;
|
||||
Parser := nil;
|
||||
try
|
||||
FileResolver := TFileResolver.Create;
|
||||
Scanner := TPascalScanner.Create(FileResolver);
|
||||
Scanner.Defines.Append('FPK');
|
||||
Scanner.Defines.Append('FPC');
|
||||
s := UpperCase(OSTarget);
|
||||
Scanner.Defines.Append(s);
|
||||
if s = 'LINUX' then
|
||||
Scanner.Defines.Append('UNIX')
|
||||
else if s = 'FREEBSD' then
|
||||
begin
|
||||
Scanner.Defines.Append('BSD');
|
||||
Scanner.Defines.Append('UNIX');
|
||||
end else if s = 'NETBSD' then
|
||||
begin
|
||||
Scanner.Defines.Append('BSD');
|
||||
Scanner.Defines.Append('UNIX');
|
||||
end else if s = 'SUNOS' then
|
||||
begin
|
||||
Scanner.Defines.Append('SOLARIS');
|
||||
Scanner.Defines.Append('UNIX');
|
||||
end else if s = 'GO32V2' then
|
||||
Scanner.Defines.Append('DPMI')
|
||||
else if s = 'BEOS' then
|
||||
Scanner.Defines.Append('UNIX')
|
||||
else if s = 'QNX' then
|
||||
Scanner.Defines.Append('UNIX');
|
||||
|
||||
Parser := TPasParser.Create(Scanner, FileResolver, AEngine);
|
||||
Filename := '';
|
||||
Start := @FPCCommandLine[1];
|
||||
CurPos := Start;
|
||||
@ -1548,10 +1709,11 @@ begin
|
||||
if Filename = '' then
|
||||
raise Exception.Create(SErrNoSourceGiven);
|
||||
|
||||
Parser := TPasParser.Create(FileResolver, AEngine, Filename);
|
||||
Scanner.OpenFile(Filename);
|
||||
Parser.ParseMain(Result);
|
||||
Parser.Free;
|
||||
finally
|
||||
Parser.Free;
|
||||
Scanner.Free;
|
||||
FileResolver.Free;
|
||||
end;
|
||||
end;
|
||||
@ -1561,7 +1723,11 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-03-13 21:47:42 sg
|
||||
Revision 1.2 2003-03-27 16:32:48 sg
|
||||
* Added $IFxxx support
|
||||
* Lots of small fixes
|
||||
|
||||
Revision 1.1 2003/03/13 21:47:42 sg
|
||||
* First version as part of FCL
|
||||
|
||||
}
|
||||
|
||||
@ -26,6 +26,9 @@ resourcestring
|
||||
SErrInvalidCharacter = 'Invalid character ''%s''';
|
||||
SErrOpenString = 'String exceeds end of line';
|
||||
SErrIncludeFileNotFound = 'Could not find include file ''%s''';
|
||||
SErrIfXXXNestingLimitReached = 'Nesting of $IFxxx too deep';
|
||||
SErrInvalidPPElse = '$ELSE without matching $IFxxx';
|
||||
SErrInvalidPPEndif = '$ENDIF without matching $IFxxx';
|
||||
|
||||
type
|
||||
|
||||
@ -49,6 +52,7 @@ type
|
||||
tkColon, // ':'
|
||||
tkSemicolon, // ';'
|
||||
tkEqual, // '='
|
||||
tkAt, // '@'
|
||||
tkSquaredBraceOpen, // '['
|
||||
tkSquaredBraceClose,// ']'
|
||||
tkCaret, // '^'
|
||||
@ -159,6 +163,9 @@ type
|
||||
|
||||
EScannerError = class(Exception);
|
||||
|
||||
TPascalScannerPPSkipMode = (ppSkipNone, ppSkipIfBranch, ppSkipElseBranch,
|
||||
ppSkipAll);
|
||||
|
||||
TPascalScanner = class
|
||||
private
|
||||
FFileResolver: TFileResolver;
|
||||
@ -168,16 +175,26 @@ type
|
||||
FCurToken: TToken;
|
||||
FCurTokenString: String;
|
||||
FCurLine: String;
|
||||
FDefines: TStrings;
|
||||
TokenStr: PChar;
|
||||
FIncludeStack: TList;
|
||||
|
||||
// Preprocessor $IFxxx skipping data
|
||||
PPSkipMode: TPascalScannerPPSkipMode;
|
||||
PPIsSkipping: Boolean;
|
||||
PPSkipStackIndex: Integer;
|
||||
PPSkipModeStack: array[0..255] of TPascalScannerPPSkipMode;
|
||||
PPIsSkippingStack: array[0..255] of Boolean;
|
||||
|
||||
function GetCurColumn: Integer;
|
||||
protected
|
||||
procedure Error(const Msg: String);
|
||||
procedure Error(const Msg: String; Args: array of Const);
|
||||
function DoFetchToken: TToken;
|
||||
public
|
||||
constructor Create(AFileResolver: TFileResolver; const AFilename: String);
|
||||
constructor Create(AFileResolver: TFileResolver);
|
||||
destructor Destroy; override;
|
||||
procedure OpenFile(const AFilename: String);
|
||||
function FetchToken: TToken;
|
||||
|
||||
property FileResolver: TFileResolver read FFileResolver;
|
||||
@ -190,6 +207,8 @@ type
|
||||
|
||||
property CurToken: TToken read FCurToken;
|
||||
property CurTokenString: String read FCurTokenString;
|
||||
|
||||
property Defines: TStrings read FDefines;
|
||||
end;
|
||||
|
||||
const
|
||||
@ -212,6 +231,7 @@ const
|
||||
':',
|
||||
';',
|
||||
'=',
|
||||
'@',
|
||||
'[',
|
||||
']',
|
||||
'^',
|
||||
@ -352,11 +372,14 @@ end;
|
||||
|
||||
function TFileResolver.FindSourceFile(const AName: String): TLineReader;
|
||||
begin
|
||||
try
|
||||
Result := TFileLineReader.Create(AName);
|
||||
except
|
||||
Result := nil;
|
||||
end;
|
||||
if not FileExists(AName) then
|
||||
Result := nil
|
||||
else
|
||||
try
|
||||
Result := TFileLineReader.Create(AName);
|
||||
except
|
||||
Result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFileResolver.FindIncludeFile(const AName: String): TLineReader;
|
||||
@ -377,27 +400,35 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
constructor TPascalScanner.Create(AFileResolver: TFileResolver;
|
||||
const AFilename: String);
|
||||
constructor TPascalScanner.Create(AFileResolver: TFileResolver);
|
||||
begin
|
||||
inherited Create;
|
||||
FFileResolver := AFileResolver;
|
||||
FCurSourceFile := FileResolver.FindSourceFile(AFilename);
|
||||
FCurFilename := AFilename;
|
||||
FIncludeStack := TList.Create;
|
||||
FDefines := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TPascalScanner.Destroy;
|
||||
begin
|
||||
FDefines.Free;
|
||||
// Dont' free the first element, because it is CurSourceFile
|
||||
while FIncludeStack.Count > 1 do
|
||||
begin
|
||||
TFileResolver(FIncludeStack[1]).Free;
|
||||
FIncludeStack.Delete(1);
|
||||
end;
|
||||
FIncludeStack.Free;
|
||||
|
||||
CurSourceFile.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.OpenFile(const AFilename: String);
|
||||
begin
|
||||
FCurSourceFile := FileResolver.FindSourceFile(AFilename);
|
||||
FCurFilename := AFilename;
|
||||
end;
|
||||
|
||||
function TPascalScanner.FetchToken: TToken;
|
||||
var
|
||||
IncludeStackItem: TIncludeStackItem;
|
||||
@ -424,7 +455,8 @@ begin
|
||||
end else
|
||||
break
|
||||
else
|
||||
break;
|
||||
if not PPIsSkipping then
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -459,7 +491,7 @@ function TPascalScanner.DoFetchToken: TToken;
|
||||
var
|
||||
TokenStart, CurPos: PChar;
|
||||
i: TToken;
|
||||
OldLength, SectionLength, NestingLevel: Integer;
|
||||
OldLength, SectionLength, NestingLevel, Index: Integer;
|
||||
Directive, Param: String;
|
||||
IncludeStackItem: TIncludeStackItem;
|
||||
begin
|
||||
@ -644,9 +676,35 @@ begin
|
||||
'0'..'9':
|
||||
begin
|
||||
TokenStart := TokenStr;
|
||||
repeat
|
||||
while True do
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
until not (TokenStr[0] in ['0'..'9', '.', 'e', 'E']);
|
||||
case TokenStr[0] of
|
||||
'.':
|
||||
begin
|
||||
if TokenStr[1] in ['0'..'9', 'e', 'E'] then
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
repeat
|
||||
Inc(TokenStr);
|
||||
until not (TokenStr[0] in ['0'..'9', 'e', 'E']);
|
||||
end;
|
||||
break;
|
||||
end;
|
||||
'0'..'9': ;
|
||||
'e', 'E':
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
if TokenStr[0] = '-' then
|
||||
Inc(TokenStr);
|
||||
while TokenStr[0] in ['0'..'9'] do
|
||||
Inc(TokenStr);
|
||||
break;
|
||||
end;
|
||||
else
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
SectionLength := TokenStr - TokenStart;
|
||||
SetLength(FCurTokenString, SectionLength);
|
||||
if SectionLength > 0 then
|
||||
@ -673,6 +731,11 @@ begin
|
||||
Inc(TokenStr);
|
||||
Result := tkEqual;
|
||||
end;
|
||||
'@':
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
Result := tkAt;
|
||||
end;
|
||||
'[':
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
@ -756,20 +819,117 @@ begin
|
||||
// WriteLn('Direktive: "', Directive, '", Param: "', Param, '"');
|
||||
if (Directive = 'I') or (Directive = 'INCLUDE') then
|
||||
begin
|
||||
IncludeStackItem := TIncludeStackItem.Create;
|
||||
IncludeStackItem.SourceFile := CurSourceFile;
|
||||
IncludeStackItem.Filename := CurFilename;
|
||||
IncludeStackItem.Token := CurToken;
|
||||
IncludeStackItem.TokenString := CurTokenString;
|
||||
IncludeStackItem.Line := CurLine;
|
||||
IncludeStackItem.Row := CurRow;
|
||||
IncludeStackItem.TokenStr := TokenStr;
|
||||
FIncludeStack.Add(IncludeStackItem);
|
||||
FCurSourceFile := FileResolver.FindIncludeFile(Param);
|
||||
if not Assigned(CurSourceFile) then
|
||||
Error(SErrIncludeFileNotFound, [Param]);
|
||||
FCurFilename := Param;
|
||||
FCurRow := 0;
|
||||
if not PPIsSkipping then
|
||||
begin
|
||||
IncludeStackItem := TIncludeStackItem.Create;
|
||||
IncludeStackItem.SourceFile := CurSourceFile;
|
||||
IncludeStackItem.Filename := CurFilename;
|
||||
IncludeStackItem.Token := CurToken;
|
||||
IncludeStackItem.TokenString := CurTokenString;
|
||||
IncludeStackItem.Line := CurLine;
|
||||
IncludeStackItem.Row := CurRow;
|
||||
IncludeStackItem.TokenStr := TokenStr;
|
||||
FIncludeStack.Add(IncludeStackItem);
|
||||
FCurSourceFile := FileResolver.FindIncludeFile(Param);
|
||||
if not Assigned(CurSourceFile) then
|
||||
Error(SErrIncludeFileNotFound, [Param]);
|
||||
FCurFilename := Param;
|
||||
FCurRow := 0;
|
||||
end;
|
||||
end else if Directive = 'DEFINE' then
|
||||
begin
|
||||
if not PPIsSkipping then
|
||||
begin
|
||||
Param := UpperCase(Param);
|
||||
if Defines.IndexOf(Param) < 0 then
|
||||
Defines.Add(Param);
|
||||
end;
|
||||
end else if Directive = 'UNDEF' then
|
||||
begin
|
||||
if not PPIsSkipping then
|
||||
begin
|
||||
Param := UpperCase(Param);
|
||||
Index := Defines.IndexOf(Param);
|
||||
if Index >= 0 then
|
||||
Defines.Delete(Index);
|
||||
end;
|
||||
end else if Directive = 'IFDEF' then
|
||||
begin
|
||||
if PPSkipStackIndex = High(PPSkipModeStack) then
|
||||
Error(SErrIfXXXNestingLimitReached);
|
||||
PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
|
||||
PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
|
||||
Inc(PPSkipStackIndex);
|
||||
if PPIsSkipping then
|
||||
begin
|
||||
PPSkipMode := ppSkipAll;
|
||||
PPIsSkipping := True;
|
||||
end else
|
||||
begin
|
||||
Param := UpperCase(Param);
|
||||
Index := Defines.IndexOf(Param);
|
||||
if Index < 0 then
|
||||
begin
|
||||
PPSkipMode := ppSkipIfBranch;
|
||||
PPIsSkipping := True;
|
||||
end else
|
||||
PPSkipMode := ppSkipElseBranch;
|
||||
end;
|
||||
end else if Directive = 'IFNDEF' then
|
||||
begin
|
||||
if PPSkipStackIndex = High(PPSkipModeStack) then
|
||||
Error(SErrIfXXXNestingLimitReached);
|
||||
PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
|
||||
PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
|
||||
Inc(PPSkipStackIndex);
|
||||
if PPIsSkipping then
|
||||
begin
|
||||
PPSkipMode := ppSkipAll;
|
||||
PPIsSkipping := True;
|
||||
end else
|
||||
begin
|
||||
Param := UpperCase(Param);
|
||||
Index := Defines.IndexOf(Param);
|
||||
if Index >= 0 then
|
||||
begin
|
||||
PPSkipMode := ppSkipIfBranch;
|
||||
PPIsSkipping := True;
|
||||
end else
|
||||
PPSkipMode := ppSkipElseBranch;
|
||||
end;
|
||||
end else if Directive = 'IFOPT' then
|
||||
begin
|
||||
if PPSkipStackIndex = High(PPSkipModeStack) then
|
||||
Error(SErrIfXXXNestingLimitReached);
|
||||
PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
|
||||
PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
|
||||
Inc(PPSkipStackIndex);
|
||||
if PPIsSkipping then
|
||||
begin
|
||||
PPSkipMode := ppSkipAll;
|
||||
PPIsSkipping := True;
|
||||
end else
|
||||
begin
|
||||
{ !!!: Currently, options are not supported, so they are just
|
||||
assumed as not being set. }
|
||||
PPSkipMode := ppSkipIfBranch;
|
||||
PPIsSkipping := True;
|
||||
end;
|
||||
end else if Directive = 'ELSE' then
|
||||
begin
|
||||
if PPSkipStackIndex = 0 then
|
||||
Error(SErrInvalidPPElse);
|
||||
if PPSkipMode = ppSkipIfBranch then
|
||||
PPIsSkipping := False
|
||||
else if PPSkipMode = ppSkipElseBranch then
|
||||
PPIsSkipping := True;
|
||||
end else if Directive = 'ENDIF' then
|
||||
begin
|
||||
if PPSkipStackIndex = 0 then
|
||||
Error(SErrInvalidPPEndif);
|
||||
Dec(PPSkipStackIndex);
|
||||
PPSkipMode := PPSkipModeStack[PPSkipStackIndex];
|
||||
PPIsSkipping := PPIsSkippingStack[PPSkipStackIndex];
|
||||
end;
|
||||
end else
|
||||
Directive := '';
|
||||
@ -815,7 +975,11 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-03-13 21:47:42 sg
|
||||
Revision 1.2 2003-03-27 16:32:48 sg
|
||||
* Added $IFxxx support
|
||||
* Lots of small fixes
|
||||
|
||||
Revision 1.1 2003/03/13 21:47:42 sg
|
||||
* First version as part of FCL
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user