[Ada] Implement AI12-0249, AI12-0295 (user-defined numeric & string literals)

2020-06-16  Steve Baird  <baird@adacore.com>

gcc/ada/

	* snames.ads-tmpl: Define names of the three new aspects.
	* aspects.ads: Define the three new aspects.
	* sem_util.ads, sem_util.adb, sem_dim.adb: Move the function
	String_From_Numeric_Literal from being declared in the body of
	package Sem_Dim to being declared in the visible part of package
	Sem_Util.
	* sem_ch13.ads, sem_ch13.adb: Declare new visible procedure
	Validate_Literal_Aspect. This is where most of the legality
	checking occurs for an aspect specification for one of the three
	new aspects, as well as resolution of the subprogram named in
	the aspect specification. Follow example of other aspects (e.g.,
	Validate_Literal_Aspect is called in much the same way as
	Validate_Iterable_Aspect in Analyze_Aspects_At_Freeze_Point; a
	small amount of legality checking is performed in
	Analyze_One_Aspect in much the same way as for Default_Value or
	Default_Component_Value aspects). Most of the work is done in
	Validate_Literal_Aspect.
	* contracts.adb (Add_Contract_Item): Call
	Validate_Literal_Aspect in much the same way that
	Validate_Iterable_Aspect was already being called.
	* sem_res.adb (Resolve): Rewrite a literal as a call if it is a
	user-defined literal.  This is where the dynamic semantics of
	the 3 new aspects are implemented.
	* sem_ch6.adb (Fully_Conformant_Expressions): Two numeric
	literals that have different text but the same value (e.g.,
	12345 and 12_345) do not conform if they are user-defined
	literals. Introduce a new function
	User_Defined_Numeric_Literal_Mismatch to avoid duplication in
	making this check.
	* sem_type.adb (Has_Compatible_Type): A numeric literal can be
	compatible with a non-numeric type (and a string literal can be
	compatible with a non-string type) if it can be interpreted as a
	user-defined literal.

11 files changed, 377 insertions, 69 deletions

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 1c7d3c4..cf292ae 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -109,6 +109,7 @@ package Aspects is
       Aspect_Initial_Condition,             -- GNAT
       Aspect_Initializes,                   -- GNAT
       Aspect_Input,
+      Aspect_Integer_Literal,
       Aspect_Interrupt_Priority,
       Aspect_Invariant,                     -- GNAT
       Aspect_Iterator_Element,
@@ -133,6 +134,7 @@ package Aspects is
       Aspect_Priority,
       Aspect_Put_Image,
       Aspect_Read,
+      Aspect_Real_Literal,
       Aspect_Refined_Depends,               -- GNAT
       Aspect_Refined_Global,                -- GNAT
       Aspect_Refined_Post,                  -- GNAT
@@ -149,6 +151,7 @@ package Aspects is
       Aspect_Storage_Pool,
       Aspect_Storage_Size,
       Aspect_Stream_Size,
+      Aspect_String_Literal,
       Aspect_Suppress,
       Aspect_Synchronization,
       Aspect_Test_Case,                     -- GNAT
@@ -373,6 +376,7 @@ package Aspects is
       Aspect_Initial_Condition          => Expression,
       Aspect_Initializes                => Expression,
       Aspect_Input                      => Name,
+      Aspect_Integer_Literal            => Name,
       Aspect_Interrupt_Priority         => Expression,
       Aspect_Invariant                  => Expression,
       Aspect_Iterable                   => Expression,
@@ -397,6 +401,7 @@ package Aspects is
       Aspect_Priority                   => Expression,
       Aspect_Put_Image                  => Name,
       Aspect_Read                       => Name,
+      Aspect_Real_Literal               => Name,
       Aspect_Refined_Depends            => Expression,
       Aspect_Refined_Global             => Expression,
       Aspect_Refined_Post               => Expression,
@@ -413,6 +418,7 @@ package Aspects is
       Aspect_Storage_Pool               => Name,
       Aspect_Storage_Size               => Expression,
       Aspect_Stream_Size                => Expression,
+      Aspect_String_Literal             => Name,
       Aspect_Suppress                   => Name,
       Aspect_Synchronization            => Name,
       Aspect_Test_Case                  => Expression,
@@ -467,6 +473,7 @@ package Aspects is
       Aspect_Initial_Condition            => False,
       Aspect_Initializes                  => False,
       Aspect_Input                        => False,
+      Aspect_Integer_Literal              => False,
       Aspect_Interrupt_Priority           => False,
       Aspect_Invariant                    => False,
       Aspect_Iterable                     => False,
@@ -491,6 +498,7 @@ package Aspects is
       Aspect_Priority                     => False,
       Aspect_Put_Image                    => False,
       Aspect_Read                         => False,
+      Aspect_Real_Literal                 => False,
       Aspect_Refined_Depends              => False,
       Aspect_Refined_Global               => False,
       Aspect_Refined_Post                 => False,
@@ -507,6 +515,7 @@ package Aspects is
       Aspect_Storage_Pool                 => True,
       Aspect_Storage_Size                 => True,
       Aspect_Stream_Size                  => True,
+      Aspect_String_Literal               => False,
       Aspect_Suppress                     => False,
       Aspect_Synchronization              => False,
       Aspect_Test_Case                    => False,
@@ -614,6 +623,7 @@ package Aspects is
       Aspect_Initial_Condition            => Name_Initial_Condition,
       Aspect_Initializes                  => Name_Initializes,
       Aspect_Input                        => Name_Input,
+      Aspect_Integer_Literal              => Name_Integer_Literal,
       Aspect_Interrupt_Handler            => Name_Interrupt_Handler,
       Aspect_Interrupt_Priority           => Name_Interrupt_Priority,
       Aspect_Invariant                    => Name_Invariant,
@@ -650,6 +660,7 @@ package Aspects is
       Aspect_Pure_Function                => Name_Pure_Function,
       Aspect_Put_Image                    => Name_Put_Image,
       Aspect_Read                         => Name_Read,
+      Aspect_Real_Literal                 => Name_Real_Literal,
       Aspect_Refined_Depends              => Name_Refined_Depends,
       Aspect_Refined_Global               => Name_Refined_Global,
       Aspect_Refined_Post                 => Name_Refined_Post,
@@ -672,6 +683,7 @@ package Aspects is
       Aspect_Storage_Pool                 => Name_Storage_Pool,
       Aspect_Storage_Size                 => Name_Storage_Size,
       Aspect_Stream_Size                  => Name_Stream_Size,
+      Aspect_String_Literal               => Name_String_Literal,
       Aspect_Suppress                     => Name_Suppress,
       Aspect_Suppress_Debug_Info          => Name_Suppress_Debug_Info,
       Aspect_Suppress_Initialization      => Name_Suppress_Initialization,
@@ -832,6 +844,7 @@ package Aspects is
       Aspect_Inline                       => Always_Delay,
       Aspect_Inline_Always                => Always_Delay,
       Aspect_Input                        => Always_Delay,
+      Aspect_Integer_Literal              => Always_Delay,
       Aspect_Interrupt_Handler            => Always_Delay,
       Aspect_Interrupt_Priority           => Always_Delay,
       Aspect_Invariant                    => Always_Delay,
@@ -857,6 +870,7 @@ package Aspects is
       Aspect_Pure_Function                => Always_Delay,
       Aspect_Put_Image                    => Always_Delay,
       Aspect_Read                         => Always_Delay,
+      Aspect_Real_Literal                 => Always_Delay,
       Aspect_Relative_Deadline            => Always_Delay,
       Aspect_Remote_Access_Type           => Always_Delay,
       Aspect_Remote_Call_Interface        => Always_Delay,
@@ -869,6 +883,7 @@ package Aspects is
       Aspect_Static_Predicate             => Always_Delay,
       Aspect_Storage_Pool                 => Always_Delay,
       Aspect_Stream_Size                  => Always_Delay,
+      Aspect_String_Literal               => Always_Delay,
       Aspect_Suppress                     => Always_Delay,
       Aspect_Suppress_Debug_Info          => Always_Delay,
       Aspect_Suppress_Initialization      => Always_Delay,
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index ae85d2c..337e4b6 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -425,7 +425,7 @@ package body Contracts is
             Analyze_Task_Contract (Defining_Entity (Decl));
 
          --  For type declarations, we need to do the preanalysis of Iterable
-         --  aspect specifications.
+         --  and the 3 Xxx_Literal aspect specifications.
 
          --  Other type aspects need to be resolved here???
 
@@ -433,13 +433,29 @@ package body Contracts is
            and then Present (Aspect_Specifications (Decl))
          then
             declare
-               E  : constant Entity_Id := Defining_Identifier (Decl);
-               It : constant Node_Id   := Find_Aspect (E, Aspect_Iterable);
+               E  : constant Entity_Id  := Defining_Identifier (Decl);
+               It : constant Node_Id    := Find_Aspect (E, Aspect_Iterable);
+               I_Lit : constant Node_Id :=
+                 Find_Aspect (E, Aspect_Integer_Literal);
+               R_Lit : constant Node_Id :=
+                 Find_Aspect (E, Aspect_Real_Literal);
+               S_Lit : constant Node_Id :=
+                 Find_Aspect (E, Aspect_String_Literal);
 
             begin
                if Present (It) then
                   Validate_Iterable_Aspect (E, It);
                end if;
+
+               if Present (I_Lit) then
+                  Validate_Literal_Aspect (E, I_Lit);
+               end if;
+               if Present (R_Lit) then
+                  Validate_Literal_Aspect (E, R_Lit);
+               end if;
+               if Present (S_Lit) then
+                  Validate_Literal_Aspect (E, S_Lit);
+               end if;
             end;
          end if;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d7d5a47..583bb98 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1461,6 +1461,12 @@ package body Sem_Ch13 is
                            ASN, E);
                      end if;
 
+                  when Aspect_Integer_Literal
+                     | Aspect_Real_Literal
+                     | Aspect_String_Literal
+                  =>
+                     Validate_Literal_Aspect (E, ASN);
+
                   when Aspect_Iterable =>
                      Validate_Iterable_Aspect (E, ASN);
 
@@ -3750,6 +3756,24 @@ package body Sem_Ch13 is
 
                   Aitem := Empty;
 
+               when Aspect_Integer_Literal
+                  | Aspect_Real_Literal
+                  | Aspect_String_Literal
+               =>
+
+                  if not Is_First_Subtype (E) then
+                     Error_Msg_N
+                       ("may only be specified for a first subtype", Aspect);
+                     goto Continue;
+                  end if;
+
+                  if Ada_Version < Ada_2020 then
+                     Check_Restriction
+                       (No_Implementation_Aspect_Specifications, N);
+                  end if;
+
+                  Aitem := Empty;
+
                --  Case 3b: The aspects listed below don't correspond to
                --  pragmas/attributes and don't need delayed analysis.
 
@@ -9868,7 +9892,10 @@ package body Sem_Ch13 is
       elsif A_Id = Aspect_Variable_Indexing or else
             A_Id = Aspect_Constant_Indexing or else
             A_Id = Aspect_Default_Iterator  or else
-            A_Id = Aspect_Iterator_Element
+            A_Id = Aspect_Iterator_Element  or else
+            A_Id = Aspect_Integer_Literal   or else
+            A_Id = Aspect_Real_Literal      or else
+            A_Id = Aspect_String_Literal
       then
          --  Make type unfrozen before analysis, to prevent spurious errors
          --  about late attributes.
@@ -9989,6 +10016,9 @@ package body Sem_Ch13 is
       Ident : constant Node_Id := Identifier (ASN);
       --  Identifier (use Entity field to save expression)
 
+      Expr : constant Node_Id := Expression (ASN);
+      --  For cases where using Entity (Identifier) doesn't work
+
       A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
 
       T : Entity_Id := Empty;
@@ -10137,6 +10167,20 @@ package body Sem_Ch13 is
             Analyze (Expression (ASN));
             return;
 
+         --  Same for Literal aspects, where the expression is a function
+         --  name. Legality rules are checked separately. Use Expr to avoid
+         --  losing track of the previous resolution of Expression.
+
+         when Aspect_Integer_Literal
+            | Aspect_Real_Literal
+            | Aspect_String_Literal
+         =>
+            Set_Entity (Expression (ASN), Entity (Expr));
+            Set_Etype (Expression (ASN), Etype (Expr));
+            Set_Is_Overloaded (Expression (ASN), False);
+            Analyze (Expression (ASN));
+            return;
+
          --  Ditto for Iterable, legality checks in Validate_Iterable_Aspect.
 
          when Aspect_Iterable =>
@@ -15122,6 +15166,115 @@ package body Sem_Ch13 is
       end if;
    end Validate_Iterable_Aspect;
 
+   ------------------------------
+   -- Validate_Literal_Aspect --
+   ------------------------------
+
+   procedure Validate_Literal_Aspect (Typ : Entity_Id; ASN : Node_Id) is
+      A_Id        : constant Aspect_Id := Get_Aspect_Id (ASN);
+      pragma Assert ((A_Id = Aspect_Integer_Literal) or
+                     (A_Id = Aspect_Real_Literal) or
+                     (A_Id = Aspect_String_Literal));
+      Func_Name   : constant Node_Id := Expression (ASN);
+      Overloaded  : Boolean := Is_Overloaded (Func_Name);
+
+      I           : Interp_Index;
+      It          : Interp;
+      Param_Type  : Entity_Id;
+      Match_Found : Boolean := False;
+      Is_Match    : Boolean;
+      Match       : Interp;
+   begin
+      if not Is_Type (Typ) then
+         Error_Msg_N ("aspect can only be specified for a type", ASN);
+         return;
+      elsif not Is_First_Subtype (Typ) then
+         Error_Msg_N ("aspect cannot be specified for a subtype", ASN);
+         return;
+      end if;
+
+      if A_Id = Aspect_String_Literal then
+         if Is_String_Type (Typ) then
+            Error_Msg_N ("aspect cannot be specified for a string type", ASN);
+            return;
+         end if;
+         Param_Type := Standard_Wide_Wide_String;
+      else
+         if Is_Numeric_Type (Typ) then
+            Error_Msg_N ("aspect cannot be specified for a numeric type", ASN);
+            return;
+         end if;
+         Param_Type := Standard_String;
+      end if;
+
+      if not Overloaded and then not Present (Entity (Func_Name)) then
+         Analyze (Func_Name);
+         Overloaded := Is_Overloaded (Func_Name);
+      end if;
+
+      if Overloaded then
+         Get_First_Interp (Func_Name, I => I, It => It);
+      else
+         --  only one possible interpretation
+         It.Nam := Entity (Func_Name);
+         pragma Assert (Present (It.Nam));
+      end if;
+
+      while It.Nam /= Empty loop
+         Is_Match := False;
+
+         if Ekind (It.Nam) = E_Function
+           and then Base_Type (Etype (It.Nam)) = Typ
+         then
+            declare
+               Params : constant List_Id :=
+                 Parameter_Specifications (Parent (It.Nam));
+               Param_Spec : Node_Id;
+               Param_Id   : Entity_Id;
+            begin
+               if List_Length (Params) = 1 then
+                  Param_Spec := First (Params);
+                  if not More_Ids (Param_Spec) then
+                     Param_Id := Defining_Identifier (Param_Spec);
+                     if Base_Type (Etype (Param_Id)) = Param_Type
+                        and then Ekind (Param_Id) = E_In_Parameter
+                     then
+                        Is_Match := True;
+                     end if;
+                  end if;
+               end if;
+            end;
+         end if;
+
+         if Is_Match then
+            if Match_Found then
+               Error_Msg_N ("aspect specification is ambiguous", ASN);
+               return;
+            end if;
+            Match_Found := True;
+            Match := It;
+         end if;
+
+         exit when not Overloaded;
+
+         if not Is_Match then
+            Remove_Interp (I => I);
+         end if;
+
+         Get_Next_Interp (I => I, It => It);
+      end loop;
+
+      if not Match_Found then
+         Error_Msg_N
+           ("function name in aspect specification cannot be resolved", ASN);
+         return;
+      end if;
+
+      Set_Entity (Func_Name, Match.Nam);
+      Set_Etype (Func_Name, Etype (Match.Nam));
+      Set_Is_Overloaded (Func_Name, False);
+   end Validate_Literal_Aspect;
+
    -----------------------------------
    -- Validate_Unchecked_Conversion --
    -----------------------------------
diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads
index 4c26473..85063a6 100644
--- a/gcc/ada/sem_ch13.ads
+++ b/gcc/ada/sem_ch13.ads
@@ -345,6 +345,10 @@ package Sem_Ch13 is
    --  for First, Next, and Has_Element. Optionally an Element primitive may
    --  also be defined.
 
+   procedure Validate_Literal_Aspect (Typ : Entity_Id; ASN : Node_Id);
+   --  Check legality of Integer_Literal, Real_Literal, and String_Literal
+   --  aspect specifications.
+
    procedure Install_Discriminants (E : Entity_Id);
    --  Make visible the discriminants of type entity E
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 55f0c6b..1b3cba8 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -9401,6 +9401,28 @@ package body Sem_Ch6 is
          end if;
       end FCO;
 
+      function User_Defined_Numeric_Literal_Mismatch return Boolean;
+      --  Usually literals with the same value like 12345 and 12_345
+      --  or 123.0 and 123.00 conform, but not if they are
+      --  user-defined literals.
+
+      -------------------------------------------
+      -- User_Defined_Numeric_Literal_Mismatch --
+      -------------------------------------------
+
+      function User_Defined_Numeric_Literal_Mismatch return Boolean is
+         E1_Is_User_Defined : constant Boolean :=
+           not Nkind_In (Given_E1, N_Integer_Literal, N_Real_Literal);
+         E2_Is_User_Defined : constant Boolean :=
+           not Nkind_In (Given_E2, N_Integer_Literal, N_Real_Literal);
+      begin
+         pragma Assert (E1_Is_User_Defined = E2_Is_User_Defined);
+
+         return E1_Is_User_Defined and then
+           not String_Equal (String_From_Numeric_Literal (E1),
+                             String_From_Numeric_Literal (E2));
+      end User_Defined_Numeric_Literal_Mismatch;
+
       --  Local variables
 
       Result : Boolean;
@@ -9662,7 +9684,8 @@ package body Sem_Ch6 is
                  FCL (Expressions (E1), Expressions (E2));
 
             when N_Integer_Literal =>
-               return (Intval (E1) = Intval (E2));
+               return (Intval (E1) = Intval (E2))
+                 and then not User_Defined_Numeric_Literal_Mismatch;
 
             when N_Null =>
                return True;
@@ -9748,7 +9771,8 @@ package body Sem_Ch6 is
                  FCE (High_Bound (E1), High_Bound (E2));
 
             when N_Real_Literal =>
-               return (Realval (E1) = Realval (E2));
+               return (Realval (E1) = Realval (E2))
+                 and then not User_Defined_Numeric_Literal_Mismatch;
 
             when N_Selected_Component =>
                return
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 378f449..d22e5d2 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -40,7 +40,6 @@ with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
-with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
@@ -377,10 +376,6 @@ package body Sem_Dim is
    procedure Set_Symbol (E : Entity_Id; Val : String_Id);
    --  Associate a symbol representation of a dimension vector with a subtype
 
-   function String_From_Numeric_Literal (N : Node_Id) return String_Id;
-   --  Return the string that corresponds to the numeric litteral N as it
-   --  appears in the source.
-
    function Symbol_Of (E : Entity_Id) return String_Id;
    --  E denotes a subtype with a dimension. Return the symbol representation
    --  of the dimension vector.
@@ -3740,63 +3735,6 @@ package body Sem_Dim is
       Symbol_Table.Set (E, Val);
    end Set_Symbol;
 
-   ---------------------------------
-   -- String_From_Numeric_Literal --
-   ---------------------------------
-
-   function String_From_Numeric_Literal (N : Node_Id) return String_Id is
-      Loc     : constant Source_Ptr        := Sloc (N);
-      Sbuffer : constant Source_Buffer_Ptr :=
-                  Source_Text (Get_Source_File_Index (Loc));
-      Src_Ptr : Source_Ptr := Loc;
-
-      C : Character  := Sbuffer (Src_Ptr);
-      --  Current source program character
-
-      function Belong_To_Numeric_Literal (C : Character) return Boolean;
-      --  Return True if C belongs to a numeric literal
-
-      -------------------------------
-      -- Belong_To_Numeric_Literal --
-      -------------------------------
-
-      function Belong_To_Numeric_Literal (C : Character) return Boolean is
-      begin
-         case C is
-            when '0' .. '9'
-               | '_' | '.' | 'e' | '#' | 'A' | 'B' | 'C' | 'D' | 'E' | 'F'
-            =>
-               return True;
-
-            --  Make sure '+' or '-' is part of an exponent.
-
-            when '+' | '-' =>
-               declare
-                  Prev_C : constant Character := Sbuffer (Src_Ptr - 1);
-               begin
-                  return Prev_C = 'e' or else Prev_C = 'E';
-               end;
-
-            --  All other character doesn't belong to a numeric literal
-
-            when others =>
-               return False;
-         end case;
-      end Belong_To_Numeric_Literal;
-
-   --  Start of processing for String_From_Numeric_Literal
-
-   begin
-      Start_String;
-      while Belong_To_Numeric_Literal (C) loop
-         Store_String_Char (C);
-         Src_Ptr := Src_Ptr + 1;
-         C       := Sbuffer (Src_Ptr);
-      end loop;
-
-      return End_String;
-   end String_From_Numeric_Literal;
-
    ---------------
    -- Symbol_Of --
    ---------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 13d925c..bdd954f 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -2142,6 +2143,12 @@ package body Sem_Res is
          return;
       end Resolution_Failed;
 
+      Literal_Aspect_Map :
+        constant array (N_Numeric_Or_String_Literal) of Aspect_Id :=
+          (N_Integer_Literal => Aspect_Integer_Literal,
+           N_Real_Literal    => Aspect_Real_Literal,
+           N_String_Literal  => Aspect_String_Literal);
+
    --  Start of processing for Resolve
 
    begin
@@ -2845,6 +2852,80 @@ package body Sem_Res is
                end;
             end if;
 
+            --  Rewrite Literal as a call if the corresponding literal aspect
+            --  is set.
+
+            if Nkind (N) in N_Numeric_Or_String_Literal
+              and then Present
+                         (Find_Aspect (Typ, Literal_Aspect_Map (Nkind (N))))
+            then
+               declare
+                  function Literal_Text (N : Node_Id) return String_Id;
+                  --  Returns the text of a literal node
+
+                  -------------------
+                  --  Literal_Text --
+                  -------------------
+
+                  function Literal_Text (N : Node_Id) return String_Id is
+                  begin
+                     pragma Assert (Nkind (N) in N_Numeric_Or_String_Literal);
+
+                     if Nkind (N) = N_String_Literal then
+                        return Strval (N);
+                     else
+                        return String_From_Numeric_Literal (N);
+                     end if;
+                  end Literal_Text;
+
+                  Lit_Aspect : constant Aspect_Id :=
+                    Literal_Aspect_Map (Nkind (N));
+
+                  Callee : constant Entity_Id :=
+                    Entity (Expression (Find_Aspect (Typ, Lit_Aspect)));
+
+                  Loc  : constant Source_Ptr := Sloc (N);
+
+                  Name : constant Node_Id :=
+                    Make_Identifier (Loc, Chars (Callee));
+
+                  Param : constant Node_Id :=
+                    Make_String_Literal (Loc, Literal_Text (N));
+
+                  Params : constant List_Id := New_List (Param);
+
+                  Call : Node_Id :=
+                    Make_Function_Call
+                      (Sloc                   => Loc,
+                       Name                   => Name,
+                       Parameter_Associations => Params);
+               begin
+                  Set_Entity (Name, Callee);
+                  Set_Is_Overloaded (Name, False);
+                  if Lit_Aspect = Aspect_String_Literal then
+                     Set_Etype (Param, Standard_Wide_Wide_String);
+                  else
+                     Set_Etype (Param, Standard_String);
+                  end if;
+                  Set_Etype (Call, Etype (Callee));
+
+                  --  Conversion needed in case of an inherited aspect
+                  --  of a derived type.
+                  --
+                  --  ??? Need to do something different here for downward
+                  --  tagged conversion case (which is only possible in the
+                  --  case of a null extension); the current call to
+                  --  Convert_To results in an error message about an illegal
+                  --  downward conversion.
+
+                  Call := Convert_To (Typ, Call);
+
+                  Rewrite (N, Call);
+               end;
+               Analyze_And_Resolve (N, Typ);
+               return;
+            end if;
+
             --  Looks like we have a type error, but check for special case
             --  of Address wanted, integer found, with the configuration pragma
             --  Allow_Integer_Address active. If we have this case, introduce
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index af0687c..a224418 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Alloc;
 with Debug;    use Debug;
@@ -2427,7 +2428,19 @@ package body Sem_Type is
            or else
              (not Is_Tagged_Type (Typ)
                and then Ekind (Typ) /= E_Anonymous_Access_Type
-               and then Covers (Etype (N), Typ));
+               and then Covers (Etype (N), Typ))
+
+           or else
+             (Nkind (N) = N_Integer_Literal
+               and then Present (Find_Aspect (Typ, Aspect_Integer_Literal)))
+
+           or else
+             (Nkind (N) = N_Real_Literal
+               and then Present (Find_Aspect (Typ, Aspect_Real_Literal)))
+
+           or else
+             (Nkind (N) = N_String_Literal
+               and then Present (Find_Aspect (Typ, Aspect_String_Literal)));
 
       --  Overloaded case
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 366eaff..43bffc9 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -26720,6 +26720,63 @@ package body Sem_Util is
       return Statically_Names_Object (Prefix (N));
    end Statically_Names_Object;
 
+   ---------------------------------
+   -- String_From_Numeric_Literal --
+   ---------------------------------
+
+   function String_From_Numeric_Literal (N : Node_Id) return String_Id is
+      Loc     : constant Source_Ptr        := Sloc (N);
+      Sbuffer : constant Source_Buffer_Ptr :=
+                  Source_Text (Get_Source_File_Index (Loc));
+      Src_Ptr : Source_Ptr := Loc;
+
+      C : Character  := Sbuffer (Src_Ptr);
+      --  Current source program character
+
+      function Belongs_To_Numeric_Literal (C : Character) return Boolean;
+      --  Return True if C belongs to the numeric literal
+
+      --------------------------------
+      -- Belongs_To_Numeric_Literal --
+      --------------------------------
+
+      function Belongs_To_Numeric_Literal (C : Character) return Boolean is
+      begin
+         case C is
+            when '0' .. '9'
+               | '_' | '.' | 'e' | '#' | 'A' | 'B' | 'C' | 'D' | 'E' | 'F'
+            =>
+               return True;
+
+            --  Make sure '+' or '-' is part of an exponent
+
+            when '+' | '-' =>
+               declare
+                  Prev_C : constant Character := Sbuffer (Src_Ptr - 1);
+               begin
+                  return Prev_C = 'e' or else Prev_C = 'E';
+               end;
+
+            --  Other characters cannot belong to a numeric literal
+
+            when others =>
+               return False;
+         end case;
+      end Belongs_To_Numeric_Literal;
+
+   --  Start of processing for String_From_Numeric_Literal
+
+   begin
+      Start_String;
+      while Belongs_To_Numeric_Literal (C) loop
+         Store_String_Char (C);
+         Src_Ptr := Src_Ptr + 1;
+         C       := Sbuffer (Src_Ptr);
+      end loop;
+
+      return End_String;
+   end String_From_Numeric_Literal;
+
    --------------------------------------
    -- Subject_To_Loop_Entry_Attributes --
    --------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index a7ca0f7..6cd626e 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2929,6 +2929,10 @@ package Sem_Util is
    function Statically_Names_Object (N : Node_Id) return Boolean;
    --  Return True iff N is a name that "statically names" an object.
 
+   function String_From_Numeric_Literal (N : Node_Id) return String_Id;
+   --  Return the string that corresponds to the numeric literal N as it
+   --  appears in the source.
+
    function Subject_To_Loop_Entry_Attributes (N : Node_Id) return Boolean;
    --  Determine whether node N is a loop statement subject to at least one
    --  'Loop_Entry attribute.
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 8d6ba41..0e807b0 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -148,8 +148,11 @@ package Snames is
    Name_Dimension_System               : constant Name_Id := N + $;
    Name_Disable_Controlled             : constant Name_Id := N + $;
    Name_Dynamic_Predicate              : constant Name_Id := N + $;
+   Name_Integer_Literal                : constant Name_Id := N + $;
+   Name_Real_Literal                   : constant Name_Id := N + $;
    Name_Relaxed_Initialization         : constant Name_Id := N + $;
    Name_Static_Predicate               : constant Name_Id := N + $;
+   Name_String_Literal                 : constant Name_Id := N + $;
    Name_Synchronization                : constant Name_Id := N + $;
    Name_Unimplemented                  : constant Name_Id := N + $;