The compiler does not report an error on a type conversion to/from a
tagged type whose parent type is an interface type and there is no
relationship between the source and target types. This bug has been
dormant since January/2016.
This patch also improves the text of errors reported on interface type
conversions suggesting how to fix these errors.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_res.adb (Resolve_Type_Conversion): Code cleanup since the
previous static check has been moved to Valid_Tagged_Conversion.
(Valid_Tagged_Conversion): Fix the code checking conversion
to/from interface types since incorrectly returns True when the
parent type of the operand type (or the target type) is an
interface type; add missing static checks on interface type
conversions.diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -31,6 +31,7 @@ with Debug_A; use Debug_A;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
+with Elists; use Elists;
with Errout; use Errout;
with Expander; use Expander;
with Exp_Ch6; use Exp_Ch6;
@@ -12308,26 +12309,7 @@ package body Sem_Res is
-- Conversion to interface type
elsif Is_Interface (Target) then
-
- -- Handle subtypes
-
- if Ekind (Opnd) in E_Protected_Subtype | E_Task_Subtype then
- Opnd := Etype (Opnd);
- end if;
-
- if Is_Class_Wide_Type (Opnd)
- or else Interface_Present_In_Ancestor
- (Typ => Opnd,
- Iface => Target)
- then
- Expand_Interface_Conversion (N);
- else
- Error_Msg_Name_1 := Chars (Etype (Target));
- Error_Msg_Name_2 := Chars (Opnd);
- Error_Msg_N
- ("wrong interface conversion (% is not a progenitor "
- & "of %)", N);
- end if;
+ Expand_Interface_Conversion (N);
end if;
end;
end if;
@@ -13621,29 +13603,115 @@ package body Sem_Res is
Conversion_Check (False,
"downward conversion of tagged objects not allowed");
- -- Ada 2005 (AI-251): The conversion to/from interface types is
- -- always valid. The types involved may be class-wide (sub)types.
+ -- Ada 2005 (AI-251): A conversion is valid if the operand and target
+ -- types are both class-wide types and the specific type associated
+ -- with at least one of them is an interface type (RM 4.6 (23.1/2));
+ -- at run-time a check will verify the validity of this interface
+ -- type conversion.
- elsif Is_Interface (Etype (Base_Type (Target_Type)))
- or else Is_Interface (Etype (Base_Type (Opnd_Type)))
+ elsif Is_Class_Wide_Type (Target_Type)
+ and then Is_Class_Wide_Type (Opnd_Type)
+ and then (Is_Interface (Target_Type)
+ or else Is_Interface (Opnd_Type))
then
return True;
- -- If the operand is a class-wide type obtained through a limited_
- -- with clause, and the context includes the nonlimited view, use
- -- it to determine whether the conversion is legal.
+ -- Report errors
+
+ elsif Is_Class_Wide_Type (Target_Type)
+ and then Is_Interface (Target_Type)
+ and then not Is_Interface (Opnd_Type)
+ and then not Interface_Present_In_Ancestor
+ (Typ => Opnd_Type,
+ Iface => Target_Type)
+ then
+ Error_Msg_Name_1 := Chars (Etype (Target_Type));
+ Error_Msg_Name_2 := Chars (Opnd_Type);
+ Conversion_Error_N
+ ("wrong interface conversion (% is not a progenitor "
+ & "of %)", N);
+ return False;
elsif Is_Class_Wide_Type (Opnd_Type)
- and then From_Limited_With (Opnd_Type)
- and then Present (Non_Limited_View (Etype (Opnd_Type)))
- and then Is_Interface (Non_Limited_View (Etype (Opnd_Type)))
+ and then Is_Interface (Opnd_Type)
+ and then not Is_Interface (Target_Type)
+ and then not Interface_Present_In_Ancestor
+ (Typ => Target_Type,
+ Iface => Opnd_Type)
then
- return True;
+ Error_Msg_Name_1 := Chars (Etype (Opnd_Type));
+ Error_Msg_Name_2 := Chars (Target_Type);
+ Conversion_Error_N
+ ("wrong interface conversion (% is not a progenitor "
+ & "of %)", N);
- elsif Is_Access_Type (Opnd_Type)
- and then Is_Interface (Directly_Designated_Type (Opnd_Type))
+ -- Search for interface types shared between the target type and
+ -- the operand interface type to complete the text of the error
+ -- since the source of this error is a missing type conversion
+ -- to such interface type.
+
+ if Has_Interfaces (Target_Type) then
+ declare
+ Operand_Ifaces_List : Elist_Id;
+ Operand_Iface_Elmt : Elmt_Id;
+ Target_Ifaces_List : Elist_Id;
+ Target_Iface_Elmt : Elmt_Id;
+ First_Candidate : Boolean := True;
+
+ begin
+ Collect_Interfaces (Base_Type (Target_Type),
+ Target_Ifaces_List);
+ Collect_Interfaces (Root_Type (Base_Type (Opnd_Type)),
+ Operand_Ifaces_List);
+
+ Operand_Iface_Elmt := First_Elmt (Operand_Ifaces_List);
+ while Present (Operand_Iface_Elmt) loop
+ Target_Iface_Elmt := First_Elmt (Target_Ifaces_List);
+ while Present (Target_Iface_Elmt) loop
+ if Node (Operand_Iface_Elmt)
+ = Node (Target_Iface_Elmt)
+ then
+ Error_Msg_Name_1 :=
+ Chars (Node (Target_Iface_Elmt));
+
+ if First_Candidate then
+ First_Candidate := False;
+ Conversion_Error_N
+ ("\must convert to `%''Class` before downward "
+ & "conversion", Operand);
+ else
+ Conversion_Error_N
+ ("\or must convert to `%''Class` before "
+ & "downward conversion", Operand);
+ end if;
+ end if;
+
+ Next_Elmt (Target_Iface_Elmt);
+ end loop;
+
+ Next_Elmt (Operand_Iface_Elmt);
+ end loop;
+ end;
+ end if;
+
+ return False;
+
+ elsif not Is_Class_Wide_Type (Target_Type)
+ and then Is_Interface (Target_Type)
then
- return True;
+ Conversion_Error_N
+ ("wrong use of interface type in tagged conversion", N);
+ Conversion_Error_N
+ ("\add ''Class to the target interface type", N);
+ return False;
+
+ elsif not Is_Class_Wide_Type (Opnd_Type)
+ and then Is_Interface (Opnd_Type)
+ then
+ Conversion_Error_N
+ ("must convert to class-wide interface type before downward "
+ & "conversion", Operand);
+ return False;
else
Conversion_Error_NE
