From 2d4fe2035920a2440ca2d787cefc6eca03a4af40 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Sat, 13 Jun 2020 12:38:00 -0400 Subject: [PATCH] [Ada] Ada2020: wording of 'Image messages gcc/ada/ * errout.ads, errout.adb (Error_Msg_Ada_2020_Feature): New procedure analogous to Error_Msg_Ada_2012_Feature. * sem_attr.adb (Analyze_Image_Attribute): Use Error_Msg_Ada_2012_Feature and Error_Msg_Ada_2020_Feature to indicate that Object'Image is allowed in Ada 2012, and that 'Image is allowed for any type in Ada 2020. --- gcc/ada/errout.adb | 18 ++++++++++++++++++ gcc/ada/errout.ads | 15 +++++++++------ gcc/ada/sem_attr.adb | 17 ++++++----------- 3 files changed, 33 insertions(+), 17 deletions(-) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 0f46ab614f7..1063d7d0548 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -630,6 +630,24 @@ package body Errout is end if; end Error_Msg_Ada_2012_Feature; + -------------------------------- + -- Error_Msg_Ada_2020_Feature -- + -------------------------------- + + procedure Error_Msg_Ada_2020_Feature (Feature : String; Loc : Source_Ptr) is + begin + if Ada_Version < Ada_2020 then + Error_Msg (Feature & " is an Ada 2020 feature", Loc); + + if No (Ada_Version_Pragma) then + Error_Msg ("\unit must be compiled with -gnat2020 switch", Loc); + else + Error_Msg_Sloc := Sloc (Ada_Version_Pragma); + Error_Msg ("\incompatible with Ada version set#", Loc); + end if; + end if; + end Error_Msg_Ada_2020_Feature; + ------------------ -- Error_Msg_AP -- ------------------ diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 1591a3712f5..83a23cc63f0 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -895,12 +895,15 @@ package Errout is -- first formal (RM 9.4(11.9/3)). procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr); - -- If not operating in Ada 2012 mode, posts errors complaining that Feature - -- is only supported in Ada 2012, with appropriate suggestions to fix this. - -- Loc is the location at which the flag is to be posted. Feature, which - -- appears at the start of the first generated message, may contain error - -- message insertion characters in the normal manner, and in particular - -- may start with | to flag a non-serious error. + -- If not operating in Ada 2012 mode or higher, posts errors complaining + -- that Feature is only supported in Ada 2012, with appropriate suggestions + -- to fix this. Loc is the location at which the flag is to be posted. + -- Feature, which appears at the start of the first generated message, may + -- contain error message insertion characters in the normal manner, and in + -- particular may start with | to flag a non-serious error. + + procedure Error_Msg_Ada_2020_Feature (Feature : String; Loc : Source_Ptr); + -- Analogous to Error_Msg_Ada_2012_Feature procedure dmsg (Id : Error_Msg_Id) renames Erroutc.dmsg; -- Debugging routine to dump an error message diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index b35f2b673df..e3c027df1e0 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1457,16 +1457,11 @@ package body Sem_Attr is procedure Check_Image_Type (Image_Type : Entity_Id) is begin - if Ada_Version >= Ada_2020 then - null; -- all types are OK - elsif not Is_Scalar_Type (Image_Type) then - if Ada_Version >= Ada_2012 then - Error_Attr_P - ("prefix of % attribute must be a scalar type or a scalar " - & "object name"); - else - Error_Attr_P ("prefix of % attribute must be a scalar type"); - end if; + if Ada_Version < Ada_2020 + and then not Is_Scalar_Type (Image_Type) + then + Error_Msg_Ada_2020_Feature ("|nonscalar ''Image", Sloc (P)); + Error_Attr; end if; end Check_Image_Type; @@ -1483,7 +1478,7 @@ package body Sem_Attr is Check_Image_Type (Etype (P)); if Attr_Id /= Attribute_Img and then Ada_Version < Ada_2012 then - Error_Attr_P ("prefix of % attribute must be a scalar type"); + Error_Msg_Ada_2012_Feature ("|Object''Image", Sloc (P)); end if; else Check_E1; -- 2.30.2