From 02bf80a34e49498cfa886cfb4c906761b6218e27 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Tue, 21 Apr 2020 09:22:28 -0400 Subject: [PATCH] [Ada] Missing error on aspects Input and Output 2020-06-18 Javier Miranda gcc/ada/ * sem_ch13.adb (Has_Good_Profile): Enforce strictness in the check. Required to detect wrong profiles for Input and Output. (Analyze_Stream_TSS_Definition): Minor enhancement in the text of the error for class-wide attributes. --- gcc/ada/sem_ch13.adb | 33 ++++++++++----------------------- 1 file changed, 10 insertions(+), 23 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 3a0a4b2331d..5318fc61603 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5019,33 +5019,14 @@ package body Sem_Ch13 is Typ := Etype (F); - -- If the attribute specification comes from an aspect - -- specification for a class-wide stream, the parameter must be - -- a class-wide type of the entity to which the aspect applies. - - if From_Aspect_Specification (N) - and then Class_Present (Parent (N)) - and then Is_Class_Wide_Type (Typ) - then - Typ := Etype (Typ); - end if; - else Typ := Etype (Subp); end if; -- Verify that the prefix of the attribute and the local name for - -- the type of the formal match, or one is the class-wide of the - -- other, in the case of a class-wide stream operation. - - if Base_Type (Typ) = Base_Type (Ent) - or else (Is_Class_Wide_Type (Typ) - and then Typ = Class_Wide_Type (Base_Type (Ent))) - or else (Is_Class_Wide_Type (Ent) - and then Ent = Class_Wide_Type (Base_Type (Typ))) - then - null; - else + -- the type of the formal match. + + if Base_Type (Typ) /= Base_Type (Ent) then return False; end if; @@ -5158,7 +5139,13 @@ package body Sem_Ch13 is else Error_Msg_Name_1 := Attr; - Error_Msg_N ("incorrect expression for% attribute", Expr); + + if Is_Class_Wide_Type (Base_Type (Ent)) then + Error_Msg_N + ("incorrect expression for class-wide% attribute", Expr); + else + Error_Msg_N ("incorrect expression for% attribute", Expr); + end if; end if; end Analyze_Stream_TSS_Definition; -- 2.30.2