Skip to content

R
riscv-gcc-1
Commit 799d0e05 by Arnaud Charlet
Options

[multiple changes] 

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb, exp_ch11.adb, exp_ch11.ads: Minor reformatting.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb (Resolve): Enforce E.2.2(11/2) and E.2.2(12) for
	'Unrestricted_Access and 'Unchecked_Access (not just 'Access):
	even in those cases, a remote access type may only designate a
	remote subprogram.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb, sem_util.ads, sem_cat.adb: Minor refactoring.
	(Enclosing_Lib_Unit_Node): Rename to Enclosing_Comp_Unit_Node.

2012-05-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Remove obsolete
	checks on nested inlined subprograms.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* fe.h (Get_RT_Exception_Name): Declare.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (db_region_for): Use %p + cast to avoid warnings.
	(get_region_description_for): Likewise.
	(db_action_for): Likewise.
	(get_call_site_action_for): Likewise.
	(get_ttype_entry_for): Remove useless 'const'.
	(PERSONALITY_FUNCTION): Add ATTRIBUTE_UNUSED on uw_exception_class.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* a-exextr.adb (Unhandled_Exception_Terminate): Save occurrence
	on the stack to avoid a dynamic memory allocation.

2012-05-15  Bob Duff  <duff@adacore.com>

	* exp_ch9.adb (Expand_N_Timed_Entry_Call): Move initialization of
	E_Stats and D_Stats after Process_Statements_For_Controlled_Objects,
	because those calls can destroy the Statements list.

From-SVN: r187518
parent 0c644c99
Showing with 171 additions and 138 deletions
gcc/ada/ChangeLog
2012-05-15 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, exp_ch11.adb, exp_ch11.ads: Minor reformatting.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* sem_res.adb (Resolve): Enforce E.2.2(11/2) and E.2.2(12) for
'Unrestricted_Access and 'Unchecked_Access (not just 'Access):
even in those cases, a remote access type may only designate a
remote subprogram.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* sem_util.adb, sem_util.ads, sem_cat.adb: Minor refactoring.
(Enclosing_Lib_Unit_Node): Rename to Enclosing_Comp_Unit_Node.
2012-05-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Remove obsolete
checks on nested inlined subprograms.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* fe.h (Get_RT_Exception_Name): Declare.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* raise-gcc.c (db_region_for): Use %p + cast to avoid warnings.
(get_region_description_for): Likewise.
(db_action_for): Likewise.
(get_call_site_action_for): Likewise.
(get_ttype_entry_for): Remove useless 'const'.
(PERSONALITY_FUNCTION): Add ATTRIBUTE_UNUSED on uw_exception_class.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* a-exextr.adb (Unhandled_Exception_Terminate): Save occurrence
on the stack to avoid a dynamic memory allocation.
2012-05-15 Bob Duff <duff@adacore.com>
* exp_ch9.adb (Expand_N_Timed_Entry_Call): Move initialization of
E_Stats and D_Stats after Process_Statements_For_Controlled_Objects,
because those calls can destroy the Statements list.
2012-05-15 Tristan Gingold <gingold@adacore.com> 2012-05-15 Tristan Gingold <gingold@adacore.com>
* fe.h (Get_RT_Exception_Name): Define. * fe.h (Get_RT_Exception_Name): Define.
......
gcc/ada/a-exextr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, 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- --
...@@ -162,14 +162,15 @@ package body Exception_Traces is ...@@ -162,14 +162,15 @@ package body Exception_Traces is
----------------------------------- -----------------------------------
procedure Unhandled_Exception_Terminate is procedure Unhandled_Exception_Terminate is
Excep : constant EOA := Save_Occurrence (Get_Current_Excep.all.all); Excep : Exception_Occurrence;
-- This occurrence will be used to display a message after finalization. -- This occurrence will be used to display a message after finalization.
-- It is necessary to save a copy here, or else the designated value -- It is necessary to save a copy here, or else the designated value
-- could be overwritten if an exception is raised during finalization -- could be overwritten if an exception is raised during finalization
-- (even if that exception is caught). -- (even if that exception is caught).
begin begin
Last_Chance_Handler (Excep.all); Save_Occurrence (Excep, Get_Current_Excep.all.all);
Last_Chance_Handler (Excep);
end Unhandled_Exception_Terminate; end Unhandled_Exception_Terminate;
------------------------------------ ------------------------------------
......
gcc/ada/exp_ch11.adb
...@@ -1909,72 +1909,78 @@ package body Exp_Ch11 is ...@@ -1909,72 +1909,78 @@ package body Exp_Ch11 is
-- case it will end up in the block statements, even though it -- case it will end up in the block statements, even though it
-- is not there now. -- is not there now.
if Is_List_Member (N) if Is_List_Member (N) then
and then (List_Containing (N) = Statements (P) declare
or else LCN : constant List_Id := List_Containing (N);
List_Containing (N) = SSE.Actions_To_Be_Wrapped_Before
or else
List_Containing (N) = SSE.Actions_To_Be_Wrapped_After)
then
-- Loop through exception handlers
H := First (Exception_Handlers (P)); begin
while Present (H) loop if LCN = Statements (P)
or else
LCN = SSE.Actions_To_Be_Wrapped_Before
or else
LCN = SSE.Actions_To_Be_Wrapped_After
then
-- Loop through exception handlers
-- Guard against other constructs appearing in the list of H := First (Exception_Handlers (P));
-- exception handlers. while Present (H) loop
if Nkind (H) = N_Exception_Handler then -- Guard against other constructs appearing in the
-- list of exception handlers.
-- Loop through choices in one handler if Nkind (H) = N_Exception_Handler then
C := First (Exception_Choices (H)); -- Loop through choices in one handler
while Present (C) loop
-- Deal with others case C := First (Exception_Choices (H));
while Present (C) loop
if Nkind (C) = N_Others_Choice then -- Deal with others case
-- Matching others handler, but we need to ensure if Nkind (C) = N_Others_Choice then
-- there is no choice parameter. If there is, then
-- we don't have a local handler after all (since
-- we do not allow choice parameters for local
-- handlers).
if No (Choice_Parameter (H)) then -- Matching others handler, but we need
return H; -- to ensure there is no choice parameter.
else -- If there is, then we don't have a local
return Empty; -- handler after all (since we do not allow
end if; -- choice parameters for local handlers).
-- If not others must be entity name if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
elsif Nkind (C) /= N_Others_Choice then -- If not others must be entity name
pragma Assert (Is_Entity_Name (C));
pragma Assert (Present (Entity (C)));
-- Get exception being handled, dealing with elsif Nkind (C) /= N_Others_Choice then
-- renaming. pragma Assert (Is_Entity_Name (C));
pragma Assert (Present (Entity (C)));
EHandle := Get_Renamed_Entity (Entity (C)); -- Get exception being handled, dealing with
-- renaming.
-- If match, then check choice parameter EHandle := Get_Renamed_Entity (Entity (C));
if ERaise = EHandle then -- If match, then check choice parameter
if No (Choice_Parameter (H)) then
return H; if ERaise = EHandle then
else if No (Choice_Parameter (H)) then
return Empty; return H;
else
return Empty;
end if;
end if;
end if; end if;
end if;
Next (C);
end loop;
end if; end if;
Next (C); Next (H);
end loop; end loop;
end if; end if;
end;
Next (H);
end loop;
end if; end if;
end if; end if;
......
gcc/ada/exp_ch11.ads
...@@ -79,9 +79,9 @@ package Exp_Ch11 is ...@@ -79,9 +79,9 @@ package Exp_Ch11 is
-- the exception entity to be passed to Local_Raise. -- the exception entity to be passed to Local_Raise.
procedure Get_RT_Exception_Name (Code : RT_Exception_Code); procedure Get_RT_Exception_Name (Code : RT_Exception_Code);
-- This procedure is provided for use by the back end to get in the -- This procedure is provided for use by the back end to obtain the name of
-- name of the Rcheck procedure for Code. The name is appended to -- the Rcheck procedure for Code. The name is appended to Namet.Name_Buffer
-- Namet.Name_Buffer, without the __gnat_rcheck_ prefix. -- without the __gnat_rcheck_ prefix.
function Is_Non_Ada_Error (E : Entity_Id) return Boolean; function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
-- This function is provided for Gigi use. It returns True if operating on -- This function is provided for Gigi use. It returns True if operating on
......
gcc/ada/exp_ch7.adb
...@@ -723,9 +723,10 @@ package body Exp_Ch7 is ...@@ -723,9 +723,10 @@ package body Exp_Ch7 is
pragma Assert (Present (Data.Raised_Id)); pragma Assert (Present (Data.Raised_Id));
if Exception_Extra_Info if Exception_Extra_Info
or else (For_Library and then not Restricted_Profile) or else (For_Library and not Restricted_Profile)
then then
if Exception_Extra_Info then if Exception_Extra_Info then
-- Generate: -- Generate:
-- Get_Current_Excep.all -- Get_Current_Excep.all
...@@ -735,8 +736,9 @@ package body Exp_Ch7 is ...@@ -735,8 +736,9 @@ package body Exp_Ch7 is
Name => Name =>
Make_Explicit_Dereference (Data.Loc, Make_Explicit_Dereference (Data.Loc,
Prefix => Prefix =>
New_Reference_To (RTE (RE_Get_Current_Excep), New_Reference_To
Data.Loc))); (RTE (RE_Get_Current_Excep), Data.Loc)));
else else
-- Generate: -- Generate:
...@@ -748,15 +750,17 @@ package body Exp_Ch7 is ...@@ -748,15 +750,17 @@ package body Exp_Ch7 is
if For_Library and then not Restricted_Profile then if For_Library and then not Restricted_Profile then
Proc_To_Call := RTE (RE_Save_Library_Occurrence); Proc_To_Call := RTE (RE_Save_Library_Occurrence);
Actuals := New_List (Except); Actuals := New_List (Except);
else else
Proc_To_Call := RTE (RE_Save_Occurrence); Proc_To_Call := RTE (RE_Save_Occurrence);
-- The dereference occurs only when Exception_Extra_Info is true, -- The dereference occurs only when Exception_Extra_Info is true,
-- and therefore Except is not null. -- and therefore Except is not null.
Actuals := New_List ( Actuals :=
New_Reference_To (Data.E_Id, Data.Loc), New_List (
Make_Explicit_Dereference (Data.Loc, Except)); New_Reference_To (Data.E_Id, Data.Loc),
Make_Explicit_Dereference (Data.Loc, Except));
end if; end if;
-- Generate: -- Generate:
...@@ -3054,6 +3058,7 @@ package body Exp_Ch7 is ...@@ -3054,6 +3058,7 @@ package body Exp_Ch7 is
A_Expr := New_Reference_To (RTE (RE_Triggered_By_Abort), Loc); A_Expr := New_Reference_To (RTE (RE_Triggered_By_Abort), Loc);
-- Generate: -- Generate:
-- Abort_Id : constant Boolean := <A_Expr>; -- Abort_Id : constant Boolean := <A_Expr>;
Append_To (Decls, Append_To (Decls,
...@@ -3073,6 +3078,7 @@ package body Exp_Ch7 is ...@@ -3073,6 +3078,7 @@ package body Exp_Ch7 is
Data.E_Id := Make_Temporary (Loc, 'E'); Data.E_Id := Make_Temporary (Loc, 'E');
-- Generate: -- Generate:
-- E_Id : Exception_Occurrence; -- E_Id : Exception_Occurrence;
E_Decl := E_Decl :=
...@@ -3089,6 +3095,7 @@ package body Exp_Ch7 is ...@@ -3089,6 +3095,7 @@ package body Exp_Ch7 is
end if; end if;
-- Generate: -- Generate:
-- Raised_Id : Boolean := False; -- Raised_Id : Boolean := False;
Append_To (Decls, Append_To (Decls,
...@@ -3134,6 +3141,7 @@ package body Exp_Ch7 is ...@@ -3134,6 +3141,7 @@ package body Exp_Ch7 is
end if; end if;
-- Generate: -- Generate:
-- Raised_Id and then not Abort_Id -- Raised_Id and then not Abort_Id
-- <or> -- <or>
-- Raised_Id -- Raised_Id
...@@ -3149,6 +3157,7 @@ package body Exp_Ch7 is ...@@ -3149,6 +3157,7 @@ package body Exp_Ch7 is
end if; end if;
-- Generate: -- Generate:
-- if Raised_Id and then not Abort_Id then -- if Raised_Id and then not Abort_Id then
-- Raise_From_Controlled_Operation (E_Id); -- Raise_From_Controlled_Operation (E_Id);
-- <or> -- <or>
......
gcc/ada/exp_ch9.adb
...@@ -11883,12 +11883,10 @@ package body Exp_Ch9 is ...@@ -11883,12 +11883,10 @@ package body Exp_Ch9 is
E_Call : Node_Id := E_Call : Node_Id :=
Entry_Call_Statement (Entry_Call_Alternative (N)); Entry_Call_Statement (Entry_Call_Alternative (N));
E_Stats : constant List_Id := E_Stats : List_Id; -- statements after entry call
Statements (Entry_Call_Alternative (N));
D_Stat : Node_Id := D_Stat : Node_Id :=
Delay_Statement (Delay_Alternative (N)); Delay_Statement (Delay_Alternative (N));
D_Stats : constant List_Id := D_Stats : List_Id; -- statements after "delay ..."
Statements (Delay_Alternative (N));
Actuals : List_Id; Actuals : List_Id;
Blk_Typ : Entity_Id; Blk_Typ : Entity_Id;
...@@ -11933,6 +11931,12 @@ package body Exp_Ch9 is ...@@ -11933,6 +11931,12 @@ package body Exp_Ch9 is
Process_Statements_For_Controlled_Objects (Entry_Call_Alternative (N)); Process_Statements_For_Controlled_Objects (Entry_Call_Alternative (N));
Process_Statements_For_Controlled_Objects (Delay_Alternative (N)); Process_Statements_For_Controlled_Objects (Delay_Alternative (N));
-- Must fetch E_Stats/D_Stats after above "Process_...", because it
-- might modify them.
E_Stats := Statements (Entry_Call_Alternative (N));
D_Stats := Statements (Delay_Alternative (N));
-- The arguments in the call may require dynamic allocation, and the -- The arguments in the call may require dynamic allocation, and the
-- call statement may have been transformed into a block. The block -- call statement may have been transformed into a block. The block
-- may contain additional declarations for internal entities, and the -- may contain additional declarations for internal entities, and the
......
gcc/ada/fe.h
...@@ -110,6 +110,7 @@ extern Nat Serious_Errors_Detected; ...@@ -110,6 +110,7 @@ extern Nat Serious_Errors_Detected;
extern Entity_Id Get_Local_Raise_Call_Entity (void); extern Entity_Id Get_Local_Raise_Call_Entity (void);
extern Entity_Id Get_RT_Exception_Entity (int); extern Entity_Id Get_RT_Exception_Entity (int);
extern void Get_RT_Exception_Name (int);
/* exp_code: */ /* exp_code: */
......
gcc/ada/raise-gcc.c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. * * Copyright (C) 1992-2012, 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- *
...@@ -535,10 +535,10 @@ db_region_for (region_descriptor *region, _Unwind_Context *uw_context) ...@@ -535,10 +535,10 @@ db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
ip = get_ip_from_context (uw_context); ip = get_ip_from_context (uw_context);
db (DB_REGIONS, "For ip @ 0x%08x => ", ip); db (DB_REGIONS, "For ip @ %p => ", (void *)ip);
if (region->lsda) if (region->lsda)
db (DB_REGIONS, "lsda @ 0x%x", region->lsda); db (DB_REGIONS, "lsda @ %p", (void *)region->lsda);
else else
db (DB_REGIONS, "no lsda"); db (DB_REGIONS, "no lsda");
...@@ -548,7 +548,7 @@ db_region_for (region_descriptor *region, _Unwind_Context *uw_context) ...@@ -548,7 +548,7 @@ db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
/* Retrieve the ttype entry associated with FILTER in the REGION's /* Retrieve the ttype entry associated with FILTER in the REGION's
ttype table. */ ttype table. */
static const _Unwind_Ptr static _Unwind_Ptr
get_ttype_entry_for (region_descriptor *region, long filter) get_ttype_entry_for (region_descriptor *region, long filter)
{ {
_Unwind_Ptr ttype_entry; _Unwind_Ptr ttype_entry;
...@@ -582,7 +582,7 @@ get_region_description_for (_Unwind_Context *uw_context, ...@@ -582,7 +582,7 @@ get_region_description_for (_Unwind_Context *uw_context,
return; return;
/* Parse the lsda and fill the region descriptor. */ /* Parse the lsda and fill the region descriptor. */
p = (char *)region->lsda; p = (const unsigned char *)region->lsda;
region->base = _Unwind_GetRegionStart (uw_context); region->base = _Unwind_GetRegionStart (uw_context);
...@@ -662,13 +662,13 @@ db_action_for (action_descriptor *action, _Unwind_Context *uw_context) ...@@ -662,13 +662,13 @@ db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
{ {
_Unwind_Ptr ip = get_ip_from_context (uw_context); _Unwind_Ptr ip = get_ip_from_context (uw_context);
db (DB_ACTIONS, "For ip @ 0x%08x => ", ip); db (DB_ACTIONS, "For ip @ %p => ", (void *)ip);
switch (action->kind) switch (action->kind)
{ {
case unknown: case unknown:
db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n", db (DB_ACTIONS, "lpad @ %p, record @ %p\n",
action->landing_pad, action->table_entry); (void *) action->landing_pad, action->table_entry);
break; break;
case nothing: case nothing:
...@@ -680,7 +680,7 @@ db_action_for (action_descriptor *action, _Unwind_Context *uw_context) ...@@ -680,7 +680,7 @@ db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
break; break;
case handler: case handler:
db (DB_ACTIONS, "Handler, filter = %d\n", action->ttype_filter); db (DB_ACTIONS, "Handler, filter = %d\n", (int) action->ttype_filter);
break; break;
default: default:
...@@ -784,9 +784,9 @@ get_call_site_action_for (_Unwind_Context *uw_context, ...@@ -784,9 +784,9 @@ get_call_site_action_for (_Unwind_Context *uw_context,
p = read_uleb128 (p, &cs_action); p = read_uleb128 (p, &cs_action);
db (DB_CSITE, db (DB_CSITE,
"c_site @ 0x%08x (+0x%03x), len = %3d, lpad @ 0x%08x (+0x%03x)\n", "c_site @ %p (+%p), len = %p, lpad @ %p (+%p)\n",
region->base+cs_start, cs_start, cs_len, (void *)region->base + cs_start, (void *)cs_start, (void *)cs_len,
region->lp_base+cs_lp, cs_lp); (void *)region->lp_base + cs_lp, (void *)cs_lp);
/* The table is sorted, so if we've passed the IP, stop. */ /* The table is sorted, so if we've passed the IP, stop. */
if (ip < region->base + cs_start) if (ip < region->base + cs_start)
...@@ -1069,7 +1069,8 @@ PERSONALITY_FUNCTION (version_arg_t, phases_arg_t, ...@@ -1069,7 +1069,8 @@ PERSONALITY_FUNCTION (version_arg_t, phases_arg_t,
_Unwind_Reason_Code _Unwind_Reason_Code
PERSONALITY_FUNCTION (version_arg_t version_arg, PERSONALITY_FUNCTION (version_arg_t version_arg,
phases_arg_t phases_arg, phases_arg_t phases_arg,
_Unwind_Exception_Class uw_exception_class, _Unwind_Exception_Class uw_exception_class
ATTRIBUTE_UNUSED,
_Unwind_Exception *uw_exception, _Unwind_Exception *uw_exception,
_Unwind_Context *uw_context) _Unwind_Context *uw_context)
{ {
......
gcc/ada/sem_cat.adb
...@@ -2131,7 +2131,7 @@ package body Sem_Cat is ...@@ -2131,7 +2131,7 @@ package body Sem_Cat is
if Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N))) if Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N)))
and then and then
Enclosing_Lib_Unit_Node (N) /= Enclosing_Lib_Unit_Node (E) Enclosing_Comp_Unit_Node (N) /= Enclosing_Comp_Unit_Node (E)
and then (Is_Preelaborated (Scope (E)) and then (Is_Preelaborated (Scope (E))
or else Is_Pure (Scope (E)) or else Is_Pure (Scope (E))
or else (Present (Renamed_Object (E)) or else (Present (Renamed_Object (E))
......
gcc/ada/sem_ch6.adb
...@@ -1812,7 +1812,6 @@ package body Sem_Ch6 is ...@@ -1812,7 +1812,6 @@ package body Sem_Ch6 is
Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id); Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id);
Conformant : Boolean; Conformant : Boolean;
HSS : Node_Id; HSS : Node_Id;
P_Ent : Entity_Id;
Prot_Typ : Entity_Id := Empty; Prot_Typ : Entity_Id := Empty;
Spec_Id : Entity_Id; Spec_Id : Entity_Id;
Spec_Decl : Node_Id := Empty; Spec_Decl : Node_Id := Empty;
...@@ -2507,42 +2506,10 @@ package body Sem_Ch6 is ...@@ -2507,42 +2506,10 @@ package body Sem_Ch6 is
end if; end if;
end if; end if;
-- Do not inline any subprogram that contains nested subprograms, since -- Previously we scanned the body to look for nested subprograms, and
-- the backend inlining circuit seems to generate uninitialized -- rejected an inline directive if nested subprograms were present,
-- references in this case. We know this happens in the case of front -- because the back-end would generate conflicting symbols for the
-- end ZCX support, but it also appears it can happen in other cases as -- nested bodies. This is now unecessary.
-- well. The backend often rejects attempts to inline in the case of
-- nested procedures anyway, so little if anything is lost by this.
-- Note that this is test is for the benefit of the back-end. There is
-- a separate test for front-end inlining that also rejects nested
-- subprograms.
-- Do not do this test if errors have been detected, because in some
-- error cases, this code blows up, and we don't need it anyway if
-- there have been errors, since we won't get to the linker anyway.
if Comes_From_Source (Body_Id)
and then Serious_Errors_Detected = 0
and then not Debug_Flag_Dot_K
then
P_Ent := Body_Id;
loop
P_Ent := Scope (P_Ent);
exit when No (P_Ent) or else P_Ent = Standard_Standard;
if Is_Subprogram (P_Ent) then
Set_Is_Inlined (P_Ent, False);
if Comes_From_Source (P_Ent)
and then Has_Pragma_Inline (P_Ent)
then
Cannot_Inline
("cannot inline& (nested subprogram)?",
N, P_Ent);
end if;
end if;
end loop;
end if;
-- Look ahead to recognize a pragma inline that appears after the body -- Look ahead to recognize a pragma inline that appears after the body
......
gcc/ada/sem_res.adb
...@@ -1967,7 +1967,10 @@ package body Sem_Res is ...@@ -1967,7 +1967,10 @@ package body Sem_Res is
-- Prefix (N) must statically denote a remote subprogram -- Prefix (N) must statically denote a remote subprogram
-- declared in a package specification. -- declared in a package specification.
if Attr = Attribute_Access then if Attr = Attribute_Access or else
Attr = Attribute_Unchecked_Access or else
Attr = Attribute_Unrestricted_Access
then
Decl := Unit_Declaration_Node (Entity (Pref)); Decl := Unit_Declaration_Node (Entity (Pref));
if Nkind (Decl) = N_Subprogram_Body then if Nkind (Decl) = N_Subprogram_Body then
...@@ -1990,26 +1993,22 @@ package body Sem_Res is ...@@ -1990,26 +1993,22 @@ package body Sem_Res is
("prefix must statically denote a remote subprogram ", ("prefix must statically denote a remote subprogram ",
N); N);
end if; end if;
end if;
-- If we are generating code for a distributed program. -- If we are generating code in distributed mode, perform
-- perform semantic checks against the corresponding -- semantic checks against corresponding remote entities.
-- remote entities.
if (Attr = Attribute_Access or else if Full_Expander_Active
Attr = Attribute_Unchecked_Access or else and then Get_PCS_Name /= Name_No_DSA
Attr = Attribute_Unrestricted_Access) then
and then Full_Expander_Active Check_Subtype_Conformant
and then Get_PCS_Name /= Name_No_DSA (New_Id => Entity (Prefix (N)),
then Old_Id => Designated_Type
Check_Subtype_Conformant (Corresponding_Remote_Type (Typ)),
(New_Id => Entity (Prefix (N)), Err_Loc => N);
Old_Id => Designated_Type
(Corresponding_Remote_Type (Typ)), if Is_Remote then
Err_Loc => N); Process_Remote_AST_Attribute (N, Typ);
end if;
if Is_Remote then
Process_Remote_AST_Attribute (N, Typ);
end if; end if;
end if; end if;
end if; end if;
......
gcc/ada/sem_util.adb
...@@ -3165,11 +3165,11 @@ package body Sem_Util is ...@@ -3165,11 +3165,11 @@ package body Sem_Util is
return Unit_Entity; return Unit_Entity;
end Enclosing_Lib_Unit_Entity; end Enclosing_Lib_Unit_Entity;
----------------------------- ------------------------------
-- Enclosing_Lib_Unit_Node -- -- Enclosing_Comp_Unit_Node --
----------------------------- ------------------------------
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id is function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id is
Current_Node : Node_Id; Current_Node : Node_Id;
begin begin
...@@ -3185,7 +3185,7 @@ package body Sem_Util is ...@@ -3185,7 +3185,7 @@ package body Sem_Util is
end if; end if;
return Current_Node; return Current_Node;
end Enclosing_Lib_Unit_Node; end Enclosing_Comp_Unit_Node;
----------------------- -----------------------
-- Enclosing_Package -- -- Enclosing_Package --
......
gcc/ada/sem_util.ads
...@@ -386,7 +386,7 @@ package Sem_Util is ...@@ -386,7 +386,7 @@ package Sem_Util is
-- root of the current scope (which must not be Standard_Standard, and the -- root of the current scope (which must not be Standard_Standard, and the
-- caller is responsible for ensuring this condition). -- caller is responsible for ensuring this condition).
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id; function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id;
-- Returns the enclosing N_Compilation_Unit Node that is the root of a -- Returns the enclosing N_Compilation_Unit Node that is the root of a
-- subtree containing N. -- subtree containing N.
......
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