diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
| -rw-r--r-- | gcc/ada/adaint.c | 14 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 132 | ||||
| -rw-r--r-- | gcc/ada/errout.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 3 |
8 files changed, 137 insertions, 90 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1bb4fdc..7b5a828 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2015-10-26 Joel Brobecker <brobecker@adacore.com brobecker> + + * adaint.c (__gnat_lwp_self): Replace current implementation re-using + the Linux one, which uses an __NR_gettid syscall rather than + pthread_self. + +2015-10-26 Arnaud Charlet <charlet@adacore.com> + + * sinfo.ads, exp_ch3.adb (Build_Array_Init_Proc, + Build_Record_Init_Proc): Do not inline init procs when + Modify_Tree_For_C is True. + +2015-10-26 Bob Duff <duff@adacore.com> + + * errout.ads: Minor comment fix. + * einfo.ads: Minor style fix. + +2015-10-26 Bob Duff <duff@adacore.com> + + * sem_ch3.adb (Derive_Interface_Subprogram): Fix + Is_Abstract_Subprogram, which might have been calculated + incorrectly, because we're passing Ultimate_Alias (Subp) (and + its dispatching type) to Derive_Subprogram, instead of the true + parent subprogram and type. + +2015-10-26 Bob Duff <duff@adacore.com> + + * sem_ch13.adb (Check_Iterator_Functions): When + printing the "default iterator must be unique" error message, + also print references to the places where the duplicates are + declared. This makes the message clearer. + 2015-10-26 Ed Schonberg <schonberg@adacore.com> * sem_ch12.adb (Analyze_Formal_Package_Declaration): Do not set diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index cb3e82c..6e18d94 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -3061,17 +3061,7 @@ __gnat_sals_init_using_constructors (void) #endif } -#if defined (__ANDROID__) - -#include <pthread.h> - -void * -__gnat_lwp_self (void) -{ - return (void *) pthread_self (); -} - -#elif defined (__linux__) +#if defined (__linux__) || defined (__ANDROID__) /* There is no function in the glibc to retrieve the LWP of the current thread. We need to do a system call in order to retrieve this information. */ @@ -3081,7 +3071,9 @@ __gnat_lwp_self (void) { return (void *) syscall (__NR_gettid); } +#endif +#if defined (__linux__) #include <sched.h> /* glibc versions earlier than 2.7 do not define the routines to handle diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index e2a236a..ae22e96 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -704,6 +704,12 @@ package Einfo is -- bodies. Set if the entity contains any ignored Ghost code in the form -- of declaration, procedure call, assignment statement or pragma. +-- Contract (Node34) +-- Defined in constant, entry, entry family, [generic] package, package +-- body, [generic] subprogram, subprogram body, and variable entities. +-- Points to the contract of the entity, holding various assertion items +-- and data classifiers. + -- Corresponding_Concurrent_Type (Node18) -- Defined in record types that are constructed by the expander to -- represent task and protected types (Is_Concurrent_Record_Type flag @@ -1123,12 +1129,6 @@ package Einfo is -- accept statement for a member of the family, and in the prefix of -- 'COUNT when it applies to a family member. --- Contract (Node34) --- Defined in constant, entry, entry family, [generic] package, package --- body, [generic] subprogram, subprogram body, and variable entities. --- Points to the contract of the entity, holding various assertion items --- and data classifiers. - -- Entry_Parameters_Type (Node15) -- Defined in entries. Points to the access-to-record type that is -- constructed by the expander to hold a reference to the parameter @@ -1519,16 +1519,16 @@ package Einfo is -- Defined in enumeration types. Set if the type as a representation -- clause whose entries are successive integers. --- Has_Controlling_Result (Flag98) --- Defined in E_Function entities. Set if the function is a primitive --- function of a tagged type which can dispatch on result. - -- Has_Controlled_Component (Flag43) [base type only] -- Defined in all type and subtype entities. Set only for composite type -- entities which contain a component that either is a controlled type, -- or itself contains controlled component (i.e. either Is_Controlled or -- Has_Controlled_Component is set for at least one component). +-- Has_Controlling_Result (Flag98) +-- Defined in E_Function entities. Set if the function is a primitive +-- function of a tagged type which can dispatch on result. + -- Has_Convention_Pragma (Flag119) -- Defined in all entities. Set for an entity for which a valid pragma -- Convention, Import, or Export has been given. Used to prevent more @@ -1836,19 +1836,19 @@ package Einfo is -- valid pragma Pack was given for the type. Note that this flag is not -- inherited by derived type. See also the Is_Packed flag. +-- Has_Pragma_Preelab_Init (Flag221) +-- Defined in type and subtype entities. If set indicates that a valid +-- pragma Preelaborable_Initialization applies to the type. + -- Has_Pragma_Pure (Flag203) -- Defined in all entities. If set, indicates that a valid pragma Pure -- was given for the entity. In some cases, we need to test whether -- Is_Pure was explicitly set using this pragma. --- Has_Pragma_Preelab_Init (Flag221) --- Defined in type and subtype entities. If set indicates that a valid --- pragma Preelaborable_Initialization applies to the type. - -- Has_Pragma_Pure_Function (Flag179) -- Defined in all entities. If set, 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. We also set +-- Pure_Function was given for the entity. In some cases, we need to test +-- whether Is_Pure was explicitly set using this pragma. We also set -- this flag for some internal entities that we know should be treated -- as pure for optimization purposes. @@ -2209,6 +2209,13 @@ package Einfo is -- carry the keyword aliased, and on record components that have the -- keyword. For Ada 2012, also applies to formal parameters. +-- Is_Array_Type (synthesized) +-- Applies to all entities, true for array types and subtypes + +-- Is_Asynchronous (Flag81) +-- Defined in all type entities and in procedure entities. Set +-- if a pragma Asynchronous applies to the entity. + -- Is_Atomic (Flag85) -- Defined in all type entities, and also in constants, components, and -- variables. Set if a pragma Atomic or Shared applies to the entity. @@ -2223,13 +2230,6 @@ package Einfo is -- usage. In the case of private and incomplete types, the predicate -- applies to both the partial view and the full view. --- Is_Array_Type (synthesized) --- Applies to all entities, true for array types and subtypes - --- Is_Asynchronous (Flag81) --- Defined in all type entities and in procedure entities. Set --- if a pragma Asynchronous applies to the entity. - -- Is_Base_Type (synthesized) -- Applies to type and subtype entities. True if entity is a base type @@ -2266,14 +2266,14 @@ package Einfo is -- Defined in all entities. Set only for defining entities of program -- units that are child units (but False for subunits). --- Is_Class_Wide_Type (synthesized) --- Applies to all entities, true for class wide types and subtypes - -- Is_Class_Wide_Equivalent_Type (Flag35) -- Defined in record types and subtypes. Set to True, if the type acts -- as a class-wide equivalent type, i.e. the Equivalent_Type field of -- some class-wide subtype entity references this record type. +-- Is_Class_Wide_Type (synthesized) +-- Applies to all entities, true for class wide types and subtypes + -- Is_Compilation_Unit (Flag149) -- Defined in all entities. Set if the entity is a package or subprogram -- entity for a compilation unit other than a subunit (since we treat @@ -2360,13 +2360,13 @@ package Einfo is -- Defined in all entities. True if the entity is type System.Address, -- or (recursively) a subtype or derived type of System.Address. --- Is_Discrete_Type (synthesized) --- Applies to all entities, true for all discrete types and subtypes - -- Is_Discrete_Or_Fixed_Point_Type (synthesized) -- Applies to all entities, true for all discrete types and subtypes -- and all fixed-point types and subtypes. +-- Is_Discrete_Type (synthesized) +-- Applies to all entities, true for all discrete types and subtypes + -- Is_Discrim_SO_Function (Flag176) -- Defined in all entities. Set only in E_Function entities that Layout -- creates to compute discriminant-dependent dynamic size/offset values. @@ -2404,9 +2404,6 @@ package Einfo is -- of pragma Eliminate. Also used to mark subprogram entities whose -- declaration and body are within unreachable code that is removed. --- Is_Enumeration_Type (synthesized) --- Defined in all entities, true for enumeration types and subtypes - -- Is_Entry (synthesized) -- Applies to all entities, True only for entry and entry family -- entities and False for all other entity kinds. @@ -2416,6 +2413,9 @@ package Einfo is -- be in, in-out or out parameters). This flag is used to speed up the -- test for the need to replace references in Exp_Ch2. +-- Is_Enumeration_Type (synthesized) +-- Defined in all entities, true for enumeration types and subtypes + -- Is_Exported (Flag99) -- Defined in all entities. Set if the entity is exported. For now we -- only allow the export of constants, exceptions, functions, procedures @@ -2807,14 +2807,14 @@ package Einfo is -- Applies to all entities, true for ordinary fixed point types and -- subtypes. --- Is_Package_Or_Generic_Package (synthesized) --- Applies to all entities. True for packages and generic packages. --- False for all other entities. - -- Is_Package_Body_Entity (Flag160) -- Defined in all entities. Set for entities defined at the top level -- of a package body. Used to control externally generated names. +-- Is_Package_Or_Generic_Package (synthesized) +-- Applies to all entities. True for packages and generic packages. +-- False for all other entities. + -- Is_Packed (Flag51) [implementation base type only] -- Defined in all type entities. This flag is set only for record and -- array types which have a packed representation. There are three @@ -2946,6 +2946,10 @@ package Einfo is -- Defined in types that are interfaces. True if interface is declared -- protected, or is derived from protected interfaces. +-- Is_Protected_Record_Type (synthesized) +-- Applies to all entities, true if Is_Concurrent_Record_Type is true and +-- Corresponding_Concurrent_Type is a protected type. + -- Is_Protected_Type (synthesized) -- Applies to all entities, true for protected types and subtypes @@ -2956,10 +2960,6 @@ package Einfo is -- example in the case of a variable name, then the backend will generate -- an appropriate external name for use by the linker. --- Is_Protected_Record_Type (synthesized) --- Applies to all entities, true if Is_Concurrent_Record_Type is true and --- Corresponding_Concurrent_Type is a protected type. - -- Is_Pure (Flag44) -- Defined in all entities. Set in all entities of a unit to which a -- pragma Pure is applied except for non-intrinsic imported subprograms, @@ -3772,16 +3772,16 @@ package Einfo is -- in the shadow entity, it points to the proper location in which to -- restore the private view saved in the shadow. +-- Protected_Body_Subprogram (Node11) +-- Defined in protected operations. References the entity for the +-- subprogram which implements the body of the operation. + -- Protected_Formal (Node22) -- Defined in formal parameters (in, in out and out parameters). Used -- only for formals of protected operations. References corresponding -- formal parameter in the unprotected version of the operation that -- is created during expansion. --- Protected_Body_Subprogram (Node11) --- Defined in protected operations. References the entity for the --- subprogram which implements the body of the operation. - -- Protection_Object (Node23) -- Applies to protected entries, entry families and subprograms. Denotes -- the entity which is used to rename the _object component of protected @@ -3902,13 +3902,6 @@ package Einfo is -- is True only for implicitly declared subprograms; it is not set on the -- parent type's subprogram. See also Is_Abstract_Subprogram. --- Return_Present (Flag54) --- Defined in function and generic function entities. Set if the --- function contains a return statement (used for error checking). --- This flag can also be set in procedure and generic procedure --- entities (for convenience in setting it), but is only tested --- for the function case. - -- Return_Applies_To (Node8) -- Defined in E_Return_Statement. Points to the entity representing -- the construct to which the return statement applies, as defined in @@ -3916,6 +3909,13 @@ package Einfo is -- extended_return_statement applies to the extended_return_statement, -- even though it causes the whole function to return. +-- Return_Present (Flag54) +-- Defined in function and generic function entities. Set if the +-- function contains a return statement (used for error checking). +-- This flag can also be set in procedure and generic procedure +-- entities (for convenience in setting it), but is only tested +-- for the function case. + -- Returns_By_Ref (Flag90) -- Defined in function entities. Set if the function returns the result -- by reference, either because its return type is a by-reference-type @@ -4127,6 +4127,21 @@ package Einfo is -- are fully analyzed and typed with the base type of the subtype. Note -- that all entries are static and have values within the subtype range. +-- Static_Elaboration_Desired (Flag77) +-- Defined in library-level packages. Set by the pragma of the same +-- name, to indicate that static initialization must be attempted for +-- all types declared in the package, and that a warning must be emitted +-- for those types to which static initialization is not available. + +-- Static_Initialization (Node30) +-- Defined in initialization procedures for types whose objects can be +-- initialized statically. The value of this attribute is a positional +-- aggregate whose components are compile-time static values. Used +-- when available in object declarations to eliminate the call to the +-- initialization procedure, and to minimize elaboration code. Note: +-- This attribute uses the same field as Overridden_Operation, which is +-- irrelevant in init_procs. + -- Static_Real_Or_String_Predicate (Node25) -- Defined in real types/subtypes with static predicates (with the two -- flags Has_Predicates and Has_Static_Predicate set). Set if the type @@ -4156,21 +4171,6 @@ package Einfo is -- or the declaration of a "hook" object. -- In which case is it a flag, or a hook object??? --- Static_Elaboration_Desired (Flag77) --- Defined in library-level packages. Set by the pragma of the same --- name, to indicate that static initialization must be attempted for --- all types declared in the package, and that a warning must be emitted --- for those types to which static initialization is not available. - --- Static_Initialization (Node30) --- Defined in initialization procedures for types whose objects can be --- initialized statically. The value of this attribute is a positional --- aggregate whose components are compile-time static values. Used --- when available in object declarations to eliminate the call to the --- initialization procedure, and to minimize elaboration code. Note: --- This attribute uses the same field as Overridden_Operation, which is --- irrelevant in init_procs. - -- Storage_Size_Variable (Node26) [implementation base type only] -- Defined in access types and task type entities. This flag is set -- if a valid and effective pragma Storage_Size applies to the base diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 35e5a97..be0c936 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -111,9 +111,6 @@ package Errout is -- This normal suppression action may be overridden in cases 2-5 (but not -- in case 1 or 7 by setting All_Errors mode, or by setting the special -- unconditional message insertion character (!) as described below. - -- This normal suppression action may be overridden in cases 2-5 (but - -- not in case 1) by setting All_Errors mode, or by setting the special - -- unconditional message insertion character (!) as described below. --------------------------------------------------------- -- Error Message Text and Message Insertion Characters -- diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 4718ff5..04d1fc8 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -760,8 +760,10 @@ package body Exp_Ch3 is -- want to inline, because nested stuff may cause difficulties in -- inter-unit inlining, and furthermore there is in any case no -- point in inlining such complex init procs. + -- Also do not inline in case of Modify_Tree_For_C where front-end + -- inlining is used and may not always play well with init procs. - if not Has_Task (Proc_Id) then + if not Has_Task (Proc_Id) and then not Modify_Tree_For_C then Set_Is_Inlined (Proc_Id); end if; @@ -3598,9 +3600,12 @@ package body Exp_Ch3 is -- In addition, when compiled for another unit for inlining purposes, -- it may make reference to entities that have not been elaborated -- yet. Similar considerations apply to task types. + -- Also do not inline in case of Modify_Tree_For_C where front-end + -- inlining is used and may not always play well with init procs. if not Is_Concurrent_Type (Rec_Type) and then not Has_Task (Rec_Type) + and then not Modify_Tree_For_C then Set_Is_Inlined (Proc_Id); end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e3b6bf7..06b5cf8 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4219,8 +4219,6 @@ package body Sem_Ch13 is ------------------------------ procedure Check_Iterator_Functions is - Default : Entity_Id; - function Valid_Default_Iterator (Subp : Entity_Id) return Boolean; -- Check one possible interpretation for validity @@ -4277,8 +4275,8 @@ package body Sem_Ch13 is end if; else - Default := Empty; declare + Default : Entity_Id := Empty; I : Interp_Index; It : Interp; @@ -4292,6 +4290,10 @@ package body Sem_Ch13 is elsif Present (Default) then Error_Msg_N ("default iterator must be unique", Expr); + Error_Msg_Sloc := Sloc (Default); + Error_Msg_N ("\\possible interpretation#", Expr); + Error_Msg_Sloc := Sloc (It.Nam); + Error_Msg_N ("\\possible interpretation#", Expr); else Default := It.Nam; @@ -4299,12 +4301,12 @@ package body Sem_Ch13 is Get_Next_Interp (I, It); end loop; - end; - if Present (Default) then - Set_Entity (Expr, Default); - Set_Is_Overloaded (Expr, False); - end if; + if Present (Default) then + Set_Entity (Expr, Default); + Set_Is_Overloaded (Expr, False); + end if; + end; end if; end Check_Iterator_Functions; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 4355329..09c72f7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15012,11 +15012,27 @@ package body Sem_Ch3 is -- Given that this new interface entity corresponds with a primitive -- of the parent that was not overridden we must leave it associated -- with its parent primitive to ensure that it will share the same - -- dispatch table slot when overridden. + -- dispatch table slot when overridden. We must set the Alias to Subp + -- (instead of Iface_Subp), and we must fix Is_Abstract_Subprogram + -- (in case we inherited Subp from Iface_Type via a nonabstract + -- generic formal type). if No (Actual_Subp) then Set_Alias (New_Subp, Subp); + declare + T : Entity_Id := Find_Dispatching_Type (Subp); + begin + while Etype (T) /= T loop + if Is_Generic_Type (T) and then not Is_Abstract_Type (T) then + Set_Is_Abstract_Subprogram (New_Subp, False); + exit; + end if; + + T := Etype (T); + end loop; + end; + -- For instantiations this is not needed since the previous call to -- Derive_Subprogram leaves the entity well decorated. diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 5f2f092..3528f9f 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -735,6 +735,9 @@ package Sinfo is -- they are systematically expanded into loops (for arrays) and -- individual assignments (for records). + -- Initialization procedures (init procs) for records and arrays are + -- not inlined. + ------------------------------------ -- Description of Semantic Fields -- ------------------------------------ |