OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2016-06-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor
	reformatting.

2016-06-16  Bob Duff  <duff@adacore.com>

	* sem_util.adb (Collect): Avoid Empty Full_T. Otherwise Etype
	(Full_T) crashes when assertions are on.
	* sem_ch12.adb (Matching_Actual): Correctly handle the case where
	"others => <>" appears in a generic formal package, other than
	by itself.

2016-06-16  Arnaud Charlet  <charlet@adacore.com>

	* usage.adb: Remove confusing comment in usage line.
	* bindgen.adb: Fix binder generated file in codepeer mode wrt
	recent additions.

2016-06-16  Javier Miranda  <miranda@adacore.com>

	* restrict.adb (Check_Restriction_No_Use_Of_Entity): Avoid
	never-ending loop, code cleanup; adding also support for Text_IO.
	* sem_ch8.adb (Find_Expanded_Name): Invoke
	Check_Restriction_No_Use_Entity.

2016-06-16  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb: Minor comment fix.
	* einfo.ads (Has_Protected): Clarify comment.
	* sem_ch9.adb (Analyze_Protected_Type_Declaration): Do not
	consider private protected types declared in the runtime for
	the No_Local_Protected_Types restriction.

From-SVN: r237507
This commit is contained in:
Arnaud Charlet 2016-06-16 11:44:04 +02:00
parent 17d7bdd87d
commit fb757f7da4
14 changed files with 129 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/ChangeLog
View File

@ -1,3 +1,37 @@
2016-06-16 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor
reformatting.
2016-06-16 Bob Duff <duff@adacore.com>
* sem_util.adb (Collect): Avoid Empty Full_T. Otherwise Etype
(Full_T) crashes when assertions are on.
* sem_ch12.adb (Matching_Actual): Correctly handle the case where
"others => <>" appears in a generic formal package, other than
by itself.
2016-06-16 Arnaud Charlet <charlet@adacore.com>
* usage.adb: Remove confusing comment in usage line.
* bindgen.adb: Fix binder generated file in codepeer mode wrt
recent additions.
2016-06-16 Javier Miranda <miranda@adacore.com>
* restrict.adb (Check_Restriction_No_Use_Of_Entity): Avoid
never-ending loop, code cleanup; adding also support for Text_IO.
* sem_ch8.adb (Find_Expanded_Name): Invoke
Check_Restriction_No_Use_Entity.
2016-06-16 Tristan Gingold <gingold@adacore.com>
* exp_ch9.adb: Minor comment fix.
* einfo.ads (Has_Protected): Clarify comment.
* sem_ch9.adb (Analyze_Protected_Type_Declaration): Do not
consider private protected types declared in the runtime for
the No_Local_Protected_Types restriction.
2016-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Set_Actual_Subtypes): Do not generate actual

53
gcc/ada/bindgen.adb
View File

@ -930,35 +930,38 @@ package body Bindgen is
Gen_Elab_Calls;
-- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
-- restriction No_Standard_Allocators_After_Elaboration is active.
if not CodePeer_Mode then
-- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
-- restriction No_Standard_Allocators_After_Elaboration is active.
if Cumulative_Restrictions.Set
(No_Standard_Allocators_After_Elaboration)
then
WBI (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;");
end if;
-- From this point, no new dispatching domain can be created
if Dispatching_Domains_Used then
WBI (" Freeze_Dispatching_Domains;");
end if;
-- Sequential partition elaboration policy
if Partition_Elaboration_Policy_Specified = 'S' then
if System_Interrupts_Used then
WBI (" Install_Restricted_Handlers_Sequential;");
if Cumulative_Restrictions.Set
(No_Standard_Allocators_After_Elaboration)
then
WBI
(" System.Elaboration_Allocators.Mark_End_Of_Elaboration;");
end if;
if System_Tasking_Restricted_Stages_Used then
WBI (" Activate_All_Tasks_Sequential;");
end if;
end if;
-- From this point, no new dispatching domain can be created
if System_BB_CPU_Primitives_Multiprocessors_Used then
WBI (" Start_Slave_CPUs;");
if Dispatching_Domains_Used then
WBI (" Freeze_Dispatching_Domains;");
end if;
-- Sequential partition elaboration policy
if Partition_Elaboration_Policy_Specified = 'S' then
if System_Interrupts_Used then
WBI (" Install_Restricted_Handlers_Sequential;");
end if;
if System_Tasking_Restricted_Stages_Used then
WBI (" Activate_All_Tasks_Sequential;");
end if;
end if;
if System_BB_CPU_Primitives_Multiprocessors_Used then
WBI (" Start_Slave_CPUs;");
end if;
end if;
WBI (" end " & Ada_Init_Name.all & ";");

8
gcc/ada/einfo.ads
View File

@ -1936,10 +1936,10 @@ package Einfo is
-- Has_Protected (Flag271) [base type only]
-- Defined in all type entities. Set on protected types themselves, and
-- also (recursively) on any composite type which has a component for
-- which Has_Protected is set. The meaning is that an allocator for
-- or declaration of such an object must create the required protected
-- objects. Note: the flag is not set on access types, even if they
-- designate an object that Has_Protected.
-- which Has_Protected is set, unless the protected type is declared in
-- the private part of an internal unit. The meaning is that restrictions
-- for protected types apply to this type. Note: the flag is not set on
-- access types, even if they designate an object that Has_Protected.
-- Has_Qualified_Name (Flag161)
-- Defined in all entities. Set if the name in the Chars field has

5
gcc/ada/exp_attr.adb
View File

@ -4398,8 +4398,9 @@ package body Exp_Attr is
-- _Postconditions must be in the tree (or inlined if we are
-- generating C code).
pragma Assert (Present (Subp)
or else (Modify_Tree_For_C and then In_Inlined_Body));
pragma Assert
(Present (Subp)
or else (Modify_Tree_For_C and then In_Inlined_Body));
Temp := Make_Temporary (Loc, 'T', Pref);

2
gcc/ada/exp_ch9.adb
View File

@ -14142,7 +14142,7 @@ package body Exp_Ch9 is
-- or, in the case of Ravenscar:
-- Install_Restricted_Handlers
-- (Prio, (Expr1, Proc1'access), ...., (ExprN, ProcN'access));
-- (Prio, ((Expr1, Proc1'access), ...., (ExprN, ProcN'access)));
declare
Args : constant List_Id := New_List;

4
gcc/ada/inline.adb
View File

@ -2323,8 +2323,8 @@ package body Inline is
and then Present (Postconditions_Proc (Enclosing_Subp)));
if Ekind (Enclosing_Subp) = E_Function then
if Nkind (First (Parameter_Associations (N)))
in N_Numeric_Or_String_Literal
if Nkind (First (Parameter_Associations (N))) in
N_Numeric_Or_String_Literal
then
Append_To (Declarations (Blk),
Make_Object_Declaration (Loc,

26
gcc/ada/restrict.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
@ -759,9 +759,16 @@ package body Restrict is
Ent := Entity (N);
Expr := NE_Ent.Entity;
loop
-- Here if at outer level of entity name in reference
-- Here if at outer level of entity name in reference (handle
-- also the direct use of Text_IO in the pragma). For example:
-- pragma Restrictions (No_Use_Of_Entity => Text_IO.Put);
if Scope (Ent) = Standard_Standard then
if Scope (Ent) = Standard_Standard
or else (Nkind (Expr) = N_Identifier
and then Chars (Ent) = Name_Text_IO
and then Chars (Scope (Ent)) = Name_Ada
and then Scope (Scope (Ent)) = Standard_Standard)
then
if Nkind_In (Expr, N_Identifier, N_Operator_Symbol)
and then Chars (Ent) = Chars (Expr)
then
@ -774,22 +781,19 @@ package body Restrict is
return;
else
goto Continue;
exit;
end if;
-- Here if at outer level of entity name in table
elsif Nkind_In (Expr, N_Identifier, N_Operator_Symbol) then
goto Continue;
exit;
-- Here if neither at the outer level
else
pragma Assert (Nkind (Expr) = N_Selected_Component);
if Chars (Selector_Name (Expr)) /= Chars (Ent) then
goto Continue;
end if;
exit when Chars (Selector_Name (Expr)) /= Chars (Ent);
end if;
-- Move up a level
@ -800,10 +804,6 @@ package body Restrict is
end loop;
Expr := Prefix (Expr);
-- Entry did not match
<<Continue>> null;
end loop;
end;
end loop;

1
gcc/ada/sem_attr.adb
View File

@ -1384,6 +1384,7 @@ package body Sem_Attr is
and then Chars (Scope (Spec_Id)) = Name_uPostconditions
then
-- This situation occurs only when preanalyzing the inlined body
pragma Assert (not Full_Analysis);
Spec_Id := Scope (Spec_Id);

13
gcc/ada/sem_ch12.adb
View File

@ -1112,7 +1112,7 @@ package body Sem_Ch12 is
-- Find actual that corresponds to a given a formal parameter. If the
-- actuals are positional, return the next one, if any. If the actuals
-- are named, scan the parameter associations to find the right one.
-- A_F is the corresponding entity in the analyzed generic,which is
-- A_F is the corresponding entity in the analyzed generic, which is
-- placed on the selector name for ASIS use.
--
-- In Ada 2005, a named association may be given with a box, in which
@ -1257,7 +1257,7 @@ package body Sem_Ch12 is
elsif No (Selector_Name (Actual)) then
Found_Assoc := Actual;
Act := Explicit_Generic_Actual_Parameter (Actual);
Act := Explicit_Generic_Actual_Parameter (Actual);
Num_Matched := Num_Matched + 1;
Next (Actual);
@ -1271,12 +1271,17 @@ package body Sem_Ch12 is
Prev := Empty;
while Present (Actual) loop
if Chars (Selector_Name (Actual)) = Chars (F) then
if Nkind (Actual) = N_Others_Choice then
Found_Assoc := Empty;
Act := Empty;
elsif Chars (Selector_Name (Actual)) = Chars (F) then
Set_Entity (Selector_Name (Actual), A_F);
Set_Etype (Selector_Name (Actual), Etype (A_F));
Generate_Reference (A_F, Selector_Name (Actual));
Found_Assoc := Actual;
Act := Explicit_Generic_Actual_Parameter (Actual);
Act := Explicit_Generic_Actual_Parameter (Actual);
Num_Matched := Num_Matched + 1;
exit;
end if;

2
gcc/ada/sem_ch8.adb
View File

@ -6224,6 +6224,8 @@ package body Sem_Ch8 is
if Is_Overloadable (Id) and then not Is_Overloaded (N) then
Generate_Reference (Id, N);
end if;
Check_Restriction_No_Use_Of_Entity (N);
end Find_Expanded_Name;
-------------------------

19
gcc/ada/sem_ch9.adb
View File

@ -32,8 +32,10 @@ with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Ch9; use Exp_Ch9;
with Elists; use Elists;
with Fname; use Fname;
with Freeze; use Freeze;
with Layout; use Layout;
with Lib; use Lib;
with Lib.Xref; use Lib.Xref;
with Namet; use Namet;
with Nlists; use Nlists;
@ -1985,12 +1987,27 @@ package body Sem_Ch9 is
Set_Ekind (T, E_Protected_Type);
Set_Is_First_Subtype (T, True);
Set_Has_Protected (T, True);
Init_Size_Align (T);
Set_Etype (T, T);
Set_Has_Delayed_Freeze (T, True);
Set_Stored_Constraint (T, No_Elist);
-- Mark this type as a protected type for the sake of restrictions,
-- unless the protected type is declared in a private part of a package
-- of the runtime. With this exception, the Suspension_Object from
-- Ada.Synchronous_Task_Control can be implemented using a protected
-- without triggering violations of No_Local_Protected_Objects when the
-- user locally declares such an object. This may look like a trick but
-- the user doesn't have to know how Suspension_Object is implemented.
if In_Private_Part (Current_Scope)
and then Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit))
then
Set_Has_Protected (T, False);
else
Set_Has_Protected (T, True);
end if;
-- Set the SPARK_Mode from the current context (may be overwritten later
-- with an explicit pragma).

17
gcc/ada/sem_elab.adb
View File

@ -516,8 +516,7 @@ package body Sem_Elab is
Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference;
-- Indicates if we have Access attribute case
function Call_To_Instance_From_Outside
(Ent : Entity_Id) return Boolean;
function Call_To_Instance_From_Outside (Id : Entity_Id) return Boolean;
-- True if we're calling an instance of a generic subprogram, or a
-- subprogram in an instance of a generic package, and the call is
-- outside that instance.
@ -543,21 +542,20 @@ package body Sem_Elab is
-- Call_To_Instance_From_Outside --
-----------------------------------
function Call_To_Instance_From_Outside
(Ent : Entity_Id) return Boolean is
function Call_To_Instance_From_Outside (Id : Entity_Id) return Boolean is
Scop : Entity_Id := Id;
X : Entity_Id := Ent;
begin
loop
if X = Standard_Standard then
if Scop = Standard_Standard then
return False;
end if;
if Is_Generic_Instance (X) then
return not In_Open_Scopes (X);
if Is_Generic_Instance (Scop) then
return not In_Open_Scopes (Scop);
end if;
X := Scope (X);
Scop := Scope (Scop);
end loop;
end Call_To_Instance_From_Outside;
@ -602,6 +600,7 @@ package body Sem_Elab is
function Find_W_Scope return Entity_Id is
Refed_Ent : constant Entity_Id := Get_Referenced_Ent (N);
W_Scope : Entity_Id;
begin
if Is_Init_Proc (Refed_Ent)
and then not In_Same_Extended_Unit (N, Refed_Ent)

6
gcc/ada/sem_util.adb
View File

@ -4239,7 +4239,11 @@ package body Sem_Util is
Full_T := Full_View (Typ);
if Ekind (Full_T) = E_Record_Subtype then
Full_T := Full_View (Etype (Typ));
Full_T := Etype (Typ);
if Present (Full_View (Full_T)) then
Full_T := Full_View (Full_T);
end if;
end if;
end if;

2
gcc/ada/usage.adb
View File

@ -347,7 +347,7 @@ begin
-- Line for -gnato switch
Write_Switch_Char ("o0");
Write_Line ("Disable overflow checking (on by default)");
Write_Line ("Disable overflow checking");
Write_Switch_Char ("o");
Write_Line ("Enable overflow checking in STRICT (-gnato1) mode (default)");