mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-04 17:58:38 +02: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