diff options
Diffstat (limited to 'gcc/ada/sem_disp.adb')
| -rw-r--r-- | gcc/ada/sem_disp.adb | 29 |
1 files changed, 23 insertions, 6 deletions
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 66fcb07e0ab..fb20b1a6554 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -850,9 +850,15 @@ package body Sem_Disp is Typ := Etype (Subp); end if; - if not Is_Class_Wide_Type (Typ) + -- The following should be better commented, especially since + -- we just added several new conditions here ??? + + if Comes_From_Source (Subp) and then Is_Interface (Typ) + and then not Is_Class_Wide_Type (Typ) and then not Is_Derived_Type (Typ) + and then not Is_Generic_Type (Typ) + and then not In_Instance then Error_Msg_N ("?declaration of& is too late!", Subp); Error_Msg_NE @@ -1150,11 +1156,14 @@ package body Sem_Disp is -- Ada 2005 (AI-251): In case of late overriding of a primitive -- that covers abstract interface subprograms we must register it -- in all the secondary dispatch tables associated with abstract - -- interfaces. We do this now only if not building static tables. - -- Otherwise the patch code is emitted after those tables are - -- built, to prevent access_before_elaboration in gigi. - - if Body_Is_Last_Primitive then + -- interfaces. We do this now only if not building static tables, + -- nor when the expander is inactive (we avoid trying to register + -- primitives in semantics-only mode, since the type may not have + -- an associated dispatch table). Otherwise the patch code is + -- emitted after those tables are built, to prevent access before + -- elaboration in gigi. + + if Body_Is_Last_Primitive and then Full_Expander_Active then declare Subp_Body : constant Node_Id := Unit_Declaration_Node (Subp); Elmt : Elmt_Id; @@ -2256,6 +2265,14 @@ package body Sem_Disp is then return; + -- When expansion is suppressed, an unexpanded call to 'Input can occur, + -- and in that case we can simply return. + + elsif Nkind (Actual) = N_Attribute_Reference then + pragma Assert (Attribute_Name (Actual) = Name_Input); + + return; + -- Only other possibilities are parenthesized or qualified expression, -- or an expander-generated unchecked conversion of a function call to -- a stream Input attribute. |