[multiple changes]

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* s-valllu.adb, a-tiinau.adb, a-timoau.adb, a-ztinau.adb, a-ztmoau.adb,
	s-valuns.adb, s-valrea.adb, a-wtflau.adb, a-tiflau.adb, a-ztflau.adb,
	a-wtinau.adb, a-wtmoau.adb: Document recognition of : in place of #.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): For aspects
	that specify stream subprograms, if the prefix is a class-wide
	type then the generated attribute definition clause must apply
	to the same class-wide type.
	(Default_Iterator): An iterator defined by an aspect of some
	container type T must have a first parameter of type T, T'class,
	or an access to such (from code reading RM 5.5.1 (2/3)).

2015-01-06  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb: Minor: complete previous change.

2015-01-06  Olivier Hainque  <hainque@adacore.com>

	* set_targ.ads (C_Type_For): New function. Return the name of
	a C type supported by the back-end and suitable as a basis to
	construct the standard Ada floating point type identified by
	the T parameter. This is used as a common ground to feed both
	ttypes values and the GNAT tree nodes for the standard floating
	point types.
	* set_targ.adb (Long_Double_Index): The index at which "long
	double" gets registered in the FPT_Mode_Table. This is useful to
	know whether we have a "long double" available at all and get at
	it's characteristics without having to search the FPT_Mode_Table
	when we need to decide which C type should be used as the
	basis for Long_Long_Float in Ada.
	(Register_Float_Type): Fill Long_Double_Index.
	(FPT_Mode_Index_For): New function. Return the index in
	FPT_Mode_Table that designates the entry corresponding to the
	provided C type name.
	(FPT_Mode_Index_For): New function. Return the index in
	FPT_Mode_Table that designates the entry for a back-end type
	suitable as a basis to construct the standard Ada floating point
	type identified by the input T parameter.
	(elaboration code): Register_Back_End_Types unconditionally,
	so C_Type_For can operate regardless of -gnateT. Do it
	early so we can query it for the floating point sizes, via
	FPT_Mode_Index_For. Initialize Float_Size, Double_Size and
	Long_Double_Size from the FPT_Mode_Table, as cstand will do.
	* cstand.adb (Create_Float_Types): Use C_Type_For to determine
	which C type should be used as the basis for the construction
	of the Standard Ada floating point types.
	* get_targ.ads (Get_Float_Size, Get_Double_Size,
	Get_Long_Double_Size): Remove.
	* get_targ.adb: Likewise.

2015-01-06  Thomas Quinot  <quinot@adacore.com>

	* sem_cat.adb (In_RCI_Declaration): Remove unnecessary
	parameter and rename to...
	(In_RCI_Visible_Declarations): Fix handling of private part of nested
	package.
	(Validate_RCI_Subprogram_Declaration): Reject illegal function
	returning anonymous access in RCI unit.

From-SVN: r219233

1 files changed, 43 insertions, 29 deletions

diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 06460fd..e03d00e 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -86,10 +86,10 @@ package body Sem_Cat is
    --  Return True if the entity or one of its subcomponents does not support
    --  external streaming.
 
-   function In_RCI_Declaration (N : Node_Id) return Boolean;
-   --  Determines if a declaration is  within the visible part of a Remote
-   --  Call Interface compilation unit, for semantic checking purposes only
-   --  (returns false within an instance and within the package body).
+   function In_RCI_Visible_Declarations return Boolean;
+   --  Determines if the visible part of a remote call interface library unit
+   --  is being compiled, for semantic checking purposes (returns False within
+   --  an instance and within the package body).
 
    function In_RT_Declaration return Boolean;
    --  Determines if current scope is within the declaration of a Remote Types
@@ -544,30 +544,39 @@ package body Sem_Cat is
       return Is_Pure (Current_Scope);
    end In_Pure_Unit;
 
-   ------------------------
-   -- In_RCI_Declaration --
-   ------------------------
+   ---------------------------------
+   -- In_RCI_Visible_Declarations --
+   ---------------------------------
 
-   function In_RCI_Declaration (N : Node_Id) return Boolean is
-      Unit_Entity : constant Entity_Id := Current_Scope;
+   function In_RCI_Visible_Declarations return Boolean is
+      Unit_Entity : Entity_Id := Current_Scope;
       Unit_Kind   : constant Node_Kind :=
                       Nkind (Unit (Cunit (Current_Sem_Unit)));
 
    begin
-      --  There are no restrictions on the private part or body
-      --  of an RCI unit.
+      --  There are no restrictions on the private part or body of an RCI unit
 
-      return Is_Remote_Call_Interface (Unit_Entity)
+      if not (Is_Remote_Call_Interface (Unit_Entity)
         and then Is_Package_Or_Generic_Package (Unit_Entity)
         and then Unit_Kind /= N_Package_Body
-        and then List_Containing (N) =
-                   Visible_Declarations (Package_Specification (Unit_Entity))
-        and then not In_Package_Body (Unit_Entity)
-        and then not In_Instance;
+        and then not In_Instance)
+      then
+         return False;
+      end if;
+
+      while Unit_Entity /= Standard_Standard loop
+         if In_Private_Part (Unit_Entity) then
+            return False;
+         end if;
+
+         Unit_Entity := Scope (Unit_Entity);
+      end loop;
+
+      --  Here if in RCI declaration, and not in private part of any open
+      --  scope.
 
-      --  What about the case of a nested package in the visible part???
-      --  This case is missed by the List_Containing check above???
-   end In_RCI_Declaration;
+      return True;
+   end In_RCI_Visible_Declarations;
 
    -----------------------
    -- In_RT_Declaration --
@@ -1371,7 +1380,7 @@ package body Sem_Cat is
       --  The visible part of an RCI library unit must not contain the
       --  declaration of a variable (RM E.1.3(9))
 
-      elsif In_RCI_Declaration (N) then
+      elsif In_RCI_Visible_Declarations then
          Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N);
 
       --  The visible part of a Shared Passive library unit must not contain
@@ -1609,7 +1618,7 @@ package body Sem_Cat is
       --    1. from Analyze_Subprogram_Declaration.
       --    2. from Validate_Object_Declaration (access to subprogram).
 
-      if not (Comes_From_Source (N) and then In_RCI_Declaration (N)) then
+      if not (Comes_From_Source (N) and then In_RCI_Visible_Declarations) then
          return;
       end if;
 
@@ -1652,12 +1661,10 @@ package body Sem_Cat is
 
                --  Report error only if declaration is in source program
 
-               if Comes_From_Source
-                 (Defining_Entity (Specification (N)))
-               then
+               if Comes_From_Source (Id) then
                   Error_Msg_N
                     ("subprogram in 'R'C'I unit cannot have access parameter",
-                      Error_Node);
+                     Error_Node);
                end if;
 
             --  For a limited private type parameter, we check only the private
@@ -1680,8 +1687,15 @@ package body Sem_Cat is
 
             Next (Param_Spec);
          end loop;
+      end if;
 
-         --  No check on return type???
+      if Ekind (Id) = E_Function
+        and then Ekind (Etype (Id)) = E_Anonymous_Access_Type
+        and then Comes_From_Source (Id)
+      then
+         Error_Msg_N
+           ("function in 'R'C'I unit cannot have access result",
+             Error_Node);
       end if;
    end Validate_RCI_Subprogram_Declaration;
 
@@ -1698,8 +1712,8 @@ package body Sem_Cat is
       --  the given node is N_Access_To_Object_Definition.
 
       if not Comes_From_Source (T)
-        or else (not In_RCI_Declaration (Parent (T))
-                  and then not In_RT_Declaration)
+        or else (not In_RCI_Visible_Declarations
+                   and then not In_RT_Declaration)
       then
          return;
       end if;
@@ -1721,7 +1735,7 @@ package body Sem_Cat is
       if Ekind (T) /= E_General_Access_Type
         or else not Is_Class_Wide_Type (Designated_Type (T))
       then
-         if In_RCI_Declaration (Parent (T)) then
+         if In_RCI_Visible_Declarations then
             Error_Msg_N
               ("error in access type in Remote_Call_Interface unit", T);
          else