c940007.a

来自「用于进行gcc测试」· A 代码 · 共 428 行 · 第 1/2 页

         function Freeway_Overload return Load_Factor is
         begin
            return    Local_Overload                    -- EACH IS A CALL OF A
                      -- + :::: others                  -- FUNCTION FROM WITHIN
                      + Next_Ramp_in_Overload;          -- A FUNCTION
         end Freeway_Overload;

         -- Freeway Breakdown is defined as traffic moving < 5mph
         function Freeway_Breakdown return Boolean is
         begin
            return Fwy_Break_State;
         end Freeway_Breakdown;
   
         -- Keep count of vehicles currently on meter queue - we can't use
         -- the 'count because we need the outcall trigger
         procedure Add_Meter_Queue is
            TC_Pass_Point : constant integer := 22;
         begin
            Ramp_Count := Ramp_Count + 1;  
            TC_Passage ( TC_Pass_Point );  -- note passage through here
            if Ramp_Count > Ramp_Count_Threshold then
               null;  -- :::: stub, trigger surface street notification
            end if;
         end Add_Meter_Queue;  
         --
         procedure Subtract_Meter_Queue is
            TC_Pass_Point : constant integer := 24;
         begin
            Ramp_Count := Ramp_Count - 1;  
            TC_Passage ( TC_Pass_Point );  -- note passage through here
         end Subtract_Meter_Queue;  
   
         -- Here each Vehicle task queues itself awaiting release
         entry Wait_at_Meter when Release_One_Vehicle is
         -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
            TC_Pass_Point : constant integer := 23;
         begin
            TC_Passage ( TC_Pass_Point );   -- note passage through here
            Release_One_Vehicle := false;   -- Consume the signal
            -- Decrement number of vehicles on ramp 
            Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY
         end Wait_at_Meter;      
   
   
         procedure Time_Pulse_Received is
            Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL FUNCTN 
                                                    -- FROM WITHIN PROCEDURE
         begin
            -- if broken down, no vehicles are released
            if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE
               if Load < Moderate_Level then
                  Release_One_Vehicle := true;
               end if;
               null;    -- stub  ::: If other levels, release every other
                        --           pulse, every third pulse  etc.
            end if;
         end Time_Pulse_Received;
       
      end Ramp;  
      --================================================================

      -- Now create two Ramp objects from this type
      Ramp_31 : Ramp;
      Ramp_32 : Ramp;

       

      -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
      -- and the generation of an accompanying carrier task
      procedure New_Arrival_31 is
         Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
         TC_Pass_Point : constant integer := 3; 
      begin
         Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
         null;   --::: stub
      end New_arrival_31;


      -- Carrier task. One is created for each vehicle arriving at Ramp_31
      task body Vehicle_31 is
         TC_Pass_point   : constant integer :=  1;
         TC_Pass_Point_2 : constant integer := 21;
         TC_Pass_Point_3 : constant integer :=  2;
      begin
         Ramp_31.TC_Passage ( TC_Pass_Point );  -- note passage through here
         if Ramp_31.Meter_in_Use_State then  
            Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
            -- Increment count of number of vehicles on ramp 
            Ramp_31.Add_Meter_Queue;    -- CALL a protected PROCEDURE
                                          -- which is also called from within
            -- enter the meter queue
            Ramp_31.Wait_at_Meter;      -- CALL a protected ENTRY   
         end if;
         Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
         null;  --:::: call to the first in the series of the Ramp_Sensors
                --     this "passes" the vehicle from one sensor to the next
      exception
         when others => 
               Report.Failed ("Unexpected exception in Vehicle Task");
      end Vehicle_31;


      -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
      -- generation of an accompanying carrier task
      procedure New_Arrival_32 is
         Next_Vehicle_Task_32 : acc_Vehicle_32 := new Vehicle_32;
         TC_Pass_Point : constant integer := 3; 
      begin
         Ramp_32.TC_Passage ( TC_Pass_Point );  -- Note passage through here
         null;  --::: stub
      end New_arrival_32;


      -- Carrier task. One is created for each vehicle arriving at Ramp_32
      task body Vehicle_32 is
         TC_Pass_point   : constant integer :=  1;
         TC_Pass_Point_2 : constant integer := 21;
         TC_Pass_Point_3 : constant integer :=  2;
      begin
         Ramp_32.TC_Passage ( TC_Pass_Point );  -- note passage through here
         if Ramp_32.Meter_in_Use_State then  
            Ramp_32.TC_Passage ( TC_Pass_Point_2 );  -- note passage
            -- Increment count of number of vehicles on ramp 
            Ramp_32.Add_Meter_Queue;    -- CALL a protected PROCEDURE
                                          -- which is also called from within
            -- enter the meter queue
            Ramp_32.Wait_at_Meter;      -- CALL a protected ENTRY   
         end if;
         Ramp_32.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
         null;  --:::: call to the first in the series of the Ramp_Sensors
                --     this "passes" the vehicle from one sensor to the next
      exception
         when others => 
               Report.Failed ("Unexpected exception in Vehicle Task");
      end Vehicle_32;


      -- Task transmits a synchronizing "pulse" to all ramps
      --
      task body Pulse_Task is
         Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
      begin
         While not Control.Stop loop
            delay until Pulse_Time;  
            Ramp_31.Time_Pulse_Received;    -- CALL OF PROCEDURE CAUSES
            Ramp_32.Time_Pulse_Received;    -- INTERNAL CALLS
            -- ::::::::::  and to all the others
            Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
         end loop;
      exception
         when others => 
               Report.Failed ("Unexpected exception in Pulse_Task");
      end Pulse_Task;


   begin -- declare

      -- Test driver.  This is ALL test control code

      -- First simulate calls to the protected functions and procedures
      -- from without the protected object
      --
      -- CALL FUNCTIONS
      if not ( Ramp_31.Local_Overload = Clear_Level and
               Ramp_31.Next_Ramp_in_Overload = Clear_Level and
               Ramp_31.Freeway_Overload = Clear_Level ) then
         Report.Failed ("Initial Calls to Ramp_31 incorrect");
      end if;
      if not ( Ramp_32.Local_Overload = Clear_Level and
               Ramp_32.Next_Ramp_in_Overload = Clear_Level and
               Ramp_32.Freeway_Overload = Clear_Level ) then
         Report.Failed ("Initial Calls to Ramp_32 incorrect");
      end if;

      -- Now Simulate the arrival of a vehicle at each ramp to verify 
      -- basic paths through the test
      New_Arrival_31; 
      New_Arrival_32; 
      delay Pulse_Time_Delta*2;  -- allow them to pass through the complex

      -- Simulate real-time sensors reporting overload
      Ramp_31.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
      Ramp_32.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)

      -- CALL FUNCTIONS again
      if not ( Ramp_31.Local_Overload = Minimum_Level and
               Ramp_31.Freeway_Overload = Minimum_Level ) then
         Report.Failed ("Secondary Calls to Ramp_31 incorrect");
      end if;
      if not ( Ramp_32.Local_Overload = Minimum_Level and
               Ramp_32.Freeway_Overload = Minimum_Level ) then
         Report.Failed ("Secondary Calls to Ramp_32 incorrect");
      end if;

      -- Now Simulate the arrival of another vehicle at each ramp again causing
      -- INTERNAL CALLS but following different paths (queuing on the 
      -- meter etc.)
      New_Arrival_31; 
      New_Arrival_32; 
      delay Pulse_Time_Delta*2;  -- allow them to pass through the complex

      Control.Stop_Now;  -- finish test

      if not (TC_Expected_Passage_Total = Ramp_31.TC_Get_Passage_Total and
              TC_Expected_Passage_Total = Ramp_32.TC_Get_Passage_Total) then
         Report.Failed ("Unexpected paths taken");
      end if;

   end; -- declare

   Report.Result;

end C940007;