Nested Packages

Here is an example where two packages are nested units, declared in another package using the two-step style of nesting. (Note that the next section illustrates a better way to accomplish what is accomplished here.) Suppose you were building a simulation of a basketball game, and you were about to focus on a subsystem representing the scoreboard.

Note that the executable part of procedure Shot_Made employs a membership test as the Boolean expression used in an if statement. The expression also includes use of the Range attribute.

------------------------------------------------------------
------------------------ Scoreboard ------------------------
--  This package provides the ability to add to team scores 
--  after shots are made by specific players, and to keep
--  track of the number of fouls committed by specific 
--  players. It also provides the ability to display the 
--  current score, and to display the foul status. 
------------------------------------------------------------
package Scoreboard is 
  type Player_Name is (Adam, Bill, Carl, Dave, Eric, 
                       Fred, Glen, Hank, Ivan, John);
  type Shot_Type is (Foul_Shot, Two_Pointer, Three_Pointer);
  ----------------------------------------------------------
  package Events is 
    procedure Shot_Made   (By   : in Player_Name;
                           Shot : in Shot_Type);
    procedure Foul_Committed(By : in Player_Name);
  end Events;
  -----------------------------------------------
  package Display is
    procedure Show_Scores;              
    procedure Show_Fouls;  
  end Display;
  -----------------------------------------------  
end Scoreboard;
------------------------------------------------------------
with Ada.Text_IO;
use  Ada.Text_IO;
package body Scoreboard is
  Home_Score     : Natural := 0;
  Visitors_Score : Natural := 0;
  
  Foul_Status    : array (Player_Name'Range) of Natural
                 := (Player_Name'Range => 0);
                 
  subtype Home_Player     is Player_Name range Adam..Eric;
  subtype Visiting_Player is Player_Name range Fred..John;
  -----------------------------------------------------
  package body Events is
    ---------------------------------------------
    procedure Shot_Made(By   : in Player_Name;
                        Shot : in Shot_Type) is
                            
      Points : Integer range 1..3;
      
    begin
        
      if    Shot = Foul_Shot then Points := 1;
      elsif Shot = Two_Pointer then Points := 2;
      elsif Shot = Three_Pointer then Points := 3;
      end if;
      
      if By in Home_Player'Range then             -- membership test
        Home_Score := Home_Score + Points;
      elsif By in Visiting_Player'Range then      -- membership test
        Visitors_Score := Visitors_Score + Points;
      end if;
                                                  
    end Shot_Made;
    -----------------------------------------------
    procedure Foul_Committed(By : in Player_Name) is 
    begin                            
        Foul_Status(By) := Foul_Status(By) + 1;    
    end Foul_Committed;
    -----------------------------------------------
  end Events;           
  ----------------------------------------------------------
  package body Display is
    ----------------------------------------------
    procedure Show_Scores is
    begin
      New_Line;
      Put_Line("Score:  Home " &
               Integer'Image(Home_Score) &
               "  Visitors " &
               Integer'Image(Visitors_Score));
      New_Line;
    end Show_Scores;
    ----------------------------------------------
    procedure Show_Fouls is
      Name : Player_Name;
    begin
        
      Put_Line("Home Team Fouls:");
      
      for Name in Home_Player'Range loop
        Put("  ");
        Put(Player_Name'Image(Name));
        Put(Integer'Image(Foul_Status(Name)));  
      end loop;
      
      New_Line;
      Put_Line("Visiting Team Fouls:");
      
      for Name in Visiting_Player'Range loop
        Put("  ");  
        Put(Player_Name'Image(Name));
        Put(Integer'Image(Foul_Status(Name)));  
      end loop;
      
      New_Line;
        
    end Show_Fouls;
    ----------------------------------------------  
  end Display;
  ------------------------------------------------------  
end Scoreboard;
------------------------------------------------------------
----------------------- Test_Scoreboard --------------------
--  This test procedure sends a sequence of messages to the 
--  Scoreboard package involving shots made and fouls 
--  committed, and messages requesting display of data. 
------------------------------------------------------------
with Scoreboard;
use  Scoreboard;
procedure Test_Scoreboard is
begin
  Display.Show_Scores;
  Display.Show_Fouls;
  Events.Shot_Made     (By => Bill, Shot => Two_Pointer);
  Events.Foul_Committed(By => Carl);
  Events.Shot_Made     (By => Hank, Shot => Foul_Shot);
  Events.Shot_Made     (By => Dave, Shot => Three_Pointer);
  Events.Shot_Made     (By => Fred, Shot => Two_Pointer);
  Events.Foul_Committed(By => Glen);
  Events.Shot_Made     (By => Eric, Shot => Foul_Shot);
  Display.Show_Scores;
  Display.Show_Fouls;  
end Test_Scoreboard;
------------------------------------------------------------

2.12 Nested Packages