Skip to content

R
riscv-gcc-1
Commit a1092b48 by Arnaud Charlet
Options

[multiple changes] 

2011-11-23  Pascal Obry  <obry@adacore.com>

	* sem_prag.adb (Process_Convention): Better error message for
	stdcall convention on dispatching calls.

2011-11-23  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch4.adb, sem_ch13.adb: Minor reformatting.

2011-11-23  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_Simple_Function_Return): Add missing
	implicit type conversion when the returned object is allocated
	in the secondary stack and the type of the returned object is
	an interface. Done to force generation of displacement of the
	"this" pointer.

From-SVN: r181657
parent 3d0c15cf
Showing with 74 additions and 43 deletions
gcc/ada/ChangeLog
2011-11-23 Pascal Obry <obry@adacore.com>
* sem_prag.adb (Process_Convention): Better error message for
stdcall convention on dispatching calls.
2011-11-23 Gary Dismukes <dismukes@adacore.com>
* sem_ch4.adb, sem_ch13.adb: Minor reformatting.
2011-11-23 Javier Miranda <miranda@adacore.com>
* exp_ch6.adb (Expand_Simple_Function_Return): Add missing
implicit type conversion when the returned object is allocated
in the secondary stack and the type of the returned object is
an interface. Done to force generation of displacement of the
"this" pointer.
2011-11-23 Pascal Obry <obry@adacore.com>
* impunit.adb: Add g-exptty and g-tty units.
2011-11-23 Robert Dewar <dewar@adacore.com>
......
gcc/ada/exp_ch6.adb
......@@ -6700,6 +6700,14 @@ package body Exp_Ch6 is
Make_Explicit_Dereference (Loc,
Prefix => New_Reference_To (Temp, Loc)));
-- Ada 2005 (AI-251): If the type of the returned object is
-- an interface then add an implicit type conversion to force
-- displacement of the "this" pointer.
if Is_Interface (R_Type) then
Rewrite (Exp, Convert_To (R_Type, Relocate_Node (Exp)));
end if;
Analyze_And_Resolve (Exp, R_Type);
end;
......
gcc/ada/sem_ch13.adb
......@@ -161,15 +161,15 @@ package body Sem_Ch13 is
----------------------------------------------
-- The following table collects unchecked conversions for validation.
-- Entries are made by Validate_Unchecked_Conversion and then the
-- call to Validate_Unchecked_Conversions does the actual error
-- checking and posting of warnings. The reason for this delayed
-- processing is to take advantage of back-annotations of size and
-- alignment values performed by the back end.
-- Entries are made by Validate_Unchecked_Conversion and then the call
-- to Validate_Unchecked_Conversions does the actual error checking and
-- posting of warnings. The reason for this delayed processing is to take
-- advantage of back-annotations of size and alignment values performed by
-- the back end.
-- Note: the reason we store a Source_Ptr value instead of a Node_Id
-- is that by the time Validate_Unchecked_Conversions is called, Sprint
-- will already have modified all Sloc values if the -gnatD option is set.
-- Note: the reason we store a Source_Ptr value instead of a Node_Id is
-- that by the time Validate_Unchecked_Conversions is called, Sprint will
-- already have modified all Sloc values if the -gnatD option is set.
type UC_Entry is record
Eloc : Source_Ptr; -- node used for posting warnings
......@@ -193,13 +193,13 @@ package body Sem_Ch13 is
-- for X'Address use Expr
-- where Expr is of the form Y'Address or recursively is a reference
-- to a constant of either of these forms, and X and Y are entities of
-- objects, then if Y has a smaller alignment than X, that merits a
-- warning about possible bad alignment. The following table collects
-- address clauses of this kind. We put these in a table so that they
-- can be checked after the back end has completed annotation of the
-- alignments of objects, since we can catch more cases that way.
-- where Expr is of the form Y'Address or recursively is a reference to a
-- constant of either of these forms, and X and Y are entities of objects,
-- then if Y has a smaller alignment than X, that merits a warning about
-- possible bad alignment. The following table collects address clauses of
-- this kind. We put these in a table so that they can be checked after the
-- back end has completed annotation of the alignments of objects, since we
-- can catch more cases that way.
type Address_Clause_Check_Record is record
N : Node_Id;
......@@ -8618,8 +8618,8 @@ package body Sem_Ch13 is
Target := Ancestor_Subtype (Etype (Act_Unit));
-- If either type is generic, the instantiation happens within a generic
-- unit, and there is nothing to check. The proper check
-- will happen when the enclosing generic is instantiated.
-- unit, and there is nothing to check. The proper check will happen
-- when the enclosing generic is instantiated.
if Is_Generic_Type (Source) or else Is_Generic_Type (Target) then
return;
......@@ -8717,9 +8717,8 @@ package body Sem_Ch13 is
end if;
-- If unchecked conversion to access type, and access type is declared
-- in the same unit as the unchecked conversion, then set the
-- No_Strict_Aliasing flag (no strict aliasing is implicit in this
-- situation).
-- in the same unit as the unchecked conversion, then set the flag
-- No_Strict_Aliasing (no strict aliasing is implicit here)
if Is_Access_Type (Target) and then
In_Same_Source_Unit (Target, N)
......@@ -8727,11 +8726,11 @@ package body Sem_Ch13 is
Set_No_Strict_Aliasing (Implementation_Base_Type (Target));
end if;
-- Generate N_Validate_Unchecked_Conversion node for back end in
-- case the back end needs to perform special validation checks.
-- Generate N_Validate_Unchecked_Conversion node for back end in case
-- the back end needs to perform special validation checks.
-- Shouldn't this be in Exp_Ch13, since the check only gets done
-- if we have full expansion and the back end is called ???
-- Shouldn't this be in Exp_Ch13, since the check only gets done if we
-- have full expansion and the back end is called ???
Vnode :=
Make_Validate_Unchecked_Conversion (Sloc (N));
......
gcc/ada/sem_ch4.adb
......@@ -3432,8 +3432,8 @@ package body Sem_Ch4 is
-- of the high bound.
procedure Check_Universal_Expression (N : Node_Id);
-- In Ada83, reject bounds of a universal range that are not literals or
-- entity names.
-- In Ada 83, reject bounds of a universal range that are not literals
-- or entity names.
-----------------------
-- Check_Common_Type --
......
gcc/ada/sem_prag.adb
......@@ -3526,30 +3526,37 @@ package body Sem_Prag is
-- Stdcall case
if C = Convention_Stdcall
if C = Convention_Stdcall then
-- A dispatching call is not allowed. A dispatching subprogram
-- cannot be used to interface to the Win32 API, so in fact this
-- check does not impose any effective restriction.
if Is_Dispatching_Operation (E) then
Error_Pragma
("dispatching subprograms cannot use Stdcall convention");
-- Subprogram is allowed, but not a generic subprogram, and not a
-- dispatching operation. A dispatching subprogram cannot be used
-- to interface to the Win32 API, so in fact this check does not
-- impose any effective restriction.
-- dispatching operation.
and then
((not Is_Subprogram (E) and then not Is_Generic_Subprogram (E))
or else Is_Dispatching_Operation (E))
elsif not Is_Subprogram (E)
and then not Is_Generic_Subprogram (E)
-- A variable is OK
-- A variable is OK
and then Ekind (E) /= E_Variable
and then Ekind (E) /= E_Variable
-- An access to subprogram is also allowed
-- An access to subprogram is also allowed
and then not
(Is_Access_Type (E)
and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
then
Error_Pragma_Arg
("second argument of pragma% must be subprogram (type)",
Arg2);
and then not
(Is_Access_Type (E)
and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
then
Error_Pragma_Arg
("second argument of pragma% must be subprogram (type)",
Arg2);
end if;
end if;
if not Is_Subprogram (E)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment