mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 07:09:29 +02:00
* Patch from Mattias Gaertner
- assigned(array) - open array: override, pass array literal, pass var - reporting type mismatches shows full path if necessary - fixed comparing basetype from different units - types with unitname git-svn-id: trunk@35681 -
This commit is contained in:
michael
parent
bfd78af212
commit
0653c7045e
File diff suppressed because it is too large
Load Diff
@ -162,12 +162,15 @@ type
|
||||
Procedure TestAlias2Type;
|
||||
Procedure TestAliasTypeRefs;
|
||||
Procedure TestAliasOfVarFail;
|
||||
Procedure TestAliasType_UnitPrefix;
|
||||
Procedure TestAliasType_UnitPrefix_CycleFail;
|
||||
Procedure TestTypeAliasType; // ToDo
|
||||
|
||||
// var, const
|
||||
Procedure TestVarLongint;
|
||||
Procedure TestVarInteger;
|
||||
Procedure TestConstInteger;
|
||||
Procedure TestConstInteger2;
|
||||
Procedure TestDuplicateVar;
|
||||
Procedure TestVarInitConst;
|
||||
Procedure TestVarOfVarFail;
|
||||
@ -196,6 +199,7 @@ type
|
||||
// enums
|
||||
Procedure TestEnums;
|
||||
Procedure TestSets;
|
||||
Procedure TestSetConstRange;
|
||||
Procedure TestSetOperators;
|
||||
Procedure TestEnumParams;
|
||||
Procedure TestSetParams;
|
||||
@ -230,6 +234,7 @@ type
|
||||
Procedure TestTypeCastBooleanToDoubleFail;
|
||||
Procedure TestHighLow;
|
||||
Procedure TestAssign_Access;
|
||||
Procedure TestAssignedIntFail;
|
||||
|
||||
// statements
|
||||
Procedure TestForLoop;
|
||||
@ -268,6 +273,7 @@ type
|
||||
Procedure TestProcOverloadWithClassTypes;
|
||||
Procedure TestProcOverloadWithInhClassTypes;
|
||||
Procedure TestProcOverloadWithInhAliasClassTypes;
|
||||
Procedure TestProcOverloadBaseTypeOtherUnit;
|
||||
Procedure TestProcDuplicate;
|
||||
Procedure TestNestedProc;
|
||||
Procedure TestForwardProc;
|
||||
@ -281,6 +287,7 @@ type
|
||||
Procedure TestUnitIntfMismatchArgName;
|
||||
Procedure TestProcOverloadIsNotFunc;
|
||||
Procedure TestProcCallMissingParams;
|
||||
Procedure TestProcArgDefaultValue;
|
||||
Procedure TestProcArgDefaultValueTypeMismatch;
|
||||
Procedure TestProcPassConstToVar;
|
||||
Procedure TestBuiltInProcCallMissingParams;
|
||||
@ -311,7 +318,8 @@ type
|
||||
Procedure TestClass_Method;
|
||||
Procedure TestClass_MethodWithoutClassFail;
|
||||
Procedure TestClass_MethodWithParams;
|
||||
Procedure TestClass_MethodUnresolved;
|
||||
Procedure TestClass_MethodUnresolvedPrg;
|
||||
Procedure TestClass_MethodUnresolvedUnit;
|
||||
Procedure TestClass_MethodAbstract;
|
||||
Procedure TestClass_MethodAbstractWithoutVirtualFail;
|
||||
Procedure TestClass_MethodAbstractHasBodyFail;
|
||||
@ -443,7 +451,8 @@ type
|
||||
Procedure TestStaticArray;
|
||||
Procedure TestArrayOfArray;
|
||||
Procedure TestFunctionReturningArray;
|
||||
Procedure TestLowHighArray;
|
||||
Procedure TestArray_LowHigh;
|
||||
Procedure TestArray_Assigned;
|
||||
Procedure TestPropertyOfTypeArray;
|
||||
Procedure TestArrayElementFromFuncResult_AsParams;
|
||||
Procedure TestArrayEnumTypeRange;
|
||||
@ -457,6 +466,7 @@ type
|
||||
Procedure TestArray_PassArrayElementToVarParam;
|
||||
Procedure TestArray_OpenArrayOfString;
|
||||
Procedure TestArray_OpenArrayOfString_IntFail;
|
||||
Procedure TestArray_OpenArrayOverride;
|
||||
|
||||
// procedure types
|
||||
Procedure TestProcTypesAssignObjFPC;
|
||||
@ -476,6 +486,7 @@ type
|
||||
Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail1;
|
||||
Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail2;
|
||||
Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail3;
|
||||
Procedure TestProcType_WhileListCompare;
|
||||
end;
|
||||
|
||||
function LinesToStr(Args: array of const): string;
|
||||
@ -1736,6 +1747,30 @@ begin
|
||||
CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAliasType_UnitPrefix;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add('interface');
|
||||
Add('type');
|
||||
Add(' {#a}a=longint;');
|
||||
Add(' {#b}{=a}b=afile.a;');
|
||||
Add('var');
|
||||
Add(' {=a}c: a;');
|
||||
Add(' {=b}d: b;');
|
||||
Add('implementation');
|
||||
ParseUnit;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAliasType_UnitPrefix_CycleFail;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add('interface');
|
||||
Add('type');
|
||||
Add(' {#a}a=afile.a;');
|
||||
Add('implementation');
|
||||
CheckResolverException('identifier not found "a"',nIdentifierNotFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestTypeAliasType;
|
||||
begin
|
||||
// ToDo
|
||||
@ -1809,7 +1844,7 @@ var
|
||||
begin
|
||||
StartProgram(true);
|
||||
Add('const');
|
||||
Add(' c1:integer=3;'); // defined in system.pp
|
||||
Add(' c1: integer=3;'); // defined in system.pp
|
||||
Add('begin');
|
||||
ParseProgram;
|
||||
AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
|
||||
@ -1828,6 +1863,15 @@ begin
|
||||
AssertEquals('c1 expr value','3',ExprC1.Value);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstInteger2;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('const');
|
||||
Add(' c1 = 3');
|
||||
Add(' c2: longint=c1;'); // defined in system.pp
|
||||
Add('begin');
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestDuplicateVar;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -2163,6 +2207,16 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestSetConstRange;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('const');
|
||||
Add(' MinInt = -1;');
|
||||
Add(' MaxInt = +1;');
|
||||
Add(' {#TMyInt}TMyInt = MinInt..MaxInt;');
|
||||
Add('begin');
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestSetOperators;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -2862,6 +2916,16 @@ begin
|
||||
CheckAccessMarkers;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAssignedIntFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('var i: longint;');
|
||||
Add('begin');
|
||||
Add(' if Assigned(i) then ;');
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "class or array"',
|
||||
nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestForLoop;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -3343,7 +3407,9 @@ end;
|
||||
procedure TTestResolver.TestProcParam;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure Proc1(a: longint);');
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
Add('procedure Proc1(a: integer);');
|
||||
Add('begin');
|
||||
Add(' a:=3;');
|
||||
Add('end;');
|
||||
@ -3354,8 +3420,10 @@ end;
|
||||
procedure TTestResolver.TestProcParamAccess;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure DoIt(vI: longint; const vJ: longint; var vK: longint);');
|
||||
Add('var vL: longint;');
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
Add('procedure DoIt(vI: integer; const vJ: integer; var vK: integer);');
|
||||
Add('var vL: integer;');
|
||||
Add('begin');
|
||||
Add(' vi:=vi+1;');
|
||||
Add(' vl:=vj+1;');
|
||||
@ -3366,7 +3434,7 @@ begin
|
||||
Add(' DoIt(vk,vk,vk);');
|
||||
Add(' DoIt(vl,vl,vl);');
|
||||
Add('end;');
|
||||
Add('var i: longint;');
|
||||
Add('var i: integer;');
|
||||
Add('begin');
|
||||
Add(' DoIt(i,i,i);');
|
||||
ParseProgram;
|
||||
@ -3495,6 +3563,29 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcOverloadBaseTypeOtherUnit;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pp',
|
||||
LinesToStr([
|
||||
'procedure Val(var d: double);',
|
||||
//'procedure Val(var i: integer);',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'procedure Val(var d: double); begin end;',
|
||||
'procedure Val(var i: integer); begin end;',
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add('uses unit2;');
|
||||
Add('var');
|
||||
Add(' d: double;');
|
||||
Add(' i: integer;');
|
||||
Add('begin');
|
||||
//Add(' Val(i);');
|
||||
Add(' Val(d);');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcDuplicate;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -3674,6 +3765,17 @@ begin
|
||||
PasResolver.nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcArgDefaultValue;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('const {#DefA}DefA = 3;');
|
||||
Add('procedure Proc1(a: longint = {@DefA}DefA);');
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcArgDefaultValueTypeMismatch;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -4177,7 +4279,7 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_MethodUnresolved;
|
||||
procedure TTestResolver.TestClass_MethodUnresolvedPrg;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -4190,6 +4292,20 @@ begin
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_MethodUnresolvedUnit;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add('interface');
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' end;');
|
||||
Add(' TClassA = class');
|
||||
Add(' procedure ProcA;');
|
||||
Add(' end;');
|
||||
Add('implementation');
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_MethodAbstract;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -6214,7 +6330,8 @@ begin
|
||||
Add(' property B: longint read FB;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Longint expected, but String found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('Incompatible types: got "Longint" expected "String"',
|
||||
PasResolver.nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyReadAccessorProcNotFunc;
|
||||
@ -6280,7 +6397,8 @@ begin
|
||||
Add(' property B: longint write FB;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Longint expected, but String found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('Incompatible types: got "Longint" expected "String"',
|
||||
PasResolver.nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyWriteAccessorFuncNotProc;
|
||||
@ -6851,7 +6969,7 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestLowHighArray;
|
||||
procedure TTestResolver.TestArray_LowHigh;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -6866,6 +6984,15 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArray_Assigned;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('var a: array of longint;');
|
||||
Add('begin');
|
||||
Add(' if Assigned(a) then ;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyOfTypeArray;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -7101,6 +7228,28 @@ begin
|
||||
CheckResolverException('Incompatible types: got "Longint" expected "String"',nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArray_OpenArrayOverride;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' end;');
|
||||
Add(' Exception = class');
|
||||
Add(' constructor CreateFmt(const Msg: string; const Args: array of string); virtual;');
|
||||
Add(' end;');
|
||||
Add(' ESome = class(Exception)');
|
||||
Add(' constructor CreateFmt(const Msg: string; const Args: array of string); override;');
|
||||
Add(' end;');
|
||||
Add('constructor Exception.CreateFmt(const Msg: string; const Args: array of string);');
|
||||
Add('begin end;');
|
||||
Add('constructor ESome.CreateFmt(const Msg: string; const Args: array of string);');
|
||||
Add('begin');
|
||||
Add(' inherited CreateFmt(Msg,Args);');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcTypesAssignObjFPC;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -7599,6 +7748,21 @@ begin
|
||||
nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcType_WhileListCompare;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
Add(' TArrInt = array of Integer;');
|
||||
Add(' TListCompare = function(Item1, Item2: Integer): integer;');
|
||||
Add('procedure Sort(P: Integer; const List: TArrInt; const Compare: TListCompare);');
|
||||
Add('begin');
|
||||
Add(' while Compare(P,List[0])>0 do ;');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTests([TTestResolver]);
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user