Re: Problems with 'class, help anyone?

[Jim Rogers <jimmaureenrogers@worldnet.att.net>]

M�rten Woxberg wrote:

> On Tue, 29 Oct 2002 06:08:40 +0000, Jim Rogers wrote:
> 
> 
>>M�rten Woxberg wrote:
>>
>>
> <snip> 
> 
> 
>>I see you are doing something *almost* exactly the same. The almost seems
>>to be your problem.
>>
>>The GNAT error messages are pretty clear. To give you a detailed analysis of
>>your code I would need to see your code, not just the compiler error messages.
>>
> 
> Ok I've tried the Code from the webpage now and that produces the same
> errors.. thus it doesnt work with gnat either.. gnat is version 3.13 and
> the code on the page was tested with 3.03 and 3.06 so it should
> work shouldn't it?


Several of the package specifications are presented with out corresponding
package bodies. The class wide access types are defined as general access types,
but the corresponding instances are not defined as aliased.

The code frequently tries to make an instance of an abstract type. This is not
allowed.

In general, these examples are both incomplete and incorrect. You might try
contacting Simon Johnston to find an errata page for this document.

I have thrown together an example of using 'class that works.

-----------------------------------------------------------------------
-- Person tagged type.
-- A tagged type is an extensible data structure.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package Persons is
    type Person is tagged private;
    procedure Set_Name (The_Person : out Person; Name : in String);
    function Get_Name(The_Person : Person) return String;
    procedure Set_Age(The_Person : out Person; Age : in Natural);
    function Get_Age(The_Person : Person) return Natural;
    procedure Display(The_Person : Person);
    package Builder is
       function Create(Name : String; Age : Natural) return Person;
    end Builder;
    procedure Print(The_Person : Person'Class);
private
    type Person is tagged record
       Name : Unbounded_String := Null_Unbounded_String;
       Age   : Natural := 0;
    end record;
end Persons;



with Ada.Text_Io;
use Ada.Text_Io;

package body Persons is
    procedure Set_Name (
          The_Person :    out Person;
          Name       : in     String  ) is
    begin
       The_Person.Name := To_Unbounded_String(Name);
    end Set_Name;

    function Get_Name (
          The_Person : Person )
      return String is
    begin
       return To_String(The_Person.Name);
    end Get_Name;

    procedure Set_Age (
          The_Person :    out Person;
          Age        : in     Natural ) is
    begin
       The_Person.Age := Age;
    end Set_Age;

    function Get_Age (
          The_Person : Person )
      return Natural is
    begin
       return The_Person.Age;
    end Get_Age;

    procedure Display (
          The_Person : Person ) is
    begin
       Put_Line(Get_Name(The_Person) & " is" &
          Integer'Image(Get_Age(The_Person)) &
          " years old.");
    end Display;
    package body Builder is
       function Create (
             Name : String;
             Age  : Natural )
         return Person is
          Temp : Person;
       begin
          Set_Name(Temp, Name);
          Set_Age(Temp, Age);
          return Temp;
       end Create;
    end Builder;
    procedure Print (
          The_Person : Person'Class ) is
    begin
       Display(The_Person);
    end Print;
end Persons;


with Persons;
use Persons;

package Employees is
    type Employee is new Person with private;
    procedure Set_Id (
          The_Employee :    out Employee;
          Id           : in     Positive  );
    function Get_Id (
          The_Employee : Employee )
      return Positive;
    procedure Display (
          The_Employee : Employee );
    package Builder is
       function Create (
             Name : String;
             Age  : Natural;
             Id   : Positive )
         return Employee;
    end Builder;
private
    type Employee is new Person with
       record
          Id : Positive;
       end record;
end Employees;


with Ada.Text_Io;
use Ada.Text_Io;

package body Employees is
    procedure Set_Id (
          The_Employee :    out Employee;
          Id           : in     Positive  ) is
    begin
       The_Employee.Id := Id;
    end Set_Id;

    function Get_Id (
          The_Employee : Employee )
      return Positive is
    begin
       return The_Employee.Id;
    end Get_Id;

    procedure Display (
          The_Employee : Employee ) is
    begin
       Display(Person(The_Employee));
       Put_Line("Id:" & Integer'Image(The_Employee.Id));
    end Display;

    package body Builder is
       function Create (
             Name : String;
             Age  : Natural;
             Id   : Positive )
         return Employee is
          Temp : Employee;
       begin
          Set_Name(Temp, Name);
          Set_Age(Temp, Age);
          Set_Id(Temp, Id);
          return Temp;
       end Create;
    end Builder;
end Employees;



with Employees;
use Employees;
with Persons;
use Persons;

procedure Employee_Test is
    E1 : Employee := Employees.Builder.Create (Name => "Fred W. Flintstone",
                       Age => 46, Id => 12345);
    E2 : Employee := Employees.Builder.Create (Name => "Barney Rubble",
                       Age => 43, Id => 10101);
    P1 : Person   := Persons.Builder.Create (Name => "Betty Rubble", Age => 39);
begin
    Print(E1);
    Print(E2);
    Print(P1);
end Employee_Test;


Jim Rogers