From 72eaa365121eec76a29a0a231c4edfff28f2a250 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 6 Jan 2015 10:24:33 +0100 Subject: [multiple changes] 2015-01-06 Robert Dewar * 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 * 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 * gnat1drv.adb: Minor: complete previous change. 2015-01-06 Olivier Hainque * 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 * 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 --- gcc/ada/sem_cat.adb | 72 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 43 insertions(+), 29 deletions(-) (limited to 'gcc/ada/sem_cat.adb') 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 -- cgit v1.1