* [COMMITTED] ada: Allow passing private types to generic formal incomplete types
@ 2024-01-09 13:15 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2024-01-09 13:15 UTC (permalink / raw)
To: gcc-patches; +Cc: Bob Duff
From: Bob Duff <duff@adacore.com>
It is legal to pass a private type, or a type with a component whose
type is private, as a generic actual type if the formal is a generic
formal incomplete type. This patch fixes a bug in which the compiler
would give an error in some such cases.
Also misc cleanup.
gcc/ada/
* sem_ch12.adb (Instantiate_Type): Make the relevant error message
conditional upon "Ekind (A_Gen_T) /= E_Incomplete_Type". Misc
cleanup.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch12.adb | 156 +++++++++++++++++++++----------------------
1 file changed, 76 insertions(+), 80 deletions(-)
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5bddb5a8556..1d17cfacec3 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -14186,124 +14186,120 @@ package body Sem_Ch12 is
if Get_Instance_Of (A_Gen_T) /= A_Gen_T then
Error_Msg_N ("duplicate instantiation of generic type", Actual);
return New_List (Error);
+ end if;
- elsif not Is_Entity_Name (Actual)
+ if not Is_Entity_Name (Actual)
or else not Is_Type (Entity (Actual))
then
Error_Msg_NE
("expect valid subtype mark to instantiate &", Actual, Gen_T);
Abandon_Instantiation (Actual);
+ end if;
- else
- Act_T := Entity (Actual);
+ Act_T := Entity (Actual);
- -- Ada 2005 (AI-216): An Unchecked_Union subtype shall only be passed
- -- as a generic actual parameter if the corresponding formal type
- -- does not have a known_discriminant_part, or is a formal derived
- -- type that is an Unchecked_Union type.
+ -- Ada 2005 (AI-216): An Unchecked_Union subtype shall only be passed
+ -- as a generic actual parameter if the corresponding formal type
+ -- does not have a known_discriminant_part, or is a formal derived
+ -- type that is an Unchecked_Union type.
- if Is_Unchecked_Union (Base_Type (Act_T)) then
- if not Has_Discriminants (A_Gen_T)
- or else (Is_Derived_Type (A_Gen_T)
- and then Is_Unchecked_Union (A_Gen_T))
- then
- null;
- else
- Error_Msg_N ("unchecked union cannot be the actual for a "
- & "discriminated formal type", Act_T);
+ if Is_Unchecked_Union (Base_Type (Act_T)) then
+ if not Has_Discriminants (A_Gen_T)
+ or else (Is_Derived_Type (A_Gen_T)
+ and then Is_Unchecked_Union (A_Gen_T))
+ then
+ null;
+ else
+ Error_Msg_N ("unchecked union cannot be the actual for a "
+ & "discriminated formal type", Act_T);
- end if;
end if;
+ end if;
- -- Deal with fixed/floating restrictions
+ -- Deal with fixed/floating restrictions
- if Is_Floating_Point_Type (Act_T) then
- Check_Restriction (No_Floating_Point, Actual);
- elsif Is_Fixed_Point_Type (Act_T) then
- Check_Restriction (No_Fixed_Point, Actual);
- end if;
+ if Is_Floating_Point_Type (Act_T) then
+ Check_Restriction (No_Floating_Point, Actual);
+ elsif Is_Fixed_Point_Type (Act_T) then
+ Check_Restriction (No_Fixed_Point, Actual);
+ end if;
- -- Deal with error of using incomplete type as generic actual.
- -- This includes limited views of a type, even if the non-limited
- -- view may be available.
+ -- Deal with error of using incomplete type as generic actual.
+ -- This includes limited views of a type, even if the non-limited
+ -- view may be available.
- if Ekind (Act_T) = E_Incomplete_Type
- or else (Is_Class_Wide_Type (Act_T)
- and then Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
- then
- -- If the formal is an incomplete type, the actual can be
- -- incomplete as well, but if an actual incomplete type has
- -- a full view, then we'll retrieve that.
+ if Ekind (Act_T) = E_Incomplete_Type
+ or else (Is_Class_Wide_Type (Act_T)
+ and then Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
+ then
+ -- If the formal is an incomplete type, the actual can be
+ -- incomplete as well, but if an actual incomplete type has
+ -- a full view, then we'll retrieve that.
- if Ekind (A_Gen_T) = E_Incomplete_Type
- and then No (Full_View (Act_T))
- then
- null;
+ if Ekind (A_Gen_T) = E_Incomplete_Type
+ and then No (Full_View (Act_T))
+ then
+ null;
- elsif Is_Class_Wide_Type (Act_T)
- or else No (Full_View (Act_T))
- then
- Error_Msg_N ("premature use of incomplete type", Actual);
- Abandon_Instantiation (Actual);
+ elsif Is_Class_Wide_Type (Act_T)
+ or else No (Full_View (Act_T))
+ then
+ Error_Msg_N ("premature use of incomplete type", Actual);
+ Abandon_Instantiation (Actual);
- else
- Act_T := Full_View (Act_T);
- Set_Entity (Actual, Act_T);
+ else
+ Act_T := Full_View (Act_T);
+ Set_Entity (Actual, Act_T);
- if Has_Private_Component (Act_T) then
- Error_Msg_N
- ("premature use of type with private component", Actual);
- end if;
+ if Has_Private_Component (Act_T) then
+ Error_Msg_N
+ ("premature use of type with private component", Actual);
end if;
+ end if;
- -- Deal with error of premature use of private type as generic actual
+ -- Deal with error of premature use of private type as generic actual,
+ -- which is allowed for incomplete formals.
- elsif Is_Private_Type (Act_T)
+ elsif Ekind (A_Gen_T) /= E_Incomplete_Type then
+ if Is_Private_Type (Act_T)
and then Is_Private_Type (Base_Type (Act_T))
and then not Is_Generic_Type (Act_T)
and then not Is_Derived_Type (Act_T)
and then No (Full_View (Root_Type (Act_T)))
then
- -- If the formal is an incomplete type, the actual can be
- -- private or incomplete as well.
-
- if Ekind (A_Gen_T) = E_Incomplete_Type then
- null;
- else
- Error_Msg_N ("premature use of private type", Actual);
- end if;
+ Error_Msg_N ("premature use of private type", Actual);
elsif Has_Private_Component (Act_T) then
Error_Msg_N
("premature use of type with private component", Actual);
end if;
+ end if;
- Set_Instance_Of (A_Gen_T, Act_T);
+ Set_Instance_Of (A_Gen_T, Act_T);
- -- If the type is generic, the class-wide type may also be used
+ -- If the type is generic, the class-wide type may also be used
- if Is_Tagged_Type (A_Gen_T)
- and then Is_Tagged_Type (Act_T)
- and then not Is_Class_Wide_Type (A_Gen_T)
- then
- Set_Instance_Of (Class_Wide_Type (A_Gen_T),
- Class_Wide_Type (Act_T));
- end if;
+ if Is_Tagged_Type (A_Gen_T)
+ and then Is_Tagged_Type (Act_T)
+ and then not Is_Class_Wide_Type (A_Gen_T)
+ then
+ Set_Instance_Of (Class_Wide_Type (A_Gen_T),
+ Class_Wide_Type (Act_T));
+ end if;
- if not Is_Abstract_Type (A_Gen_T)
- and then Is_Abstract_Type (Act_T)
- then
- Error_Msg_N
- ("actual of non-abstract formal cannot be abstract", Actual);
- end if;
+ if not Is_Abstract_Type (A_Gen_T)
+ and then Is_Abstract_Type (Act_T)
+ then
+ Error_Msg_N
+ ("actual of non-abstract formal cannot be abstract", Actual);
+ end if;
- -- A generic scalar type is a first subtype for which we generate
- -- an anonymous base type. Indicate that the instance of this base
- -- is the base type of the actual.
+ -- A generic scalar type is a first subtype for which we generate
+ -- an anonymous base type. Indicate that the instance of this base
+ -- is the base type of the actual.
- if Is_Scalar_Type (A_Gen_T) then
- Set_Instance_Of (Etype (A_Gen_T), Etype (Act_T));
- end if;
+ if Is_Scalar_Type (A_Gen_T) then
+ Set_Instance_Of (Etype (A_Gen_T), Etype (Act_T));
end if;
Check_Shared_Variable_Control_Aspects;
--
2.43.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2024-01-09 13:15 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-01-09 13:15 [COMMITTED] ada: Allow passing private types to generic formal incomplete types Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).