Commit 393525af by Arnaud Charlet

[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
parent f40dbd80
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> 2016-10-11 Eric Botcazou <ebotcazou@adacore.com>
* system-linux-armeb.ads (Backend_Overflow_Checks): Change to True. * system-linux-armeb.ads (Backend_Overflow_Checks): Change to True.
......
...@@ -603,6 +603,7 @@ package body Ghost is ...@@ -603,6 +603,7 @@ package body Ghost is
and then Present (Deriv_Typ) and then Present (Deriv_Typ)
and then not Is_Ghost_Entity (Deriv_Typ) and then not Is_Ghost_Entity (Deriv_Typ)
and then not Is_Ghost_Entity (Over_Subp) and then not Is_Ghost_Entity (Over_Subp)
and then not Is_Abstract_Subprogram (Over_Subp)
then then
Error_Msg_N ("incompatible overriding in effect", Subp); Error_Msg_N ("incompatible overriding in effect", Subp);
...@@ -617,6 +618,7 @@ package body Ghost is ...@@ -617,6 +618,7 @@ package body Ghost is
-- inherited Ghost primitive (SPARK RM 6.9(8)). -- inherited Ghost primitive (SPARK RM 6.9(8)).
if not Is_Ghost_Entity (Subp) if not Is_Ghost_Entity (Subp)
and then not Is_Abstract_Subprogram (Subp)
and then Is_Ghost_Entity (Over_Subp) and then Is_Ghost_Entity (Over_Subp)
then then
Error_Msg_N ("incompatible overriding in effect", Subp); Error_Msg_N ("incompatible overriding in effect", Subp);
......
...@@ -1194,8 +1194,10 @@ package body Restrict is ...@@ -1194,8 +1194,10 @@ package body Restrict is
Restricted_Profile_Cached := True; Restricted_Profile_Cached := True;
declare declare
R : Restriction_Flags renames Profile_Info (Restricted).Set; R : Restriction_Flags renames
V : Restriction_Values renames Profile_Info (Restricted).Value; Profile_Info (Restricted_Tasking).Set;
V : Restriction_Values renames
Profile_Info (Restricted_Tasking).Value;
begin begin
for J in R'Range loop for J in R'Range loop
if R (J) if R (J)
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -424,10 +424,10 @@ package Restrict is ...@@ -424,10 +424,10 @@ package Restrict is
-- executing this code only if needed. -- executing this code only if needed.
function Restricted_Profile return Boolean; function Restricted_Profile return Boolean;
-- Tests if set of restrictions corresponding to Profile (Restricted) is -- Tests if set of restrictions corresponding to Restricted_Tasking profile
-- currently in effect (set by pragma Profile, or by an appropriate set of -- is currently in effect (set by pragma Profile, or by an appropriate set
-- individual Restrictions pragmas). Returns True only if all the required -- of individual Restrictions pragmas). Returns True only if all the
-- restrictions are set. -- required restrictions are set.
procedure Set_Hidden_Part_In_SPARK (Loc1, Loc2 : Source_Ptr); procedure Set_Hidden_Part_In_SPARK (Loc1, Loc2 : Source_Ptr);
-- Insert a new hidden region range in the SPARK hides table. The effect -- Insert a new hidden region range in the SPARK hides table. The effect
......
...@@ -378,15 +378,19 @@ package System.Rident is ...@@ -378,15 +378,19 @@ package System.Rident is
type Profile_Name is type Profile_Name is
(No_Profile, (No_Profile,
No_Implementation_Extensions, No_Implementation_Extensions,
Restricted_Tasking,
Restricted,
Ravenscar, Ravenscar,
GNAT_Extended_Ravenscar, GNAT_Extended_Ravenscar);
Restricted);
-- Names of recognized profiles. No_Profile is used to indicate that a -- Names of recognized profiles. No_Profile is used to indicate that a
-- restriction came from pragma Restrictions[_Warning], as opposed to -- 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 subtype Profile_Name_Actual is Profile_Name
range No_Implementation_Extensions .. Restricted; range No_Implementation_Extensions .. GNAT_Extended_Ravenscar;
-- Actual used profile names -- Actual used profile names
type Profile_Data is record type Profile_Data is record
...@@ -422,6 +426,37 @@ package System.Rident is ...@@ -422,6 +426,37 @@ package System.Rident is
Value => Value =>
(others => 0)), (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 Profile
Restricted => Restricted =>
......
...@@ -5787,8 +5787,9 @@ package body Sem_Ch12 is ...@@ -5787,8 +5787,9 @@ package body Sem_Ch12 is
(Formal_Pack : Entity_Id; (Formal_Pack : Entity_Id;
Actual_Pack : Entity_Id) Actual_Pack : Entity_Id)
is is
E1 : Entity_Id := First_Entity (Actual_Pack); E1 : Entity_Id := First_Entity (Actual_Pack);
E2 : Entity_Id := First_Entity (Formal_Pack); E2 : Entity_Id := First_Entity (Formal_Pack);
Prev_E1 : Entity_Id;
Expr1 : Node_Id; Expr1 : Node_Id;
Expr2 : Node_Id; Expr2 : Node_Id;
...@@ -5954,6 +5955,7 @@ package body Sem_Ch12 is ...@@ -5954,6 +5955,7 @@ package body Sem_Ch12 is
-- Start of processing for Check_Formal_Package_Instance -- Start of processing for Check_Formal_Package_Instance
begin begin
Prev_E1 := E1;
while Present (E1) and then Present (E2) loop while Present (E1) and then Present (E2) loop
exit when Ekind (E1) = E_Package exit when Ekind (E1) = E_Package
and then Renamed_Entity (E1) = Renamed_Entity (Actual_Pack); and then Renamed_Entity (E1) = Renamed_Entity (Actual_Pack);
...@@ -5983,6 +5985,14 @@ package body Sem_Ch12 is ...@@ -5983,6 +5985,14 @@ package body Sem_Ch12 is
if No (E1) then if No (E1) then
return; 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 -- If the formal entity comes from a formal declaration, it was
-- defaulted in the formal package, and no check is needed on it. -- defaulted in the formal package, and no check is needed on it.
...@@ -5990,6 +6000,13 @@ package body Sem_Ch12 is ...@@ -5990,6 +6000,13 @@ package body Sem_Ch12 is
N_Formal_Object_Declaration, N_Formal_Object_Declaration,
N_Formal_Type_Declaration) N_Formal_Type_Declaration)
then 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; goto Next_E;
-- Ditto for defaulted formal subprograms. -- Ditto for defaulted formal subprograms.
...@@ -6144,6 +6161,7 @@ package body Sem_Ch12 is ...@@ -6144,6 +6161,7 @@ package body Sem_Ch12 is
end if; end if;
<<Next_E>> <<Next_E>>
Prev_E1 := E1;
Next_Entity (E1); Next_Entity (E1);
Next_Entity (E2); Next_Entity (E2);
end loop; end loop;
......
...@@ -877,7 +877,6 @@ package body Sem_Ch3 is ...@@ -877,7 +877,6 @@ package body Sem_Ch3 is
then then
Build_Itype_Reference (Anon_Type, Parent (Current_Scope)); Build_Itype_Reference (Anon_Type, Parent (Current_Scope));
end if; end if;
return Anon_Type; return Anon_Type;
end if; end if;
...@@ -2805,6 +2804,13 @@ package body Sem_Ch3 is ...@@ -2805,6 +2804,13 @@ package body Sem_Ch3 is
if not Analyzed (T) then if not Analyzed (T) then
Set_Analyzed (T); 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 case Nkind (Def) is
when N_Access_To_Subprogram_Definition => when N_Access_To_Subprogram_Definition =>
Access_Subprogram_Declaration (T, Def); Access_Subprogram_Declaration (T, Def);
...@@ -2887,13 +2893,6 @@ package body Sem_Ch3 is ...@@ -2887,13 +2893,6 @@ package body Sem_Ch3 is
Check_SPARK_05_Restriction ("controlled type is not allowed", N); Check_SPARK_05_Restriction ("controlled type is not allowed", N);
end if; 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 -- Some common processing for all types
Set_Depends_On_Private (T, Has_Private_Component (T)); Set_Depends_On_Private (T, Has_Private_Component (T));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment