From 7f9fcce8343219550bb754890c178f34ccdddce7 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Tue, 12 Sep 2017 09:09:30 +0000 Subject: [PATCH] sem_ch6.adb (Analyze_Expression_Function): Call Check_Dynamically_Tagged_Expression. 2017-09-12 Bob Duff * sem_ch6.adb (Analyze_Expression_Function): Call Check_Dynamically_Tagged_Expression. * sem_util.adb (Check_Dynamically_Tagged_Expression): Remove "and then Is_Tagged_Type (Typ)" because there is an earlier "Assert (Is_Tagged_Type (Typ))". From-SVN: r251999 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch6.adb | 15 +++++++++++++++ gcc/ada/sem_util.adb | 1 - 3 files changed, 23 insertions(+), 1 deletion(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dbf52109e23..4882093bf32 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2017-09-12 Bob Duff + + * sem_ch6.adb (Analyze_Expression_Function): Call + Check_Dynamically_Tagged_Expression. + * sem_util.adb (Check_Dynamically_Tagged_Expression): Remove + "and then Is_Tagged_Type (Typ)" because there is an earlier + "Assert (Is_Tagged_Type (Typ))". + 2017-09-12 Eric Botcazou * gcc-interface/Makefile.in (SPARC/Solaris): Remove obsolete stuff. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b016193c099..b4232a5cfcd 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -741,6 +741,21 @@ package body Sem_Ch6 is end; end if; + -- Check incorrect use of dynamically tagged expression. This doesn't + -- fall out automatically when analyzing the generated function body, + -- because Check_Dynamically_Tagged_Expression deliberately ignores + -- nodes that don't come from source. + + if Present (Def_Id) + and then Nkind (Def_Id) in N_Has_Etype + and then Is_Tagged_Type (Etype (Def_Id)) + then + Check_Dynamically_Tagged_Expression + (Expr => Expr, + Typ => Etype (Def_Id), + Related_Nod => Original_Node (N)); + end if; + -- If the return expression is a static constant, we suppress warning -- messages on unused formals, which in most cases will be noise. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 97c83a26bfc..bbf60a65bb0 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2022,7 +2022,6 @@ package body Sem_Util is or else In_Generic_Actual (Expr)) and then (Is_Class_Wide_Type (Etype (Expr)) or else Is_Dynamically_Tagged (Expr)) - and then Is_Tagged_Type (Typ) and then not Is_Class_Wide_Type (Typ) then Error_Msg_N ("dynamically tagged expression not allowed!", Expr); -- 2.30.2