summaryrefslogtreecommitdiff
path: root/gcc/ada/sem_ch7.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/sem_ch7.adb')
-rw-r--r--gcc/ada/sem_ch7.adb57
1 files changed, 53 insertions, 4 deletions
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 11be7c1df51..91d3067ba95 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -692,10 +692,15 @@ package body Sem_Ch7 is
-- is a public child of Parent as defined in 10.1.1
procedure Inspect_Deferred_Constant_Completion;
- -- Examines the deferred constants in the private part of the
- -- package specification. Emits the error "constant declaration
- -- requires initialization expression " if not completed by an
- -- import pragma.
+ -- Examines the deferred constants in the private part of the package
+ -- specification. Emits the error message "constant declaration requires
+ -- initialization expression " if not completed by an Import pragma.
+
+ procedure Inspect_Unchecked_Union_Completion (Decls : List_Id);
+ -- Detects all incomplete or private type declarations having a known
+ -- discriminant part that are completed by an Unchecked_Union. Emits
+ -- the error message "Unchecked_Union may not complete discriminated
+ -- partial view".
---------------------
-- Clear_Constants --
@@ -834,6 +839,37 @@ package body Sem_Ch7 is
end loop;
end Inspect_Deferred_Constant_Completion;
+ ----------------------------------------
+ -- Inspect_Unchecked_Union_Completion --
+ ----------------------------------------
+
+ procedure Inspect_Unchecked_Union_Completion (Decls : List_Id) is
+ Decl : Node_Id := First (Decls);
+
+ begin
+ while Present (Decl) loop
+
+ -- We are looking at an incomplete or private type declaration
+ -- with a known_discriminant_part whose full view is an
+ -- Unchecked_Union.
+
+ if (Nkind (Decl) = N_Incomplete_Type_Declaration
+ or else
+ Nkind (Decl) = N_Private_Type_Declaration)
+ and then Has_Discriminants (Defining_Identifier (Decl))
+ and then Present (Full_View (Defining_Identifier (Decl)))
+ and then Is_Unchecked_Union
+ (Full_View (Defining_Identifier (Decl)))
+ then
+ Error_Msg_N ("completion of discriminated partial view" &
+ " cannot be an Unchecked_Union",
+ Full_View (Defining_Identifier (Decl)));
+ end if;
+
+ Next (Decl);
+ end loop;
+ end Inspect_Unchecked_Union_Completion;
+
-- Start of processing for Analyze_Package_Specification
begin
@@ -982,6 +1018,18 @@ package body Sem_Ch7 is
Next_Entity (E);
end loop;
+ -- Ada 2005 (AI-216): The completion of an incomplete or private type
+ -- declaration having a known_discriminant_part shall not be an
+ -- Unchecked_Union type.
+
+ if Present (Vis_Decls) then
+ Inspect_Unchecked_Union_Completion (Vis_Decls);
+ end if;
+
+ if Present (Priv_Decls) then
+ Inspect_Unchecked_Union_Completion (Priv_Decls);
+ end if;
+
if Ekind (Id) = E_Generic_Package
and then Nkind (Orig_Decl) = N_Generic_Package_Declaration
and then Present (Priv_Decls)
@@ -1443,6 +1491,7 @@ package body Sem_Ch7 is
while Present (Id) loop
Install_Package_Entity (Id);
+ Set_Is_Hidden (Id, False);
Next_Entity (Id);
end loop;