mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 21:29:26 +02:00
fcl-passrc: resolver: type alias type
git-svn-id: trunk@38851 -
This commit is contained in:
Mattias Gaertner
parent
16e0172021
commit
20199d3903
File diff suppressed because it is too large
Load Diff
@ -826,7 +826,7 @@ begin
|
||||
begin
|
||||
Member:=TPasArrayType(El).Ranges[i];
|
||||
Resolver.ComputeElement(Member,MemberResolved,[rcConstant]);
|
||||
UseSubEl(MemberResolved.TypeEl);
|
||||
UseSubEl(MemberResolved.HiTypeEl);
|
||||
end;
|
||||
end
|
||||
else if C=TPasPointerType then
|
||||
@ -1315,7 +1315,7 @@ begin
|
||||
pekArrayParams:
|
||||
begin
|
||||
Resolver.ComputeElement(Params.Value,ValueResolved,[]);
|
||||
if not Resolver.IsDynArray(ValueResolved.TypeEl) then
|
||||
if not Resolver.IsDynArray(ValueResolved.LoTypeEl) then
|
||||
UseExprRef(El,Params.Value,Access,UseFull);
|
||||
end;
|
||||
pekSet: ;
|
||||
|
||||
@ -192,6 +192,7 @@ type
|
||||
UseParentAsResultParent: Boolean; const ASrcPos: TPasSourcePos): TPasFunctionType;
|
||||
function FindElement(const AName: String): TPasElement; virtual; abstract;
|
||||
procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
|
||||
procedure FinishTypeAlias(var aType: TPasType); virtual;
|
||||
function FindModule(const AName: String): TPasModule; virtual;
|
||||
function FindModule(const AName: String; NameExpr, InFileExpr: TPasExpr): TPasModule; virtual;
|
||||
function CheckPendingUsedInterface(Section: TPasSection): boolean; virtual; // true if changed
|
||||
@ -376,7 +377,7 @@ type
|
||||
function ParseProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; const PT: TProcType): TPasProcedureType;
|
||||
function ParseStringType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasAliasType;
|
||||
function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
|
||||
function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasTypeAliasType;
|
||||
function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasType;
|
||||
function ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; out Expr: TPasExpr): TPasType;
|
||||
function ParsePointerType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasPointerType;
|
||||
Function ParseArrayType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String; PackMode : TPackMode) : TPasArrayType;
|
||||
@ -765,6 +766,11 @@ begin
|
||||
El.SourceEndLinenumber := CurrentParser.CurSourcePos.Row;
|
||||
end;
|
||||
|
||||
procedure TPasTreeContainer.FinishTypeAlias(var aType: TPasType);
|
||||
begin
|
||||
if aType=nil then ;
|
||||
end;
|
||||
|
||||
function TPasTreeContainer.FindModule(const AName: String): TPasModule;
|
||||
begin
|
||||
if AName='' then ; // avoid compiler warning
|
||||
@ -1435,14 +1441,15 @@ end;
|
||||
|
||||
// On entry, we're on the TYPE token
|
||||
function TPasParser.ParseAliasType(Parent: TPasElement;
|
||||
const NamePos: TPasSourcePos; const TypeName: String): TPasTypeAliasType;
|
||||
const NamePos: TPasSourcePos; const TypeName: String): TPasType;
|
||||
var
|
||||
ok: Boolean;
|
||||
begin
|
||||
Result := TPasTypeAliasType(CreateElement(TPasTypeAliasType, TypeName, Parent, NamePos));
|
||||
ok:=false;
|
||||
try
|
||||
Result.DestType := ParseType(Result,NamePos,'');
|
||||
TPasTypeAliasType(Result).DestType := ParseType(Result,NamePos,'');
|
||||
Engine.FinishTypeAlias(Result);
|
||||
Engine.FinishScope(stTypeDef,Result);
|
||||
ok:=true;
|
||||
finally
|
||||
@ -1594,8 +1601,8 @@ Const
|
||||
// Parsing of these types already takes care of hints
|
||||
NoHintTokens = [tkProcedure,tkFunction];
|
||||
var
|
||||
PM : TPackMode;
|
||||
CH , isHelper,ok: Boolean; // Check hint ?
|
||||
PM: TPackMode;
|
||||
CH, isHelper, ok: Boolean;
|
||||
begin
|
||||
Result := nil;
|
||||
// NextToken and check pack mode
|
||||
@ -2263,8 +2270,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasParser.DoParseExpression(AParent: TPasElement; InitExpr: TPasExpr;
|
||||
AllowEqual : Boolean = True): TPasExpr;
|
||||
function TPasParser.DoParseExpression(AParent: TPaselement; InitExpr: TPasExpr;
|
||||
AllowEqual: Boolean): TPasExpr;
|
||||
type
|
||||
TOpStackItem = record
|
||||
Token: TToken;
|
||||
|
||||
@ -184,7 +184,7 @@ type
|
||||
Procedure TestAliasType_UnitPrefix;
|
||||
Procedure TestAliasType_UnitPrefix_CycleFail;
|
||||
Procedure TestAliasTypeNotFoundPosition;
|
||||
Procedure TestTypeAliasType; // ToDo
|
||||
Procedure TestTypeAliasType;
|
||||
|
||||
// vars, const
|
||||
Procedure TestVarLongint;
|
||||
@ -361,6 +361,7 @@ type
|
||||
Procedure TestProcParamAccess;
|
||||
Procedure TestFunctionResult;
|
||||
Procedure TestProcedureResultFail;
|
||||
Procedure TestProc_ArgVarTypeAlias;
|
||||
Procedure TestProcOverload;
|
||||
Procedure TestProcOverloadImplDuplicateFail;
|
||||
Procedure TestProcOverloadImplDuplicate2Fail;
|
||||
@ -371,6 +372,8 @@ type
|
||||
Procedure TestProcCallLowPrecision;
|
||||
Procedure TestProcOverloadUntyped;
|
||||
Procedure TestProcOverloadMultiLowPrecisionFail;
|
||||
Procedure TestProcOverload_TypeAlias;
|
||||
Procedure TestProcOverload_TypeAliasLiteralFail;
|
||||
Procedure TestProcOverloadWithClassTypes;
|
||||
Procedure TestProcOverloadWithInhClassTypes;
|
||||
Procedure TestProcOverloadWithInhAliasClassTypes;
|
||||
@ -524,6 +527,7 @@ type
|
||||
Procedure TestClass_Enumerator;
|
||||
Procedure TestClass_EnumeratorFunc;
|
||||
Procedure TestClass_ForInPropertyStaticArray;
|
||||
Procedure TestClass_TypeAlias;
|
||||
// Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
|
||||
|
||||
// published
|
||||
@ -2298,20 +2302,21 @@ end;
|
||||
|
||||
procedure TTestResolver.TestTypeAliasType;
|
||||
begin
|
||||
// ToDo
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' {#integer}integer = longint;');
|
||||
Add(' {#tcolor}TColor = type integer;');
|
||||
Add('var');
|
||||
Add(' {=integer}i: integer;');
|
||||
Add(' {=tcolor}c: TColor;');
|
||||
Add('begin');
|
||||
Add(' c:=i;');
|
||||
Add(' i:=c;');
|
||||
Add(' i:=integer(c);');
|
||||
Add(' c:=TColor(i);');
|
||||
// ParseProgram;
|
||||
Add([
|
||||
'type',
|
||||
' {#integer}integer = longint;',
|
||||
' {#tcolor}TColor = type integer;',
|
||||
'var',
|
||||
' {=integer}i: integer;',
|
||||
' {=tcolor}c: TColor;',
|
||||
'begin',
|
||||
' c:=i;',
|
||||
' i:=c;',
|
||||
' i:=integer(c);',
|
||||
' c:=TColor(i);',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestVarLongint;
|
||||
@ -5365,6 +5370,7 @@ begin
|
||||
Add('var i: integer;');
|
||||
Add('begin');
|
||||
Add(' DoIt(i,i,i);');
|
||||
Add(' DoIt(1,1,i);');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
@ -5389,6 +5395,26 @@ begin
|
||||
nParserExpectTokenError);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProc_ArgVarTypeAlias;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TColor = type longint;',
|
||||
'procedure DoColor(var c: TColor); external;',
|
||||
'procedure DoInt(var i: longint); external;',
|
||||
'var',
|
||||
' i: longint;',
|
||||
' c: TColor;',
|
||||
'begin',
|
||||
' DoColor(c);',
|
||||
' DoColor(i);',
|
||||
' DoInt(i);',
|
||||
' DoInt(c);',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcOverload;
|
||||
var
|
||||
El: TPasElement;
|
||||
@ -5569,6 +5595,44 @@ begin
|
||||
nCantDetermineWhichOverloadedFunctionToCall);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcOverload_TypeAlias;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TValue = type longint;',
|
||||
' TAliasValue = TValue;',
|
||||
' TColor = type TAliasValue;',
|
||||
' TAliasColor = TColor;',
|
||||
'procedure DoIt(i: TAliasValue); external;',
|
||||
'procedure DoIt(i: TAliasColor); external;',
|
||||
'var',
|
||||
' v: TAliasValue;',
|
||||
' c: TAliasColor;',
|
||||
'begin',
|
||||
' DoIt(v);',
|
||||
' DoIt(c);',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcOverload_TypeAliasLiteralFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' integer = longint;',
|
||||
' TValue = type longint;',
|
||||
' TAliasValue = TValue;',
|
||||
'procedure DoIt(i: integer); external;',
|
||||
'procedure DoIt(i: TAliasValue); external;',
|
||||
'begin',
|
||||
' DoIt(1);',
|
||||
'']);
|
||||
CheckResolverException('Can''t determine which overloaded function to call, afile.pp(7,15), afile.pp(6,15)',
|
||||
nCantDetermineWhichOverloadedFunctionToCall);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcOverloadWithClassTypes;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -8891,6 +8955,23 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_TypeAlias;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' end;',
|
||||
' TBird = type TObject;',
|
||||
'var',
|
||||
' o: TObject;',
|
||||
' b: TBird;',
|
||||
'begin',
|
||||
' o:=b;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_PublishedClassVarFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user