[Ada] Spurious error on local instantiation of pure generic unit

[Arnaud Charlet <charlet at adacore dot com>]

This patch fixes an error in the legality checks of aspects that apply
to library units: these aspects are legal on a local instantiation of a
library-level generic unit that carries the aspect pure.

The following must compile quietly:

   gcc -c my_buffer.adb

---
package My_Buffer
  with Elaborate_Body
is
end My_Buffer;
---
with Common.Gen_Circular_Buffer;
package body My_Buffer is
   type Capacity_Count is range 0 .. 10;

   procedure Copy_Integer
     (From_Element : in     Integer;
      To_Element   :    out Integer)
   is
   begin
      To_Element := From_Element;
   end Copy_Integer;

   package Buffer is new
     Common.Gen_Circular_Buffer (Capacity_Count => Capacity_Count,
                                 Capacity       => 10,
                                 Element_Type   => Integer,
                                 Copy_Element   => Copy_Integer);
end My_Buffer;
---
package body Common.Gen_Circular_Buffer is
   procedure Initialize (Buffer : out Buffer_Type) is
   begin
      Buffer.Start_Index := Element_Index'First;
      Buffer.Count       := 0;
   end Initialize;

   procedure Insert
     (Element : in Element_Type;
      Buffer : in out Buffer_Type)
   is
      End_Index : Element_Index;
      --  Index into the end of the buffer where Element is to be stored.
   begin
      if Element_Index'Last - Buffer.Start_Index >= Buffer.Count then
         End_Index := Buffer.Start_Index + Buffer.Count;
      else
         End_Index := Element_Index'First +
          (Buffer.Count - ((Element_Index'Last - Buffer.Start_Index) + 1));
      end if;

      Copy_Element (From_Element => Element,
         To_Element => Buffer.Elements (End_Index));

      Buffer.Count := Buffer.Count + 1;
   end Insert;

   procedure Remove
     (Buffer : in out Buffer_Type;
      Element : out Element_Type)
   is
   begin
      Copy_Element (From_Element => Buffer.Elements (Buffer.Start_Index),
                    To_Element => Element);

      Discard_First (Buffer);
   end Remove;

   procedure Discard_First (Buffer : in out Buffer_Type) is
   begin
      if Buffer.Start_Index = Element_Index'Last then
         Buffer.Start_Index := Element_Index'First;
      else
         Buffer.Start_Index := Buffer.Start_Index + 1;
      end if;

      Buffer.Count := Buffer.Count - 1;
   end Discard_First;

   function Capacity_Used (Buffer : in Buffer_Type) return Element_Count is
   begin
      return Buffer.Count;
   end Capacity_Used;

end Common.Gen_Circular_Buffer;
---
generic
   type Capacity_Count is range <>;
   Capacity : Capacity_Count;

   type Element_Type is limited private;

   with procedure Copy_Element (From_Element : in Element_Type;
       To_Element : out Element_Type);
package Common.Gen_Circular_Buffer
  with Pure
is
   type Buffer_Type is limited private;

   type Element_Count is new Capacity_Count range 0 .. Capacity;

   procedure Initialize (Buffer : out Buffer_Type);

   procedure Insert (Element : in Element_Type; Buffer : in out Buffer_Type)
   with Pre => Capacity_Used (Buffer) < Element_Count'Last;

   procedure Remove (Buffer : in out Buffer_Type; Element : out Element_Type)
   with Pre => Capacity_Used (Buffer) > 0;

   procedure Discard_First (Buffer : in out Buffer_Type)
   with Pre => Capacity_Used (Buffer) > 0;

   function Capacity_Used (Buffer : in Buffer_Type) return Element_Count;
private

   subtype Element_Index is Element_Count range 1 .. Element_Count'Last;

   type Element_Array is array (Element_Index) of Element_Type;

   type Buffer_Type is
      record
         Start_Index : Element_Index;

         Count : Element_Count;

         Elements : Element_Array;
         --  Element storage.
      end record;
end Common.Gen_Circular_Buffer;
---
package Common
with Pure
is
end Common;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications, Library_Unit_Aspects):
	Aspect specification is legal on a local instantiation of a
	library-level generic unit.

Attachment: difs
Description: Text document