[Ada] fix support for CPP_Class pragma

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

Add missing support to propagate the CPP_Class attribute to the full
private declaration. After this patch the following test compiles
and executes without errors:
--
// filename: idbase.h
class IdBase {
public:
    int id() const;
protected:
    IdBase (int id);
private:
    void initialize (int id);
    IdBase();
    int _id;
};
--
// filename: idbase.cpp
#include "idbase.h"
int  IdBase::id() const         {return _id;}
void IdBase::initialize(int id) {_id = id;}
IdBase::IdBase (int id)         {_id = id;}
IdBase::IdBase()                {_id = 999;}
--
package Idbase_Iface is
   type IdBase is tagged limited private;
   pragma CPP_Class (IdBase);
--
   function Id (This : IdBase) return Integer;
   pragma Import (CPP, Id, "_ZNK6IdBase2idEv");
   pragma Cpp_Virtual (Id);
--
   procedure Initialize (This : IdBase; Id : Integer);
   pragma Import (CPP, Initialize, "_ZN6IdBase10initializeEi");
   pragma Cpp_Virtual (Initialize);
--
   function New_Id return IdBase'Class;
   pragma CPP_Constructor (New_Id);
   pragma Import (CPP, New_Id, "_ZN6IdBaseC2Ev");
private
   type IdBase is tagged limited record
     My_Id : Integer;
   end record;
end;
--
with Idbase_Iface; use Idbase_Iface;
with Ada.Text_IO;  use Ada.Text_IO;
procedure Main is
   Obj : IdBase;
begin
   Put_Line ("Default init = " & Integer'Image (Obj.Id));
   Initialize (Obj, 1234);
   Put_Line ("   New value = " & Integer'Image (Obj.Id));
end;
--
Command:
  $ g++ -c idbase.cpp
  $ gnatmake -gnat05 main.adb -largs idbase.o
  $ ./main
--
Output:
  Default init =  999
     New value =  1234

This patch also adds an accessibility check for cases when a component of a
type is initialized with the value of an access discriminants.
Source:
  procedure P is
     type Animal is tagged null record;
     type Rec (D : access Animal'Class) is record
        Comp : access Animal'Class := D;
     end record;
  begin
     null;
  end P;
Compilation:
  gnatmake p.adb
Output:
  p.adb:4:37: discriminant has deeper accessibility level than target

A component list, like other lists of declarations, can contain pragmas. When
iterating over the component lists to locate components that correspond to
secondary tags of implemented parent interfaces, those pragmas must be ignored.

gnat.dg/specs/cpp1.ads must compile quietly.

Components of a self-referential anonymous access type generate an incomplete
type declaration for the enclosing record type, before the analysis of the
record type declaration itself. In order to recognize properly a self-reference
of the form P.T, we must examine the names themselves: P must have the name of
the current scope, and T the name of the type, which has not been introduced yet
into the environment. It is too early to analyze the selected component itself.

gnat.dg/specs/tag1.ads must compile quietly.

Finally, character literals are ambiguous in various contexts, including index
definitions given by a range whose bounds are literals. This small patch
make the corresponding error message uniform with ambiguities in comparison
operations and membership tests.

When compiled in gnat05 mode, r1.ads given below must be rejected with:

r1.ads:2:21: ambiguous character literal
r1.ads:2:21: possible interpretation: Character
r1.ads:2:21: possible interpretation: Wide_Character
r1.ads:2:21: possible interpretation: Wide_Wide_Character

package R1 is
   type T is array ('A' ..'B') of integer;
end R1;

2007-06-06  Javier Miranda  <miranda@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Process_Full_View): Propagate the CPP_Class attribute to
	the full type declaration.
	(Analyze_Component_Declaration): Add local variable E to capture the
	initialization expression of the declaration. Replace the occurences of
	Expression (N) with E.
	(OK_For_Limited_Init_In_05): Allow initialization of class-wide
	limited interface object with a function call.
	(Array_Type_Declaration): If the declaration lacks subtype marks for
	indices, create a simple index list to prevent cascaded errors.
	(Is_Null_Extension): Ignore internal components created for secondary
	tags when checking whether a record extension is a null extension.
	(Check_Abstract_Interfaces): Add missing support for interface subtypes
	and generic formals.
	(Derived_Type_Declaration): Add missing support for interface subtypes
	and generic formals.
	(Analyze_Object_Declaration): If an initialization expression is
	present, traverse its subtree and mark all allocators as static
	coextensions.
	(Add_Interface_Tag_Component): When looking for components that may be
	secondary tags, ignore pragmas that can appear within a record
	declaration.
	(Check_Abstract_Overriding): an inherited function that dispatches on
	result does not need to be overriden if the controlling type is a null
	extension.
	(Mentions_T): Handle properly a 'class attribute in an anonymous access
	component declaration, when the prefix is an expanded name.
	(Inherit_Component): If the derivation is for a private extension,
	inherited components remain visible and their ekind should not be set
	to Void.
	(Find_Type_Of_Object): In the case of an access definition, always set
	Is_Local_Anonymous_Access. We were previously not marking the anonymous
	access type of a return object as a local anonymous type.
	(Make_Index): Use Ambiguous_Character to report ambiguity on a discrete
	range with character literal bounds.
	(Constrain_Array): Initialize the Packed_Array_Type field to Empty.
	(Access_Subprogram_Declaration): Indicate that the type declaration
	depends on an incomplete type only if the incomplete type is declared
	in an open scope.
	(Analyze_Subtype_Declaration): Handle properly subtypes of
	synchronized types that are tagged, and that may appear as generic
	actuals.
	(Access_Subprogram_Declaration): An anonymous access to subprogram can
	appear as an access discriminant in a private type declaration.
	(Add_Interface_Tag_Components): Complete decoration of the component
	containing the tag of a secondary dispatch table and the component
	containing the offset to the base of the object (this latter component
	is only generated when the parent type has discriminants --as documented
	in this routine).
	(Inherit_Components): Use the new decoration of the tag components to
	improve the condition that avoids inheriting the components associated
	with secondary tags of the parent.
	(Build_Discriminanted_Subtype): Indicate to the backend that the
	size of record types associated with dispatch tables is known at
	compile time.
	(Analyze_Subtype_Declaration): Propagate Is_Interface flag when needed.
	(Analyze_Interface_Declaration): Change setting of Is_Limited_Interface
	to include task, protected, and synchronized interfaces as limited
	interfaces.
	(Process_Discriminants): Remove the setting of
	Is_Local_Anonymous_Access on the type of (anonymous) access
	discriminants of nonlimited types.
	(Analyze_Interface_Type_Declaration): Complete the decoration of the
	class-wide entity it is is already present. This situation occurs if
	the limited-view has been previously built.
	(Enumeration_Type_Declaration): Initialize properly the Enum_Pos_To_Rep
	field.
	(Add_Interface_Tag_Components.Add_Tag): Set the value of the attribute
	Related_Interface.

Attachment: difs
Description: Text document