-------------------------------------------------------------------------------
--
--  <!--
--  This is a HTML comment. It will not be displayed.
--  -->
--
--  Author: &lt;twolf@acm.org&gt; <AUTHOR>
--
--  <A HREF="test.html">@Test@</A>
--
--  <CODE>@Test@</CODE>
--
--  <PRE>
--     This is
--     a @Test  @Test@  @Test."<="@
--  </PRE>
--
--  This comment is before the context clauses. Such a "header" comment is
--  taken by adabrowse to build the synopsis section.
--
--  Note how empty lines generate new HTML paragraphs.
----------------------------------------------------------------
--  <PRE>
--     Unless
--
--     we are in a
--
--        preformatted block.
--  </PRE>
-------------------------------------------------------------------------------
--  <A
--  HREF="http://home.tiscalinet.ch/t_wolf/tw/ada95/adabrowse/">adabrowse</A>
--  builds an index of known child packages (see e.g. package <CODE><A
--  HREF="test.html">Test</A></CODE> and also an index of types. For (tagged)
--  record types, private types, and types derived from those, this index
--  also contains a list of all primitive operations.
--
--  In the example below, note
--  <UL>
--    <LI>that type <CODE>Child</CODE> has even
--        <CODE>Do_B</CODE> as an inherited primitive operation.
--        <BR><BR>
--    <LI>that the cross-reference on "is new XYZ.Mix_In" goes to
--        the <A HREF="test-gen.html">generic template</A>, not to
--        the instantiation "XYZ"!
--        <BR><BR>
--    <LI>that the private part is not displayed!
--  </UL>
--
-------------------------------------------------------------------------------

with GAL;
with Test.Gen2;
with Test.Gen3;
with Test.G4;
with Test.Swap;
with Test.Use_Instance;

-----------------------------
-- This is a block comment --
-----------------------------


package Test.Ch is

   use GAL;

   Ex_A, Ex_B : exception; -- Two exception with a trailing comment.

   type Int_Ptr is access all Integer;

   Test_Var : Boolean := Float'signed_zeros;

   Deferred : constant Natural;

   Max : constant Natural := Natural'last;
   -- A constant.

   Test2 : Boolean := Max > 65536;

   test3 : Boolean :=
     test2
     and
      then

        test_var;
   -- The funny formatting is on purpose here!

   type Length is new Natural;
   type Area   is new Natural;

   function "*" (A, B : in Length) return Length
     is abstract;

   function "*" (A, B : in Area) return Area
     is abstract;

   function "*" (A, B : in Length)
     return Area;

   Q,
   R,

   S : Integer;
   -- Empty line above.

   A_Meter : constant Length := 1;

   A_Square_Meter : constant Area := A_Meter * A_Meter;

   Four_Square_Meters : constant Area :=
     "*"
       (A_Meter + A_Meter, A_Meter + A_Meter);

   package XYZ is new Test.Gen2 (Base => Test.Parent);
   --  A generic instantiation.

   package XYZ_2 is new Test.Gen3 (Base => Test.Parent);

   package XYZ_3 is new Test.G4 (Base => Test.Parent);

   type Child is new XYZ.Mix_In with null record;
   -- A derivation from a type declared in the generic template.

   procedure Do_D
     (C : in out Child);
   -- The first operation
   --
   -- of this type.

   function Quark (X : in Integer) return Integer;

   procedure Swap is new Test.Swap (Integer);

   Another_Exception : exception
     renames An_Exception;
   -- A renaming
   -- from the parent package
   Yet_Another_Exception : exception renames XYZ.My_Exception;
   -- A renaming from the generic instantiation.
   --
   -- We'll see what this gives.

   Gen_Exc : exception renames XYZ.Some_Exception;

   A, B, C : Natural := Max;

   Quork : Integer := Quark (X => A);

   An_Int : constant := 42;
   --  A named integral number.

   D : Natural := An_Int;
   for D'Alignment use 4;


   --  A nested package

   package Inner is

     --  This one has two comments!

     type Another_Type is
        record
           A : Integer;
        end record; -- We have a trailing comment here!
     --  This type is here just for fun.

     procedure Q (A : in out Another_Type);

     --  And this is a primitive
     --  operation of type 'Another_Type'.
     --  It performs a classic foo, followed by a bar,
     --  and raises Another_Exception if A.A is negative.

     Min : Integer :=
       (- Max) +
       42;

     -- Just for fun.

   end inner;

   procedure Test_R
      (X : integer := R);

   for Int_Ptr'Storage_Size use 0;

   procedure Do_E (C : in Child);
   -- The second 'Child' operation.
   --
   --!
   --! This should be a line.
   --! And so should this.
   --!
   --! And an empty line above.
   --!
   -- Yeah!


   A_Number : constant := 1.23456789;
   -- A named real number

   procedure Dummy (A, B : in Integer)
     renames Test.Use_Instance.Y_Proc;

   type My_Rec;
   type My_Ptr is access all My_Rec;
   type My_Rec is
      record
         A : Integer;
         P : My_Ptr;
      end record;

   procedure my_rec_prim (M : in out my_rec);

private

   A_Private_Int : constant := 42;

   X : Integer := 0;

   Deferred : constant Natural := 42;

   type To_Be_Completed;
   type TBC_Ptr is access all To_Be_Completed;

end Test.Ch;
