+2015-11-13 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sigtramp-ios.c, init.c: Minor cosmetic tweaks.
+
+2015-11-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * s-gloloc.adb, g-debpoo.adb: Minor reformatting.
+
+2015-11-13 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch5.adb (Analyze_Iterator_Specification): Improve error
+ message for the case the iterable name (array or container)
+ is a component that depends on a discriminant.
+
+2015-11-13 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Indicate_Name_And_Type): If the analysis of
+ one interpretation succeeds, set type of name in call, for
+ completeness.
+ (Try_Container_Indexing): If there are multiple indexing
+ functions, collect possible interpretations that are compatible
+ with given parameters, and add implicit dereference types when
+ present.
+ * sem_util.adb (Build_Explicit_Dereference): If the expression
+ is an overloaded function call use the given discriminant to
+ resolve the call, and set properly the type of the call and of
+ the resulting dereference.
+
+2015-11-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma): Pragma Constant_After_Elaboration can
+ now apply to a variable without an initialization expression.
+
+2015-11-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch9.adb (Add_Matching_Formals): Parameter Actuals is now of mode
+ IN OUT. Create a new list when list Actuals is not present.
+ (Build_Contract_Wrapper): Create the wrapper
+ only when the entry has at least on checked contract case or
+ pre/postcondition. Ensure that the call to the original entry
+ lacks an actual parameter list when the entry appears without
+ formal parameters.
+ (Expand_Entry_Declaration): Code cleanup.
+
+2015-11-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch13.adb (Analyze_Aspect_Specifications): Continue the analysis
+ after encountering an illegal aspect Part_Of.
+
+2015-11-13 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_attr.adb (Expand_N_Attribute_Reference, case
+ Overlaps_Storage): Add copies for nodes that represent the integer
+ addresses of the two actuals, to prevent identical nodes in the
+ tree, which the backend cannot handle properly.
+
2015-11-13 Bob Duff <duff@adacore.com>
* sem_ch6.adb (Check_Private_Overriding): Change
X : constant Node_Id := Prefix (N);
Y : constant Node_Id := First (Expressions (N));
- -- The argumens
+ -- The arguments
X_Addr, Y_Addr : Node_Id;
-- the expressions for their integer addresses
-- with the proper address operations. We convert addresses to
-- integer addresses to use predefined arithmetic. The size is
- -- expressed in storage units.
+ -- expressed in storage units. We add copies of X_Addr and Y_Addr
+ -- to prevent the appearance of the same node in two places in
+ -- the tree.
X_Addr :=
Unchecked_Convert_To (RTE (RE_Integer_Address),
Make_Op_Ge (Loc,
Left_Opnd =>
Make_Op_Add (Loc,
- Left_Opnd => X_Addr,
+ Left_Opnd => New_Copy_Tree (X_Addr),
Right_Opnd =>
Make_Op_Subtract (Loc,
Left_Opnd => X_Size,
Make_Op_Ge (Loc,
Make_Op_Add (Loc,
- Left_Opnd => Y_Addr,
+ Left_Opnd => New_Copy_Tree (Y_Addr),
Right_Opnd =>
Make_Op_Subtract (Loc,
Left_Opnd => Y_Size,
-- Conc_Typ. Obj_Id is the entity of the wrapper formal parameter which
-- represents the concurrent object.
- procedure Add_Matching_Formals (Formals : List_Id; Actuals : List_Id);
+ procedure Add_Matching_Formals
+ (Formals : List_Id;
+ Actuals : in out List_Id);
-- Add formal parameters that match those of entry E to list Formals.
-- The routine also adds matching actuals for the new formals to list
-- Actuals.
-- Add_Matching_Formals --
--------------------------
- procedure Add_Matching_Formals (Formals : List_Id; Actuals : List_Id) is
+ procedure Add_Matching_Formals
+ (Formals : List_Id;
+ Actuals : in out List_Id)
+ is
Formal : Entity_Id;
New_Formal : Entity_Id;
Parameter_Type =>
New_Occurrence_Of (Etype (Formal), Loc)));
+ if No (Actuals) then
+ Actuals := New_List;
+ end if;
+
Append_To (Actuals, New_Occurrence_Of (New_Formal, Loc));
Next_Formal (Formal);
end loop;
-- Local variables
Items : constant Node_Id := Contract (E);
- Actuals : List_Id;
+ Actuals : List_Id := No_List;
Call : Node_Id;
Call_Nam : Node_Id;
Decls : List_Id := No_List;
while Present (Prag) loop
if Nam_In (Pragma_Name (Prag), Name_Postcondition,
Name_Precondition)
+ and then Is_Checked (Prag)
then
Has_Pragma := True;
Transfer_Pragma (Prag, To => Decls);
Prag := Contract_Test_Cases (Items);
while Present (Prag) loop
- if Pragma_Name (Prag) = Name_Contract_Cases then
+ if Pragma_Name (Prag) = Name_Contract_Cases
+ and then Is_Checked (Prag)
+ then
Has_Pragma := True;
Transfer_Pragma (Prag, To => Decls);
end if;
Expressions => New_List (New_Occurrence_Of (Index_Id, Loc)));
end if;
- Actuals := New_List;
- Call :=
- Make_Procedure_Call_Statement (Loc,
- Name => Call_Nam,
- Parameter_Associations => Actuals);
-
-- Add formal parameters to match those of the entry and build actuals
-- for the entry call.
Add_Matching_Formals (Formals, Actuals);
+ Call :=
+ Make_Procedure_Call_Statement (Loc,
+ Name => Call_Nam,
+ Parameter_Associations => Actuals);
+
-- Add renaming declarations for the discriminants of the enclosing type
-- as the various contract items may reference them.
Body_Id : Entity_Id;
Cdecls : List_Id;
Comp : Node_Id;
- Comp_Id : Entity_Id;
Current_Node : Node_Id := N;
E_Count : Int;
Entries_Aggr : Node_Id;
Object_Comp : Node_Id;
Priv : Node_Id;
Rec_Decl : Node_Id;
- Sub : Node_Id;
procedure Check_Inlining (Subp : Entity_Id);
-- If the original operation has a pragma Inline, propagate the flag
-- static because of a discriminant constraint we can specialize the
-- warning by mentioning discriminants explicitly.
- procedure Expand_Entry_Declaration (Comp : Entity_Id);
- -- Create the subprograms for the barrier and for the body, and append
- -- then to Entry_Bodies_Array.
+ procedure Expand_Entry_Declaration (Decl : Node_Id);
+ -- Create the entry barrier and the procedure body for entry declaration
+ -- Decl. All generated subprograms are added to Entry_Bodies_Array.
function Static_Component_Size (Comp : Entity_Id) return Boolean;
-- When compiling under the Ravenscar profile, private components must
-- Expand_Entry_Declaration --
------------------------------
- procedure Expand_Entry_Declaration (Comp : Entity_Id) is
- Bdef : Entity_Id;
- Edef : Entity_Id;
+ procedure Expand_Entry_Declaration (Decl : Node_Id) is
+ Ent_Id : constant Entity_Id := Defining_Entity (Decl);
+ Bar_Id : Entity_Id;
+ Bod_Id : Entity_Id;
+ Subp : Node_Id;
begin
E_Count := E_Count + 1;
- Comp_Id := Defining_Identifier (Comp);
- Edef :=
+ -- Create the protected body subprogram
+
+ Bod_Id :=
Make_Defining_Identifier (Loc,
- Chars => Build_Selected_Name (Prot_Typ, Comp_Id, 'E'));
- Sub :=
+ Chars => Build_Selected_Name (Prot_Typ, Ent_Id, 'E'));
+ Set_Protected_Body_Subprogram (Ent_Id, Bod_Id);
+
+ Subp :=
Make_Subprogram_Declaration (Loc,
Specification =>
- Build_Protected_Entry_Specification (Loc, Edef, Comp_Id));
+ Build_Protected_Entry_Specification (Loc, Bod_Id, Ent_Id));
+
+ Insert_After (Current_Node, Subp);
+ Current_Node := Subp;
- Insert_After (Current_Node, Sub);
- Analyze (Sub);
+ Analyze (Subp);
-- Build a wrapper procedure to handle contract cases, preconditions,
-- and postconditions.
- Build_Contract_Wrapper (Comp_Id, N);
-
- Set_Protected_Body_Subprogram
- (Defining_Identifier (Comp),
- Defining_Unit_Name (Specification (Sub)));
+ Build_Contract_Wrapper (Ent_Id, N);
- Current_Node := Sub;
+ -- Create the barrier function
- Bdef :=
+ Bar_Id :=
Make_Defining_Identifier (Loc,
- Chars => Build_Selected_Name (Prot_Typ, Comp_Id, 'B'));
- Sub :=
+ Chars => Build_Selected_Name (Prot_Typ, Ent_Id, 'B'));
+ Set_Barrier_Function (Ent_Id, Bar_Id);
+
+ Subp :=
Make_Subprogram_Declaration (Loc,
Specification =>
- Build_Barrier_Function_Specification (Loc, Bdef));
- Set_Is_Entry_Barrier_Function (Sub);
+ Build_Barrier_Function_Specification (Loc, Bar_Id));
+ Set_Is_Entry_Barrier_Function (Subp);
+
+ Insert_After (Current_Node, Subp);
+ Current_Node := Subp;
+
+ Analyze (Subp);
- Insert_After (Current_Node, Sub);
- Analyze (Sub);
- Set_Protected_Body_Subprogram (Bdef, Bdef);
- Set_Barrier_Function (Comp_Id, Bdef);
- Set_Scope (Bdef, Scope (Comp_Id));
- Current_Node := Sub;
+ Set_Protected_Body_Subprogram (Bar_Id, Bar_Id);
+ Set_Scope (Bar_Id, Scope (Ent_Id));
-- Collect pointers to the protected subprogram and the barrier
-- of the current entry, for insertion into Entry_Bodies_Array.
Make_Aggregate (Loc,
Expressions => New_List (
Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Bdef, Loc),
+ Prefix => New_Occurrence_Of (Bar_Id, Loc),
Attribute_Name => Name_Unrestricted_Access),
Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Edef, Loc),
+ Prefix => New_Occurrence_Of (Bod_Id, Loc),
Attribute_Name => Name_Unrestricted_Access))));
end Expand_Entry_Declaration;
Append_Freeze_Action (Prot_Proc, RTS_Call);
end Register_Handler;
+ -- Local variables
+
+ Sub : Node_Id;
+
-- Start of processing for Expand_N_Protected_Type_Declaration
begin
-- Warning: secondary stack cannot be used here. When System.Memory
-- implementation uses Debug_Pool, Print_Address can be called during
-- secondary stack creation for foreign threads.
+
Put (File, Image_C (Addr));
end Print_Address;
propagation after the required low level adjustments. */
static void
-__gnat_error_handler (int sig,
- siginfo_t *si ATTRIBUTE_UNUSED,
- void *ucontext ATTRIBUTE_UNUSED)
+__gnat_error_handler (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *ucontext)
{
struct Exception_Data *exception;
const char *msg;
}
void
-__gnat_install_handler(void)
+__gnat_install_handler (void)
{
struct sigaction act;
void *sc ATTRIBUTE_UNUSED)
{
/* In case of ARM exceptions, the registers context have the PC pointing
- to the instruction that raised the signal. However the Unwinder expects
- the instruction to be in the range ]PC,PC+1].
- */
- uintptr_t *pc_addr; /* address of the pc value to restore */
+ to the instruction that raised the signal. However the unwinder expects
+ the instruction to be in the range ]PC,PC+1]. */
+ uintptr_t *pc_addr;
#ifdef __RTP__
mcontext_t *mcontext = &((ucontext_t *) sc)->uc_mcontext;
pc_addr = (uintptr_t*)&mcontext->regs.pc;
__gnat_adjust_context_for_raise (sig, sc);
#endif
- #include "sigtramp.h"
+#include "sigtramp.h"
__gnat_sigtramp (sig, (void *)si, (void *)sc,
(__sigtramphandler_t *)&__gnat_map_signal);
}
void
-__gnat_install_handler(void)
+__gnat_install_handler (void)
{
struct sigaction act;
}
void
-__gnat_install_handler(void)
+__gnat_install_handler (void)
{
struct sigaction act;
{
__gnat_adjust_context_for_raise (sig, ucontext);
+ /* The Darwin libc comes with a signal trampoline, except for ARM64. */
#ifdef __arm64__
- /* Use a trampoline so that the unwinder won't see the signal frame. */
__gnat_sigtramp (sig, (void *)si, ucontext,
(__sigtramphandler_t *)&__gnat_map_signal);
#else
static void
__gnat_map_signal (int sig,
siginfo_t *si ATTRIBUTE_UNUSED,
- void *ucontext ATTRIBUTE_UNUSED)
+ void *mcontext ATTRIBUTE_UNUSED)
{
struct Exception_Data *exception;
const char *msg;
}
static void
-__gnat_error_handler (int sig,
- siginfo_t *si ATTRIBUTE_UNUSED,
- void *ucontext ATTRIBUTE_UNUSED)
+__gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
{
__gnat_adjust_context_for_raise (sig, ucontext);
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2015, 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- --
File : String;
Wait : Duration := 0.1;
Retries : Natural := Natural'Last);
- -- Create a lock file File in directory Dir. If the file cannot be
+ -- Create a lock file File in directory Dir. If the file cannot be
-- locked because someone already owns the lock, this procedure
-- waits Wait seconds and retries at most Retries times. If the file
-- still cannot be locked, Lock_Error is raised. The default is to try
Decorate (Aspect, Aitem);
Insert_Pragma (Aitem);
- goto Continue;
else
Error_Msg_NE
Aspect, Id);
end if;
+ goto Continue;
+
-- SPARK_Mode
when Aspect_SPARK_Mode =>
if not Is_Type (Nam) then
if Is_Entity_Name (Name (N)) then
Set_Entity (Name (N), Nam);
+ Set_Etype (Name (N), Etype (Nam));
elsif Nkind (Name (N)) = N_Selected_Component then
Set_Entity (Selector_Name (Name (N)), Nam);
end if;
else
+ -- If there are multiple indexing functions, build a function call
+ -- and analyze it for each of the possible interpretations.
+
Indexing :=
Make_Function_Call (Loc,
Name =>
Set_Parent (Indexing, Parent (N));
Set_Generalized_Indexing (N, Indexing);
+ Set_Etype (N, Any_Type);
+ Set_Etype (Name (Indexing), Any_Type);
declare
I : Interp_Index;
begin
Get_First_Interp (Func_Name, I, It);
Set_Etype (Indexing, Any_Type);
+
while Present (It.Nam) loop
Analyze_One_Call (Indexing, It.Nam, False, Success);
if Success then
- Set_Etype (Name (Indexing), It.Typ);
- Set_Entity (Name (Indexing), It.Nam);
- Set_Etype (N, Etype (Indexing));
- -- Add implicit dereference interpretation
+ -- Function in current interpretation is a valid candidate.
+ -- Its result type is also a potential type for the
+ -- original Indexed_Component node.
+
+ Add_One_Interp (Name (Indexing), It.Nam, It.Typ);
+ Add_One_Interp (N, It.Nam, It.Typ);
+
+ -- Add implicit dereference interpretation to original node
if Has_Discriminants (Etype (It.Nam)) then
Check_Implicit_Dereference (N, Etype (It.Nam));
end if;
-
- exit;
end if;
Get_Next_Interp (I, It);
Set_Is_Aliased (Def_Id, Has_Aliased_Components (Typ));
- -- AI12-0151 stipulates that the container cannot be a component
- -- that depends on a discriminant if the enclosing object is
- -- mutable, to prevent a modification of the container in the
- -- course of an iteration.
+ -- AI12-0047 stipulates that the domain (array or container)
+ -- cannot be a component that depends on a discriminant if the
+ -- enclosing object is mutable, to prevent a modification of the
+ -- dowmain of iteration in the course of an iteration.
- -- Should comment on need to go to Original_Node ???
+ -- If the object is an expression it has been captured in a
+ -- temporary, so examine original node.
if Nkind (Original_Node (Iter_Name)) = N_Selected_Component
and then Is_Dependent_Component_Of_Mutable_Object
(Original_Node (Iter_Name))
then
Error_Msg_N
- ("container cannot be a discriminant-dependent "
+ ("iterable name cannot be a discriminant-dependent "
& "component of a mutable object", N);
end if;
Obj_Id := Defining_Entity (Obj_Decl);
- -- The object declaration must be a library-level variable with
- -- an initialization expression. The expression must depend on
- -- a variable, parameter, or another constant_after_elaboration,
- -- but the compiler cannot detect this property, as this requires
- -- full flow analysis (SPARK RM 3.3.1).
+ -- The object declaration must be a library-level variable which
+ -- is either explicitly initialized or obtains a value during the
+ -- elaboration of a package body (SPARK RM 3.3.1).
if Ekind (Obj_Id) = E_Variable then
if not Is_Library_Level_Entity (Obj_Id) then
Error_Pragma
("pragma % must apply to a library level variable");
return;
-
- elsif not Has_Init_Expression (Obj_Decl) then
- Error_Pragma
- ("pragma % must apply to a variable with initialization "
- & "expression");
end if;
-- Otherwise the pragma applies to a constant, which is illegal
Disc : Entity_Id)
is
Loc : constant Source_Ptr := Sloc (Expr);
+ I : Interp_Index;
+ It : Interp;
begin
-- An entity of a type with a reference aspect is overloaded with
Set_Etype (Expr, Etype (Entity (Expr)));
elsif Nkind (Expr) = N_Function_Call then
+
+ -- If the name of the indexing function is overloaded, locate the one
+ -- whose return type has an implicit dereference on the desired
+ -- discriminant, and set entity and type of function call.
+
+ if Is_Overloaded (Name (Expr)) then
+ Get_First_Interp (Name (Expr), I, It);
+
+ while Present (It.Nam) loop
+ if Ekind ((It.Typ)) = E_Record_Type
+ and then First_Entity ((It.Typ)) = Disc
+ then
+ Set_Entity (Name (Expr), It.Nam);
+ Set_Etype (Name (Expr), Etype (It.Nam));
+ exit;
+ end if;
+
+ Get_Next_Interp (I, It);
+ end loop;
+ end if;
+
+ -- Set type of call from resolved function name.
+
Set_Etype (Expr, Etype (Name (Expr)));
end if;
TCR(COMMON_LONG128_CFI(GR(27))) \
TCR(COMMON_LONG128_CFI(GR(28))) \
TCR(COMMON_LONG128_CFI(GR(29))) \
- TCR(COMMON_LONG256_CFI(PC)) \
+ TCR(COMMON_LONG256_CFI(PC))
/* Trampoline body block
--------------------- */
projects / gcc.git / commitdiff