mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 05:59:28 +02:00
fcl-passrc: fixed parsing generic array type
git-svn-id: trunk@42472 -
This commit is contained in:
Mattias Gaertner
parent
e97a2cb03e
commit
f35e711024
@ -606,6 +606,10 @@ type
|
||||
{ TPasArrayType }
|
||||
|
||||
TPasArrayType = class(TPasType)
|
||||
private
|
||||
procedure ClearChildReferences(El: TPasElement; arg: pointer);
|
||||
protected
|
||||
procedure SetParent(const AValue: TPasElement); override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
function ElementTypeName: string; override;
|
||||
@ -617,9 +621,11 @@ type
|
||||
Ranges: TPasExprArray; // only valid if Parser po_arrayrangeexpr enabled
|
||||
PackMode : TPackMode;
|
||||
ElType: TPasType;
|
||||
Function IsGenericArray : Boolean;
|
||||
Function IsPacked : Boolean;
|
||||
GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType, can be nil
|
||||
function IsGenericArray : Boolean;
|
||||
function IsPacked : Boolean;
|
||||
procedure AddRange(Range: TPasExpr);
|
||||
procedure SetGenericTemplates(AList: TFPList); virtual;
|
||||
end;
|
||||
|
||||
{ TPasFileType }
|
||||
@ -1734,6 +1740,7 @@ const
|
||||
= ('cvar', 'external', 'public', 'export', 'class', 'static');
|
||||
|
||||
procedure ReleaseAndNil(var El: TPasElement {$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF}); overload;
|
||||
procedure ReleaseGenericTemplateTypes(var GenericTemplateTypes: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
|
||||
function GenericTemplateTypesAsString(List: TFPList): string;
|
||||
|
||||
{$IFDEF HasPTDumpStack}
|
||||
@ -1755,6 +1762,21 @@ begin
|
||||
El:=nil;
|
||||
end;
|
||||
|
||||
procedure ReleaseGenericTemplateTypes(var GenericTemplateTypes: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
|
||||
var
|
||||
i: Integer;
|
||||
El: TPasElement;
|
||||
begin
|
||||
if GenericTemplateTypes=nil then exit;
|
||||
for i := 0 to GenericTemplateTypes.Count - 1 do
|
||||
begin
|
||||
El:=TPasElement(GenericTemplateTypes[i]);
|
||||
El.Parent:=nil;
|
||||
El.Release{$IFDEF CheckPasTreeRefCount}(Id){$ENDIF};
|
||||
end;
|
||||
FreeAndNil(GenericTemplateTypes);
|
||||
end;
|
||||
|
||||
function GenericTemplateTypesAsString(List: TFPList): string;
|
||||
var
|
||||
i, j: Integer;
|
||||
@ -3056,11 +3078,28 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPasArrayType.ClearChildReferences(El: TPasElement; arg: pointer);
|
||||
begin
|
||||
El.ClearTypeReferences(Self);
|
||||
if arg=nil then ;
|
||||
end;
|
||||
|
||||
procedure TPasArrayType.SetParent(const AValue: TPasElement);
|
||||
begin
|
||||
if (AValue=nil) and (Parent<>nil) then
|
||||
begin
|
||||
// parent is cleared
|
||||
// -> clear all child references to this array (releasing loops)
|
||||
ForEachCall(@ClearChildReferences,nil);
|
||||
end;
|
||||
inherited SetParent(AValue);
|
||||
end;
|
||||
|
||||
destructor TPasArrayType.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
ReleaseGenericTemplateTypes(GenericTemplateTypes{$IFDEF CheckPasTreeRefCount},'TPasArrayType'{$ENDIF});
|
||||
for i:=0 to length(Ranges)-1 do
|
||||
Ranges[i].Release{$IFDEF CheckPasTreeRefCount}('TPasArrayType.Ranges'){$ENDIF};
|
||||
ReleaseAndNil(TPasElement(ElType){$IFDEF CheckPasTreeRefCount},'TPasArrayType.ElType'{$ENDIF});
|
||||
@ -3073,7 +3112,6 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
constructor TPasEnumType.Create(const AName: string; AParent: TPasElement);
|
||||
begin
|
||||
inherited Create(AName, AParent);
|
||||
@ -4032,29 +4070,39 @@ end;
|
||||
function TPasArrayType.GetDeclaration (full : boolean) : string;
|
||||
begin
|
||||
Result:='Array';
|
||||
if Full then
|
||||
begin
|
||||
if GenericTemplateTypes<>nil then
|
||||
Result:=Result+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Result
|
||||
else
|
||||
Result:=Result+' = '+Result;
|
||||
end;
|
||||
If (IndexRange<>'') then
|
||||
Result:=Result+'['+IndexRange+']';
|
||||
Result:=Result+' of ';
|
||||
If IsPacked then
|
||||
Result := 'packed '+Result; // 12/04/04 Dave - Added
|
||||
Result := 'packed '+Result; // 12/04/04 Dave - Added
|
||||
If Assigned(Eltype) then
|
||||
Result:=Result+ElType.Name
|
||||
else
|
||||
Result:=Result+'const';
|
||||
If Full Then
|
||||
Result:=FixTypeDecl(Result);
|
||||
end;
|
||||
|
||||
procedure TPasArrayType.ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited ForEachCall(aMethodCall, Arg);
|
||||
if GenericTemplateTypes<>nil then
|
||||
for i:=0 to GenericTemplateTypes.Count-1 do
|
||||
ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
|
||||
ForEachChildCall(aMethodCall,Arg,ElType,true);
|
||||
end;
|
||||
|
||||
function TPasArrayType.IsGenericArray: Boolean;
|
||||
begin
|
||||
Result:=ElType is TPasGenericTemplateType;
|
||||
Result:=GenericTemplateTypes<>nil;
|
||||
end;
|
||||
|
||||
function TPasArrayType.IsPacked: Boolean;
|
||||
@ -4071,6 +4119,22 @@ begin
|
||||
Ranges[i]:=Range;
|
||||
end;
|
||||
|
||||
procedure TPasArrayType.SetGenericTemplates(AList: TFPList);
|
||||
var
|
||||
I: Integer;
|
||||
El: TPasElement;
|
||||
begin
|
||||
if GenericTemplateTypes=nil then
|
||||
GenericTemplateTypes:=TFPList.Create;
|
||||
For I:=0 to AList.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(AList[i]);
|
||||
El.Parent:=Self;
|
||||
GenericTemplateTypes.Add(El);
|
||||
end;
|
||||
AList.Clear;
|
||||
end;
|
||||
|
||||
function TPasFileType.GetDeclaration (full : boolean) : string;
|
||||
begin
|
||||
Result:='File';
|
||||
@ -4198,13 +4262,8 @@ begin
|
||||
end;
|
||||
FreeAndNil(Members);
|
||||
|
||||
for i := 0 to GenericTemplateTypes.Count - 1 do
|
||||
begin
|
||||
El:=TPasElement(GenericTemplateTypes[i]);
|
||||
El.Parent:=nil;
|
||||
El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.GenericTemplateTypes'){$ENDIF};
|
||||
end;
|
||||
FreeAndNil(GenericTemplateTypes);
|
||||
ReleaseGenericTemplateTypes(GenericTemplateTypes
|
||||
{$IFDEF CheckPasTreeRefCount},'TPasMembersType.GenericTemplateTypes'{$ENDIF});
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -312,7 +312,7 @@ type
|
||||
Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif};SkipSourceInfo : Boolean = False);overload;
|
||||
function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
|
||||
procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement); virtual;
|
||||
procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
|
||||
procedure ParseRecordMembers(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
|
||||
procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
|
||||
function GetProcedureClass(ProcType : TProcType): TPTreeElement;
|
||||
procedure ParseClassFields(AType: TPasClassType; const AVisibility: TPasMemberVisibility; IsClassField : Boolean);
|
||||
@ -366,6 +366,7 @@ type
|
||||
function ParseExprOperand(AParent : TPasElement): TPasExpr;
|
||||
function ParseExpIdent(AParent : TPasElement): TPasExpr; deprecated 'use ParseExprOperand instead'; // since fpc 3.3.1
|
||||
procedure DoParseClassType(AType: TPasClassType);
|
||||
procedure DoParseArrayType(ArrType: TPasArrayType);
|
||||
function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
|
||||
function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
|
||||
function CheckPackMode: TPackMode;
|
||||
@ -1957,67 +1958,13 @@ function TPasParser.ParseArrayType(Parent: TPasElement;
|
||||
): TPasArrayType;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
ok: Boolean;
|
||||
RangeExpr: TPasExpr;
|
||||
|
||||
begin
|
||||
Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent, NamePos));
|
||||
ok:=false;
|
||||
try
|
||||
Result.PackMode:=PackMode;
|
||||
NextToken;
|
||||
S:='';
|
||||
case CurToken of
|
||||
tkSquaredBraceOpen:
|
||||
begin
|
||||
// static array
|
||||
if Parent is TPasArgument then
|
||||
ParseExcTokenError('of');
|
||||
repeat
|
||||
NextToken;
|
||||
if po_arrayrangeexpr in Options then
|
||||
begin
|
||||
RangeExpr:=DoParseExpression(Result);
|
||||
Result.AddRange(RangeExpr);
|
||||
end
|
||||
else if CurToken<>tkSquaredBraceClose then
|
||||
S:=S+CurTokenText;
|
||||
if CurToken=tkSquaredBraceClose then
|
||||
break
|
||||
else if CurToken=tkComma then
|
||||
continue
|
||||
else if po_arrayrangeexpr in Options then
|
||||
ParseExcTokenError(']');
|
||||
until false;
|
||||
Result.IndexRange:=S;
|
||||
ExpectToken(tkOf);
|
||||
Result.ElType := ParseType(Result,CurSourcePos);
|
||||
end;
|
||||
tkOf:
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkConst then
|
||||
// array of const
|
||||
begin
|
||||
if not (Parent is TPasArgument) then
|
||||
ParseExcExpectedIdentifier;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (CurToken=tkarray) and (Parent is TPasArgument) then
|
||||
ParseExcExpectedIdentifier;
|
||||
UngetToken;
|
||||
Result.ElType := ParseType(Result,CurSourcePos);
|
||||
end;
|
||||
end
|
||||
else
|
||||
ParseExc(nParserArrayTypeSyntaxError,SParserArrayTypeSyntaxError);
|
||||
end;
|
||||
// TPasProcedureType parsing has eaten the semicolon;
|
||||
// We know it was a local definition if the array def (result) is the parent
|
||||
if (Result.ElType is TPasProcedureType) and (Result.ElType.Parent=Result) then
|
||||
UnGetToken;
|
||||
DoParseArrayType(Result);
|
||||
Engine.FinishScope(stTypeDef,Result);
|
||||
ok:=true;
|
||||
finally
|
||||
@ -3669,7 +3616,7 @@ begin
|
||||
Declarations.Classes.Add(RecordEl);
|
||||
RecordEl.SetGenericTemplates(List);
|
||||
NextToken;
|
||||
ParseRecordFieldList(RecordEl,tkend,
|
||||
ParseRecordMembers(RecordEl,tkend,
|
||||
(msAdvancedRecords in Scanner.CurrentModeSwitches)
|
||||
and not (Declarations is TProcedureBody)
|
||||
and (RecordEl.Name<>''));
|
||||
@ -3678,18 +3625,12 @@ begin
|
||||
end;
|
||||
tkArray:
|
||||
begin
|
||||
if List.Count<>1 then
|
||||
ParseExc(nParserGenericArray1Element,sParserGenericArray1Element);
|
||||
ArrEl:=TPasArrayType(ParseArrayType(Declarations,NamePos,TypeName,pmNone));
|
||||
ArrEl := TPasArrayType(CreateElement(TPasArrayType, TypeName, Declarations, NamePos));
|
||||
Declarations.Declarations.Add(ArrEl);
|
||||
Declarations.Types.Add(ArrEl);
|
||||
ArrEl.SetGenericTemplates(List);
|
||||
DoParseArrayType(ArrEl);
|
||||
CheckHint(ArrEl,True);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
ParseExcTokenError('20190619145000');
|
||||
{$ENDIF}
|
||||
ArrEl.ElType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
|
||||
ArrEl.ElType:=TPasGenericTemplateType(List[0]);
|
||||
List.Clear;
|
||||
Engine.FinishScope(stTypeDef,ArrEl);
|
||||
end;
|
||||
else
|
||||
@ -6516,7 +6457,7 @@ begin
|
||||
NextToken;
|
||||
M:=TPasRecordType(CreateElement(TPasRecordType,'',V));
|
||||
V.Members:=M;
|
||||
ParseRecordFieldList(M,tkBraceClose,False);
|
||||
ParseRecordMembers(M,tkBraceClose,False);
|
||||
// Current token is closing ), so we eat that
|
||||
NextToken;
|
||||
// If there is a semicolon, we eat that too.
|
||||
@ -6564,7 +6505,7 @@ begin
|
||||
end;
|
||||
|
||||
// Starts on first token after Record or (. Ends on AEndToken
|
||||
procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType;
|
||||
procedure TPasParser.ParseRecordMembers(ARec: TPasRecordType;
|
||||
AEndToken: TToken; AllowMethods: Boolean);
|
||||
var
|
||||
isClass : Boolean;
|
||||
@ -6756,7 +6697,7 @@ begin
|
||||
try
|
||||
Result.PackMode:=PackMode;
|
||||
NextToken;
|
||||
ParseRecordFieldList(Result,tkEnd,
|
||||
ParseRecordMembers(Result,tkEnd,
|
||||
(msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
|
||||
Engine.FinishScope(stTypeDef,Result);
|
||||
ok:=true;
|
||||
@ -7172,6 +7113,65 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasParser.DoParseArrayType(ArrType: TPasArrayType);
|
||||
var
|
||||
S: String;
|
||||
RangeExpr: TPasExpr;
|
||||
begin
|
||||
NextToken;
|
||||
S:='';
|
||||
case CurToken of
|
||||
tkSquaredBraceOpen:
|
||||
begin
|
||||
// static array
|
||||
if ArrType.Parent is TPasArgument then
|
||||
ParseExcTokenError('of');
|
||||
repeat
|
||||
NextToken;
|
||||
if po_arrayrangeexpr in Options then
|
||||
begin
|
||||
RangeExpr:=DoParseExpression(ArrType);
|
||||
ArrType.AddRange(RangeExpr);
|
||||
end
|
||||
else if CurToken<>tkSquaredBraceClose then
|
||||
S:=S+CurTokenText;
|
||||
if CurToken=tkSquaredBraceClose then
|
||||
break
|
||||
else if CurToken=tkComma then
|
||||
continue
|
||||
else if po_arrayrangeexpr in Options then
|
||||
ParseExcTokenError(']');
|
||||
until false;
|
||||
ArrType.IndexRange:=S;
|
||||
ExpectToken(tkOf);
|
||||
ArrType.ElType := ParseType(ArrType,CurSourcePos);
|
||||
end;
|
||||
tkOf:
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkConst then
|
||||
// array of const
|
||||
begin
|
||||
if not (ArrType.Parent is TPasArgument) then
|
||||
ParseExcExpectedIdentifier;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (CurToken=tkarray) and (ArrType.Parent is TPasArgument) then
|
||||
ParseExcExpectedIdentifier;
|
||||
UngetToken;
|
||||
ArrType.ElType := ParseType(ArrType,CurSourcePos);
|
||||
end;
|
||||
end
|
||||
else
|
||||
ParseExc(nParserArrayTypeSyntaxError,SParserArrayTypeSyntaxError);
|
||||
end;
|
||||
// TPasProcedureType parsing has eaten the semicolon;
|
||||
// We know it was a local definition if the array def (ArrType) is the parent
|
||||
if (ArrType.ElType is TPasProcedureType) and (ArrType.ElType.Parent=ArrType) then
|
||||
UnGetToken;
|
||||
end;
|
||||
|
||||
function TPasParser.ParseClassDecl(Parent: TPasElement;
|
||||
const NamePos: TPasSourcePos; const AClassName: String;
|
||||
AObjKind: TPasObjKind; PackMode: TPackMode; GenericArgs: TFPList): TPasType;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user