Browse Source

* Implement missing tests

Michaël Van Canneyt 1 year ago
parent
commit
a7b449da8b

+ 34 - 6
packages/fcl-passrc/tests/tcclasstype.pas

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

+ 13 - 16
packages/fcl-passrc/tests/tcprocfunc.pas

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

+ 2 - 2
packages/fcl-passrc/tests/tcscanner.pas

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