OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Geert Bosch 2001-12-04 17:55:48 +01:00
parent 9678de4977
commit 0839863cfa
4 changed files with 41 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,4 +1,13 @@
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.

26
gcc/ada/einfo.adb
View File

@ -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));

12
gcc/ada/einfo.ads
View File

@ -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);

1
gcc/ada/sem_prag.adb
View File

@ -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;