ada: Fix bogus Constraint_Error for 'Wide_Wide_Value on wide enumeration literal

The problem is that 'Wide_Wide_Value is piggybacked on 'Value and the latter
invokes System.Val_Util.Normalize_String, which incorrectly normalizes the
input string in the presence of enumeration literals with wide characters.

gcc/ada/ChangeLog:
	PR ada/115507
	* exp_imgv.adb (Expand_Valid_Value_Attribute): Add actual parameter
	for Is_Wide formal in the call to Valid_Value_Enumeration_NN.
	(Expand_Value_Attribute): Likewise.
	* libgnat/s-vaen16.ads (Value_Enumeration_16): Add Is_Wide formal.
	(Valid_Value_Enumeration_16): Likewise.
	* libgnat/s-vaen32.ads (Value_Enumeration_32): Likewise.
	(Valid_Value_Enumeration_32): Likewise.
	* libgnat/s-vaenu8.ads (Value_Enumeration_8): Likewise.
	(Valid_Value_Enumeration_8): Likewise.
	* libgnat/s-valboo.adb (Value_Boolean): Pass True for To_Upper_Case
	formal parameter in call to Normalize_String.
	* libgnat/s-valcha.adb (Value_Character): Likewise.
	* libgnat/s-valuen.ads (Value_Enumeration): Add Is_Wide formal.
	(Valid_Value_Enumeration): Likewise.
	* libgnat/s-valuen.adb (Value_Enumeration_Pos): Likewise and pass
	its negation for To_Upper_Case formal in call to Normalize_String.
	(Valid_Value_Enumeration): Add Is_Wide formal and forward it in
	call to Value_Enumeration_Pos.
	(Value_Enumeration): Likewise.
	* libgnat/s-valuti.ads (Normalize_String): Add To_Upper_Case formal
	parameter and adjust post-condition accordingly.
	* libgnat/s-valuti.adb (Normalize_String): Add To_Upper_Case formal
	parameter and adjust implementation accordingly.
	* libgnat/s-valwch.adb (Value_Wide_Wide_Character): Pass False for
	To_Upper_Case formal parameter in call to Normalize_String.

10 files changed, 36 insertions, 17 deletions

diff --git a/gcc/ada/libgnat/s-vaen16.ads b/gcc/ada/libgnat/s-vaen16.ads
index 5ac8beb..7cc98be 100644
--- a/gcc/ada/libgnat/s-vaen16.ads
+++ b/gcc/ada/libgnat/s-vaen16.ads
@@ -45,6 +45,7 @@ package System.Val_Enum_16 is
       Indexes : System.Address;
       Hash    : Impl.Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Natural
      renames Impl.Value_Enumeration;
@@ -54,6 +55,7 @@ package System.Val_Enum_16 is
       Indexes : System.Address;
       Hash    : Impl.Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Boolean
      renames Impl.Valid_Value_Enumeration;
diff --git a/gcc/ada/libgnat/s-vaen32.ads b/gcc/ada/libgnat/s-vaen32.ads
index ee540f1..0900d18 100644
--- a/gcc/ada/libgnat/s-vaen32.ads
+++ b/gcc/ada/libgnat/s-vaen32.ads
@@ -45,6 +45,7 @@ package System.Val_Enum_32 is
       Indexes : System.Address;
       Hash    : Impl.Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Natural
      renames Impl.Value_Enumeration;
@@ -54,6 +55,7 @@ package System.Val_Enum_32 is
       Indexes : System.Address;
       Hash    : Impl.Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Boolean
      renames Impl.Valid_Value_Enumeration;
diff --git a/gcc/ada/libgnat/s-vaenu8.ads b/gcc/ada/libgnat/s-vaenu8.ads
index 6d34533..62e9fa3 100644
--- a/gcc/ada/libgnat/s-vaenu8.ads
+++ b/gcc/ada/libgnat/s-vaenu8.ads
@@ -45,6 +45,7 @@ package System.Val_Enum_8 is
       Indexes : System.Address;
       Hash    : Impl.Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Natural
      renames Impl.Value_Enumeration;
@@ -54,6 +55,7 @@ package System.Val_Enum_8 is
       Indexes : System.Address;
       Hash    : Impl.Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Boolean
      renames Impl.Valid_Value_Enumeration;
diff --git a/gcc/ada/libgnat/s-valboo.adb b/gcc/ada/libgnat/s-valboo.adb
index 5cb3b98..f7a13ba 100644
--- a/gcc/ada/libgnat/s-valboo.adb
+++ b/gcc/ada/libgnat/s-valboo.adb
@@ -53,7 +53,7 @@ is
       S : String (Str'Range) := Str;
 
    begin
-      Normalize_String (S, F, L);
+      Normalize_String (S, F, L, To_Upper_Case => True);
 
       pragma Assert (F = System.Val_Spec.First_Non_Space_Ghost
                      (S, Str'First, Str'Last));
diff --git a/gcc/ada/libgnat/s-valcha.adb b/gcc/ada/libgnat/s-valcha.adb
index 46f3eb4..13cbcb5 100644
--- a/gcc/ada/libgnat/s-valcha.adb
+++ b/gcc/ada/libgnat/s-valcha.adb
@@ -43,7 +43,9 @@ package body System.Val_Char is
       S : String (Str'Range) := Str;
 
    begin
-      Normalize_String (S, F, L);
+      --  The names of control characters use upper case letters
+
+      Normalize_String (S, F, L, To_Upper_Case => True);
 
       --  Accept any single character enclosed in quotes
 
diff --git a/gcc/ada/libgnat/s-valuen.adb b/gcc/ada/libgnat/s-valuen.adb
index caf4fc6..8fa4c26 100644
--- a/gcc/ada/libgnat/s-valuen.adb
+++ b/gcc/ada/libgnat/s-valuen.adb
@@ -40,6 +40,7 @@ package body System.Value_N is
       Indexes : System.Address;
       Hash    : Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Integer with Pure_Function;
    --  Same as Value_Enumeration, except returns negative if Value_Enumeration
@@ -54,6 +55,7 @@ package body System.Value_N is
       Indexes : System.Address;
       Hash    : Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Integer
    is
@@ -76,7 +78,7 @@ package body System.Value_N is
       pragma Assert (Num + 1 in IndexesT'Range);
 
    begin
-      Normalize_String (S, F, L);
+      Normalize_String (S, F, L, To_Upper_Case => not Is_Wide);
 
       declare
          Normal : String renames S (F .. L);
@@ -120,11 +122,13 @@ package body System.Value_N is
       Indexes : System.Address;
       Hash    : Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Boolean
    is
    begin
-      return Value_Enumeration_Pos (Names, Indexes, Hash, Num, Str) >= 0;
+      return
+        Value_Enumeration_Pos (Names, Indexes, Hash, Num, Is_Wide, Str) >= 0;
    end Valid_Value_Enumeration;
 
    -----------------------
@@ -136,11 +140,12 @@ package body System.Value_N is
       Indexes : System.Address;
       Hash    : Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Natural
    is
       Result : constant Integer :=
-        Value_Enumeration_Pos (Names, Indexes, Hash, Num, Str);
+        Value_Enumeration_Pos (Names, Indexes, Hash, Num, Is_Wide, Str);
 
    begin
       --  The comparison eliminates the need for a range check on return
diff --git a/gcc/ada/libgnat/s-valuen.ads b/gcc/ada/libgnat/s-valuen.ads
index 83ffd71..fe2babf 100644
--- a/gcc/ada/libgnat/s-valuen.ads
+++ b/gcc/ada/libgnat/s-valuen.ads
@@ -47,6 +47,7 @@ package System.Value_N is
       Indexes : System.Address;
       Hash    : Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Natural with Inline;
    --  Used to compute Enum'Value (Str) where Enum is some enumeration type
@@ -60,7 +61,8 @@ package System.Value_N is
    --  The parameter Hash is a (perfect) hash function for Names and Indexes.
    --  The parameter Num is the value N - 1 (i.e. Enum'Pos (Enum'Last)).
    --  The reason that Indexes is passed by address is that the actual type
-   --  is created on the fly by the expander.
+   --  is created on the fly by the expander. The parameter Is_Wide is True
+   --  if the original attribute was [Wide_]Wide_Value.
    --
    --  Str is the argument of the attribute function, and may have leading
    --  and trailing spaces, and letters can be upper or lower case or mixed.
@@ -72,6 +74,7 @@ package System.Value_N is
       Indexes : System.Address;
       Hash    : Hash_Function_Ptr;
       Num     : Natural;
+      Is_Wide : Boolean;
       Str     : String)
       return    Boolean with Inline;
    --  Returns True if Str is a valid Image of some enumeration literal, False
diff --git a/gcc/ada/libgnat/s-valuti.adb b/gcc/ada/libgnat/s-valuti.adb
index 147a10a..50e7f6a 100644
--- a/gcc/ada/libgnat/s-valuti.adb
+++ b/gcc/ada/libgnat/s-valuti.adb
@@ -67,8 +67,9 @@ is
    ----------------------
 
    procedure Normalize_String
-     (S    : in out String;
-      F, L : out Integer)
+     (S             : in out String;
+      F, L          : out Integer;
+      To_Upper_Case : Boolean)
    is
    begin
       F := S'First;
@@ -106,9 +107,9 @@ is
          L := L - 1;
       end loop;
 
-      --  Except in the case of a character literal, convert to upper case
+      --  Convert to upper case if requested and not a character literal
 
-      if S (F) /= ''' then
+      if To_Upper_Case and then S (F) /= ''' then
          for J in F .. L loop
             S (J) := To_Upper (S (J));
             pragma Loop_Invariant
diff --git a/gcc/ada/libgnat/s-valuti.ads b/gcc/ada/libgnat/s-valuti.ads
index 70585477..cc804f4 100644
--- a/gcc/ada/libgnat/s-valuti.ads
+++ b/gcc/ada/libgnat/s-valuti.ads
@@ -60,8 +60,9 @@ is
    --  Raises constraint error with message: bad input for 'Value: "xxx"
 
    procedure Normalize_String
-     (S    : in out String;
-      F, L : out Integer)
+     (S             : in out String;
+      F, L          : out Integer;
+      To_Upper_Case : Boolean)
    with
      Post => (if Sp.Only_Space_Ghost (S'Old, S'First, S'Last) then
                 F > L
@@ -76,7 +77,7 @@ is
                     (if L < S'Last then
                       Sp.Only_Space_Ghost (S'Old, L + 1, S'Last))
                   and then
-                    (if S'Old (F) /= ''' then
+                    (if To_Upper_Case and then S'Old (F) /= ''' then
                       (for all J in S'Range =>
                         (if J in F .. L then
                            S (J) = System.Case_Util.To_Upper (S'Old (J))
@@ -84,9 +85,10 @@ is
                            S (J) = S'Old (J)))));
    --  This procedure scans the string S setting F to be the index of the first
    --  non-blank character of S and L to be the index of the last non-blank
-   --  character of S. Any lower case characters present in S will be folded to
-   --  their upper case equivalent except for character literals. If S consists
-   --  of entirely blanks (including when S = "") then we return with F > L.
+   --  character of S. If To_Upper_Case is True and S does not represent a
+   --  character literal, then any lower case characters in S are changed to
+   --  their upper case counterparts. If S consists of only blank characters
+   --  (including when S = "") then we return with F > L.
 
    procedure Scan_Sign
      (Str   : String;
diff --git a/gcc/ada/libgnat/s-valwch.adb b/gcc/ada/libgnat/s-valwch.adb
index e452e31..4162bc1 100644
--- a/gcc/ada/libgnat/s-valwch.adb
+++ b/gcc/ada/libgnat/s-valwch.adb
@@ -67,7 +67,7 @@ package body System.Val_WChar is
       S : String (Str'Range) := Str;
 
    begin
-      Normalize_String (S, F, L);
+      Normalize_String (S, F, L, To_Upper_Case => False);
 
       --  Character literal case