mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2016-10-12 Ed Schonberg <schonberg@adacore.com> * 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 <gingold@adacore.com> * 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 <schonberg@adacore.com> * 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
This commit is contained in:
parent
f40dbd80eb
commit
393525afc3
|
|
@ -1,3 +1,33 @@
|
|||
2016-10-12 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* 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 <ebotcazou@adacore.com>
|
||||
|
||||
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 <gingold@adacore.com>
|
||||
|
||||
* 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 <schonberg@adacore.com>
|
||||
|
||||
* 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 <ebotcazou@adacore.com>
|
||||
|
||||
* system-linux-armeb.ads (Backend_Overflow_Checks): Change to True.
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =>
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
<<Next_E>>
|
||||
Prev_E1 := E1;
|
||||
Next_Entity (E1);
|
||||
Next_Entity (E2);
|
||||
end loop;
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
|
|
|
|||
Loading…
Reference in New Issue