This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Mark functions with address param as non-pure
- From: Geert Bosch <bosch at darwin dot gnat dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Tue, 4 Dec 2001 12:00:00 -0500 (EST)
- Subject: [Ada] Mark functions with address param as non-pure
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.
*** einfo.adb 2001/10/09 14:32:08 1.632
--- einfo.adb 2001/10/21 10:17:39 1.633
***************
*** 58,80 ****
-- 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.
-- 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
-- First_Rep_Item Node6
-- Freeze_Node Node7
--- 58,77 ----
-- 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. 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
-- 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,404 ****
-- Is_Discrim_SO_Function Flag176
-- Size_Depends_On_Discriminant Flag177
-- Is_Null_Init_Proc Flag178
- -- (unused) Flag179
-- (unused) Flag180
-- (unused) Flag181
-- (unused) Flag182
--- 394,401 ----
-- Is_Discrim_SO_Function Flag176
-- Size_Depends_On_Discriminant Flag177
-- Is_Null_Init_Proc Flag178
+ -- Has_Pragma_Pure_Function Flag179
-- (unused) Flag180
-- (unused) Flag181
-- (unused) Flag182
***************
*** 1087,1092 ****
--- 1084,1095 ----
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,2929 ****
--- 2927,2938 ----
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,5840 ****
--- 5844,5850 ----
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));
*** einfo.ads 2001/10/18 12:32:23 1.643
--- einfo.ads 2001/10/21 10:17:52 1.644
***************
*** 1354,1359 ****
--- 1354,1364 ----
-- 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 ???
***************
*** 4055,4060 ****
--- 4060,4066 ----
-- 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)
***************
*** 4177,4182 ****
--- 4183,4189 ----
-- 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
***************
*** 4284,4289 ****
--- 4291,4297 ----
-- 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)
***************
*** 4835,4840 ****
--- 4843,4849 ----
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;
***************
*** 5290,5295 ****
--- 5299,5305 ----
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);
***************
*** 5757,5762 ****
--- 5767,5773 ----
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);
***************
*** 6102,6107 ****
--- 6113,6119 ----
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);
*** sem_prag.adb 2001/10/11 16:09:25 1.561
--- sem_prag.adb 2001/10/21 10:47:17 1.562
***************
*** 7267,7272 ****
--- 7267,7273 ----
end if;
Set_Is_Pure (Def_Id);
+ Set_Has_Pragma_Pure_Function (Def_Id);
E := Homonym (E);
end loop;
end Pure_Function;