einfo.adb (Has_Pragma_Pure_Function): New flag.

	* einfo.adb (Has_Pragma_Pure_Function): New flag.
	Fix problem that stopped ceinfo from working

	* einfo.ads (Has_Pragma_Pure_Function): New flag.

	* sem_prag.adb (Pure_Function): Set new flag Has_Pragma_Pure_Function.

From-SVN: r47614

gcc/ada/ChangeLog

-2001-12-04  Douglas B. <rupp@gnat.com>
+2001-12-04  Robert Dewar <dewar@gnat.com>
+
+	* einfo.adb (Has_Pragma_Pure_Function): New flag.
+	Fix problem that stopped ceinfo from working
+	
+	* einfo.ads (Has_Pragma_Pure_Function): New flag.
+	
+	* sem_prag.adb (Pure_Function): Set new flag Has_Pragma_Pure_Function.
+
+2001-12-04  Douglas B. Rupp <rupp@gnat.com>
 
 	* gnatchop.adb:
 	(File_Time_Stamp): New procedure.

gcc/ada/einfo.adb

@@ -58,23 +58,20 @@ package body Einfo is
    --  Four of these fields are defined in Sinfo, since they in are the
    --  base part of the node. The access routines for these fields and
    --  the corresponding set procedures are defined in Sinfo. These fields
-   --  are present in all entities.
+   --  are present in all entities. Note that Homonym is also in the base
+   --  part of the node, but has access routines that are more properly
+   --  part of Einfo, which is why they are defined here.
 
    --    Chars                           Name1
    --    Next_Entity                     Node2
    --    Scope                           Node3
    --    Etype                           Node5
 
-   --    The fifth field is also in the base part of the node, but it
-   --    carries some additional semantic checks and its subprograms are
-   --    more properly defined in Einfo.
-
-   --    Homonym                         Node4
-
    --   Remaining fields are present only in extended nodes (i.e. entities)
 
    --  The following fields are present in all entities
 
+   --    Homonym                         Node4
    --    First_Rep_Item                  Node6
    --    Freeze_Node                     Node7
 
@@ -397,8 +394,8 @@ package body Einfo is
    --    Is_Discrim_SO_Function         Flag176
    --    Size_Depends_On_Discriminant   Flag177
    --    Is_Null_Init_Proc              Flag178
+   --    Has_Pragma_Pure_Function       Flag179
 
-   --    (unused)                       Flag179
    --    (unused)                       Flag180
    --    (unused)                       Flag181
    --    (unused)                       Flag182
@@ -1087,6 +1084,12 @@ package body Einfo is
       return Flag121 (Implementation_Base_Type (Id));
    end Has_Pragma_Pack;
 
+   function Has_Pragma_Pure_Function (Id : E) return B is
+   begin
+      pragma Assert (Is_Subprogram (Id));
+      return Flag179 (Id);
+   end Has_Pragma_Pure_Function;
+
    function Has_Primitive_Operations (Id : E) return B is
    begin
       pragma Assert (Is_Type (Id));
@@ -2924,6 +2927,12 @@ package body Einfo is
       Set_Flag121 (Implementation_Base_Type (Id), V);
    end Set_Has_Pragma_Pack;
 
+   procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Subprogram (Id));
+      Set_Flag179 (Id, V);
+   end Set_Has_Pragma_Pure_Function;
+
    procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Type (Id));
@@ -5835,6 +5844,7 @@ package body Einfo is
       W ("Has_Pragma_Elaborate_Body",     Flag150 (Id));
       W ("Has_Pragma_Inline",             Flag157 (Id));
       W ("Has_Pragma_Pack",               Flag121 (Id));
+      W ("Has_Pragma_Pure_Function",      Flag179 (Id));
       W ("Has_Primitive_Operations",      Flag120 (Id));
       W ("Has_Private_Declaration",       Flag155 (Id));
       W ("Has_Qualified_Name",            Flag161 (Id));

gcc/ada/einfo.ads

@@ -1347,6 +1347,11 @@ package Einfo is
 --       was given for the type. Note that this flag is not inherited by a
 --       derived type. See also the Is_Packed flag.
 
+--    Has_Pragma_Pure_Function (Flag179)
+--       Present in subprogram entities. It indicates that a valid pragma
+--       Pure_Function was given for the entity. In some cases, we need to
+--       know that Is_Pure was explicitly set using this pragma.
+
 --    Has_Primitive_Operations (Flag120) [base type only]
 --       Present in all type entities. Set if at least one primitive operation
 --       is defined on the type. This flag is not yet properly set ???
@@ -4048,6 +4053,7 @@ package Einfo is
    --    Has_Master_Entity             (Flag21)
    --    Has_Missing_Return            (Flag142)
    --    Has_Nested_Block_With_Handler (Flag101)
+   --    Has_Pragma_Pure_Function      (Flag179)  (non-generic case only)
    --    Has_Recursive_Call            (Flag143)
    --    Has_Subprogram_Descriptor     (Flag93)
    --    Is_Abstract                   (Flag19)
@@ -4170,6 +4176,7 @@ package Einfo is
    --    Is_Pure                       (Flag44)
    --    Is_Intrinsic_Subprogram       (Flag64)
    --    Default_Expressions_Processed (Flag108)
+   --    Has_Pragma_Pure_Function      (Flag179)
 
    --  E_Ordinary_Fixed_Point_Type
    --  E_Ordinary_Fixed_Point_Subtype
@@ -4277,6 +4284,7 @@ package Einfo is
    --    Has_Completion                (Flag26)
    --    Has_Master_Entity             (Flag21)
    --    Has_Nested_Block_With_Handler (Flag101)
+   --    Has_Pragma_Pure_Function      (Flag179)  (non-generic case only)
    --    Has_Subprogram_Descriptor     (Flag93)
    --    Is_Visible_Child_Unit         (Flag116)
    --    Is_Abstract                   (Flag19)
@@ -4828,6 +4836,7 @@ package Einfo is
    function Has_Pragma_Elaborate_Body          (Id : E) return B;
    function Has_Pragma_Inline                  (Id : E) return B;
    function Has_Pragma_Pack                    (Id : E) return B;
+   function Has_Pragma_Pure_Function           (Id : E) return B;
    function Has_Primitive_Operations           (Id : E) return B;
    function Has_Qualified_Name                 (Id : E) return B;
    function Has_Record_Rep_Clause              (Id : E) return B;
@@ -5283,6 +5292,7 @@ package Einfo is
    procedure Set_Has_Pragma_Elaborate_Body     (Id : E; V : B := True);
    procedure Set_Has_Pragma_Inline             (Id : E; V : B := True);
    procedure Set_Has_Pragma_Pack               (Id : E; V : B := True);
+   procedure Set_Has_Pragma_Pure_Function      (Id : E; V : B := True);
    procedure Set_Has_Primitive_Operations      (Id : E; V : B := True);
    procedure Set_Has_Private_Declaration       (Id : E; V : B := True);
    procedure Set_Has_Qualified_Name            (Id : E; V : B := True);
@@ -5750,6 +5760,7 @@ package Einfo is
    pragma Inline (Has_Pragma_Elaborate_Body);
    pragma Inline (Has_Pragma_Inline);
    pragma Inline (Has_Pragma_Pack);
+   pragma Inline (Has_Pragma_Pure_Function);
    pragma Inline (Has_Primitive_Operations);
    pragma Inline (Has_Private_Declaration);
    pragma Inline (Has_Qualified_Name);
@@ -6095,6 +6106,7 @@ package Einfo is
    pragma Inline (Set_Has_Pragma_Elaborate_Body);
    pragma Inline (Set_Has_Pragma_Inline);
    pragma Inline (Set_Has_Pragma_Pack);
+   pragma Inline (Set_Has_Pragma_Pure_Function);
    pragma Inline (Set_Has_Primitive_Operations);
    pragma Inline (Set_Has_Private_Declaration);
    pragma Inline (Set_Has_Qualified_Name);

gcc/ada/sem_prag.adb

@@ -7267,6 +7267,7 @@ package body Sem_Prag is
                end if;
 
                Set_Is_Pure (Def_Id);
+               Set_Has_Pragma_Pure_Function (Def_Id);
                E := Homonym (E);
             end loop;
          end Pure_Function;