env;
procedure writename(Var z : inoutZone; Inspect name : String); EXTERNAL;
.
PROCEDURE test9a(Var OK : Boolean; VAR ZoneVar : inoutZone);
(** sets **)
const
  setlow = 0;
  sethigh= 10;

type
set_range = setlow..sethigh;
set_type = set of set_range;

FUNCTION firstbit(s : set_type) : Integer;
   begin
     firstbit := setlow - 1;
     for i := setlow to sethigh do
      if i in s then
      begin
        firstbit := i;
        exitloop;
      end;
   end;

FUNCTION sumbits(s : set_type) : Integer;
   var sum : Integer;
   begin
     sum := 0;
     for i := setlow to sethigh do
      if i in s then
      begin
        sum := sum + i;
      end;
     sumbits := sum;
   end;

var
set1, set2, set3 : set_type;
set4 : set of 2..13;
setvar : integer;
b : boolean;
repeats : Integer := 10;

procedure printset(s: set_type);
var b : boolean;
begin
b := true;
for i := setlow to sethigh do
if i in s then
begin
PrintInteger(ZoneVar, i);
b := false;
end;
if b then printinteger(zonevar, setlow - 1);
end;

function checkset(s: set_type; value : integer): boolean;
var b : boolean;
    foundvalue : integer;
begin
b := true;
foundvalue := 0;
for i := setlow to sethigh do
if i in s then
begin
foundvalue := foundvalue + i;
b := false;
end;

if b then foundvalue := setlow - 1;
checkset := foundvalue = value;
end; (* checkset *)

procedure printsetboo(b: boolean);
begin
printBoolean(zonevar, b);
end; (* printsetboo *)

begin 
for counter := 1 to repeats do
begin
   WriteName(ZoneVar,"Test9A");
  Ok := false;
set1 := (.1.);
$code
printset(set1);               (* 1 *)
$nocode
if firstbit(set1) <> 1 then exit;
if sumbits(set1) <> 1 then exit;

set1 := (..);
printset(set1);               (* -1 *)
if firstbit(set1) <> -1 then exit;
if sumbits(set1) <> 0 then exit;

set1 := (. 2, 4 .);
printset(set1);               (* 2 4 *)
if firstbit(set1) <> 2 then exit;
if sumbits(set1) <> 6 then exit;

setvar := 10;
set2 := (. 4, setvar.);
printset(set2);               (* 4 10 *)
if firstbit(set2) <> 4 then exit;
if sumbits(set2) <> 14 then exit;

set3 := set1 + set2;
printset(set3);               (* 2 4 10 *)
if firstbit(set3) <> 2 then exit;
if sumbits(set3) <> 16 then exit;

set3 := set1 - set2;
printset(set3);               (* 2 *)
if firstbit(set3) <> 2 then exit;
if sumbits(set3) <> 2 then exit;

set3 := set1 * set2;
printset(set3);               (* 4 *)
if firstbit(set3) <> 4 then exit;
if sumbits(set3) <> 4 then exit;

b := set1 <= set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 >= set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 = set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 <> set2;
printsetboo(b);               (* True *)
if not b then exit;

b := set3 <= set2;
printsetboo(b);               (* True *)
if not b then exit;

b := set3 >= set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 = set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 <> set2;
printsetboo(b);               (* True *)
if not b then exit;

setvar := 4;
set4 := ( (.2..setvar.) - (.setvar-1.)) + set2;
printset(set4);               (* 2 4 10 *)
if firstbit(set4) <> 2 then exit;
if sumbits(set4) <> 16 then exit;

set4 := ( (.2..setvar.) - (.setvar-1.)) - set2;
printset(set4);               (* 2 *)
if firstbit(set4) <> 2 then exit;
if sumbits(set4) <> 2 then exit;

set4 := ( (.2..setvar.) - (.setvar-1.)) * set2;
printset(set4);               (* 4 *)
if firstbit(set4) <> 4 then exit;
if sumbits(set4) <> 4 then exit;

b := ( (.2..setvar.) - (.setvar-1.)) <= set2;
printsetboo(b);               (* False *)
if b then exit;

b := ( (.2..setvar.) - (.setvar-1.)) >= set2;
printsetboo(b);               (* False *)
if b then exit;

b := ( (.2..setvar.) - (.setvar-1.)) = set2;
printsetboo(b);               (* False *)
if b then exit;

b := ( (.2..setvar.) - (.setvar-1.)) <> set2;
printsetboo(b);               (* True *)
if not b then exit;
printset((.5..setvar.) + (..));     (* -1 *)

if not checkset((.5..setvar.) + (..), -1) then exit;
end;
ok := true;
end;

PROCEDURE test9aa(Var OK : Boolean; VAR ZoneVar : inoutZone);
(** sets **)
const
  setlow = 50;
  sethigh= 1000;

type
set_range = setlow..sethigh;
set_type = set of set_range;

FUNCTION firstbit(s : set_type) : Integer;
   begin
     firstbit := setlow - 1;
     for i := setlow to sethigh do
      if i in s then
      begin
        firstbit := i;
        exitloop;
      end;
   end;

FUNCTION sumbits(s : set_type) : Integer;
   var sum : Integer;
   begin
     sum := 0;
     for i := setlow to sethigh do
      if i in s then
      begin
        sum := sum + i;
      end;
     sumbits := sum;
   end;

var
set1, set2, set3 : set_type;
set4 : set of 2..1300;
setvar : integer;
b : boolean;
repeats : Integer := 10;

procedure printset(s: set_type);
var b : boolean;
begin
b := true;
for i := setlow to sethigh do
if i in s then
begin
PrintInteger(ZoneVar, i);
b := false;
end;
if b then printinteger(zonevar, setlow - 1);
end;

function checkset(s: set_type; value : integer): boolean;
var b : boolean;
    foundvalue : integer;
begin
b := true;
foundvalue := 0;
for i := setlow to sethigh do
if i in s then
begin
foundvalue := foundvalue + i;
b := false;
end;

if b then foundvalue := setlow - 1;
checkset := foundvalue = value;
end; (* checkset *)

procedure printsetboo(b: boolean);
begin
printBoolean(zonevar, b);
end; (* printsetboo *)

begin 
for counter := 1 to repeats do
begin
   WriteName(ZoneVar,"Test9AA");
  Ok := false;
set1 := (.100.);
printset(set1);               (* 100 *)
if firstbit(set1) <> 100 then exit;
if sumbits(set1) <> 100 then exit;

set1 := (..);
printset(set1);               (* 49 *)
if firstbit(set1) <> 49 then exit;
if sumbits(set1) <> 0 then exit;

set1 := (. 200, 400 .);
printset(set1);               (* 200 400 *)
if firstbit(set1) <> 200 then exit;
if sumbits(set1) <> 600 then exit;

setvar := 1000;
set2 := (. 400, setvar.);
printset(set2);               (* 400 1000 *)
if firstbit(set2) <> 400 then exit;
if sumbits(set2) <> 1400 then exit;

set3 := set1 + set2;
printset(set3);               (* 200 400 1000 *)
if firstbit(set3) <> 200 then exit;
if sumbits(set3) <> 1600 then exit;

set3 := set1 - set2;
printset(set3);               (* 200 *)
if firstbit(set3) <> 200 then exit;
if sumbits(set3) <> 200 then exit;

set3 := set1 * set2;
printset(set3);               (* 400 *)
if firstbit(set3) <> 400 then exit;
if sumbits(set3) <> 400 then exit;

b := set1 <= set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 >= set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 = set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 <> set2;
printsetboo(b);               (* True *)
if not b then exit;

b := set3 <= set2;
printsetboo(b);               (* True *)
if not b then exit;

b := set3 >= set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 = set2;
printsetboo(b);               (* False *)
if b then exit;

b := set1 <> set2;
printsetboo(b);               (* True *)
if not b then exit;
$code
setvar := 400;
set4 := ( (.200..setvar.) - (.201..setvar-1.)) + set2;
printset(set4);               (* 200 400 1000 *)
$nocode
if firstbit(set4) <> 200 then exit;
if sumbits(set4) <> 1600 then exit;

set4 := ( (.200..setvar.) - (.201..setvar-1.)) - set2;
printset(set4);               (* 200 *)
if firstbit(set4) <> 200 then exit;
if sumbits(set4) <> 200 then exit;

set4 := ( (.200..setvar.) - (.201..setvar-1.)) * set2;
printset(set4);               (* 400 *)
if firstbit(set4) <> 400 then exit;
if sumbits(set4) <> 400 then exit;

b := ( (.200..setvar.) - (.201..setvar-1.)) <= set2;
printsetboo(b);               (* False *)
if b then exit;

b := ( (.200..setvar.) - (.201..setvar-1.)) >= set2;
printsetboo(b);               (* False *)
if b then exit;

b := ( (.200..setvar.) - (.201..setvar-1.)) = set2;
printsetboo(b);               (* False *)
if b then exit;

b := ( (.200..setvar.) - (.201..setvar-1.)) <> set2;
printsetboo(b);               (* True *)
if not b then exit;
printset((.500..setvar.) + (..));     (* 49 *)

if not checkset((.500..setvar.) + (..), 49) then exit;
end;
ok := true;
end;
PROCEDURE test9(Var OK : Boolean; VAR ZoneVar : inoutZone);
PROCEDURE test9a(Var OK : Boolean; VAR ZoneVar : inoutZone); external;
PROCEDURE test9aa(Var OK : Boolean; VAR ZoneVar : inoutZone); external;
begin
test9a(ok, zonevar);
if ok then test9aa(ok, zonevar);
end.