Q: Endless loop by dispatching

[Michael Erdmann <michael.erdmann@snafu.de>]

Dear all,

i got a problem with the following code fragment below. The Idea is that 
the procedure Serialize defines the strategy how to display object which
are derived from A.Object. Searialize simply dispatches into the class
by calling a procedure Write, which does the job for the class.

package A is

    type Object is tagged record
          P1 : Natural := 1;
          P2 : Natural := 2;
       end record;


    procedure Write(
       This : in Object );

    procedure Serialize(
       This : in Object'Class );

end A;


package body A is

    procedure Serialize(
       This : in Object'Class ) is
    begin
       Write( This );
    end Serialize;

    procedure Write(
       This : in Object ) is
    begin
       Put_Line( "P1 =" & Natural'Image( This.P1 ) );
       Put_Line( "P2 =" & Natural'Image( This.P2 ) );
    end Write;

end A;

In the following fragment i am defining a package B with an
derived objec B.Object as below. When an instance of B.Object
shall be serialized, the element of the super class (A.Object)
shall be serialzed as well. The code looks nice and compiles
but does not work, since the Serialize dispatches again with
Object.B even ther was a a case given  A.Object( This ).

package B is

    type Object is new A.Object with record
          Q : Natural := 2;
       end record;

    procedure Write(
       This : in Object );

end B;

..........
package body B is

    procedure Write(
       This : in Object ) is
    begin
       A.Serialize( A.Object( This ) );
       Put_Line( "Q =" & Natural'Image(This.Q));
    end Write;

end B;

Does any body know, what this loop causes?! I am not sure
if this is a bug or simply i missed the point.

Michael