From 393525afc3eefc8d29d34b3cf603cb94483b04e0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 12 Oct 2016 12:33:08 +0200 Subject: [PATCH] [multiple changes] 2016-10-12 Ed Schonberg * sem_ch12.adb (Check_Formal_Package_Instance): Handle properly an instance of a formal package with defaults, when defaulted parameters include tagged private types and array types. 2016-10-12 Tristan Gingold * restrict.ads, restrict.adb (Restricted_Profile): Adjust comment, use Restricted_Tasking to compare restrictions. * s-rident.ads (Profile_Name): Add Restricted_Tasking and reorder literals. (Profile_Info): Set restrictions for Restricted_Tasking. 2016-10-12 Ed Schonberg * sem_ch3.adb (Analyze_Full_Type_Declaration): Set Ghost status of type before elaborating inherited operations, so that the Ghost status is set properly for them. * ghost.adb (Check_Ghost_Overriding): A ghost subprogram can override an abstract subprogram coming from an interface operation. From-SVN: r241026 --- gcc/ada/ChangeLog | 30 ++++++++++++++++++++++++++++++ gcc/ada/ghost.adb | 2 ++ gcc/ada/restrict.adb | 6 ++++-- gcc/ada/restrict.ads | 10 +++++----- gcc/ada/s-rident.ads | 43 +++++++++++++++++++++++++++++++++++++++---- gcc/ada/sem_ch12.adb | 22 ++++++++++++++++++++-- gcc/ada/sem_ch3.adb | 15 +++++++-------- 7 files changed, 107 insertions(+), 21 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7e71e44b269..350fc3ef5fa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2016-10-12 Ed Schonberg + + * sem_ch12.adb (Check_Formal_Package_Instance): Handle properly + an instance of a formal package with defaults, when defaulted + parameters include tagged private types and array types. + +2016-10-12 Eric Botcazou + + PR ada/64057. + * exp_ch5.adb (Is_Non_Local_Array): Return true for every array + that is not a component or slice of an entity in the current + scope. + +2016-10-12 Tristan Gingold + + * restrict.ads, restrict.adb (Restricted_Profile): Adjust + comment, use Restricted_Tasking to compare restrictions. + * s-rident.ads (Profile_Name): Add Restricted_Tasking and + reorder literals. + (Profile_Info): Set restrictions for Restricted_Tasking. + +2016-10-12 Ed Schonberg + + * sem_ch3.adb (Analyze_Full_Type_Declaration): Set Ghost status + of type before elaborating inherited operations, so that the + Ghost status is set properly for them. + * ghost.adb (Check_Ghost_Overriding): A ghost subprogram can + override an abstract subprogram coming from an interface + operation. + 2016-10-11 Eric Botcazou * system-linux-armeb.ads (Backend_Overflow_Checks): Change to True. diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 2a640a2b88c..60b3866a905 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -603,6 +603,7 @@ package body Ghost is and then Present (Deriv_Typ) and then not Is_Ghost_Entity (Deriv_Typ) and then not Is_Ghost_Entity (Over_Subp) + and then not Is_Abstract_Subprogram (Over_Subp) then Error_Msg_N ("incompatible overriding in effect", Subp); @@ -617,6 +618,7 @@ package body Ghost is -- inherited Ghost primitive (SPARK RM 6.9(8)). if not Is_Ghost_Entity (Subp) + and then not Is_Abstract_Subprogram (Subp) and then Is_Ghost_Entity (Over_Subp) then Error_Msg_N ("incompatible overriding in effect", Subp); diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index c56c2e0b6ac..9d22f854e89 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -1194,8 +1194,10 @@ package body Restrict is Restricted_Profile_Cached := True; declare - R : Restriction_Flags renames Profile_Info (Restricted).Set; - V : Restriction_Values renames Profile_Info (Restricted).Value; + R : Restriction_Flags renames + Profile_Info (Restricted_Tasking).Set; + V : Restriction_Values renames + Profile_Info (Restricted_Tasking).Value; begin for J in R'Range loop if R (J) diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 3f05cd4f617..d725de799a9 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -424,10 +424,10 @@ package Restrict is -- executing this code only if needed. function Restricted_Profile return Boolean; - -- Tests if set of restrictions corresponding to Profile (Restricted) is - -- currently in effect (set by pragma Profile, or by an appropriate set of - -- individual Restrictions pragmas). Returns True only if all the required - -- restrictions are set. + -- Tests if set of restrictions corresponding to Restricted_Tasking profile + -- is currently in effect (set by pragma Profile, or by an appropriate set + -- of individual Restrictions pragmas). Returns True only if all the + -- required restrictions are set. procedure Set_Hidden_Part_In_SPARK (Loc1, Loc2 : Source_Ptr); -- Insert a new hidden region range in the SPARK hides table. The effect diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 4f36b460b6a..9b23b5b763f 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -378,15 +378,19 @@ package System.Rident is type Profile_Name is (No_Profile, No_Implementation_Extensions, + Restricted_Tasking, + Restricted, Ravenscar, - GNAT_Extended_Ravenscar, - Restricted); + GNAT_Extended_Ravenscar); -- Names of recognized profiles. No_Profile is used to indicate that a -- restriction came from pragma Restrictions[_Warning], as opposed to - -- pragma Profile[_Warning]. + -- pragma Profile[_Warning]. Restricted_Tasking is a non-user profile that + -- contaings the minimal set of restrictions to trigger the user of the + -- restricted tasking runtime. Restricted is the corresponding user profile + -- that also restrict protected types. subtype Profile_Name_Actual is Profile_Name - range No_Implementation_Extensions .. Restricted; + range No_Implementation_Extensions .. GNAT_Extended_Ravenscar; -- Actual used profile names type Profile_Data is record @@ -422,6 +426,37 @@ package System.Rident is Value => (others => 0)), + -- Restricted_Tasking Profile + + Restricted_Tasking => + + -- Restrictions for Restricted_Tasking profile + + (Set => + (No_Abort_Statements => True, + No_Asynchronous_Control => True, + No_Dynamic_Attachment => True, + No_Dynamic_Priorities => True, + No_Local_Protected_Objects => True, + No_Protected_Type_Allocators => True, + No_Requeue_Statements => True, + No_Task_Allocators => True, + No_Task_Attributes_Package => True, + No_Task_Hierarchy => True, + No_Terminate_Alternatives => True, + Max_Asynchronous_Select_Nesting => True, + Max_Select_Alternatives => True, + Max_Task_Entries => True, + others => False), + + -- Value settings for Restricted_Tasking profile + + Value => + (Max_Asynchronous_Select_Nesting => 0, + Max_Select_Alternatives => 0, + Max_Task_Entries => 0, + others => 0)), + -- Restricted Profile Restricted => diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 8533af0ecc7..efeaf4f661c 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5787,8 +5787,9 @@ package body Sem_Ch12 is (Formal_Pack : Entity_Id; Actual_Pack : Entity_Id) is - E1 : Entity_Id := First_Entity (Actual_Pack); - E2 : Entity_Id := First_Entity (Formal_Pack); + E1 : Entity_Id := First_Entity (Actual_Pack); + E2 : Entity_Id := First_Entity (Formal_Pack); + Prev_E1 : Entity_Id; Expr1 : Node_Id; Expr2 : Node_Id; @@ -5954,6 +5955,7 @@ package body Sem_Ch12 is -- Start of processing for Check_Formal_Package_Instance begin + Prev_E1 := E1; while Present (E1) and then Present (E2) loop exit when Ekind (E1) = E_Package and then Renamed_Entity (E1) = Renamed_Entity (Actual_Pack); @@ -5983,6 +5985,14 @@ package body Sem_Ch12 is if No (E1) then return; + -- Entities may be declared without full declaration, such as + -- itypes and predefined operators (concatenation for arrays, eg). + -- Skip it and keep the formal entity to find a later match for it. + + elsif No (Parent (E2)) then + E1 := Prev_E1; + goto Next_E; + -- If the formal entity comes from a formal declaration, it was -- defaulted in the formal package, and no check is needed on it. @@ -5990,6 +6000,13 @@ package body Sem_Ch12 is N_Formal_Object_Declaration, N_Formal_Type_Declaration) then + -- If the formal is a tagged type the corresponding class-wide + -- type has been generated as well, and it must be skipped. + + if Is_Type (E2) and then Is_Tagged_Type (E2) then + Next_Entity (E2); + end if; + goto Next_E; -- Ditto for defaulted formal subprograms. @@ -6144,6 +6161,7 @@ package body Sem_Ch12 is end if; <> + Prev_E1 := E1; Next_Entity (E1); Next_Entity (E2); end loop; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 4053ead57d6..07f25dcf846 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -877,7 +877,6 @@ package body Sem_Ch3 is then Build_Itype_Reference (Anon_Type, Parent (Current_Scope)); end if; - return Anon_Type; end if; @@ -2805,6 +2804,13 @@ package body Sem_Ch3 is if not Analyzed (T) then Set_Analyzed (T); + -- A type declared within a Ghost region is automatically Ghost + -- (SPARK RM 6.9(2)). + + if Ghost_Mode > None then + Set_Is_Ghost_Entity (T); + end if; + case Nkind (Def) is when N_Access_To_Subprogram_Definition => Access_Subprogram_Declaration (T, Def); @@ -2887,13 +2893,6 @@ package body Sem_Ch3 is Check_SPARK_05_Restriction ("controlled type is not allowed", N); end if; - -- A type declared within a Ghost region is automatically Ghost - -- (SPARK RM 6.9(2)). - - if Ghost_Mode > None then - Set_Is_Ghost_Entity (T); - end if; - -- Some common processing for all types Set_Depends_On_Private (T, Has_Private_Component (T)); -- 2.30.2