[multiple changes]
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. From-SVN: r230316
This commit is contained in:
parent
6672e40209
commit
90b510e4aa
@ -1,3 +1,59 @@
|
||||
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
|
||||
|
@ -4462,7 +4462,7 @@ package body Exp_Attr is
|
||||
|
||||
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
|
||||
@ -4483,7 +4483,9 @@ package body Exp_Attr is
|
||||
|
||||
-- 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),
|
||||
@ -4528,7 +4530,7 @@ package body Exp_Attr is
|
||||
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,
|
||||
@ -4537,7 +4539,7 @@ package body Exp_Attr is
|
||||
|
||||
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,
|
||||
|
@ -1234,7 +1234,9 @@ package body Exp_Ch9 is
|
||||
-- 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.
|
||||
@ -1281,7 +1283,10 @@ package body Exp_Ch9 is
|
||||
-- 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;
|
||||
|
||||
@ -1301,6 +1306,10 @@ package body Exp_Ch9 is
|
||||
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;
|
||||
@ -1327,7 +1336,7 @@ package body Exp_Ch9 is
|
||||
-- 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;
|
||||
@ -1384,6 +1393,7 @@ package body Exp_Ch9 is
|
||||
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);
|
||||
@ -1397,7 +1407,9 @@ package body Exp_Ch9 is
|
||||
|
||||
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;
|
||||
@ -1455,17 +1467,16 @@ package body Exp_Ch9 is
|
||||
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.
|
||||
|
||||
@ -9030,7 +9041,6 @@ package body Exp_Ch9 is
|
||||
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;
|
||||
@ -9038,7 +9048,6 @@ package body Exp_Ch9 is
|
||||
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
|
||||
@ -9051,9 +9060,9 @@ package body Exp_Ch9 is
|
||||
-- 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
|
||||
@ -9173,51 +9182,57 @@ package body Exp_Ch9 is
|
||||
-- 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, Sub);
|
||||
Analyze (Sub);
|
||||
Insert_After (Current_Node, Subp);
|
||||
Current_Node := Subp;
|
||||
|
||||
Analyze (Subp);
|
||||
|
||||
-- Build a wrapper procedure to handle contract cases, preconditions,
|
||||
-- and postconditions.
|
||||
|
||||
Build_Contract_Wrapper (Comp_Id, N);
|
||||
Build_Contract_Wrapper (Ent_Id, N);
|
||||
|
||||
Set_Protected_Body_Subprogram
|
||||
(Defining_Identifier (Comp),
|
||||
Defining_Unit_Name (Specification (Sub)));
|
||||
-- Create the barrier function
|
||||
|
||||
Current_Node := Sub;
|
||||
|
||||
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, Sub);
|
||||
Analyze (Sub);
|
||||
Set_Protected_Body_Subprogram (Bdef, Bdef);
|
||||
Set_Barrier_Function (Comp_Id, Bdef);
|
||||
Set_Scope (Bdef, Scope (Comp_Id));
|
||||
Current_Node := Sub;
|
||||
Insert_After (Current_Node, Subp);
|
||||
Current_Node := Subp;
|
||||
|
||||
Analyze (Subp);
|
||||
|
||||
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.
|
||||
@ -9226,10 +9241,10 @@ package body Exp_Ch9 is
|
||||
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;
|
||||
|
||||
@ -9260,6 +9275,10 @@ package body Exp_Ch9 is
|
||||
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
|
||||
|
@ -482,6 +482,7 @@ package body GNAT.Debug_Pools is
|
||||
-- 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;
|
||||
|
||||
|
@ -324,9 +324,7 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
|
||||
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;
|
||||
@ -683,7 +681,7 @@ __gnat_error_handler (int sig)
|
||||
}
|
||||
|
||||
void
|
||||
__gnat_install_handler(void)
|
||||
__gnat_install_handler (void)
|
||||
{
|
||||
struct sigaction act;
|
||||
|
||||
@ -1930,10 +1928,9 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
|
||||
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;
|
||||
@ -1997,7 +1994,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
|
||||
__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);
|
||||
@ -2189,7 +2186,7 @@ __gnat_error_handler (int sig)
|
||||
}
|
||||
|
||||
void
|
||||
__gnat_install_handler(void)
|
||||
__gnat_install_handler (void)
|
||||
{
|
||||
struct sigaction act;
|
||||
|
||||
@ -2252,7 +2249,7 @@ __gnat_error_handler (int sig)
|
||||
}
|
||||
|
||||
void
|
||||
__gnat_install_handler(void)
|
||||
__gnat_install_handler (void)
|
||||
{
|
||||
struct sigaction act;
|
||||
|
||||
@ -2443,8 +2440,8 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
|
||||
{
|
||||
__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
|
||||
@ -2515,7 +2512,7 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
|
||||
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;
|
||||
@ -2546,9 +2543,7 @@ __gnat_map_signal (int sig,
|
||||
}
|
||||
|
||||
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);
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -51,7 +51,7 @@ package body System.Global_Locks is
|
||||
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
|
||||
|
@ -2673,7 +2673,6 @@ package body Sem_Ch13 is
|
||||
|
||||
Decorate (Aspect, Aitem);
|
||||
Insert_Pragma (Aitem);
|
||||
goto Continue;
|
||||
|
||||
else
|
||||
Error_Msg_NE
|
||||
@ -2682,6 +2681,8 @@ package body Sem_Ch13 is
|
||||
Aspect, Id);
|
||||
end if;
|
||||
|
||||
goto Continue;
|
||||
|
||||
-- SPARK_Mode
|
||||
|
||||
when Aspect_SPARK_Mode =>
|
||||
|
@ -3073,6 +3073,7 @@ package body Sem_Ch4 is
|
||||
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);
|
||||
@ -7456,6 +7457,9 @@ package body Sem_Ch4 is
|
||||
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 =>
|
||||
@ -7464,6 +7468,8 @@ package body Sem_Ch4 is
|
||||
|
||||
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;
|
||||
@ -7473,21 +7479,24 @@ package body Sem_Ch4 is
|
||||
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);
|
||||
|
@ -2057,19 +2057,20 @@ package body Sem_Ch5 is
|
||||
|
||||
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;
|
||||
|
||||
|
@ -12604,22 +12604,15 @@ package body Sem_Prag is
|
||||
|
||||
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
|
||||
|
@ -1732,6 +1732,8 @@ package body Sem_Util is
|
||||
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
|
||||
@ -1744,6 +1746,29 @@ package body Sem_Util is
|
||||
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;
|
||||
|
||||
|
@ -178,7 +178,7 @@ void __gnat_sigtramp (int signo, void *si, void *ucontext,
|
||||
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
|
||||
--------------------- */
|
||||
|
Loading…
Reference in New Issue
Block a user