+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
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;
+ 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
+ -- From this point, no new dispatching domain can be created
- if Dispatching_Domains_Used then
- WBI (" Freeze_Dispatching_Domains;");
- end if;
+ if Dispatching_Domains_Used then
+ WBI (" Freeze_Dispatching_Domains;");
+ end if;
- -- Sequential partition elaboration policy
+ -- Sequential partition elaboration policy
- if Partition_Elaboration_Policy_Specified = 'S' then
- if System_Interrupts_Used then
- WBI (" Install_Restricted_Handlers_Sequential;");
- end if;
+ 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;");
+ if System_Tasking_Restricted_Stages_Used then
+ WBI (" Activate_All_Tasks_Sequential;");
+ end if;
end if;
- end if;
- if System_BB_CPU_Primitives_Multiprocessors_Used then
- WBI (" Start_Slave_CPUs;");
+ if System_BB_CPU_Primitives_Multiprocessors_Used then
+ WBI (" Start_Slave_CPUs;");
+ end if;
end if;
WBI (" end " & Ada_Init_Name.all & ";");
-- 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
-- _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);
-- 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;
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,
-- --
-- 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- --
Ent := Entity (N);
Expr := NE_Ent.Entity;
loop
- -- Here if at outer level of entity name in reference
-
- if Scope (Ent) = Standard_Standard then
+ -- 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
+ 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
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
end loop;
Expr := Prefix (Expr);
-
- -- Entry did not match
-
- <<Continue>> null;
end loop;
end;
end loop;
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);
-- 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
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);
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;
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;
-------------------------
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;
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).
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.
-- 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;
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)
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;
-- 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)");
projects / gcc.git / commitdiff