Overriding and Type Extension - oop

Question

Just hoping someone can explain why my program is defaulting to the Move_Piece procedure for the Piece Type, and not the Move_Piece procedure for the Pond type when I attempt to move a pond. When I pass a variable of Pond type to the Move_Piece procedure, "Using basic Move_Piece" gets printed instead of "1". Why is this?
I am using Ada 2005, in case that wasnt obvious by the overriding keyword. I hope I have not provided too little of information. Thanks!
chess_types.ads:
package Chess_Types is
type Color is (Black, White);
type Piece is tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Integer;
end record;
procedure Move_Piece(P: in out Piece);
-- Board Types
type Board_Row is array (Positive range 1 .. 8) of Piece;
type Board_Type is array (Positive range 1 .. 8) of Board_Row;
end Chess_Types;
chess_types.adb:
with Ada.Text_IO;
use Ada.Text_IO;
package body Chess_Types is
procedure Move_Piece(P: in out Piece) is
begin
Put_Line("Using basic Move_Piece");
end Move_Piece;
end Chess_types;
chess_types-piece_types.ads:
package Chess_Types.Piece_Types is
type Pond is new Piece with
record
First_Move : Boolean := True;
end record;
overriding
procedure Move_Piece(Po: in out Pond);
type Rook is new Piece with null record;
overriding
procedure Move_Piece(Ro: in out Rook);
type Knight is new Piece with null record;
overriding
procedure Move_Piece(Kn: in out Knight);
type Bishop is new Piece with null record;
overriding
procedure Move_Piece(Bi: in out Bishop);
type Queen is new Piece with null record;
overriding
procedure Move_Piece(Qu: in out Queen);
type King is new Piece with null record;
overriding
procedure Move_Piece(Ki: in out King);
end Chess_Types.Piece_Types;
chess_types-piece_types.adb:
with Ada.Text_IO;
use Ada.Text_IO;
package body Chess_Types.Piece_Types is
-- Possible_Moves : array (Integer range 1 .. 100) of Integer range 11 .. 88;
procedure Move_Piece(Po: in out Pond) is
begin
Put_Line("1");
end Move_Piece;
procedure Move_Piece(Ro: in out Rook) is
begin
Put_Line("2");
end Move_Piece;
procedure Move_Piece(Kn: in out Knight) is
begin
Put_Line("3");
end Move_Piece;
procedure Move_Piece(Bi: in out Bishop) is
begin
Put_Line("4");
end Move_Piece;
procedure Move_Piece(Qu: in out Queen) is
begin
Put_Line("5");
end Move_Piece;
procedure Move_Piece(Ki: in out King) is
begin
Put_Line("6");
end Move_Piece;
end Chess_types.Piece_Types;
chess.adb:
with Ada.Text_IO;
with Print_Things;
with Adjust_Board;
with Chess_Types;
with Chess_Types.Piece_Types;
use Ada.Text_IO;
use Print_Things;
use Adjust_Board;
use Chess_Types;
use Chess_Types.Piece_Types;
procedure Chess is
Board : Board_Type;
Move : String (1 .. 5);
Move_From : Integer range 11 .. 88;
Move_To : Integer range 11 .. 88;
begin
-- Initialize and Print default board
Initialize_Board(Board);
Print_Board(Board);
-- Get the move
Put_Line("Select a move:");
Move := Get_Line;
while move /= "Q" loop
Move_From := Integer'Value(Move(Move'First .. Move'First + 1));
Move_To := Integer'Value(Move(Move'First + 3 .. Move'Last));
-- Put_Line(Integer'Image(Move_From) & " to" & Integer'Image(Move_To));
-- Associate the move with a piece
for I in Board'Range(1) loop
for J in Board'Range(1) loop
if Move_From = Board(I)(J).Coordinate then
Move_Piece(Board(I)(J));
end if;
end loop;
end loop;
-- Print the Board
Print_Board(Board);
-- Get the move
Put_Line("Select a move:");
Move := Get_Line;
end loop;
end Chess;
adjust_board.adb:
with Chess_Types;
use Chess_Types;
with Chess_Types.Piece_Types;
use Chess_Types.Piece_Types;
package body Adjust_Board is
procedure Initialize_Board(Board: in out Board_Type) is
-- Define White Chess Pieces
WP1 : Pond := ("wP ", True, White, 12, True);
WP2 : Pond := ("wP ", True, White, 22, True);
WP3 : Pond := ("wP ", True, White, 32, True);
WP4 : Pond := ("wP ", True, White, 42, True);
WP5 : Pond := ("wP ", True, White, 52, True);
WP6 : Pond := ("wP ", True, White, 62, True);
WP7 : Pond := ("wP ", True, White, 72, True);
WP8 : Pond := ("wP ", True, White, 82, True);
WR1 : Rook := ("wRk", True, White, 11);
WR2 : Rook := ("wRk", True, White, 81);
WK1 : Knight := ("wKn", True, White, 21);
WK2 : Knight := ("wKn", True, White, 71);
WB1 : Bishop := ("wBi", True, White, 31);
WB2 : Bishop := ("wBi", True, White, 61);
WQ : Queen := ("wQu", True, White, 41);
WK : King := ("wKi", True, White, 51);
-- Define Black Chess Pieces
BP1 : Pond := ("bP ", True, Black, 17, True);
BP2 : Pond := ("bP ", True, Black, 27, True);
BP3 : Pond := ("bP ", True, Black, 37, True);
BP4 : Pond := ("bP ", True, Black, 47, True);
BP5 : Pond := ("bP ", True, Black, 57, True);
BP6 : Pond := ("bP ", True, Black, 67, True);
BP7 : Pond := ("bP ", True, Black, 77, True);
BP8 : Pond := ("bP ", True, Black, 87, True);
BR1 : Rook := ("bRk", True, Black, 18);
BR2 : Rook := ("bRk", True, Black, 88);
BK1 : Knight := ("bKn", True, Black, 28);
BK2 : Knight := ("bKn", True, Black, 78);
BB1 : Bishop := ("bBi", True, Black, 38);
BB2 : Bishop := ("bBi", True, Black, 68);
BQ : Queen := ("bQu", True, Black, 48);
BK : King := ("bKi", True, Black, 58);
begin
-- Initialize Chess Board
Board(1)(1) := Piece(WR1);
Board(8)(1) := Piece(WR2);
Board(2)(1) := Piece(WK1);
Board(7)(1) := Piece(WK1);
Board(3)(1) := Piece(WB1);
Board(6)(1) := Piece(WB1);
Board(4)(1) := Piece(WQ);
Board(5)(1) := Piece(WK);
Board(1)(2) := Piece(WP1);
Board(2)(2) := Piece(WP2);
Board(3)(2) := Piece(WP3);
Board(4)(2) := Piece(WP4);
Board(5)(2) := Piece(WP5);
Board(6)(2) := Piece(WP6);
Board(7)(2) := Piece(WP7);
Board(8)(2) := Piece(WP8);
Board(1)(8) := Piece(BR1);
Board(8)(8) := Piece(BR2);
Board(2)(8) := Piece(BK1);
Board(7)(8) := Piece(BK1);
Board(3)(8) := Piece(BB1);
Board(6)(8) := Piece(BB1);
Board(4)(8) := Piece(BQ);
Board(5)(8) := Piece(BK);
Board(1)(7) := Piece(BP1);
Board(2)(7) := Piece(BP2);
Board(3)(7) := Piece(BP3);
Board(4)(7) := Piece(BP4);
Board(5)(7) := Piece(BP5);
Board(6)(7) := Piece(BP6);
Board(7)(7) := Piece(BP7);
Board(8)(7) := Piece(BP8);
end Initialize_Board;
end Adjust_Board;

Answer 1

In chess_types.ads, add
type Piece_Acc is access all Piece'Class;
Board_Row needs to be an array of Piece_Acc:
type Board_Row is array (1..8) of Piece_Acc;
You really want the elements in your array to be Piece'Class, but that doesn't work, since the compiler can't tell at that point what types might be derived from Piece and what their memory size is, so it wouldn't be able to set up an array. So it needs to be an access type instead. (In C# or Java, all objects are automatically access types [pointers] whether you want it or not. In Ada you need to tell it when you want things to be pointers.) Then when you set things up in adjust_board.adb, you'd say things like
Board(1)(1) := new Rook' (WR1);
and so on, in order to create the access object.
[Also, this will cause everything else in Board that isn't initialized to be initialized to null. If you want to initialize it to some other Piece that indicates "no piece", you'll need to assign to the unused spaces in the Board yourself.]
But once all that's done, when you say
Board(I)(J).Move_Piece; -- same as Board(I)(J).all.Move_Piece;
or
Move_Piece(Board(I)(J).all);
the type of Board(I)(J).all is a class-wide type, so it will dispatch to the correct Move_Piece like you want.
Note that if when you allocate things yourself with "new", you also have to be responsible for deallocation to avoid memory leaks (unless everything is allocated only once, and then you don't really care). The best way to do that involves controlled types, i.e. making Piece derived from Ada.Finalization.Controlled.
MORE: A way to avoid dealing with the access and allocation/deallocation stuff yourself might be to use Ada.Containers.Indefinite_Vectors instead of an array:
subtype Board_Index is Integer range 1 .. 64;
package Chessboard is new Ada.Containers.Indefinite_Vectors (Board_Index, Piece'Class);
This package doesn't allow multidimensional-type indexes, so you'd need to compute a single index yourself (in the range 1..64 or 0..63), or instantiate Indefinite_Vectors twice which I think is clunky. But this should eliminate the need to do your own allocations, and I think it also does the deallocations for you when the container is destroyed.