* [Ada] Derived subprogram called handled incorrectly
@ 2008-05-21 8:26 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2008-05-21 8:26 UTC (permalink / raw)
To: gcc-patches; +Cc: Hristian Kirtchev
[-- Attachment #1: Type: text/plain, Size: 1599 bytes --]
Tested on i686-linux, commited on trunk
The patch corrects the machinery that generates type conversions for actual
parameters in derived subprograms. The need for a conversion arrises when
the parent type has a different representation than that of a derived type.
A subsequent call to a derived routine where the actual is of the derived
type must use a type conversion to obtain the proper view of the parent
type.
Source:
package Pack is
type T is record
A : Boolean;
B : Boolean;
C : Boolean;
end record;
procedure Print (Obj : T);
type T1 is new T;
pragma Pack (T);
for T'Size use 3;
end Pack;
with Ada.Text_IO; use Ada.Text_IO;
package body Pack is
procedure Print (Obj : T) is
begin
Put_Line (Boolean'Image (Obj.A));
Put_Line (Boolean'Image (Obj.B));
Put_Line (Boolean'Image (Obj.C));
end Print;
end Pack;
with Ada.Text_IO; use Ada.Text_IO;
with Pack; use Pack;
procedure Main is
Obj_T : T := (others => True);
Obj_T1 : T1 := (others => True);
begin
Print (Obj_T);
Print (Obj_T1);
end Main;
--
Compilation:
gnatmake -q main.adb
--
Execution and output:
$ ./main
$ TRUE
$ TRUE
$ TRUE
$ TRUE
$ TRUE
$ TRUE
2008-05-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Expand_Call): Add guard to ensure that both the parent
and the derived type are of the same kind.
(Expand_Call): Generate type conversions for actuals of
record or array types when the parent and the derived types differ in
size and/or packed status.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 8253 bytes --]
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 134945)
+++ exp_ch6.adb (working copy)
@@ -2641,77 +2641,110 @@ package body Exp_Ch6 is
("cannot call abstract subprogram &!", Name (N), Parent_Subp);
end if;
- -- Add an explicit conversion for parameter of the derived type.
- -- This is only done for scalar and access in-parameters. Others
- -- have been expanded in expand_actuals.
-
- Formal := First_Formal (Subp);
- Parent_Formal := First_Formal (Parent_Subp);
- Actual := First_Actual (N);
-
- -- It is not clear that conversion is needed for intrinsic
- -- subprograms, but it certainly is for those that are user-
- -- defined, and that can be inherited on derivation, namely
- -- unchecked conversion and deallocation.
- -- General case needs study ???
+ -- Inspect all formals of derived subprogram Subp. Compare parameter
+ -- types with the parent subprogram and check whether an actual may
+ -- need a type conversion to the corresponding formal of the parent
+ -- subprogram.
+
+ -- Not clear whether intrinsic subprograms need such conversions. ???
if not Is_Intrinsic_Subprogram (Parent_Subp)
or else Is_Generic_Instance (Parent_Subp)
then
- while Present (Formal) loop
- if Etype (Formal) /= Etype (Parent_Formal)
- and then Is_Scalar_Type (Etype (Formal))
- and then Ekind (Formal) = E_In_Parameter
- and then
- not Subtypes_Statically_Match
- (Etype (Parent_Formal), Etype (Actual))
- and then not Raises_Constraint_Error (Actual)
- then
- Rewrite (Actual,
- OK_Convert_To (Etype (Parent_Formal),
- Relocate_Node (Actual)));
-
- Analyze (Actual);
- Resolve (Actual, Etype (Parent_Formal));
- Enable_Range_Check (Actual);
-
- elsif Is_Access_Type (Etype (Formal))
- and then Base_Type (Etype (Parent_Formal)) /=
- Base_Type (Etype (Actual))
- then
- if Ekind (Formal) /= E_In_Parameter then
- Rewrite (Actual,
- Convert_To (Etype (Parent_Formal),
- Relocate_Node (Actual)));
-
- Analyze (Actual);
- Resolve (Actual, Etype (Parent_Formal));
-
- elsif
- Ekind (Etype (Parent_Formal)) = E_Anonymous_Access_Type
- and then Designated_Type (Etype (Parent_Formal))
- /=
- Designated_Type (Etype (Actual))
- and then not Is_Controlling_Formal (Formal)
+ declare
+ procedure Convert (Act : Node_Id; Typ : Entity_Id);
+ -- Rewrite node Act as a type conversion of Act to Typ. Analyze
+ -- and resolve the newly generated construct.
+
+ -------------
+ -- Convert --
+ -------------
+
+ procedure Convert (Act : Node_Id; Typ : Entity_Id) is
+ begin
+ Rewrite (Act, OK_Convert_To (Typ, Relocate_Node (Act)));
+ Analyze (Act);
+ Resolve (Act, Typ);
+ end Convert;
+
+ -- Local variables
+
+ Actual_Typ : Entity_Id;
+ Formal_Typ : Entity_Id;
+ Parent_Typ : Entity_Id;
+
+ begin
+ Actual := First_Actual (N);
+ Formal := First_Formal (Subp);
+ Parent_Formal := First_Formal (Parent_Subp);
+ while Present (Formal) loop
+ Actual_Typ := Etype (Actual);
+ Formal_Typ := Etype (Formal);
+ Parent_Typ := Etype (Parent_Formal);
+
+ -- For an IN parameter of a scalar type, the parent formal
+ -- type and derived formal type differ or the parent formal
+ -- type and actual type do not match statically.
+
+ if Is_Scalar_Type (Formal_Typ)
+ and then Ekind (Formal) = E_In_Parameter
+ and then Formal_Typ /= Parent_Typ
+ and then
+ not Subtypes_Statically_Match (Parent_Typ, Actual_Typ)
+ and then not Raises_Constraint_Error (Actual)
+ then
+ Convert (Actual, Parent_Typ);
+ Enable_Range_Check (Actual);
+
+ -- For access types, the parent formal type and actual type
+ -- differ.
+
+ elsif Is_Access_Type (Formal_Typ)
+ and then Base_Type (Parent_Typ) /= Base_Type (Actual_Typ)
then
- -- This unchecked conversion is not necessary unless
- -- inlining is enabled, because in that case the type
- -- mismatch may become visible in the body about to be
- -- inlined.
-
- Rewrite (Actual,
- Unchecked_Convert_To (Etype (Parent_Formal),
- Relocate_Node (Actual)));
+ if Ekind (Formal) /= E_In_Parameter then
+ Convert (Actual, Parent_Typ);
- Analyze (Actual);
- Resolve (Actual, Etype (Parent_Formal));
+ elsif Ekind (Parent_Typ) = E_Anonymous_Access_Type
+ and then Designated_Type (Parent_Typ) /=
+ Designated_Type (Actual_Typ)
+ and then not Is_Controlling_Formal (Formal)
+ then
+ -- This unchecked conversion is not necessary unless
+ -- inlining is enabled, because in that case the type
+ -- mismatch may become visible in the body about to be
+ -- inlined.
+
+ Rewrite (Actual,
+ Unchecked_Convert_To (Parent_Typ,
+ Relocate_Node (Actual)));
+
+ Analyze (Actual);
+ Resolve (Actual, Parent_Typ);
+ end if;
+
+ -- For array and record types, the parent formal type and
+ -- derived formal type have different sizes or pragma Pack
+ -- status.
+
+ elsif ((Is_Array_Type (Formal_Typ)
+ and then Is_Array_Type (Parent_Typ))
+ or else
+ (Is_Record_Type (Formal_Typ)
+ and then Is_Record_Type (Parent_Typ)))
+ and then
+ (Esize (Formal_Typ) /= Esize (Parent_Typ)
+ or else Has_Pragma_Pack (Formal_Typ) /=
+ Has_Pragma_Pack (Parent_Typ))
+ then
+ Convert (Actual, Parent_Typ);
end if;
- end if;
- Next_Formal (Formal);
- Next_Formal (Parent_Formal);
- Next_Actual (Actual);
- end loop;
+ Next_Actual (Actual);
+ Next_Formal (Formal);
+ Next_Formal (Parent_Formal);
+ end loop;
+ end;
end if;
Orig_Subp := Subp;
@@ -2744,7 +2777,7 @@ package body Exp_Ch6 is
-- Handle case of access to protected subprogram type
if Is_Access_Protected_Subprogram_Type
- (Base_Type (Etype (Prefix (Name (N)))))
+ (Base_Type (Etype (Prefix (Name (N)))))
then
-- If this is a call through an access to protected operation,
-- the prefix has the form (object'address, operation'access).
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2008-05-21 8:24 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2008-05-21 8:26 [Ada] Derived subprogram called handled incorrectly Arnaud Charlet
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).