diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 47 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 41 |
5 files changed, 74 insertions, 43 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 673d266..c9169fa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,22 @@ 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> diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 9339652..4c94604 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a38cd59..7de3c16 100644 --- a/gcc/ada/sem_ch13.adb +++ b/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)); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4b438e1..0f918c0 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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 -- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 14961cb..c63e9da 100644 --- a/gcc/ada/sem_prag.adb +++ b/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) |