General Stack Client

Download

--
-- A few examples of a record with variant parts.
--

procedure Variant is
   -- This is a fixed type with two decimal places and 14 digits.
   type Money is delta 0.01 digits 14;

   -- Types of employees.
   type Employee_Catagory is ( Salaried, Hourly, Contract );

   -- This has a variant constraint based on the type of employee.
   type Employee_Type(Cat: Employee_Catagory) is record
      Name: String(1..15);
      case Cat is
         when Salaried =>
            Salary: Money;
         when Hourly =>
            Hourly_Rate: Money;
            Paid_Overtime: Boolean;
         when Contract =>
            Contract_Value: Money;
            Contract_Length: Integer; -- Months.
      end case;
   end record;

   -- None of these may be assigned to another.  The (Salaried) in the second
   -- one is redundant.
   E1: aliased Employee_Type := (Hourly, "Mike Smith     ", 23.50, false);
   E2: aliased Employee_Type(Salaried) :=
     (Salaried, "Alice Gromwith ", 43_155.10);
   E3: aliased Employee_Type := (Contract, "Fred Johnson   ", 10_000.00, 2);

   E4: Employee_Type(Hourly);

   -- E5: Employee_Type; -- Cannot create w/o fixing discriminant.

   -- This really should work, but it's to hard to implement.
   -- EArr: array(1..3) of Employee_Type := (E1, E2, E3);

   EArr: array(1..3) of Employee_Type(Salaried);

   -- Must use pointers to make a heterogeneous array
   type EmplPtr is access all Employee_Type;
   EArr2: array (1..3) of EmplPtr := (E1'Access, E2'Access, E3'Access);

begin
   E4 := E1;
   -- E1 := E2; -- Generates constraint error at run time.
   E1.Paid_Overtime := True;
   -- E2.Paid_Overtime := True;  -- Generates a constraint error at run.
   -- E3.Cat := Salaried; -- Compile error.  Cannot change discriminant.
   EArr(2) := E2;
end Variant;

General Stack Client