diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
| -rw-r--r-- | gcc/ada/gnatls.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 600 |
5 files changed, 412 insertions, 278 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 43024e2..38edfbe 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2014-10-23 Vincent Celier <celier@adacore.com> + + * gnatls.adb: If --RTS= was not used, check if there is a default + runtime. If there is none, in verbose mode, indicate that the + default runtime is not available and show only the current + directory in the source and the object search paths. + +2014-10-23 Ed Schonberg <schonberg@adacore.com> + + * sem_ch6.adb (Process_Formals): A thunk procedure with a + parameter of a limited view does not need a freeze node. + +2014-10-23 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_ch7.adb (Analyze_Package_Body_Helper): + The logic which hides local entities from external + visibility is now contained in routine Hide_Public_Entities. + (Hide_Public_Entities): New routine. Object and subprogram + renamings are now hidden from external visibility the same way + objects are. + +2014-10-23 Ed Schonberg <schonberg@adacore.com> + + * sem_attr.adb (Analyze_Attribute): The prefix of attribute Elaborated + does not require freezing, in particular if it denotes a generic + function. + 2014-10-23 Yannick Moy <moy@adacore.com> * sem_prag.adb (Analyze_Pragma/Pragma_Inline & Pragma_Inline_Always): diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 79d9595..808b009 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -65,6 +65,9 @@ procedure Gnatls is No_Obj : aliased String := "<no_obj>"; + No_Runtime : Boolean := False; + -- Set to True if there is no default runtime and --RTS= is not specified + type File_Status is ( OK, -- matching timestamp Checksum_OK, -- only matching checksum @@ -1631,10 +1634,37 @@ begin Osint.Add_Default_Search_Dirs; + -- If --RTS= is not specified, check if there is a default runtime + + if RTS_Specified = null then + declare + Text : Source_Buffer_Ptr; + Hi : Source_Ptr; + + begin + Name_Buffer (1 .. 10) := "system.ads"; + Name_Len := 10; + + Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text); + + if Text = null then + No_Runtime := True; + end if; + end; + end if; + if Verbose_Mode then Write_Eol; Display_Version ("GNATLS", "1997"); Write_Eol; + + if No_Runtime then + Write_Str + ("Default runtime not available. Use --RTS= with a valid runtime"); + Write_Eol; + Write_Eol; + end if; + Write_Str ("Source Search Path:"); Write_Eol; @@ -1643,14 +1673,15 @@ begin if Dir_In_Src_Search_Path (J)'Length = 0 then Write_Str ("<Current_Directory>"); - else + Write_Eol; + + elsif not No_Runtime then Write_Str (Normalize (To_Host_Dir_Spec - (Dir_In_Src_Search_Path (J).all, True).all)); + (Dir_In_Src_Search_Path (J).all, True).all)); + Write_Eol; end if; - - Write_Eol; end loop; Write_Eol; @@ -1663,14 +1694,15 @@ begin if Dir_In_Obj_Search_Path (J)'Length = 0 then Write_Str ("<Current_Directory>"); - else + Write_Eol; + + elsif not No_Runtime then Write_Str (Normalize (To_Host_Dir_Spec - (Dir_In_Obj_Search_Path (J).all, True).all)); + (Dir_In_Obj_Search_Path (J).all, True).all)); + Write_Eol; end if; - - Write_Eol; end loop; Write_Eol; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 10220ee..071399b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -11164,7 +11164,16 @@ package body Sem_Attr is -- Normally the Freezing is done by Resolve but sometimes the Prefix -- is not resolved, in which case the freezing must be done now. - Freeze_Expression (P); + -- For an elaboration check on a subprogram, we do not freeze its type. + -- It may be declared in an unrelated scope, in particular in the case + -- of a generic function whose type may remain unelaborated. + + if Attr_Id = Attribute_Elaborated then + null; + + else + Freeze_Expression (P); + end if; -- Finally perform static evaluation on the attribute reference diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 88e2773..8940d82 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9946,7 +9946,9 @@ package body Sem_Ch6 is -- (Note that the same is done for controlling access -- parameter cases in function Access_Definition.) - Set_Has_Delayed_Freeze (Current_Scope); + if not Is_Thunk (Current_Scope) then + Set_Has_Delayed_Freeze (Current_Scope); + end if; end if; end if; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 70f8a09..f15b8ff 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -220,12 +220,12 @@ package body Sem_Ch7 is --------------------------------- procedure Analyze_Package_Body_Helper (N : Node_Id) is - HSS : Node_Id; - Body_Id : Entity_Id; - Spec_Id : Entity_Id; - Last_Spec_Entity : Entity_Id; - New_N : Node_Id; - Pack_Decl : Node_Id; + procedure Hide_Public_Entities (Decls : List_Id); + -- Attempt to hide all public entities found in declarative list Decls + -- by resetting their Is_Public flag to False depending on whether the + -- entities are not referenced by inlined or generic bodies. This kind + -- of processing is a conservative approximation and may still leave + -- certain entities externally visible. procedure Install_Composite_Operations (P : Entity_Id); -- Composite types declared in the current scope may depend on types @@ -233,6 +233,310 @@ package body Sem_Ch7 is -- is now in scope. Indicate that the corresponding operations on the -- composite type are available. + -------------------------- + -- Hide_Public_Entities -- + -------------------------- + + procedure Hide_Public_Entities (Decls : List_Id) is + function Contains_Subp_Or_Const_Refs (N : Node_Id) return Boolean; + -- Subsidiary to routine Has_Referencer. Determine whether a node + -- contains a reference to a subprogram or a non-static constant. + -- WARNING: this is a very expensive routine as it performs a full + -- tree traversal. + + function Has_Referencer + (Decls : List_Id; + Top_Level : Boolean := False) return Boolean; + -- A "referencer" is a construct which may reference a previous + -- declaration. Examine all declarations in list Decls in reverse + -- and determine whether once such referencer exists. All entities + -- in the range Last (Decls) .. Referencer are hidden from external + -- visibility. + + --------------------------------- + -- Contains_Subp_Or_Const_Refs -- + --------------------------------- + + function Contains_Subp_Or_Const_Refs (N : Node_Id) return Boolean is + Reference_Seen : Boolean := False; + + function Is_Subp_Or_Const_Ref + (N : Node_Id) return Traverse_Result; + -- Determine whether a node denotes a reference to a subprogram or + -- a non-static constant. + + -------------------------- + -- Is_Subp_Or_Const_Ref -- + -------------------------- + + function Is_Subp_Or_Const_Ref + (N : Node_Id) return Traverse_Result + is + Val : Node_Id; + + begin + -- Detect a reference of the form + -- Subp_Call + + if Nkind (N) in N_Subprogram_Call + and then Is_Entity_Name (Name (N)) + then + Reference_Seen := True; + return Abandon; + + -- Detect a reference of the form + -- Subp'Some_Attribute + + elsif Nkind (N) = N_Attribute_Reference + and then Is_Entity_Name (Prefix (N)) + and then Is_Subprogram (Entity (Prefix (N))) + then + Reference_Seen := True; + return Abandon; + + -- Detect the use of a non-static constant + + elsif Is_Entity_Name (N) + and then Present (Entity (N)) + and then Ekind (Entity (N)) = E_Constant + then + Val := Constant_Value (Entity (N)); + + if Present (Val) + and then not Compile_Time_Known_Value (Val) + then + Reference_Seen := True; + return Abandon; + end if; + end if; + + return OK; + end Is_Subp_Or_Const_Ref; + + procedure Find_Subp_Or_Const_Ref is + new Traverse_Proc (Is_Subp_Or_Const_Ref); + + -- Start of processing for Contains_Subp_Or_Const_Refs + + begin + Find_Subp_Or_Const_Ref (N); + + return Reference_Seen; + end Contains_Subp_Or_Const_Refs; + + -------------------- + -- Has_Referencer -- + -------------------- + + function Has_Referencer + (Decls : List_Id; + Top_Level : Boolean := False) return Boolean + is + Decl : Node_Id; + Decl_Id : Entity_Id; + Spec : Node_Id; + + Has_Non_Subp_Const_Referencer : Boolean := False; + -- Flag set for inlined subprogram bodies that do not contain + -- references to other subprograms or non-static constants. + + begin + if No (Decls) then + return False; + end if; + + -- Examine all declarations in reverse order, hiding all entities + -- from external visibility until a referencer has been found. The + -- algorithm recurses into nested packages. + + Decl := Last (Decls); + while Present (Decl) loop + + -- A stub is always considered a referencer + + if Nkind (Decl) in N_Body_Stub then + return True; + + -- Package declaration + + elsif Nkind (Decl) = N_Package_Declaration + and then not Has_Non_Subp_Const_Referencer + then + Spec := Specification (Decl); + + -- Inspect the declarations of a non-generic package to try + -- and hide more entities from external visibility. + + if not Is_Generic_Unit (Defining_Entity (Spec)) then + if Has_Referencer (Private_Declarations (Spec)) + or else Has_Referencer (Visible_Declarations (Spec)) + then + return True; + end if; + end if; + + -- Package body + + elsif Nkind (Decl) = N_Package_Body + and then Present (Corresponding_Spec (Decl)) + then + Decl_Id := Corresponding_Spec (Decl); + + -- A generic package body is a referencer. It would seem + -- that we only have to consider generics that can be + -- exported, i.e. where the corresponding spec is the + -- spec of the current package, but because of nested + -- instantiations, a fully private generic body may export + -- other private body entities. Furthermore, regardless of + -- whether there was a previous inlined subprogram, (an + -- instantiation of) the generic package may reference any + -- entity declared before it. + + if Is_Generic_Unit (Decl_Id) then + return True; + + -- Inspect the declarations of a non-generic package body to + -- try and hide more entities from external visibility. + + elsif not Has_Non_Subp_Const_Referencer + and then Has_Referencer (Declarations (Decl)) + then + return True; + end if; + + -- Subprogram body + + elsif Nkind (Decl) = N_Subprogram_Body then + if Present (Corresponding_Spec (Decl)) then + Decl_Id := Corresponding_Spec (Decl); + + -- A generic subprogram body acts as a referencer + + if Is_Generic_Unit (Decl_Id) then + return True; + end if; + + -- An inlined subprogram body acts as a referencer + + if Is_Inlined (Decl_Id) + or else Has_Pragma_Inline (Decl_Id) + then + -- Inspect the statements of the subprogram body + -- to determine whether the body references other + -- subprograms and/or non-static constants. + + if Top_Level + and then not Contains_Subp_Or_Const_Refs (Decl) + then + Has_Non_Subp_Const_Referencer := True; + else + return True; + end if; + end if; + + -- Otherwise this is a stand alone subprogram body + + else + Decl_Id := Defining_Entity (Decl); + + -- An inlined body acts as a referencer. Note that an + -- inlined subprogram remains Is_Public as gigi requires + -- the flag to be set. + + -- Note that we test Has_Pragma_Inline here rather than + -- Is_Inlined. We are compiling this for a client, and + -- it is the client who will decide if actual inlining + -- should occur, so we need to assume that the procedure + -- could be inlined for the purpose of accessing global + -- entities. + + if Has_Pragma_Inline (Decl_Id) then + if Top_Level + and then not Contains_Subp_Or_Const_Refs (Decl) + then + Has_Non_Subp_Const_Referencer := True; + else + return True; + end if; + else + Set_Is_Public (Decl_Id, False); + end if; + end if; + + -- Exceptions, objects and renamings do not need to be public + -- if they are not followed by a construct which can reference + -- and export them. The Is_Public flag is reset on top level + -- entities only as anything nested is local to its context. + + elsif Nkind_In (Decl, N_Exception_Declaration, + N_Object_Declaration, + N_Object_Renaming_Declaration, + N_Subprogram_Declaration, + N_Subprogram_Renaming_Declaration) + then + Decl_Id := Defining_Entity (Decl); + + if Top_Level + and then not Is_Imported (Decl_Id) + and then not Is_Exported (Decl_Id) + and then No (Interface_Name (Decl_Id)) + and then + (not Has_Non_Subp_Const_Referencer + or else Nkind (Decl) = N_Subprogram_Declaration) + then + Set_Is_Public (Decl_Id, False); + end if; + end if; + + Prev (Decl); + end loop; + + return Has_Non_Subp_Const_Referencer; + end Has_Referencer; + + -- Local variables + + Discard : Boolean := True; + pragma Unreferenced (Discard); + + -- Start of processing for Hide_Public_Entities + + begin + -- The algorithm examines the top level declarations of a package + -- body in reverse looking for a construct that may export entities + -- declared prior to it. If such a scenario is encountered, then all + -- entities in the range Last (Decls) .. construct are hidden from + -- external visibility. Consider: + + -- package Pack is + -- generic + -- package Gen is + -- end Gen; + -- end Pack; + + -- package body Pack is + -- External_Obj : ...; -- (1) + + -- package body Gen is -- (2) + -- ... External_Obj ... -- (3) + -- end Gen; + + -- Local_Obj : ...; -- (4) + -- end Pack; + + -- In this example Local_Obj (4) must not be externally visible as + -- it cannot be exported by anything in Pack. The body of generic + -- package Gen (2) on the other hand acts as a "referencer" and may + -- export anything declared before it. Since the compiler does not + -- perform flow analysis, it is not possible to determine precisely + -- which entities will be exported when Gen is instantiated. In the + -- example above External_Obj (1) is exported at (3), but this may + -- not always be the case. The algorithm takes a conservative stance + -- and leaves entity External_Obj public. + + Discard := Has_Referencer (Decls, Top_Level => True); + end Hide_Public_Entities; + ---------------------------------- -- Install_Composite_Operations -- ---------------------------------- @@ -256,6 +560,15 @@ package body Sem_Ch7 is end loop; end Install_Composite_Operations; + -- Local variables + + Body_Id : Entity_Id; + HSS : Node_Id; + Last_Spec_Entity : Entity_Id; + New_N : Node_Id; + Pack_Decl : Node_Id; + Spec_Id : Entity_Id; + -- Start of processing for Analyze_Package_Body_Helper begin @@ -557,272 +870,23 @@ package body Sem_Ch7 is Check_References (Spec_Id); end if; - -- The processing so far has made all entities of the package body - -- public (i.e. externally visible to the linker). This is in general - -- necessary, since inlined or generic bodies, for which code is - -- generated in other units, may need to see these entities. The - -- following loop runs backwards from the end of the entities of the - -- package body making these entities invisible until we reach a - -- referencer, i.e. a declaration that could reference a previous - -- declaration, a generic body or an inlined body, or a stub (which may - -- contain either of these). This is of course an approximation, but it - -- is conservative and definitely correct. - - -- We only do this at the outer (library) level non-generic packages. - -- The reason is simply to cut down on the number of global symbols - -- generated, which has a double effect: (1) to make the compilation - -- process more efficient and (2) to give the code generator more - -- freedom to optimize within each unit, especially subprograms. + -- At this point all entities of the package body are externally visible + -- to the linker as their Is_Public flag is set to True. This proactive + -- approach is necessary because an inlined or a generic body for which + -- code is generated in other units may need to see these entities. Cut + -- down the number of global symbols that do not neet public visibility + -- as this has two beneficial effects: + -- (1) It makes the compilation process more efficient. + -- (2) It gives the code generatormore freedom to optimize within each + -- unit, especially subprograms. + + -- This is done only for top level library packages or child units as + -- the algorithm does a top down traversal of the package body. if (Scope (Spec_Id) = Standard_Standard or else Is_Child_Unit (Spec_Id)) and then not Is_Generic_Unit (Spec_Id) - and then Present (Declarations (N)) then - Make_Non_Public_Where_Possible : declare - - function Has_Referencer - (L : List_Id; - Outer : Boolean) return Boolean; - -- Traverse given list of declarations in reverse order. Return - -- True if a referencer is present. Return False if none is found. - -- - -- The Outer parameter is True for the outer level call and False - -- for inner level calls for nested packages. If Outer is True, - -- then any entities up to the point of hitting a referencer get - -- their Is_Public flag cleared, so that the entities will be - -- treated as static entities in the C sense, and need not have - -- fully qualified names. Furthermore, if the referencer is an - -- inlined subprogram that doesn't reference other subprograms, - -- we keep clearing the Is_Public flag on subprograms. For inner - -- levels, we need all names to be fully qualified to deal with - -- the same name appearing in parallel packages (right now this - -- is tied to their being external). - - -------------------- - -- Has_Referencer -- - -------------------- - - function Has_Referencer - (L : List_Id; - Outer : Boolean) return Boolean - is - Has_Referencer_Except_For_Subprograms : Boolean := False; - - D : Node_Id; - E : Entity_Id; - K : Node_Kind; - S : Entity_Id; - - function Check_Subprogram_Ref (N : Node_Id) - return Traverse_Result; - -- Look for references to subprograms - - -------------------------- - -- Check_Subprogram_Ref -- - -------------------------- - - function Check_Subprogram_Ref (N : Node_Id) - return Traverse_Result - is - V : Node_Id; - - begin - -- Check name of procedure or function calls - - if Nkind (N) in N_Subprogram_Call - and then Is_Entity_Name (Name (N)) - then - return Abandon; - end if; - - -- Check prefix of attribute references - - if Nkind (N) = N_Attribute_Reference - and then Is_Entity_Name (Prefix (N)) - and then Present (Entity (Prefix (N))) - and then Ekind (Entity (Prefix (N))) in Subprogram_Kind - then - return Abandon; - end if; - - -- Check value of constants - - if Nkind (N) = N_Identifier - and then Present (Entity (N)) - and then Ekind (Entity (N)) = E_Constant - then - V := Constant_Value (Entity (N)); - - if Present (V) - and then not Compile_Time_Known_Value_Or_Aggr (V) - then - return Abandon; - end if; - end if; - - return OK; - end Check_Subprogram_Ref; - - function Check_Subprogram_Refs is - new Traverse_Func (Check_Subprogram_Ref); - - -- Start of processing for Has_Referencer - - begin - if No (L) then - return False; - end if; - - D := Last (L); - while Present (D) loop - K := Nkind (D); - - if K in N_Body_Stub then - return True; - - -- Processing for subprogram bodies - - elsif K = N_Subprogram_Body then - if Acts_As_Spec (D) then - E := Defining_Entity (D); - - -- An inlined body acts as a referencer. Note also - -- that we never reset Is_Public for an inlined - -- subprogram. Gigi requires Is_Public to be set. - - -- Note that we test Has_Pragma_Inline here rather - -- than Is_Inlined. We are compiling this for a - -- client, and it is the client who will decide if - -- actual inlining should occur, so we need to assume - -- that the procedure could be inlined for the purpose - -- of accessing global entities. - - if Has_Pragma_Inline (E) then - if Outer and then Check_Subprogram_Refs (D) = OK - then - Has_Referencer_Except_For_Subprograms := True; - else - return True; - end if; - else - Set_Is_Public (E, False); - end if; - - else - E := Corresponding_Spec (D); - - if Present (E) then - - -- A generic subprogram body acts as a referencer - - if Is_Generic_Unit (E) then - return True; - end if; - - if Has_Pragma_Inline (E) or else Is_Inlined (E) then - if Outer and then Check_Subprogram_Refs (D) = OK - then - Has_Referencer_Except_For_Subprograms := True; - else - return True; - end if; - end if; - end if; - end if; - - -- Processing for package bodies - - elsif K = N_Package_Body - and then Present (Corresponding_Spec (D)) - then - E := Corresponding_Spec (D); - - -- Generic package body is a referencer. It would seem - -- that we only have to consider generics that can be - -- exported, i.e. where the corresponding spec is the - -- spec of the current package, but because of nested - -- instantiations, a fully private generic body may - -- export other private body entities. Furthermore, - -- regardless of whether there was a previous inlined - -- subprogram, (an instantiation of) the generic package - -- may reference any entity declared before it. - - if Is_Generic_Unit (E) then - return True; - - -- For non-generic package body, recurse into body unless - -- this is an instance, we ignore instances since they - -- cannot have references that affect outer entities. - - elsif not Is_Generic_Instance (E) - and then not Has_Referencer_Except_For_Subprograms - then - if Has_Referencer - (Declarations (D), Outer => False) - then - return True; - end if; - end if; - - -- Processing for package specs, recurse into declarations. - -- Again we skip this for the case of generic instances. - - elsif K = N_Package_Declaration - and then not Has_Referencer_Except_For_Subprograms - then - S := Specification (D); - - if not Is_Generic_Unit (Defining_Entity (S)) then - if Has_Referencer - (Private_Declarations (S), Outer => False) - then - return True; - elsif Has_Referencer - (Visible_Declarations (S), Outer => False) - then - return True; - end if; - end if; - - -- Objects and exceptions need not be public if we have not - -- encountered a referencer so far. We only reset the flag - -- for outer level entities that are not imported/exported, - -- and which have no interface name. - - elsif Nkind_In (K, N_Object_Declaration, - N_Exception_Declaration, - N_Subprogram_Declaration) - then - E := Defining_Entity (D); - - if Outer - and then (not Has_Referencer_Except_For_Subprograms - or else K = N_Subprogram_Declaration) - and then not Is_Imported (E) - and then not Is_Exported (E) - and then No (Interface_Name (E)) - then - Set_Is_Public (E, False); - end if; - end if; - - Prev (D); - end loop; - - return Has_Referencer_Except_For_Subprograms; - end Has_Referencer; - - -- Start of processing for Make_Non_Public_Where_Possible - - begin - declare - Discard : Boolean; - pragma Warnings (Off, Discard); - - begin - Discard := Has_Referencer (Declarations (N), Outer => True); - end; - end Make_Non_Public_Where_Possible; + Hide_Public_Entities (Declarations (N)); end if; -- If expander is not active, then here is where we turn off the |