* Implement missing tests

This commit is contained in:
Michaël Van Canneyt 2023-11-17 16:23:34 +01:00
parent 5b1574bd63
commit a7b449da8b
3 changed files with 49 additions and 24 deletions

View File

@ -29,6 +29,7 @@ type
function GetP1: TPasProperty; function GetP1: TPasProperty;
function GetP2: TPasProperty; function GetP2: TPasProperty;
function GetT(AIndex : Integer) : TPasType; function GetT(AIndex : Integer) : TPasType;
procedure TestExternalClassFunctionFinal;
protected protected
Procedure StartClass (AncestorName : String = 'TObject'; InterfaceList : String = ''; aClassType : TClassDeclType = cdtClass); Procedure StartClass (AncestorName : String = 'TObject'; InterfaceList : String = ''; aClassType : TClassDeclType = cdtClass);
Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String ); Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String );
@ -595,6 +596,7 @@ Procedure TTestClassType.TestForwardExternalObjCClass;
begin begin
FStarted:=True; FStarted:=True;
FEnded:=True; FEnded:=True;
Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msObjectiveC1];
FDecl.Add('TMyClass = ObjcClass external'); FDecl.Add('TMyClass = ObjcClass external');
ParseClass; ParseClass;
end; end;
@ -2311,22 +2313,48 @@ end;
procedure TTestClassType.TestExternalClassFinalVar; procedure TTestClassType.TestExternalClassFinalVar;
begin begin
// final var Xyz : Integer; Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
Fail ('To be implemented'); FStarted:=True;
FDecl.add('TMyClass = Class external name ''me'' ');
FDecl.add('final var X : integer');
ParseClass;
AssertNotNull('Have 1 field',Field1);
AssertMemberName('X');
AssertVisibility;
end; end;
Procedure TTestClassType.TestExternalClassFunctionFinal;
begin
Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
FStarted:=True;
FDecl.add('TMyClass = Class external name ''me'' ');
FDecl.add('function Something : Someresult; final');
ParseClass;
AssertNotNull('Have 1 field',Field1);
AssertMemberName('Something');
AssertVisibility;
end;
procedure TTestClassType.TestEscapedVisibilityVar; procedure TTestClassType.TestEscapedVisibilityVar;
begin begin
// &Public : Integer; AddMember('&public : integer');
Fail('To be implemented'); ParseClass;
AssertNotNull('Have 1 field',Field1);
AssertMemberName('public');
AssertVisibility;
end; end;
procedure TTestClassType.TestEscapedAbsoluteVar; procedure TTestClassType.TestEscapedAbsoluteVar;
begin begin
// var absolute : integer; AddMember('&absolute : integer');
Fail('To be implemented.'); ParseClass;
AssertNotNull('Have 1 field',Field1);
AssertMemberName('absolute');
AssertVisibility;
end; end;
initialization initialization

View File

@ -187,7 +187,6 @@ type
procedure TestOperatorNames; procedure TestOperatorNames;
Procedure TestAssignOperatorAfterObject; Procedure TestAssignOperatorAfterObject;
Procedure TestFunctionNoResult; Procedure TestFunctionNoResult;
Procedure TestExternalFunctionFinal;
Procedure TestFunctionSyscallSingleNumber; Procedure TestFunctionSyscallSingleNumber;
Procedure TestFunctionSyscallDoubleNumber; Procedure TestFunctionSyscallDoubleNumber;
Procedure TestFunctionSysCallSysTrapIdentifier; Procedure TestFunctionSysCallSysTrapIdentifier;
@ -869,19 +868,19 @@ end;
procedure TTestProcedureFunction.TestCallingConventionSysCallExecbase; procedure TTestProcedureFunction.TestCallingConventionSysCallExecbase;
begin begin
ParseProcedure('; syscall _execBase 123'); ParseProcedure('; syscall _execBase 123');
AssertProc([],[],ccSysCall,0); AssertProc([pmExternal],[],ccSysCall,0);
end; end;
procedure TTestProcedureFunction.TestCallingConventionSysCallUtilitybase; procedure TTestProcedureFunction.TestCallingConventionSysCallUtilitybase;
begin begin
ParseProcedure('; syscall _utilityBase 123'); ParseProcedure('; syscall _utilityBase 123');
AssertProc([],[],ccSysCall,0); AssertProc([pmExternal],[],ccSysCall,0);
end; end;
procedure TTestProcedureFunction.TestCallingConventionSysCallConsoleDevice; procedure TTestProcedureFunction.TestCallingConventionSysCallConsoleDevice;
begin begin
ParseProcedure('; syscall ConsoleDevice 123'); ParseProcedure('; syscall ConsoleDevice 123');
AssertProc([],[],ccSysCall,0); AssertProc([pmExternal],[],ccSysCall,0);
end; end;
procedure TTestProcedureFunction.TestFunctionDiscardResult; procedure TTestProcedureFunction.TestFunctionDiscardResult;
@ -1491,20 +1490,13 @@ begin
end; end;
Procedure TTestProcedureFunction.TestExternalFunctionFinal;
begin
// class external 'XYZ' name 'ABC'
// function Something : Someresult; final;
// end;
Fail('To be implemented');
end;
Procedure TTestProcedureFunction.TestFunctionSyscallSingleNumber; Procedure TTestProcedureFunction.TestFunctionSyscallSingleNumber;
begin begin
// function Something : Someresult; syscall 12 // function Something : Someresult; syscall 12
Fail('To be implemented'); AddDeclaration('function A : Integer; syscall 12');
ParseFunction;
AssertFunc([pmExternal],[],ccSysCall,0);
end; end;
@ -1512,7 +1504,9 @@ Procedure TTestProcedureFunction.TestFunctionSyscallDoubleNumber;
begin begin
// function Something : Someresult; syscall 12 13 // function Something : Someresult; syscall 12 13
Fail('To be implemented'); AddDeclaration('function A : Integer; syscall 12 13');
ParseFunction;
AssertFunc([pmExternal],[],ccSysCall,0);
end; end;
@ -1520,7 +1514,10 @@ Procedure TTestProcedureFunction.TestFunctionSysCallSysTrapIdentifier;
begin begin
// function Something : Someresult; syscall systrapNNN // function Something : Someresult; syscall systrapNNN
Fail('To be implemented'); // Fail('To be implemented');
AddDeclaration('function A : Integer; syscall systrap12');
ParseFunction;
AssertFunc([pmExternal],[],ccSysCall,0);
end; end;

View File

@ -1325,13 +1325,13 @@ end;
procedure TTestScanner.TestAsmComments; procedure TTestScanner.TestAsmComments;
begin begin
Fail('To be implemented'); TestTokens([tkAsm,tkWhitespace,tkComment,tkLineEnding,tkEnd],'asm { something '+sLinebreak+' in comment }'+sLineBreak+'end');
end; end;
procedure TTestScanner.TestAsmConditionals; procedure TTestScanner.TestAsmConditionals;
begin begin
Fail('To be implemented'); TestTokens([tkAsm,tkWhitespace,tkComment,tkLineEnding,tkEnd],'asm {$IFDEF SOMETHING}{ something '+sLinebreak+' in comment }{$ENDIF}'+sLineBreak+'end');
end; end;