aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_util.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/sem_util.adb')
-rw-r--r--gcc/ada/sem_util.adb74
1 files changed, 31 insertions, 43 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 0ce9e95..679d0ee 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -333,7 +333,7 @@ package body Sem_Util is
-- Add_Global_Declaration --
----------------------------
- procedure Add_Global_Declaration (N : Node_Id) is
+ procedure Add_Global_Declaration (Decl : Node_Id) is
Aux_Node : constant Node_Id := Aux_Decls_Node (Cunit (Current_Sem_Unit));
begin
@@ -341,8 +341,8 @@ package body Sem_Util is
Set_Declarations (Aux_Node, New_List);
end if;
- Append_To (Declarations (Aux_Node), N);
- Analyze (N);
+ Append_To (Declarations (Aux_Node), Decl);
+ Analyze (Decl);
end Add_Global_Declaration;
--------------------------------
@@ -8026,6 +8026,7 @@ package body Sem_Util is
-- but the error should be posted on it, not on the component.
elsif Ekind (E) = E_Discriminant
+ and then Is_Not_Self_Hidden (E)
and then Present (Scope (Def_Id))
and then Scope (Def_Id) /= Current_Scope
then
@@ -8051,7 +8052,10 @@ package body Sem_Util is
-- Avoid cascaded messages with duplicate components in
-- derived types.
- if Ekind (E) in E_Component | E_Discriminant then
+ if Ekind (E) = E_Component
+ or else (Ekind (E) = E_Discriminant
+ and then Is_Not_Self_Hidden (E))
+ then
return;
end if;
end if;
@@ -8082,20 +8086,7 @@ package body Sem_Util is
-- If we fall through, declaration is OK, at least OK enough to continue
- -- If Def_Id is a discriminant or a record component we are in the midst
- -- of inheriting components in a derived record definition. Preserve
- -- their Ekind and Etype.
-
- if Ekind (Def_Id) in E_Discriminant | E_Component then
- null;
-
- -- If a type is already set, leave it alone (happens when a type
- -- declaration is reanalyzed following a call to the optimizer).
-
- elsif Present (Etype (Def_Id)) then
- null;
-
- else
+ if No (Etype (Def_Id)) then
Set_Etype (Def_Id, Any_Type); -- avoid cascaded errors
end if;
@@ -8923,9 +8914,10 @@ package body Sem_Util is
--------------------------
procedure Find_Overlaid_Entity
- (N : Node_Id;
- Ent : out Entity_Id;
- Off : out Boolean)
+ (N : Node_Id;
+ Ent : out Entity_Id;
+ Ovrl_Typ : out Entity_Id;
+ Off : out Boolean)
is
pragma Assert
(Nkind (N) = N_Attribute_Definition_Clause
@@ -8947,8 +8939,9 @@ package body Sem_Util is
-- In the second case, the expr is either Y'Address, or recursively a
-- constant that eventually references Y'Address.
- Ent := Empty;
- Off := False;
+ Ent := Empty;
+ Ovrl_Typ := Empty;
+ Off := False;
Expr := Expression (N);
@@ -8978,6 +8971,8 @@ package body Sem_Util is
end if;
end loop;
+ Ovrl_Typ := Etype (Expr);
+
-- This loop checks the form of the prefix for an entity, using
-- recursion to deal with intermediate components.
@@ -8996,8 +8991,10 @@ package body Sem_Util is
pragma Assert
(not Expander_Active
and then Is_Concurrent_Type (Scope (Ent)));
- Ent := Empty;
+ Ent := Empty;
+ Ovrl_Typ := Empty;
end if;
+
return;
-- Check for components
@@ -18382,6 +18379,7 @@ package body Sem_Util is
case Nkind (N) is
when N_Indexed_Component
+ | N_Selected_Component
| N_Slice
=>
return
@@ -18393,13 +18391,6 @@ package body Sem_Util is
when N_Attribute_Reference =>
return Attribute_Name (N) in Name_Input | Name_Old | Name_Result;
- when N_Selected_Component =>
- return
- Is_Name_Reference (Selector_Name (N))
- and then
- (Is_Name_Reference (Prefix (N))
- or else Is_Access_Type (Etype (Prefix (N))));
-
when N_Explicit_Dereference =>
return True;
@@ -21907,7 +21898,7 @@ package body Sem_Util is
Set_Last_Assignment (Ent, Empty);
end if;
- if Is_Object (Ent) then
+ if Is_Object (Ent) and then Ekind (Ent) not in Record_Field_Kind then
if not Last_Assignment_Only then
Kill_Checks (Ent);
Set_Current_Value (Ent, Empty);
@@ -25593,16 +25584,18 @@ package body Sem_Util is
if Sure
and then Modification_Comes_From_Source
+ and then Ekind (Ent) in E_Constant | E_Variable
and then Overlays_Constant (Ent)
and then Address_Clause_Overlay_Warnings
then
declare
Addr : constant Node_Id := Address_Clause (Ent);
O_Ent : Entity_Id;
+ O_Typ : Entity_Id;
Off : Boolean;
begin
- Find_Overlaid_Entity (Addr, O_Ent, Off);
+ Find_Overlaid_Entity (Addr, O_Ent, O_Typ, Off);
Error_Msg_Sloc := Sloc (Addr);
Error_Msg_NE
@@ -28522,12 +28515,6 @@ package body Sem_Util is
return False;
end if;
- if Ekind (Entity (Selector_Name (N))) not in
- E_Component | E_Discriminant
- then
- return False;
- end if;
-
declare
Comp : constant Entity_Id :=
Original_Record_Component (Entity (Selector_Name (N)));
@@ -29050,9 +29037,10 @@ package body Sem_Util is
------------------------------
function Ultimate_Overlaid_Entity (E : Entity_Id) return Entity_Id is
- Address : Node_Id;
- Alias : Entity_Id := E;
- Offset : Boolean;
+ Address : Node_Id;
+ Alias : Entity_Id := E;
+ Offset : Boolean;
+ Ovrl_Typ : Entity_Id;
begin
-- Currently this routine is only called for stand-alone objects that
@@ -29064,7 +29052,7 @@ package body Sem_Util is
loop
Address := Address_Clause (Alias);
if Present (Address) then
- Find_Overlaid_Entity (Address, Alias, Offset);
+ Find_Overlaid_Entity (Address, Alias, Ovrl_Typ, Offset);
if Present (Alias) then
null;
else