diff options
-rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/ada/sem_type.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 14 |
3 files changed, 21 insertions, 3 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index baf17ca..32d35b9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-09-17 Steve Baird <baird@adacore.com> + + * sem_util.adb (Wrong_Type): In deciding to suppress a message, + it is not enough for In_Instance to be True; in addition, + In_Generic_Actual (Expr) must be False. + * sem_type.adb (In_Generic_Actual): Fix bug where traversal of + parents skips every other node. + 2019-09-17 Claire Dross <dross@adacore.com> * sem_spark.adb (Get_Observed_Or_Borrowed_Expr): If the diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index fee9c5e..fc50524 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2849,7 +2849,7 @@ package body Sem_Type is return False; else - return In_Generic_Actual (Parent (Par)); + return In_Generic_Actual (Par); end if; end In_Generic_Actual; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b7d2895..99cdb8d 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -26689,7 +26689,7 @@ package body Sem_Util is return; -- In an instance, there is an ongoing problem with completion of - -- type derived from private types. Their structure is what Gigi + -- types derived from private types. Their structure is what Gigi -- expects, but the Etype is the parent type rather than the -- derived private type itself. Do not flag error in this case. The -- private completion is an entity without a parent, like an Itype. @@ -26700,7 +26700,17 @@ package body Sem_Util is -- same reason: inserted body may be outside of the original package -- and only partial views are visible at the point of insertion. - elsif In_Instance or else In_Inlined_Body then + -- If In_Generic_Actual (Expr) is True then we cannot assume that + -- the successful semantic analysis of the generic guarantees anything + -- useful about type checking of this instance, so we ignore + -- In_Instance in that case. There may be cases where this is not + -- right (the symptom would probably be rejecting something + -- that ought to be accepted) but we don't currently have any + -- concrete examples of this. + + elsif (In_Instance and then not In_Generic_Actual (Expr)) + or else In_Inlined_Body + then if Etype (Etype (Expr)) = Etype (Expected_Type) and then (Has_Private_Declaration (Expected_Type) |