ada: Evaluate calls to GNAT.Source_Info routines in semantic checking

When semantic checking mode is active, i.e. when switch -gnatc is
present or when the frontend is operating in the GNATprove mode,
we now rewrite calls to GNAT.Source_Info routines in evaluation
and not expansion (which is disabled in these modes).

This is needed to recognize constants initialized with calls to
GNAT.Source_Info as static constants, regardless of expansion being
enabled.

gcc/ada/

	* exp_intr.ads, exp_intr.adb (Expand_Source_Info): Move
	declaration to package spec.
	* sem_eval.adb (Eval_Intrinsic_Call): Evaluate calls to
	GNAT.Source_Info where possible.

diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index a076eb0eeb6a3608ade4e0746e80c4ec045abb76..0db0a66ab1c938d0d2b072763a74039f61337a3f 100644 (file)
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -109,12 +109,6 @@ package body Exp_Intr is
    --  Expand a call to corresponding function, declared in an instance of
    --  System.Address_To_Access_Conversions.
 
-   procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id);
-   --  Rewrite the node as the appropriate string literal or positive
-   --  constant. Nam is the name of one of the intrinsics declared in
-   --  GNAT.Source_Info; see g-souinf.ads for documentation of these
-   --  intrinsics.
-
    ---------------------
    -- Add_Source_Info --
    ---------------------

diff --git a/gcc/ada/exp_intr.ads b/gcc/ada/exp_intr.ads
index 699d1c8164f94201058b598845f653cfd3b52265..75f24bf54950fddde0c87e79996d38aedfbadd97 100644 (file)
--- a/gcc/ada/exp_intr.ads
+++ b/gcc/ada/exp_intr.ads
@@ -39,6 +39,11 @@ package Exp_Intr is
    --  documentation of these intrinsics. Loc is passed to provide location
    --  information where it is needed.
 
+   procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id);
+   --  Rewrite the node as the appropriate string literal or positive constant.
+   --  Nam is the name of one of the intrinsics declared in GNAT.Source_Info;
+   --  see g-souinf.ads for documentation of these intrinsics.
+
    procedure Expand_Intrinsic_Call (N : Node_Id; E : Entity_Id);
    --  N is either a function call node, a procedure call statement node, or
    --  an operator where the corresponding subprogram is intrinsic (i.e. was

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index aaf0a766dc31cb03d591ff6cae3fbc3f7978fb21..de3f35e9a619e69b217a62eca0f4c1afe25890ce 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -33,6 +33,7 @@ with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
 with Errout;         use Errout;
 with Eval_Fat;       use Eval_Fat;
+with Exp_Intr;       use Exp_Intr;
 with Exp_Util;       use Exp_Util;
 with Freeze;         use Freeze;
 with Lib;            use Lib;
@@ -191,7 +192,7 @@ package body Sem_Eval is
    --  (it is an error to make the call if these conditions are not met).
 
    procedure Eval_Intrinsic_Call (N : Node_Id; E : Entity_Id);
-   --  Evaluate a call N to an intrinsic subprogram E.
+   --  Evaluate a call N to an intrinsic subprogram E
 
    function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id;
    --  Check whether an arithmetic operation with universal operands which is a
@@ -2888,13 +2889,43 @@ package body Sem_Eval is
       end if;
 
       case Nam is
-         when Name_Shift_Left  =>
+
+         --  Compilation date and time are the same for the entire compilation
+         --  unit, so we can replace them with static strings.
+
+         when Name_Compilation_ISO_Date
+            | Name_Compilation_Date
+            | Name_Compilation_Time
+         =>
+            Expand_Source_Info (N, Nam);
+
+         --  Calls to other intrinsics from the GNAT.Source_Info package give
+         --  different results, depending on where they occur. In particular,
+         --  for generics their results depend on where those generics are
+         --  instantiated; same for default values of subprogram parameters.
+         --  Those calls will behave as nonstatic, and we postpone their
+         --  rewriting until expansion.
+
+         when Name_Enclosing_Entity
+            | Name_File
+            | Name_Line
+            | Name_Source_Location
+         =>
+            if Inside_A_Generic
+              or else In_Spec_Expression
+            then
+               null;
+            else
+               Expand_Source_Info (N, Nam);
+            end if;
+
+         when Name_Shift_Left =>
             Eval_Shift (N, E, N_Op_Shift_Left);
          when Name_Shift_Right =>
             Eval_Shift (N, E, N_Op_Shift_Right);
          when Name_Shift_Right_Arithmetic =>
             Eval_Shift (N, E, N_Op_Shift_Right_Arithmetic);
-         when others           =>
+         when others =>
             null;
       end case;
    end Eval_Intrinsic_Call;