paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 14:50:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: typed pointer, ^, @

Browse Source 
git-svn-id: trunk@38819 -
This commit is contained in:
Mattias Gaertner 2018-04-23 10:03:38 +00:00
parent 6a95122007
commit ec338c4787
3 changed files with 720 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -165,6 +165,8 @@ const
nDuplicateImplementsForIntf = 3103;
nImplPropMustHaveReadSpec = 3104;
nDoesNotImplementInterface = 3105;
nTypeCycleFound = 3106;
nTypeXIsNotYetCompletelyDefined = 3107;
// resourcestring patterns of messages
resourcestring
@ -262,6 +264,8 @@ resourcestring
sDuplicateImplementsForIntf = 'Duplicate implements for interface "%s" at %s';
sImplPropMustHaveReadSpec = 'Implements-property must have read specifier';
sDoesNotImplementInterface = '"%s" does not implement interface "%s"';
sTypeCycleFound = 'Type cycle found';
sTypeXIsNotYetCompletelyDefined = 'type "%s" is not yet completely defined';
type
{ TResolveData - base class for data stored in TPasElement.CustomData }

706
packages/fcl-passrc/src/pasresolver.pp
View File

File diff suppressed because it is too large Load Diff

178
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -729,6 +729,14 @@ type
Procedure TestPointer_TypecastFromMethodTypeFail;
Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer;
Procedure TestPointer_OverloadSignature;
Procedure TestPointerTyped;
Procedure TestPointerTypedForwardMissingFail;
Procedure TestPointerTyped_CycleFail;
Procedure TestPointerTyped_AssignMismatchFail;
Procedure TestPointerTyped_AddrAddrFail;
Procedure TestPointerTyped_RecordObjFPC;
Procedure TestPointerTyped_RecordDelphi;
Procedure TestPointerTyped_Arithmetic;
// resourcestrings
Procedure TestResourcestring;
@ -12741,6 +12749,176 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestPointerTyped;
begin
StartProgram(false);
Add([
'type',
' PBoolean = ^boolean;',
' PPInteger = ^PInteger;',
' PInteger = ^integer;',
' integer = longint;',
'var',
' i: integer;',
' p1: PInteger;',
' p2: ^Integer;',
' p3: ^PInteger;',
' a: array of integer;',
'begin',
' p1:=@i;',
' p1:=p2;',
' p2:=@i;',
' p3:=@p1;',
' p1:=@a[1];',
' p1^:=i;',
' i:=(@i)^;',
' i:=p1^;',
' i:=p2^;',
' i:=p3^^;',
' i:=PInteger(p3)^;',
' if p1=@i then ;',
' if @i=p1 then ;',
' if p1=p2 then ;',
' if p2=p1 then ;',
' if p2=@i then ;',
' if @i=p2 then ;',
' if p1=@a[2] then ;',
' if @a[3]=p1 then ;',
' if i=p1^ then ;',
' if p1^=i then ;',
' i:=p1[1];',
' i:=(@i)[1];',
' i:=p2[2];',
' i:=p3[3][4];',
'']);
ParseProgram;
end;
procedure TTestResolver.TestPointerTypedForwardMissingFail;
begin
StartProgram(false);
Add([
'type',
' PInteger = ^integer;',
'var',
' i: integer;',
' p1: PInteger;',
'begin',
'']);
CheckResolverException('identifier not found "integer"',nIdentifierNotFound);
end;
procedure TTestResolver.TestPointerTyped_CycleFail;
begin
StartProgram(false);
Add([
'type',
' PInteger = ^integer;',
' integer = PInteger;',
'var',
' i: integer;',
' p1: PInteger;',
'begin',
'']);
CheckResolverException(sTypeCycleFound,nTypeCycleFound);
end;
procedure TTestResolver.TestPointerTyped_AssignMismatchFail;
begin
StartProgram(false);
Add([
'type',
' PInt = ^longint;',
' PBool = ^boolean;',
'var',
' pi: Pint;',
' pb: PBool;',
'begin',
' pi:=pb;',
'']);
CheckResolverException('Incompatible types: got "PBool" expected "PInt"',nIncompatibleTypesGotExpected);
end;
procedure TTestResolver.TestPointerTyped_AddrAddrFail;
begin
StartProgram(false);
Add([
'type',
' PInt = ^longint;',
' PPInt = ^PInt;',
'var',
' i: longint;',
' p: PPint;',
'begin',
' p:=@(@i);',
'']);
CheckResolverException('illegal qualifier "@" in front of "Pointer"',nIllegalQualifierInFrontOf);
end;
procedure TTestResolver.TestPointerTyped_RecordObjFPC;
begin
StartProgram(false);
Add([
'type',
' PRec = ^TRec;',
' TRec = record x: longint; end;',
'var',
' r: TRec;',
' p: PRec;',
' i: longint;',
'begin',
' p:=@r;',
' i:=p^.x;',
' p^.x:=i;',
' if i=p^.x then;',
' if p^.x=i then;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestPointerTyped_RecordDelphi;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'type',
' PRec = ^TRec;',
' TRec = record x: longint; end;',
'var',
' r: TRec;',
' p: PRec;',
' i: longint;',
'begin',
' i:=p.x;',
' p.x:=i;',
' if i=p.x then;',
' if p.x=i then;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestPointerTyped_Arithmetic;
begin
StartProgram(false);
Add([
'type',
' PInt = ^longint;',
'var',
' i: longint;',
' p: PInt;',
'begin',
' inc(p);',
' inc(p,2);',
' p:=p+3;',
' p:=4+p;',
' p:=@i+5;',
' p:=6+@i;',
' i:=(p+7)^;',
' i:=(@i+8)^;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestResourcestring;
begin
StartProgram(false);