diff options
| author | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2001-12-11 22:50:45 +0000 |
|---|---|---|
| committer | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2001-12-11 22:50:45 +0000 |
| commit | 95a5c38ed22b3b3c3d1d7746f32453035b116cf7 (patch) | |
| tree | b4ff6b95bcd0d7b38300eb8065cd673c688596c6 /gcc/ada/sem_attr.adb | |
| parent | 3d236665245a6e17df6ffef3509fb709120b3a00 (diff) | |
| download | gcc-95a5c38ed22b3b3c3d1d7746f32453035b116cf7.tar.gz | |
* lib-xref.adb (Output_Refs): Don't output type references outside
the main unit if they are not otherwise referenced.
* sem_attr.adb (Analyze_attribute, case Address and Size): Simplify
code and diagnose additional illegal uses
* sem_util.adb (Is_Object_Reference): An indexed component is an
object only if the prefix is.
* g-diopit.adb: Initial version.
* g-diopit.ads: Initial version.
* g-dirope.adb:
(Expand_Path): Avoid use of Unbounded_String
(Find, Wildcard_Iterator): Moved to child package Iteration
* Makefile.in: Added g-diopit.o to GNATRTL_NONTASKING_OBJS
* sem_attr.adb: Minor reformatting
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@47901 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/sem_attr.adb')
| -rw-r--r-- | gcc/ada/sem_attr.adb | 98 |
1 files changed, 47 insertions, 51 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 97002bb605d..c0bc236c822 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1545,33 +1545,48 @@ package body Sem_Attr is -- get the proper value, but if expansion is not active, then -- the check here allows proper semantic analysis of the reference. - if (Is_Entity_Name (P) - and then - (((Ekind (Entity (P)) = E_Task_Type - or else Ekind (Entity (P)) = E_Protected_Type) - and then Etype (Entity (P)) = Base_Type (Entity (P))) - or else Ekind (Entity (P)) = E_Package - or else Is_Generic_Unit (Entity (P)))) - or else - (Nkind (P) = N_Attribute_Reference - and then - Attribute_Name (P) = Name_AST_Entry) + -- An Address attribute created by expansion is legal even when it + -- applies to other entity-denoting expressions. + + if (Is_Entity_Name (P)) then + if Is_Subprogram (Entity (P)) + or else Is_Object (Entity (P)) + or else Ekind (Entity (P)) = E_Label + then + Set_Address_Taken (Entity (P)); + + elsif ((Ekind (Entity (P)) = E_Task_Type + or else Ekind (Entity (P)) = E_Protected_Type) + and then Etype (Entity (P)) = Base_Type (Entity (P))) + or else Ekind (Entity (P)) = E_Package + or else Is_Generic_Unit (Entity (P)) + then + Rewrite (N, + New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N))); + + else + Error_Attr ("invalid prefix for % attribute", P); + end if; + + elsif Nkind (P) = N_Attribute_Reference + and then Attribute_Name (P) = Name_AST_Entry then Rewrite (N, New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N))); - -- The following logic is obscure, needs explanation ??? + elsif Is_Object_Reference (P) then + null; - elsif Nkind (P) = N_Attribute_Reference - or else (Is_Entity_Name (P) - and then not Is_Subprogram (Entity (P)) - and then not Is_Object (Entity (P)) - and then Ekind (Entity (P)) /= E_Label) + elsif Nkind (P) = N_Selected_Component + and then Is_Subprogram (Entity (Selector_Name (P))) then - Error_Attr ("invalid prefix for % attribute", P); + null; - elsif Is_Entity_Name (P) then - Set_Address_Taken (Entity (P)); + elsif not Comes_From_Source (N) then + null; + + else + Error_Attr ("invalid prefix for % attribute", P); end if; Set_Etype (N, RTE (RE_Address)); @@ -3138,22 +3153,21 @@ package body Sem_Attr is if Is_Object_Reference (P) or else (Is_Entity_Name (P) - and then - Ekind (Entity (P)) = E_Function) + and then Ekind (Entity (P)) = E_Function) then Check_Object_Reference (P); - elsif Nkind (P) = N_Attribute_Reference - or else - (Nkind (P) = N_Selected_Component - and then (Is_Entry (Entity (Selector_Name (P))) - or else - Is_Subprogram (Entity (Selector_Name (P))))) - or else - (Is_Entity_Name (P) - and then not Is_Type (Entity (P)) - and then not Is_Object (Entity (P))) + elsif Is_Entity_Name (P) + and then Is_Type (Entity (P)) then + null; + + elsif Nkind (P) = N_Type_Conversion + and then not Comes_From_Source (P) + then + null; + + else Error_Attr ("invalid prefix for % attribute", P); end if; @@ -5490,7 +5504,7 @@ package body Sem_Attr is when Attribute_Small => - -- The floating-point case is present only for Ada 83 compatibility. + -- The floating-point case is present only for Ada 83 compatability. -- Note that strictly this is an illegal addition, since we are -- extending an Ada 95 defined attribute, but we anticipate an -- ARG ruling that will permit this. @@ -6511,24 +6525,6 @@ package body Sem_Attr is end if; end if; - -- Do not permit address to be applied to entry - - if (Is_Entity_Name (P) and then Is_Entry (Entity (P))) - or else Nkind (P) = N_Entry_Call_Statement - - or else (Nkind (P) = N_Selected_Component - and then Is_Entry (Entity (Selector_Name (P)))) - - or else (Nkind (P) = N_Indexed_Component - and then Nkind (Prefix (P)) = N_Selected_Component - and then Is_Entry (Entity (Selector_Name (Prefix (P))))) - then - Error_Msg_Name_1 := Aname; - Error_Msg_N - ("prefix of % attribute cannot be entry", N); - return; - end if; - if not Is_Entity_Name (P) or else not Is_Overloadable (Entity (P)) then |