diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-01 10:08:59 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-01 10:08:59 +0200 |
commit | 2b9fbec94e888c688fa4d7e1d23658f54cab2b41 (patch) | |
tree | 80c8a3e299e4948e227885f4ac63a5389fea90c7 /gcc/ada/sem_case.adb | |
parent | 0494285ab09288a7f21e12ad0a9908c6a61626f5 (diff) | |
download | gcc-2b9fbec94e888c688fa4d7e1d23658f54cab2b41.zip gcc-2b9fbec94e888c688fa4d7e1d23658f54cab2b41.tar.gz gcc-2b9fbec94e888c688fa4d7e1d23658f54cab2b41.tar.bz2 |
[multiple changes]
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_case.adb (Dup_Choice): Improve message for integer constants.
2014-08-01 Arnaud Charlet <charlet@adacore.com>
* gnatlink.adb: Remove special handling of VMS, RTX and JVM.
2014-08-01 Pascal Obry <obry@adacore.com>
* adaint.h (GNAT_OPEN): Defines as open64 where supported.
* adaint.c (GNAT_OPEN): Uses new macro where needed.
From-SVN: r213410
Diffstat (limited to 'gcc/ada/sem_case.adb')
-rw-r--r-- | gcc/ada/sem_case.adb | 61 |
1 files changed, 55 insertions, 6 deletions
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index e00b567..1009bb0 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -456,12 +456,33 @@ package body Sem_Case is return; end if; - -- Case of only one value that is missing + -- Case of only one value that is duplicated if Lo = Hi then + + -- Integer type + if Is_Integer_Type (Bounds_Type) then - Error_Msg_Uint_1 := Lo; - Error_Msg_N ("duplication of choice value: ^#!", C); + + -- We have an integer value, Lo, but if the given choice + -- placement is a constant with that value, then use the + -- name of that constant instead in the message: + + if Nkind (C) = N_Identifier + and then Compile_Time_Known_Value (C) + and then Expr_Value (C) = Lo + then + Error_Msg_N ("duplication of choice value: &#!", C); + + -- Not that special case, so just output the integer value + + else + Error_Msg_Uint_1 := Lo; + Error_Msg_N ("duplication of choice value: ^#!", C); + end if; + + -- Enumeration type + else Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type); Error_Msg_N ("duplication of choice value: %#!", C); @@ -470,10 +491,38 @@ package body Sem_Case is -- More than one choice value, so print range of values else + -- Integer type + if Is_Integer_Type (Bounds_Type) then - Error_Msg_Uint_1 := Lo; - Error_Msg_Uint_2 := Hi; - Error_Msg_N ("duplication of choice values: ^ .. ^#!", C); + + -- Similar to the above, if C is a range of known values which + -- match Lo and Hi, then use the names. We have to go to the + -- original nodes, since the values will have been rewritten + -- to their integer values. + + if Nkind (C) = N_Range + and then Nkind (Original_Node (Low_Bound (C))) = N_Identifier + and then Nkind (Original_Node (High_Bound (C))) = N_Identifier + and then Compile_Time_Known_Value (Low_Bound (C)) + and then Compile_Time_Known_Value (High_Bound (C)) + and then Expr_Value (Low_Bound (C)) = Lo + and then Expr_Value (High_Bound (C)) = Hi + then + Error_Msg_Node_2 := Original_Node (High_Bound (C)); + Error_Msg_N + ("duplication of choice values: & .. &#!", + Original_Node (Low_Bound (C))); + + -- Not that special case, output integer values + + else + Error_Msg_Uint_1 := Lo; + Error_Msg_Uint_2 := Hi; + Error_Msg_N ("duplication of choice values: ^ .. ^#!", C); + end if; + + -- Enumeration type + else Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type); Error_Msg_Name_2 := Choice_Image (Hi, Bounds_Type); |