--
--


--

with text_io;
use text_io;

with Ada.Integer_Text_IO;
use  Ada.Integer_Text_IO;


package Package_With_Private is

   type Private_Type is private;

private

   type Private_Type is array (1 .. 10) of Integer;

end Package_With_Private;


procedure Range_1( i : integer );   -- forward declaration


Block_Name :   -- CHECK: block labels are handled sensibly
declare
   A_Variable : The_Type;
begin
   Use A_Variable
end Block_Name;

generic
   Max: Positive;
   type Element_T is private;
package Generic_Stack is
   procedure Push (E: Element_T);
   function Pop return Element_T;
end Generic_Stack;


procedure Generic_Swap is
   generic
      type Item is private;
   procedure Exchange(X, Y: in out Item);
   procedure Exchange(X, Y: in out Item) is
      Temp: Item;
   begin
      Temp := X;
      Result.Elements (i, Result.Elements'Last (2))
         := 3 + Right.Elements (i);
      a := long_expression
           + another_long_expression;     -- CHECK: this should be indented
      func
         ( a,
           b
         );
      Y := func
              ( a,
                b
              );
      Y :=
         func
            ( a,
              b
            );
   end;

   A, B : Integer;
   procedure Swap is new Exchange(integer);

begin
   A := 1;
   B := 2;
   Swap(A,B);
   Ada.Float_Text_IO.put                        --  Float literal
      (Item => gamma(i), Fore => 1, Aft => 1, Exp => 0);
   new_line;
   Ada.Float_Text_IO.put(                        --  Float literal
                           Item => gamma(i), Fore => 1, Aft => 1, Exp => 0);
   new_line;
   return( a+b );
   return(
            a+b );
   return
      ( a
        +b);

end Generic_Swap;


function SUBSTRING (DSTR: DYN_STRING;   -- this is a forward reference
                    START  : natural;
                    LENGTH : natural := 0)
   return DYN_STRING;

function SUBSTRING (DSTR: DYN_STRING;
                    LENGTH : natural := 0)
   return DYN_STRING is
   DS: DYN_STRING;
   L : natural := LENGTH;

   type Degrees is new Float range -273.15 .. Float'Last;
   Temperature : Degrees;

   type Car is record
      Identity       : Long_Long_Integer;
      Number_Wheels  : Positive range 1 .. 10;
      Paint          : Color;
      Horse_Power_kW : Float range 0.0 .. 2_000.0;
      Consumption    : Float range 0.0 .. 100.0;
   end record;

   BMW : Car :=
      (Identity       => 2007_752_83992434,
       Number_Wheels  => 5,
       Horse_Power_kW => 190.0,
       Consumption    => 10.1,
       Paint          => Blue);

   type Directions is (North, South, East, West);
   Heading : Directions;

begin
   put_line("It works!");

   case long_expression
      + Another_long_expression is
      when 89 ==>
         s1;
         s2;
<<lab>>         -- CHECK: label should be aligned with begin
#
      when 1 =>
         Walk_The_Dog;

      when 16#5# ==>
         a := 5;
         a := 9;
         f(18);
         s1;

#include "fred"

      when 5 =>
         case Heading is
            when North =>
               Y := Y + 1;
            when South =>
               Y := Y - 1;
            when East =>
               X := X + 1;
            when West =>
               X := X - 1;
         end case;

      when 8 | 10 =>

         Sell_All_Stock;

      when others =>

         if Temperature >= 40.0 then
            Put_Line ("Wow!");
            Put_Line ("It's extremely hot");
         elsif Temperature >= 30.0 then
            Put_Line ("It's hot");
         elsif Temperature >= 20.0 then
            Put_Line ("It's warm");
         elsif Temperature >= 10.0 then
            Put_Line ("It's cool");
         elsif Temperature >= 0.0 then
            Put_Line ("It's cold");
         else
            Put_Line ("It's freezing");
         end if;

   end case;

   DS3.DATA(1..DS3.SIZE):=   DS1.DATA(1..DS1.SIZE)
                             & DS2.DATA(1..DS2.SIZE);
   return DS3;  -- CHECK: should align with DS3 above
end main;


procedure Quadratic_Equation
             (A, B, C :     Float;   -- By default it is "in".
              R1, R2  : out Float;
              Valid   : out Boolean)
is
   Z : Float;

   type Discriminated_Record (Size : Natural) is
      record
         A : String (1 .. Size);
         B : Integer;
      end record;

begin
   Z := B**2 - 4.0 * A * C;

   if At_Location > In_Text'Last
      or else At_Location + Pattern'Length - 1 >
      In_Text'Last
      or else Slided_Text_T (In_Text (
                                        At_Location .. At_Location + Pattern'Length - 1)) /=
         Slided_Pattern
   then
      Valid := False;  -- Being out parameter, it should be modified at least once.
      R1    := 0.0;
      R2    := 0.0;
<<lab>>
   else
      Valid := True;
      R1    := (-B + Sqrt (Z)) / (2.0 * A);
      R2    := (-B - Sqrt (Z)) / (2.0 * A);
   end if;
end Quadratic_Equation;


procedure Error_Handling_4 is

   Float_Error : exception;

   type DEVICE is (PRINTER, DISK, DRUM);
   type STATE  is (OPEN, CLOSED);

   type PERIPHERAL(UNIT : DEVICE := DISK) is
      record
         STATUS : STATE;
         case UNIT is
            when PRINTER =>
               LINE_COUNT : INTEGER range 1 .. PAGE_SIZE;
            when others =>
               CYLINDER   : CYLINDER_INDEX;
               TRACK      : TRACK_NUMBER;
         end case;
      end record;


   function Square_Root (X : in Float) return Float is
      use Ada.Numerics.Elementary_Functions;
   begin
      if (X < 0.0) then
         raise Float_Error;
      else
         return Sqrt (X);
      end if;
   end Square_Root;

begin

   begin
      C := Square_Root (A ** 2 + B ** 2);

      T_IO.Put ("C is ");
      F_IO.Put
         (Item => C,
          Fore => (F_IO.Default_Fore +
                   1 ),
          Aft  => F_IO.Default_Aft,
          Exp  => F_IO.Default_Exp);
   exception
      when Constraint_Error =>
         T_IO.Put ("C cannot be calculated!");
   end;

   return;
end Error_Handling_4;


procedure Range_1 is
   type Range_Type is range -5 .. 10;

   Default_String : constant String := "This is the long string returned by" &
                                       " default.  It is broken into multiple" &
                                       " Ada source lines for convenience.";

   Another_Default_String : constant String :=
      "This is the long string returned by" &
      " default.  It is broken into multiple" &
      " Ada source lines for convenience.";

   type Op_Codes_In_Column is
           ( Push,
             Pop,
             Add );

   package T_IO renames Ada.Text_IO;
   package I_IO is
      new  Ada.Text_IO.Integer_IO (Range_Type);

   a: real;


begin
   for A in Range_Type loop
      I_IO.Put (Item  => A,
                Width => 3,                   -- CHECK: params should line up
                Base  => 10);

      if A < Range_Type'Last then
         Process_Each_Page:
         loop

            declare
               package Float_100_Stack is new Generic_Stack (100, Float);
               use Float_100_Stack;
            begin
               Push (45.8);
            end;

            Process_All_The_Lines_On_This_Page:
            loop
               s1;
               exit Process_All_The_Lines_On_This_Page when Line_Number = Max_Lines_On_Page;
               s2;
               Look_For_Sentinel_Value:
               loop
                  s3;
                  exit Look_For_Sentinel_Value when Current_Symbol = Sentinel;
                  s4;
               end loop Look_For_Sentinel_Value;
               s5;
            end loop Process_All_The_Lines_On_This_Page;
            s6;
            exit Process_Each_Page when Page_Number = Maximum_Pages;
            s7;
         end loop Process_Each_Page;
      else
         T_IO.New_Line;

         -- comment below scans back to here !!??
         for I in  A'Range (1) loop
            for J in  A'Range (2) loop
               Sum := 0.0;
               for R in  A'Range (2) loop
                  Sum := Sum + A.all (I, R) * B.all (R, J);
               end loop;
               C.all (I, J) := Sum +
                               second_part_of_long_expression +
                               third_part_of_long_expression;
               if Input_Found then
                  Count_Characters;

               else  --not Input_Found
                  Reset_State;
                  Character_Total :=
                     First_Part_Total  * First_Part_Scale_Factor  +
                     Second_Part_Total * Second_Part_Scale_Factor +
                     Default_String'Length + Delimiter_Size;
               end if;

            end loop;
         end loop;
      end if;
   end loop;
end Range_1;

-- generic instantiation   -- TODO: wrong, ...
-- ... statementIndent() scans back to for R in A'Range ... ??? ...
-- ... because it skips over the ends

package Day_Of_Month_IO is  -- TODO: scans back to beginning of file: generic? should have stopped at 'procedure'
   new Ada.Text_IO.Integer_IO (Day_Of_Month);

procedure f;

-- CHECK: these should be recognised as forward procedures ...
procedure Day_Of (Day, Month, Year : in Integer;
                  Result           : out Integer);
procedure x;
procedure x1;

procedure TRAVERSE_TREE;
procedure INCREMENT(X : in out INTEGER);
procedure RIGHT_INDENT(MARGIN : out LINE_SIZE);          --  see 3.5.4
procedure SWITCH(FROM, TO : in out LINK);                --  see 3.8.1

function RANDOM return PROBABILITY;                      --  see 3.5.7

function MIN_CELL(X : LINK) return CELL;                 --  see 3.8.1
function NEXT_FRAME(K : POSITIVE) return FRAME;          --  see 3.8
function DOT_PRODUCT(LEFT,RIGHT: VECTOR) return REAL;    --  see 3.6

function "*"(LEFT,RIGHT : MATRIX) return MATRIX;         --  see 3.6

procedure Nesting is

   procedure Triple is

      procedure Second_Layer(Persistence : in out Persistence_View;
                             Stream      : not null access Root_Stream_Type'Class)
      is

         procedure Bottom_Layer is
         begin
            Put_Line("This is the Bottom Layer talking.");
            Do_Something;

            if Test then
               goto Exit_Use_Goto;
            end if;
            Do_Something_Else;
         <<Label>>

         <<Exit_Use_Goto>>  -- CHECK: should align with 'begin'
            return;
         end Bottom_Layer;

      begin -- Second_Layer
         Put_Line("This is the Second Layer talking.");
         Bottom_Layer;
      <<Exit_Use_Goto>>  -- CHECK: should align with 'begin'
         Put_Line("We are back up to the Second Layer.");
      end Second_Layer;

   begin -- Triple
      Put_Line("This is procedure Triple talking to you.");
      Second_Layer;
      Put_Line("We are back up to the procedure named Triple.");
   end Triple;

begin -- Nesting
   Put_Line("Start the triple nesting here.");
   Triple;
   Put_Line("Finished, and back to the top level.");
end Nesting;


procedure Proced3 is

   Dogs, Cats, Animals : INTEGER;

   -- This is a procedure specification
   procedure Total_Number_Of_Animals(Variety1 : in     INTEGER;
                                     Variety2 : in     INTEGER;
                                     Total    :    out INTEGER);

   -- This is a procedure body
   procedure Total_Number_Of_Animals(Variety1 : in     INTEGER;
                                     Variety2 : in     INTEGER;
                                     Total    :    out INTEGER) is
   begin
      Total := Variety1 + Variety2;
   end Total_Number_Of_Animals;

begin
   Dogs := 3;
   Cats := 4;
   if some_condition
      or some_other_condition
      or yet_another_condition
   then
      action( a,
              b+c,
              c + d
              + e +f +g,  -- would be nice if this was indented
            );

   end if;

   Total_Number_Of_Animals(Dogs, Cats, Animals);
   Put("The total number of animals is");
   Put(Animals, 3);
   if cond then
      while c loop
         for i in integer  -- multiline for loop
            range 1..1000
         loop
            a := long_expression
                 + long_expression
                 + long_expression;
            a(i) := 10;
         end loop;
         a := long_expression
              + long_expression
              + long_expression;

         while x > 0
            and x <= 100
         loop                -- CHECK: not indented
            loop             -- CHECK: indented
               a := q1 +
                    q2 +
                    q3;
            end loop;
         end loop;

         while x > 0 loop
            loop -- forever loop
               aaaaaaa :=
                  q1 +
                  q2 +
                  q3;
            end loop;
         end loop;
      end loop;

      end loop;

      fredzarmplezzzzzzzzzzzz(       arg1,
                                     arg1,
                                     arg2,
                                     arg3
                             );
      x := f(a) + f(b);
      fffffffffffff(    func0(  func1(    func2( f3(       arg1,
                                                           arg2,
                                                           arg3,
                                                           arg4
                                                   ),
                                                 a1,  -- should be aligned with arg f3, not '('
                                                 a2,
                                                 a3,
                                                 a4
                                               ),

                                          aa2,
                                          aa3,
                                          aa4,
                                          aa5
                                     ),
                                bb1,
                                bb2,
                                bb3,
                                bb4
                             ),
                        cc1,
                        cc2,
                        cc3,
                        cc4
                   );

      s1;
   end if;

   New_Line;
end Proced3;


procedure Main is
   task Sub is
      entry Wake_Up(I: Integer);
   end Sub;

   task body Sub is
      Stop: Boolean := False;
   begin
      while not Stop loop
         Put("Sub:  Wait"); New_Line(1);
         accept Wake_Up(I: Integer) do
            Put("Sub:  "); Put(I); New_Line(1);
            if I = 0 then
               Stop := True;
            end if;
         end Wake_Up;
      end loop;
      Put("Sub:  Stop"); New_Line(1);
   end Sub;
begin
   Extract_Publisher:
   for Index in Base_11_Digits (Item.Country + 1) ..
      Base_11_Digits (Item.Publisher) loop
      declare

         Digit : constant Natural range 0 .. 9
            := Natural (Item.Number (Index));
         Power : constant Natural range 0 .. 9
            := Item.Publisher - Natural (Index);

      begin
         Publisher := Publisher + Digit * (10 ** Power);
      end;
   end loop Extract_Publisher;   -- CHECK: matches 'for' above

   Put("Main: Stop"); New_Line(1);
   declare
   begin
   end;
   if c
      and c2
   then
      s1;
      for i in a'range
      loop
         loop
            s12;
            s13;
         end lop;
      end loop;
   elsif c05
      or c06
   then
      s12;
   elsif c1 then
      s2;
   else
      s3;
      a12 :=
         f(13);
   end if;
end;
end;


package Utilities is
   generic
      type Item is private;
   procedure Swap(L, R : in out Item);
   -- A handy package at the project-specific level
   -- A constrained generic formal parameter
   generic
      type Item is (<>);
   function Next (Data : Item) return Item;
   -- A discrete type generic formal parameter
   generic
      type Item is (<>);
      -- A discrete type generic formal parameter
   function Prev (Data : Item) return Item;
   -- more generic subprograms as appropriate to your particular project needs
end Utilities;


// kate: line-numbers true; indent-width 3; replace-tabs on
// kate: debugMode off
