mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-26 16:33:45 +01:00 
			
		
		
		
	+ Added tests for mode macpas
This commit is contained in:
		
							parent
							
								
									1e050cf077
								
							
						
					
					
						commit
						403043058c
					
				
							
								
								
									
										65
									
								
								tests/test/tmacpas1.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										65
									
								
								tests/test/tmacpas1.pp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,65 @@ | |||||||
|  | program tmacpas1; | ||||||
|  | 
 | ||||||
|  | {Tests of mac pascal constructs, concerning two units} | ||||||
|  | 
 | ||||||
|  | {$MODE MACPAS} | ||||||
|  | 
 | ||||||
|  | uses | ||||||
|  |   umacpas1; | ||||||
|  | 
 | ||||||
|  | {** Test exportable macros **} | ||||||
|  | 
 | ||||||
|  | {$IFC UNDEFINED UMACPAS_COMP_VAR } | ||||||
|  | {$NOTE In using unit: UMACPAS_COMP_VAR is undefined} | ||||||
|  | {$ERRORC UMACPAS_COMP_VAR should be defined} | ||||||
|  | {$ELSEC} | ||||||
|  | {$IFC UMACPAS_COMP_VAR } | ||||||
|  | {$NOTE In using unit: UMACPAS_COMP_VAR is true} | ||||||
|  | {$ELSEC} | ||||||
|  | {$NOTE In using unit: UMACPAS_COMP_VAR is false} | ||||||
|  | {$ERRORC UMACPAS_COMP_VAR should be true} | ||||||
|  | {$ENDC} | ||||||
|  | {$ENDC} | ||||||
|  | 
 | ||||||
|  | {$IFC UNDEFINED UMACPAS_PRE_IMPL_COMP_VAR } | ||||||
|  | {$ERRORC UMACPAS_PRE_IMPL_COMP_VAR is not defined} | ||||||
|  | {$ENDC} | ||||||
|  | 
 | ||||||
|  | {$IFC UNDEFINED UMACPAS_PRE_IMPL_COMP_VAR } | ||||||
|  | {$ERRORC UMACPAS_PRE_IMPL_COMP_VAR is defined, while it shoud not} | ||||||
|  | {$ENDC} | ||||||
|  | 
 | ||||||
|  | {** Test Push/Pop **} | ||||||
|  | 
 | ||||||
|  | {$J-} | ||||||
|  | 
 | ||||||
|  | {$PUSH} | ||||||
|  | {$PUSH} | ||||||
|  | 
 | ||||||
|  | {$J+} | ||||||
|  | 
 | ||||||
|  | {$POP} | ||||||
|  | {$POP} | ||||||
|  | 
 | ||||||
|  | {$IFC OPTION(J)} | ||||||
|  | {$ERRORC $PUSH/$POP doesnt work properly} | ||||||
|  | {$ENDC} | ||||||
|  | 
 | ||||||
|  | {** Test J directive for var and external for proc **} | ||||||
|  | 
 | ||||||
|  | {$J+} | ||||||
|  | var | ||||||
|  |   nisse: Integer; {Is available in Umacpas} | ||||||
|  | {$J-} | ||||||
|  | 
 | ||||||
|  | function Get84: Integer; | ||||||
|  | external; | ||||||
|  | 
 | ||||||
|  | begin | ||||||
|  |   Writeln(nisse); | ||||||
|  |   Writeln(Get84); | ||||||
|  |   if nisse <> 42 then | ||||||
|  |     halt(1); | ||||||
|  |   if Get84 <> 84 then | ||||||
|  |     halt(1); | ||||||
|  | end. | ||||||
							
								
								
									
										59
									
								
								tests/test/tmacpas2.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										59
									
								
								tests/test/tmacpas2.pp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,59 @@ | |||||||
|  | {$MODE MACPAS} | ||||||
|  | 
 | ||||||
|  | {Tests of mac pascal constructs} | ||||||
|  | 
 | ||||||
|  | program tmacpas2; | ||||||
|  | 
 | ||||||
|  | var | ||||||
|  |   success: Boolean = true; | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | procedure Proc; | ||||||
|  | 
 | ||||||
|  | begin | ||||||
|  |   {** Exit with proc name as argument **} | ||||||
|  |   Exit(Proc); | ||||||
|  | end; | ||||||
|  | 
 | ||||||
|  | const | ||||||
|  |   a = true; | ||||||
|  |   b = true; | ||||||
|  |   c = false; | ||||||
|  | 
 | ||||||
|  | var | ||||||
|  |   p: pointer; | ||||||
|  |   l,i: longint; | ||||||
|  | 
 | ||||||
|  | begin | ||||||
|  |   {** Test & and | as alias for AND and OR **} | ||||||
|  |   if not (a & b) then | ||||||
|  |     success:= false; | ||||||
|  |   if not (c | b) then | ||||||
|  |     success:= false; | ||||||
|  | 
 | ||||||
|  |   {** Test that Ord() can take pointer values **} | ||||||
|  |   p:= pointer(4711); | ||||||
|  |   l:= Ord(p); | ||||||
|  |   if l <> 4711 then | ||||||
|  |     success:= false; | ||||||
|  | 
 | ||||||
|  |   i:= 0; | ||||||
|  |   while true do | ||||||
|  |     begin | ||||||
|  |       i:= i+1; | ||||||
|  |       if i = 1 then | ||||||
|  |         Cycle; | ||||||
|  |       Leave; | ||||||
|  |     end; | ||||||
|  |   if i<> 2 then | ||||||
|  |     success:= false; | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  |   if success then | ||||||
|  |     Writeln('Whole test succeded') | ||||||
|  |   else | ||||||
|  |     begin | ||||||
|  |       Writeln('Whole test failed'); | ||||||
|  |       halt(1); | ||||||
|  |     end; | ||||||
|  | end. | ||||||
							
								
								
									
										59
									
								
								tests/test/umacpas1.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										59
									
								
								tests/test/umacpas1.pp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,59 @@ | |||||||
|  | unit umacpas1; | ||||||
|  | 
 | ||||||
|  | {$DEFINE UMACPAS_PRE_INTERFACE_VAR} | ||||||
|  | {The above will _not_ be exported, unless it is redefined | ||||||
|  |  after the mode switch (which it is). Note the non-macpas | ||||||
|  |  style, because $mode macpas has not yet been parsed.} | ||||||
|  | 
 | ||||||
|  | {$MODE MACPAS} | ||||||
|  | 
 | ||||||
|  | interface | ||||||
|  | {$SETC UMACPAS_COMP_VAR = TRUE} | ||||||
|  | {The above macro is deliberatelly immediatelly after INTERFACE | ||||||
|  |  to check that this works.} | ||||||
|  | 
 | ||||||
|  | {$SETC UMACPAS_PRE_INTERFACE_VAR = TRUE} | ||||||
|  | {Is redefined here and thus exported..} | ||||||
|  | 
 | ||||||
|  | {$IFC UMACPAS_COMP_VAR } | ||||||
|  | {$NOTE UMACPAS_COMP_VAR is true} | ||||||
|  | {$ELSEC} | ||||||
|  | {$NOTE UMACPAS_COMP_VAR is false} | ||||||
|  | {$ENDC} | ||||||
|  | 
 | ||||||
|  | var | ||||||
|  |   a: Integer; | ||||||
|  | 
 | ||||||
|  | {The below macro should be exported} | ||||||
|  | {$SETC UMACPAS_PRE_IMPL_COMP_VAR = TRUE} | ||||||
|  | implementation | ||||||
|  | {$SETC UMACPAS_COMP_VAR = FALSE} | ||||||
|  | {The above macro is deliberatelly immediatelly after IMPLEMENTATION | ||||||
|  |  to check that this works. Note that here UMACPAS_COMP_VAR is set to false, | ||||||
|  |  but the exported value of UMACPAS_COMP_VAR should nevertheless be TRUE. } | ||||||
|  | 
 | ||||||
|  | {$Z+} | ||||||
|  | var | ||||||
|  |   nisse: Integer; | ||||||
|  |     {To be available in tmacpas via the mode macpas $J directive} | ||||||
|  | 
 | ||||||
|  | function Get84: Integer; | ||||||
|  |     {To be available in tmacpas via EXTERNAL} | ||||||
|  | 
 | ||||||
|  | begin | ||||||
|  |   Get84:= 84; | ||||||
|  | end; | ||||||
|  | 
 | ||||||
|  | {$Z-} | ||||||
|  | 
 | ||||||
|  | {$IFC UMACPAS_PRE_INTERFACE_VAR } | ||||||
|  | {$NOTE UMACPAS_PRE_INTERFACE_VAR is true} | ||||||
|  | {$ELSEC} | ||||||
|  | {$ERRORC UMACPAS_PRE_INTERFACE_VAR is false} | ||||||
|  | {Erroneous since it was set to true in the interface section.} | ||||||
|  | {$ENDC} | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | begin | ||||||
|  |   nisse:= 42; | ||||||
|  | end. | ||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 olle
						olle