[Ada] Implement 'Valid_Value attribute

gcc/ada/

	* libgnat/s-valuen.ads, libgnat/s-valuen.adb
	(Value_Enumeration_Pos): New function to compute the 'Pos of the
	enumeration literal for a given String.  Return a special value
	instead of raising an exception on invalid input. Called by both
	Valid_Enumeration_Image and Value_Enumeration.
	(Valid_Enumeration_Image): Return a Boolean indicating whether
	the String is a valid Image for the given enumeration type.
	(Value_Enumeration): Implement in terms of
	Value_Enumeration_Pos.
	* libgnat/s-vaenu8.ads, libgnat/s-vaen16.ads,
	libgnat/s-vaen32.ads: Rename Valid_Enumeration_Image from the
	instances.
	* libgnat/s-valuti.ads: Correct documentation (it was not true
	for the null string).
	* libgnat/s-valuti.adb (Normalize_String): Do not raise
	Constraint_Error for the null string, nor strings containing
	nothing but blanks, so that Valid_Enumeration_Image can return
	False in these cases, rather than raising an exception.
	* rtsfind.ads (RE_Value_Enumeration_8, RE_Value_Enumeration_16,
	RE_Value_Enumeration_32): New functions.
	(RTE_Available): Improve comment (E doesn't have to be a
	subprogram, although that's the usual case).
	* sem_attr.adb (nalid_Value): Semantic analysis for new
	attribute.
	* exp_attr.adb: Call Expand_Valid_Value_Attribute for new
	attribute.
	* exp_imgv.ads, exp_imgv.adb (Expand_Valid_Value_Attribute): New
	procedure to expand Valid_Value into a call to
	Valid_Enumeration_Image_NN.
	(Expand_Value_Attribute): Misc code cleanups.  Remove two ???
	mark comments. RTE_Available won't work here.  For one thing,
	RTE_Available (X) shouldn't be called until the compiler has
	decided to make use of X (see comments on RTE_Available), and in
	this case we're trying to AVOID calling something.
	* snames.ads-tmpl: New attribute name.
	* doc/gnat_rm/implementation_defined_attributes.rst: Document
	new attribute.
	* gnat_rm.texi: Regenerate.

7 files changed, 126 insertions, 35 deletions

diff --git a/gcc/ada/libgnat/s-vaen16.ads b/gcc/ada/libgnat/s-vaen16.ads
index f119778..86cdaa1 100644
--- a/gcc/ada/libgnat/s-vaen16.ads
+++ b/gcc/ada/libgnat/s-vaen16.ads
@@ -30,7 +30,7 @@
 ------------------------------------------------------------------------------
 
 --  Instantiation of System.Value_N for enumeration types whose names table
---  has a length that fits in a 16-bit but not a 8-bit integer.
+--  has a length that fits in a 16-bit but not an 8-bit integer.
 
 with Interfaces;
 with System.Value_N;
@@ -49,4 +49,13 @@ package System.Val_Enum_16 is
       return    Natural
      renames Impl.Value_Enumeration;
 
+   function Valid_Enumeration_Value_16
+     (Names   : String;
+      Indexes : System.Address;
+      Hash    : Impl.Hash_Function_Ptr;
+      Num     : Natural;
+      Str     : String)
+      return    Boolean
+     renames Impl.Valid_Enumeration_Value;
+
 end System.Val_Enum_16;
diff --git a/gcc/ada/libgnat/s-vaen32.ads b/gcc/ada/libgnat/s-vaen32.ads
index ba24af3..0dead07 100644
--- a/gcc/ada/libgnat/s-vaen32.ads
+++ b/gcc/ada/libgnat/s-vaen32.ads
@@ -49,4 +49,13 @@ package System.Val_Enum_32 is
       return    Natural
      renames Impl.Value_Enumeration;
 
+   function Valid_Enumeration_Value_32
+     (Names   : String;
+      Indexes : System.Address;
+      Hash    : Impl.Hash_Function_Ptr;
+      Num     : Natural;
+      Str     : String)
+      return    Boolean
+     renames Impl.Valid_Enumeration_Value;
+
 end System.Val_Enum_32;
diff --git a/gcc/ada/libgnat/s-vaenu8.ads b/gcc/ada/libgnat/s-vaenu8.ads
index 4de9b0e..db0b360 100644
--- a/gcc/ada/libgnat/s-vaenu8.ads
+++ b/gcc/ada/libgnat/s-vaenu8.ads
@@ -30,7 +30,7 @@
 ------------------------------------------------------------------------------
 
 --  Instantiation of System.Value_N for enumeration types whose names table
---  has a length that fits in a 8-bit integer.
+--  has a length that fits in an 8-bit integer.
 
 with Interfaces;
 with System.Value_N;
@@ -49,4 +49,13 @@ package System.Val_Enum_8 is
       return    Natural
      renames Impl.Value_Enumeration;
 
+   function Valid_Enumeration_Value_8
+     (Names   : String;
+      Indexes : System.Address;
+      Hash    : Impl.Hash_Function_Ptr;
+      Num     : Natural;
+      Str     : String)
+      return    Boolean
+     renames Impl.Valid_Enumeration_Value;
+
 end System.Val_Enum_8;
diff --git a/gcc/ada/libgnat/s-valuen.adb b/gcc/ada/libgnat/s-valuen.adb
index 08d1a738..7b72bc6 100644
--- a/gcc/ada/libgnat/s-valuen.adb
+++ b/gcc/ada/libgnat/s-valuen.adb
@@ -35,22 +35,21 @@ with System.Val_Util; use System.Val_Util;
 
 package body System.Value_N is
 
-   -----------------------
-   -- Value_Enumeration --
-   -----------------------
+   ---------------------------
+   -- Value_Enumeration_Pos --
+   ---------------------------
 
-   function Value_Enumeration
+   function Value_Enumeration_Pos
      (Names   : String;
       Indexes : System.Address;
       Hash    : Hash_Function_Ptr;
       Num     : Natural;
       Str     : String)
-      return    Natural
+      return    Integer
    is
-      F : Natural;
-      L : Natural;
-      H : Natural;
-      S : String (Str'Range) := Str;
+      F, L : Integer;
+      H  : Natural;
+      S  : String (Str'Range) := Str;
 
       subtype Names_Index is
         Index_Type range Index_Type (Names'First)
@@ -69,32 +68,75 @@ package body System.Value_N is
    begin
       Normalize_String (S, F, L);
 
-      --  If we have a valid hash value, do a single lookup
+      declare
+         Normal : String renames S (F .. L);
 
-      H := (if Hash /= null then Hash.all (S (F .. L)) else Natural'Last);
+      begin
+         --  If we have a valid hash value, do a single lookup
 
-      if H /= Natural'Last then
-         if Names
-           (Natural (IndexesT (H)) ..
-            Natural (IndexesT (H + 1)) - 1) = S (F .. L)
-         then
-            return H;
-         end if;
-
-      --  Otherwise do a linear search
+         H := (if Hash /= null then Hash.all (Normal) else Natural'Last);
 
-      else
-         for J in 0 .. Num loop
+         if H /= Natural'Last then
             if Names
-              (Natural (IndexesT (J)) ..
-               Natural (IndexesT (J + 1)) - 1) = S (F .. L)
+              (Natural (IndexesT (H)) ..
+               Natural (IndexesT (H + 1)) - 1) = Normal
             then
-               return J;
+               return H;
             end if;
-         end loop;
-      end if;
 
-      Bad_Value (Str);
+         --  Otherwise do a linear search
+
+         else
+            for J in 0 .. Num loop
+               if Names
+                 (Natural (IndexesT (J)) ..
+                  Natural (IndexesT (J + 1)) - 1) = Normal
+               then
+                  return J;
+               end if;
+            end loop;
+         end if;
+      end;
+
+      return Invalid;
+   end Value_Enumeration_Pos;
+
+   -----------------------
+   -- Value_Enumeration --
+   -----------------------
+
+   function Value_Enumeration
+     (Names   : String;
+      Indexes : System.Address;
+      Hash    : Hash_Function_Ptr;
+      Num     : Natural;
+      Str     : String)
+      return    Natural
+   is
+      Result : constant Integer :=
+        Value_Enumeration_Pos (Names, Indexes, Hash, Num, Str);
+   begin
+      if Result = Invalid then
+         Bad_Value (Str);
+      else
+         return Result;
+      end if;
    end Value_Enumeration;
 
+   -----------------------------
+   -- Valid_Enumeration_Value --
+   -----------------------------
+
+   function Valid_Enumeration_Value
+     (Names   : String;
+      Indexes : System.Address;
+      Hash    : Hash_Function_Ptr;
+      Num     : Natural;
+      Str     : String)
+      return    Boolean
+   is
+   begin
+      return Value_Enumeration_Pos (Names, Indexes, Hash, Num, Str) /= Invalid;
+   end Valid_Enumeration_Value;
+
 end System.Value_N;
diff --git a/gcc/ada/libgnat/s-valuen.ads b/gcc/ada/libgnat/s-valuen.ads
index dafa451..258d279 100644
--- a/gcc/ada/libgnat/s-valuen.ads
+++ b/gcc/ada/libgnat/s-valuen.ads
@@ -67,4 +67,28 @@ package System.Value_N is
    --  If the image is found in Names, then the corresponding Pos value is
    --  returned. If not, Constraint_Error is raised.
 
+   function Valid_Enumeration_Value
+     (Names   : String;
+      Indexes : System.Address;
+      Hash    : Hash_Function_Ptr;
+      Num     : Natural;
+      Str     : String)
+      return    Boolean;
+   --  Returns True if Str is a valid Image of some enumeration literal, False
+   --  otherwise. That is, returns False if and only if Value_Enumeration would
+   --  raise Constraint_Error. The parameters have the same meaning as for
+   --  Value_Enumeration.
+
+   Invalid : constant Integer := -1;
+
+   function Value_Enumeration_Pos
+     (Names   : String;
+      Indexes : System.Address;
+      Hash    : Hash_Function_Ptr;
+      Num     : Natural;
+      Str     : String)
+      return    Integer;
+   --  Same as Value_Enumeration, except returns Invalid if Value_Enumeration
+   --  would raise Constraint_Error.
+
 end System.Value_N;
diff --git a/gcc/ada/libgnat/s-valuti.adb b/gcc/ada/libgnat/s-valuti.adb
index 1ad758b..31edc40 100644
--- a/gcc/ada/libgnat/s-valuti.adb
+++ b/gcc/ada/libgnat/s-valuti.adb
@@ -68,10 +68,10 @@ package body System.Val_Util is
          F := F + 1;
       end loop;
 
-      --  Check for case when the string contained no characters
+      --  Case of no nonspace characters found
 
       if F > L then
-         Bad_Value (S);
+         return;
       end if;
 
       --  Scan for trailing spaces
diff --git a/gcc/ada/libgnat/s-valuti.ads b/gcc/ada/libgnat/s-valuti.ads
index 07b2c77..3d426d9 100644
--- a/gcc/ada/libgnat/s-valuti.ads
+++ b/gcc/ada/libgnat/s-valuti.ads
@@ -45,9 +45,7 @@ package System.Val_Util is
    --  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 then Constraint_Error is raised.
-   --
-   --  Note: if S is the null string, F is set to S'First, L to S'Last
+   --  of entirely blanks (including when S = "") then we return with F > L.
 
    procedure Scan_Sign
      (Str   : String;