diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 1 |
4 files changed, 41 insertions, 9 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3fdfd09..1c1279d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index b81df9b..eaa362e 100644 --- a/gcc/ada/einfo.adb +++ b/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)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index b521971..bac1287 100644 --- a/gcc/ada/einfo.ads +++ b/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); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3c547c8..8e102cd 100644 --- a/gcc/ada/sem_prag.adb +++ b/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; |