c3a2001.a

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

                      Amperage    : C3A2001_2.Amps )
    return Special_Breaker;

  procedure Flip ( The_Breaker : in out Special_Breaker );
  procedure Trip ( The_Breaker : in out Special_Breaker );
  procedure Reset( The_Breaker : in out Special_Breaker );
  procedure Fail ( The_Breaker : in out Special_Breaker );

  function Status_Of( The_Breaker : Special_Breaker ) return C3A2001_1.Status;
  function On_Backup( The_Breaker : Special_Breaker ) return Boolean;

private
  type Special_Breaker is new C3A2001_2.Basic_Breaker with record
    Backup : C3A2001_2.Basic_Breaker;
  end record;
end C3A2001_4;

----------------------------------------------------------------------------

with TCTouch;
package body C3A2001_4 is

  function Construct( Voltage     : C3A2001_2.Voltages;
                      Amperage    : C3A2001_2.Amps )
    return Special_Breaker is
    It: Special_Breaker;
    procedure Set_Root( It: in out C3A2001_2.Basic_Breaker ) is
    begin
      It := C3A2001_2.Construct( Voltage, Amperage );
    end Set_Root;
  begin
    TCTouch.Touch( 'i' ); --------------------------------------------- i
    Set_Root( C3A2001_2.Basic_Breaker( It ) );
    Set_Root( It.Backup );
    return It;
  end Construct;

  function Status_Of( It: C3A2001_1.Breaker ) return C3A2001_1.Status
    renames C3A2001_1.Status_Of;

  procedure Flip ( The_Breaker : in out Special_Breaker ) is
  begin
    TCTouch.Touch( 'j' ); --------------------------------------------- j
    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
      when C3A2001_1.Power_Off | C3A2001_1.Power_On =>
        C3A2001_2.Flip( C3A2001_2.Basic_Breaker( The_Breaker ) );
      when others =>
        C3A2001_2.Flip( The_Breaker.Backup );
    end case;
  end Flip;

  procedure Trip ( The_Breaker : in out Special_Breaker ) is
  begin
    TCTouch.Touch( 'k' ); --------------------------------------------- k
    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
      when C3A2001_1.Power_Off => null;
      when C3A2001_1.Power_On  =>
        C3A2001_2.Reset( The_Breaker.Backup );
        C3A2001_2.Trip( C3A2001_2.Basic_Breaker( The_Breaker ) );
      when others =>
        C3A2001_2.Trip( The_Breaker.Backup );
    end case;
  end Trip;

  procedure Reset( The_Breaker : in out Special_Breaker ) is
  begin
    TCTouch.Touch( 'l' ); --------------------------------------------- l
    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
      when C3A2001_1.Tripped  =>
        C3A2001_2.Reset( C3A2001_2.Basic_Breaker( The_Breaker ));
      when C3A2001_1.Failed  =>
        C3A2001_2.Reset( The_Breaker.Backup );
      when C3A2001_1.Power_On | C3A2001_1.Power_Off =>
        null;
    end case;
  end Reset;

  procedure Fail ( The_Breaker : in out Special_Breaker ) is
  begin
    TCTouch.Touch( 'm' ); --------------------------------------------- m
    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
      when C3A2001_1.Failed  =>
        C3A2001_2.Fail( The_Breaker.Backup );
      when others => 
        C3A2001_2.Fail( C3A2001_2.Basic_Breaker( The_Breaker ));
        C3A2001_2.Reset( The_Breaker.Backup );
    end case;
  end Fail;

  function Status_Of( The_Breaker : Special_Breaker )
    return C3A2001_1.Status is
  begin
    TCTouch.Touch( 'n' ); --------------------------------------------- n
    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
      when C3A2001_1.Power_On  => return C3A2001_1.Power_On;
      when C3A2001_1.Power_Off => return C3A2001_1.Power_Off;
      when others =>
        return C3A2001_2.Status_Of( The_Breaker.Backup );
    end case;
  end Status_Of;

  function On_Backup( The_Breaker : Special_Breaker ) return Boolean is
    use C3A2001_2;
    use type C3A2001_1.Status;
  begin
    return Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Tripped
        or Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Failed;
  end On_Backup;

end C3A2001_4;

----------------------------------------------------------------------------

with C3A2001_1;
package C3A2001_5 is

  type Component is access C3A2001_1.Breaker'Class;

  type Circuit;
  type Connection is access Circuit;

  type Circuit is record
    The_Gadget : Component;
    Next : Connection;
  end record;

  procedure Flipper( The_Circuit : Connection );
  procedure Tripper( The_Circuit : Connection );
  procedure Restore( The_Circuit : Connection );
  procedure Failure( The_Circuit : Connection );

  Short : Connection := null;

end C3A2001_5;

----------------------------------------------------------------------------
with Report;
with TCTouch;
with C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4;

pragma Elaborate_All( Report, TCTouch,
                      C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4 );

package body C3A2001_5 is

  function Neww( Breaker: in C3A2001_1.Breaker'Class )
    return Component is
  begin
    return new C3A2001_1.Breaker'Class'( Breaker );
  end Neww;

  procedure Add( Gadget     : in     Component;
                 To_Circuit : in out Connection) is
  begin
    To_Circuit := new Circuit'(Gadget,To_Circuit);
  end Add;

  procedure Flipper( The_Circuit : Connection ) is
    Probe : Connection := The_Circuit;
  begin
    while Probe /= null loop
      C3A2001_1.Flip( Probe.The_Gadget.all );
      Probe := Probe.Next;
    end loop;
  end Flipper;

  procedure Tripper( The_Circuit : Connection ) is
    Probe : Connection := The_Circuit;
  begin
    while Probe /= null loop
      C3A2001_1.Trip( Probe.The_Gadget.all );
      Probe := Probe.Next;
    end loop;
  end Tripper;

  procedure Restore( The_Circuit : Connection ) is
    Probe : Connection := The_Circuit;
  begin
    while Probe /= null loop
      C3A2001_1.Reset( Probe.The_Gadget.all );
      Probe := Probe.Next;
    end loop;
  end Restore;

  procedure Failure( The_Circuit : Connection ) is
    Probe : Connection := The_Circuit;
  begin
    while Probe /= null loop
      C3A2001_1.Fail( Probe.The_Gadget.all );
      Probe := Probe.Next;
    end loop;
  end Failure;

begin
  Add( Neww( C3A2001_2.Construct( C3A2001_2.V440, C3A2001_2.A5   )), Short );
  Add( Neww( C3A2001_3.Construct( C3A2001_2.V110, C3A2001_2.A1   )), Short );
  Add( Neww( C3A2001_4.Construct( C3A2001_2.V12,  C3A2001_2.A100 )), Short );
end C3A2001_5;

----------------------------------------------------------------------------

with Report;
with TCTouch;
with C3A2001_5;
procedure C3A2001 is

begin  -- Main test procedure.

  Report.Test ("C3A2001", "Check that an abstract type can be declared " &
               "and used.  Check actual subprograms dispatch correctly" );

  -- This Validate call must be _after_ the call to Report.Test
  TCTouch.Validate( "cgcicc", "Adding" );

  C3A2001_5.Flipper( C3A2001_5.Short );
  TCTouch.Validate( "jbdbdbdb", "Flipping" );

  C3A2001_5.Tripper( C3A2001_5.Short );
  TCTouch.Validate( "kbfbeee", "Tripping" );

  C3A2001_5.Restore( C3A2001_5.Short );
  TCTouch.Validate( "lbfbfbfb", "Restoring" );

  C3A2001_5.Failure( C3A2001_5.Short );
  TCTouch.Validate( "mbafbaa", "Circuits Failing" );

  Report.Result;

end C3A2001;