aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_case.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-08-01 10:08:59 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2014-08-01 10:08:59 +0200
commit2b9fbec94e888c688fa4d7e1d23658f54cab2b41 (patch)
tree80c8a3e299e4948e227885f4ac63a5389fea90c7 /gcc/ada/sem_case.adb
parent0494285ab09288a7f21e12ad0a9908c6a61626f5 (diff)
downloadgcc-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.adb61
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);