From 1e60643a12e9c6d8278fd8531b0ccfdfbe920f43 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 2 May 2016 11:23:49 +0200 Subject: [PATCH] [multiple changes] 2016-05-02 Hristian Kirtchev * sem_ch4.adb (Find_Indexing_Operations): Use the underlying type of the container base type in case the container is a subtype. * sem_ch5.adb (Analyze_Iterator_Specification): Ensure that the selector has an entity when checking for a component of a mutable object. 2016-05-02 Arnaud Charlet Remove dead code. * opt.ads (Latest_Ada_Only): New flag. * sem_prag.adb, par-prag.adb: Ignore pragma Ada_xx under this flag. * usage.adb, switch-c.adb: Disable support for -gnatxx under this flag. * einfo.ads (Has_Predicates, Predicate_Function): Clarify that Has_Predicates does not imply that Predicate_Function will return a non-empty entity. 2016-05-02 Ed Schonberg * sem_res.adb (Resolve_Qualified_Expression): Generate a predicate check if type requires it. * checks.adb (Apply_Predicate_Check): Disable checks in the object declaration created for an expression with side-effects that requires a predicate check to prevent infinite recursion during expansion. 2016-05-02 Ed Schonberg * sem_ch6.adb (Process_Formals): Check properly the type of a formal to determine whether a given convention applies to it. 2016-05-02 Doug Rupp * tracebak.c: Add incantations for arm-vxworks[67] traceback. 2016-05-02 Thomas Quinot * freeze.adb (Check_Component_Storage_Order): Make it a warning, not an error, to have a component with implicit SSO within a composite type that has explicit SSO. 2016-05-02 Bob Duff * s-stposu.adb (Allocate_Any_Controlled): Don't lock/unlock twice. 2016-05-02 Ed Schonberg * repinfo.adb (List_Entities): Make procedure recursive, to provide representation information for subprograms declared within subprogram bodies. From-SVN: r235713 --- gcc/ada/ChangeLog | 52 ++++++++++++++++++ gcc/ada/checks.adb | 23 ++++++-- gcc/ada/einfo.ads | 11 ++++ gcc/ada/freeze.adb | 14 ++--- gcc/ada/opt.ads | 7 ++- gcc/ada/par-prag.adb | 20 ++++--- gcc/ada/repinfo.adb | 25 +++++++-- gcc/ada/s-stposu.adb | 123 +++++++++++++++++++++++-------------------- gcc/ada/sem_ch4.adb | 4 +- gcc/ada/sem_ch5.adb | 4 +- gcc/ada/sem_ch6.adb | 30 ++++++----- gcc/ada/sem_prag.adb | 71 +++++++++++-------------- gcc/ada/sem_res.adb | 18 +++++++ gcc/ada/switch-c.adb | 12 +++-- gcc/ada/tracebak.c | 21 +++++++- gcc/ada/usage.adb | 50 +++++++----------- 16 files changed, 313 insertions(+), 172 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4f67c19819f..58115af2808 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,55 @@ +2016-05-02 Hristian Kirtchev + + * sem_ch4.adb (Find_Indexing_Operations): Use the underlying type + of the container base type in case the container is a subtype. + * sem_ch5.adb (Analyze_Iterator_Specification): Ensure that + the selector has an entity when checking for a component of a + mutable object. + +2016-05-02 Arnaud Charlet + + Remove dead code. + * opt.ads (Latest_Ada_Only): New flag. + * sem_prag.adb, par-prag.adb: Ignore pragma Ada_xx under this flag. + * usage.adb, switch-c.adb: Disable support for -gnatxx under this flag. + * einfo.ads (Has_Predicates, Predicate_Function): + Clarify that Has_Predicates does not imply that Predicate_Function + will return a non-empty entity. + +2016-05-02 Ed Schonberg + + * sem_res.adb (Resolve_Qualified_Expression): Generate a predicate + check if type requires it. + * checks.adb (Apply_Predicate_Check): Disable checks in the + object declaration created for an expression with side-effects + that requires a predicate check to prevent infinite recursion + during expansion. + +2016-05-02 Ed Schonberg + + * sem_ch6.adb (Process_Formals): Check properly the type of a + formal to determine whether a given convention applies to it. + +2016-05-02 Doug Rupp + + * tracebak.c: Add incantations for arm-vxworks[67] traceback. + +2016-05-02 Thomas Quinot + + * freeze.adb (Check_Component_Storage_Order): Make it a warning, not an + error, to have a component with implicit SSO within a composite type + that has explicit SSO. + +2016-05-02 Bob Duff + + * s-stposu.adb (Allocate_Any_Controlled): Don't lock/unlock twice. + +2016-05-02 Ed Schonberg + + * repinfo.adb (List_Entities): Make procedure recursive, to + provide representation information for subprograms declared + within subprogram bodies. + 2016-05-02 Arnaud Charlet * exp_ch5.adb, layout.adb, gnatcmd.adb exp_attr.adb, make.adb, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 47fe1bfe63f..ca499e49d44 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2667,8 +2667,10 @@ package body Checks is S : Entity_Id; begin - if Present (Predicate_Function (Typ)) then + if Predicate_Checks_Suppressed (Empty) then + return; + elsif Present (Predicate_Function (Typ)) then S := Current_Scope; while Present (S) and then not Is_Subprogram (S) loop S := Scope (S); @@ -2703,8 +2705,21 @@ package body Checks is Check_Expression_Against_Static_Predicate (N, Typ); - Insert_Action (N, - Make_Predicate_Check (Typ, Duplicate_Subexpr (N))); + if Is_Entity_Name (N) then + Insert_Action (N, + Make_Predicate_Check + (Typ, New_Occurrence_Of (Entity (N), Sloc (N)))); + + -- If the expression is not an entity it may have side-effects, + -- and the following call will create an object declaration for + -- it. We disable checks during its analysis, to prevent an + -- infinite recursion. + + else + Insert_Action (N, + Make_Predicate_Check (Typ, Duplicate_Subexpr (N)), + Suppress => All_Checks); + end if; end if; end if; end Apply_Predicate_Check; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index e8cee391b5f..df42700c06d 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1910,6 +1910,9 @@ package Einfo is -- Defined in type and subtype entities. Set if a pragma Predicate or -- Predicate aspect applies to the type or subtype, or if it inherits a -- Predicate aspect from its parent or progenitor types. +-- +-- Note: this flag is set on both partial and full view of types to which +-- a Predicate pragma or aspect applies. -- Has_Primitive_Operations (Flag120) [base type only] -- Defined in all type entities. Set if at least one primitive operation @@ -3747,6 +3750,14 @@ package Einfo is -- which takes a single argument of the given type, and returns True if -- the predicate holds and False if it does not. -- +-- Note: flag Has_Predicate does not imply that Predicate_Function is set +-- to a non-empty entity; this happens, for example, for itypes created +-- when instantiating generic units with private types with predicates. +-- However, if an explicit pragma Predicate or Predicate aspect is given +-- either for private or full type declaration then both Has_Predicates +-- and a non-empty Predicate_Function will be set on both the partial and +-- full views of the type. +-- -- Note: the reason this is marked as a synthesized attribute is that the -- way this is stored is as an element of the Subprograms_For_Type field. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 74e1688c7b6..c96435ce4f8 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1269,13 +1269,6 @@ package body Freeze is & "parent", Err_Node); end if; - -- If enclosing composite has explicit SSO then nested composite must - -- have explicit SSO as well. - - elsif Present (ADC) and then No (Comp_ADC) then - Error_Msg_N ("nested composite must have explicit scalar " - & "storage order", Err_Node); - -- If component and composite SSO differs, check that component -- falls on byte boundaries and isn't packed. @@ -1306,6 +1299,13 @@ package body Freeze is Error_Msg_N ("type of non-byte-aligned component must have same scalar " & "storage order as enclosing composite", Err_Node); + + -- Warn if specified only for the outer composite + + elsif Present (ADC) and then No (Comp_ADC) then + Error_Msg_NE + ("scalar storage order specified for& doesn''t " + & "apply to component?", Err_Node, Encl_Type); end if; end if; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index ad4ab8155c8..6feb21c89a5 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -112,6 +112,11 @@ package Opt is -- case of some binder variables, Gnatbind.Scan_Bind_Arg may modify -- the default values. + Latest_Ada_Only : Boolean := False; + -- If True, the only value valid for Ada_Version is Ada_Version_Type'Last, + -- trying to specify other values will be ignored (in case of pragma + -- Ada_xxx) or generate an error (in case of -gnat83/95/xx switches). + type Ada_Version_Type is (Ada_83, Ada_95, Ada_2005, Ada_2012); pragma Ordered (Ada_Version_Type); -- Versions of Ada for Ada_Version below. Note that these are ordered, diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 123f9090ff7..56299140d4d 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -329,9 +329,11 @@ begin -- Ada version syntax. when Pragma_Ada_83 => - Ada_Version := Ada_83; - Ada_Version_Explicit := Ada_83; - Ada_Version_Pragma := Pragma_Node; + if not Latest_Ada_Only then + Ada_Version := Ada_83; + Ada_Version_Explicit := Ada_83; + Ada_Version_Pragma := Pragma_Node; + end if; ------------ -- Ada_95 -- @@ -342,9 +344,11 @@ begin -- Ada version syntax. when Pragma_Ada_95 => - Ada_Version := Ada_95; - Ada_Version_Explicit := Ada_95; - Ada_Version_Pragma := Pragma_Node; + if not Latest_Ada_Only then + Ada_Version := Ada_95; + Ada_Version_Explicit := Ada_95; + Ada_Version_Pragma := Pragma_Node; + end if; --------------------- -- Ada_05/Ada_2005 -- @@ -356,7 +360,7 @@ begin -- must be processed at parse time. when Pragma_Ada_05 | Pragma_Ada_2005 => - if Arg_Count = 0 then + if Arg_Count = 0 and not Latest_Ada_Only then Ada_Version := Ada_2005; Ada_Version_Explicit := Ada_2005; Ada_Version_Pragma := Pragma_Node; diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 4d710a3afb4..28bdc4495ac 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -135,10 +135,15 @@ package body Repinfo is -- Called before outputting anything for an entity. Ensures that -- a blank line precedes the output for a particular entity. - procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean); + procedure List_Entities + (Ent : Entity_Id; + Bytes_Big_Endian : Boolean; + In_Subprogram : Boolean := False); -- This procedure lists the entities associated with the entity E, starting -- with the First_Entity and using the Next_Entity link. If a nested -- package is found, entities within the package are recursively processed. + -- When recursing within a subprogram body, Is_Subprogram suppresses + -- duplicate information about signature. procedure List_Name (Ent : Entity_Id); -- List name of entity Ent in appropriate case. The name is listed with @@ -314,7 +319,11 @@ package body Repinfo is -- List_Entities -- ------------------- - procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is + procedure List_Entities + (Ent : Entity_Id; + Bytes_Big_Endian : Boolean; + In_Subprogram : Boolean := False) + is Body_E : Entity_Id; E : Entity_Id; @@ -353,12 +362,15 @@ package body Repinfo is and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration then -- If entity is a subprogram and we are listing mechanisms, - -- then we need to list mechanisms for this entity. + -- then we need to list mechanisms for this entity. We skip this + -- if it is a nested subprogram, as the information has already + -- been produced when listing the enclosing scope. if List_Representation_Info_Mechanisms and then (Is_Subprogram (Ent) or else Ekind (Ent) = E_Entry or else Ekind (Ent) = E_Entry_Family) + and then not In_Subprogram then Need_Blank_Line := True; List_Mechanisms (Ent); @@ -386,6 +398,13 @@ package body Repinfo is List_Mechanisms (E); end if; + -- Recurse into entities local to subprogram + + List_Entities (E, Bytes_Big_Endian, True); + + elsif Ekind (E) in Formal_Kind and then In_Subprogram then + null; + elsif Ekind_In (E, E_Entry, E_Entry_Family, E_Subprogram_Type) diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb index c7d2819ca9c..1ea23b3304e 100644 --- a/gcc/ada/s-stposu.adb +++ b/gcc/ada/s-stposu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2011-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -123,9 +123,6 @@ package body System.Storage_Pools.Subpools is N_Size : Storage_Count; Subpool : Subpool_Handle := null; - Allocation_Locked : Boolean; - -- This flag stores the state of the associated collection - Header_And_Padding : Storage_Offset; -- This offset includes the size of a FM_Node plus any additional -- padding due to a larger alignment. @@ -170,25 +167,25 @@ package body System.Storage_Pools.Subpools is else -- If the master is missing, then the expansion of the access type - -- failed to create one. This is a serious error. + -- failed to create one. This is a compiler bug. - if Context_Master = null then - raise Program_Error - with "missing master in pool allocation"; + pragma Assert + (Context_Master /= null, "missing master in pool allocation"); -- If a subpool is present, then this is the result of erroneous -- allocator expansion. This is not a serious error, but it should -- still be detected. - elsif Context_Subpool /= null then + if Context_Subpool /= null then raise Program_Error with "subpool not required in pool allocation"; + end if; -- If the allocation is intended to be on a subpool, but the access -- type's pool does not support subpools, then this is the result of - -- erroneous end-user code. + -- incorrect end-user code. - elsif On_Subpool then + if On_Subpool then raise Program_Error with "pool of access type does not support subpools"; end if; @@ -209,24 +206,20 @@ package body System.Storage_Pools.Subpools is -- Write - finalization Lock_Task.all; - Allocation_Locked := Finalization_Started (Master.all); - Unlock_Task.all; -- Do not allow the allocation of controlled objects while the -- associated master is being finalized. - if Allocation_Locked then + if Finalization_Started (Master.all) then raise Program_Error with "allocation after finalization started"; end if; -- Check whether primitive Finalize_Address is available. If it is -- not, then either the expansion of the designated type failed or - -- the expansion of the allocator failed. This is a serious error. + -- the expansion of the allocator failed. This is a compiler bug. - if Fin_Address = null then - raise Program_Error - with "primitive Finalize_Address not available"; - end if; + pragma Assert + (Fin_Address /= null, "primitive Finalize_Address not available"); -- The size must acount for the hidden header preceding the object. -- Account for possible padding space before the header due to a @@ -262,7 +255,7 @@ package body System.Storage_Pools.Subpools is -- Step 4: Attachment if Is_Controlled then - Lock_Task.all; + -- Note that we already did "Lock_Task.all;" in Step 2 above. -- Map the allocated memory into a FM_Node record. This converts the -- top of the allocated bits into a list header. If there is padding @@ -334,6 +327,16 @@ package body System.Storage_Pools.Subpools is else Addr := N_Addr; end if; + + exception + when others => + -- If we locked, we want to unlock + + if Is_Controlled then + Unlock_Task.all; + end if; + + raise; end Allocate_Any_Controlled; ------------ @@ -384,59 +387,67 @@ package body System.Storage_Pools.Subpools is if Is_Controlled then Lock_Task.all; - -- Destroy the relation pair object - Finalize_Address since it is no - -- longer needed. + begin + -- Destroy the relation pair object - Finalize_Address since it is + -- no longer needed. - if Finalize_Address_Table_In_Use then + if Finalize_Address_Table_In_Use then - -- Synchronization: - -- Read - finalization - -- Write - allocation, deallocation + -- Synchronization: + -- Read - finalization + -- Write - allocation, deallocation - Delete_Finalize_Address_Unprotected (Addr); - end if; + Delete_Finalize_Address_Unprotected (Addr); + end if; - -- Account for possible padding space before the header due to a - -- larger alignment. + -- Account for possible padding space before the header due to a + -- larger alignment. - Header_And_Padding := Header_Size_With_Padding (Alignment); + Header_And_Padding := Header_Size_With_Padding (Alignment); - -- N_Addr N_Ptr Addr (from input) - -- | | | - -- V V V - -- +-------+---------------+----------------------+ - -- |Padding| Header | Object | - -- +-------+---------------+----------------------+ - -- ^ ^ ^ - -- | +- Header_Size -+ - -- | | - -- +- Header_And_Padding --+ + -- N_Addr N_Ptr Addr (from input) + -- | | | + -- V V V + -- +-------+---------------+----------------------+ + -- |Padding| Header | Object | + -- +-------+---------------+----------------------+ + -- ^ ^ ^ + -- | +- Header_Size -+ + -- | | + -- +- Header_And_Padding --+ - -- Convert the bits preceding the object into a list header + -- Convert the bits preceding the object into a list header - N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Size); + N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Size); - -- Detach the object from the related finalization master. This - -- action does not need to know the prior context used during - -- allocation. + -- Detach the object from the related finalization master. This + -- action does not need to know the prior context used during + -- allocation. - -- Synchronization: - -- Write - allocation, deallocation, finalization + -- Synchronization: + -- Write - allocation, deallocation, finalization - Detach_Unprotected (N_Ptr); + Detach_Unprotected (N_Ptr); - -- Move the address from the object to the beginning of the list - -- header. + -- Move the address from the object to the beginning of the list + -- header. - N_Addr := Addr - Header_And_Padding; + N_Addr := Addr - Header_And_Padding; - -- The size of the deallocated object must include the size of the - -- hidden list header. + -- The size of the deallocated object must include the size of the + -- hidden list header. - N_Size := Storage_Size + Header_And_Padding; + N_Size := Storage_Size + Header_And_Padding; - Unlock_Task.all; + Unlock_Task.all; + exception + when others => + -- If we locked, we want to unlock + + Unlock_Task.all; + raise; + end; else N_Addr := Addr; N_Size := Storage_Size; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index fdefb004a7e..e31704b818c 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7619,12 +7619,14 @@ package body Sem_Ch4 is begin Typ := T; + -- Use the specific type when the parameter type is class-wide + if Is_Class_Wide_Type (Typ) then Typ := Root_Type (Typ); end if; Ref := Empty; - Typ := Underlying_Type (Typ); + Typ := Underlying_Type (Base_Type (Typ)); Inspect_Primitives (Typ, Ref); Inspect_Declarations (Typ, Ref); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 5dcdf445c81..bdfe02e4572 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1817,7 +1817,7 @@ package body Sem_Ch5 is Bas : Entity_Id; Typ : Entity_Id; - -- Start of processing for Analyze_iterator_Specification + -- Start of processing for Analyze_Iterator_Specification begin Enter_Name (Def_Id); @@ -2207,6 +2207,8 @@ package body Sem_Ch5 is -- be performed. if Nkind (Orig_Iter_Name) = N_Selected_Component + and then + Present (Entity (Selector_Name (Orig_Iter_Name))) and then Ekind_In (Entity (Selector_Name (Orig_Iter_Name)), E_Component, diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9b821485155..06937225957 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -10792,24 +10792,28 @@ package body Sem_Ch6 is -- Force call by reference if aliased - if Is_Aliased (Formal) then - Set_Mechanism (Formal, By_Reference); + declare + Conv : constant Convention_Id := Convention (Etype (Formal)); + begin + if Is_Aliased (Formal) then + Set_Mechanism (Formal, By_Reference); - -- Warn if user asked this to be passed by copy + -- Warn if user asked this to be passed by copy - if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then - Error_Msg_N - ("cannot pass aliased parameter & by copy??", Formal); - end if; + if Conv = Convention_Ada_Pass_By_Copy then + Error_Msg_N + ("cannot pass aliased parameter & by copy??", Formal); + end if; - -- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy + -- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy - elsif Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then - Set_Mechanism (Formal, By_Copy); + elsif Conv = Convention_Ada_Pass_By_Copy then + Set_Mechanism (Formal, By_Copy); - elsif Convention (Formal_Type) = Convention_Ada_Pass_By_Reference then - Set_Mechanism (Formal, By_Reference); - end if; + elsif Conv = Convention_Ada_Pass_By_Reference then + Set_Mechanism (Formal, By_Reference); + end if; + end; <> Next (Param_Spec); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c02cb0f2e8c..2516df2b245 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5203,32 +5203,22 @@ package body Sem_Prag is Handler_Proc := Find_Unique_Parameterless_Procedure (Arg1_X, Arg1); Proc_Scope := Scope (Handler_Proc); - -- On AAMP only, a pragma Interrupt_Handler is supported for - -- nonprotected parameterless procedures. - - if not AAMP_On_Target - or else Prag_Id = Pragma_Attach_Handler - then - if Ekind (Proc_Scope) /= E_Protected_Type then - Error_Pragma_Arg - ("argument of pragma% must be protected procedure", Arg1); - end if; + if Ekind (Proc_Scope) /= E_Protected_Type then + Error_Pragma_Arg + ("argument of pragma% must be protected procedure", Arg1); + end if; - -- For pragma case (as opposed to access case), check placement. - -- We don't need to do that for aspects, because we have the - -- check that they aspect applies an appropriate procedure. + -- For pragma case (as opposed to access case), check placement. + -- We don't need to do that for aspects, because we have the + -- check that they aspect applies an appropriate procedure. - if not From_Aspect_Specification (N) - and then Parent (N) /= Protected_Definition (Parent (Proc_Scope)) - then - Error_Pragma ("pragma% must be in protected definition"); - end if; + if not From_Aspect_Specification (N) + and then Parent (N) /= Protected_Definition (Parent (Proc_Scope)) + then + Error_Pragma ("pragma% must be in protected definition"); end if; - if not Is_Library_Level_Entity (Proc_Scope) - or else (AAMP_On_Target - and then not Is_Library_Level_Entity (Handler_Proc)) - then + if not Is_Library_Level_Entity (Proc_Scope) then Error_Pragma_Arg ("argument for pragma% must be library level entity", Arg1); end if; @@ -9027,14 +9017,9 @@ package body Sem_Prag is Mark_Pragma_As_Ghost (N, Handler); Set_Is_Interrupt_Handler (Handler); - -- If the pragma is not associated with a handler procedure within a - -- protected type, then it must be for a nonprotected procedure for - -- the AAMP target, in which case we don't associate a representation - -- item with the procedure's scope. + pragma Assert (Ekind (Prot_Typ) = E_Protected_Type); - if Ekind (Prot_Typ) = E_Protected_Type then - Record_Rep_Item (Prot_Typ, N); - end if; + Record_Rep_Item (Prot_Typ, N); -- Chain the pragma on the contract for completeness @@ -11064,9 +11049,11 @@ package body Sem_Prag is -- Now set Ada 83 mode - Ada_Version := Ada_83; - Ada_Version_Explicit := Ada_83; - Ada_Version_Pragma := N; + if not Latest_Ada_Only then + Ada_Version := Ada_83; + Ada_Version_Explicit := Ada_83; + Ada_Version_Pragma := N; + end if; ------------ -- Ada_95 -- @@ -11096,9 +11083,11 @@ package body Sem_Prag is -- Now set Ada 95 mode - Ada_Version := Ada_95; - Ada_Version_Explicit := Ada_95; - Ada_Version_Pragma := N; + if not Latest_Ada_Only then + Ada_Version := Ada_95; + Ada_Version_Explicit := Ada_95; + Ada_Version_Pragma := N; + end if; --------------------- -- Ada_05/Ada_2005 -- @@ -11153,9 +11142,11 @@ package body Sem_Prag is -- Now set appropriate Ada mode - Ada_Version := Ada_2005; - Ada_Version_Explicit := Ada_2005; - Ada_Version_Pragma := N; + if not Latest_Ada_Only then + Ada_Version := Ada_2005; + Ada_Version_Explicit := Ada_2005; + Ada_Version_Pragma := N; + end if; end if; end; @@ -28957,12 +28948,10 @@ package body Sem_Prag is begin -- If first character is asterisk, this is a link name, and we leave it -- completely unmodified. We also ignore null strings (the latter case - -- happens only in error cases) and no encoding should occur for AAMP - -- interface names. + -- happens only in error cases). if Len = 0 or else Get_String_Char (Str, 1) = Get_Char_Code ('*') - or else AAMP_On_Target then Set_Interface_Name (E, S); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 57a7fc9e539..bf326bf7285 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9445,6 +9445,24 @@ package body Sem_Res is if Nkind (N) = N_Qualified_Expression and then Is_Scalar_Type (Typ) then Apply_Scalar_Range_Check (Expr, Typ); end if; + + -- Finally, check whether a predicate applies to the target type. + -- This comes from AI12-0100. As for type conversions, check the + -- enclosing context to prevent an infinite expansion. + + if Has_Predicates (Target_Typ) then + if Nkind (Parent (N)) = N_Function_Call + and then Present (Name (Parent (N))) + and then (Is_Predicate_Function (Entity (Name (Parent (N)))) + or else + Is_Predicate_Function_M (Entity (Name (Parent (N))))) + then + null; + + elsif Nkind (N) = N_Qualified_Expression then + Apply_Predicate_Check (N, Target_Typ); + end if; + end if; end Resolve_Qualified_Expression; ------------------------------ diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 4ded20b7f2f..b282245ddcd 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1400,7 +1400,7 @@ package body Switch.C is Ptr := Ptr + 1; - if Switch_Chars (Ptr) /= '3' then + if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; @@ -1418,7 +1418,7 @@ package body Switch.C is Ptr := Ptr + 1; - if Switch_Chars (Ptr) /= '5' then + if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; @@ -1436,7 +1436,7 @@ package body Switch.C is Ptr := Ptr + 1; - if Switch_Chars (Ptr) /= '5' then + if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; @@ -1469,7 +1469,9 @@ package body Switch.C is if Ptr > Max - 3 then Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); - elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then + elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" + and then not Latest_Ada_Only + then Ada_Version := Ada_2005; elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c index 7b1849bdf03..7532ca2d71b 100644 --- a/gcc/ada/tracebak.c +++ b/gcc/ada/tracebak.c @@ -300,7 +300,20 @@ __gnat_backtrace (void **array, #define PC_ADJUST -2 /* The minimum size of call instructions on this architecture is 2 bytes */ -/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/ +/*---------------------- ARM VxWorks ------------------------------------*/ +#elif (defined (ARMEL) && defined (__vxworks)) + +#include "vxWorks.h" +#include "version.h" + +#define USE_GCC_UNWINDER +#define PC_ADJUST -2 + +#if (_WRS_VXWORKS_MAJOR >= 7) +#define USING_ARM_UNWINDING 1 +#endif + +/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin --------------*/ #elif ((defined (_POWER) && defined (_AIX)) || \ (defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \ (defined (__ppc__) && defined (__APPLE__))) @@ -518,6 +531,12 @@ struct layout The condition is expressed the way above because we cannot reliably rely on any other macro from the base compiler when compiling stage1. */ +#ifdef USING_ARM_UNWINDING +/* This value is not part of the enumerated reason codes defined in unwind.h + for ARM style unwinding, but is used in the included "C" code, so we + define it to a reasonable value to avoid a compilation error. */ +#define _URC_NORMAL_STOP 0 +#endif #include "tb-gcc.c" /*------------------------------------------------------------------* diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 99edf948928..cb7d6a386b6 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -26,7 +26,6 @@ -- Warning: the output of this usage for warnings is duplicated in the GNAT -- reference manual. Be sure to update that if you change the warning list. -with Targparm; use Targparm; with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; @@ -91,19 +90,6 @@ begin Write_Eol; - -- Common GCC switches not available for AAMP targets - - if not AAMP_On_Target then - Write_Switch_Char ("fstack-check ", ""); - Write_Line ("Generate stack checking code"); - - Write_Switch_Char ("fno-inline ", ""); - Write_Line ("Inhibit all inlining (makes executable smaller)"); - - Write_Switch_Char ("fpreserve-control-flow ", ""); - Write_Line ("Preserve control flow for coverage analysis"); - end if; - -- Common switches available everywhere Write_Switch_Char ("g ", ""); @@ -681,29 +667,31 @@ begin Write_Switch_Char ("zr"); Write_Line ("Distribution stub generation for receiver stubs"); - -- Line for -gnat83 switch + if not Latest_Ada_Only then + -- Line for -gnat83 switch - Write_Switch_Char ("83"); - Write_Line ("Ada 83 mode"); + Write_Switch_Char ("83"); + Write_Line ("Ada 83 mode"); - -- Line for -gnat95 switch + -- Line for -gnat95 switch - Write_Switch_Char ("95"); + Write_Switch_Char ("95"); - if Ada_Version_Default = Ada_95 then - Write_Line ("Ada 95 mode (default)"); - else - Write_Line ("Ada 95 mode"); - end if; + if Ada_Version_Default = Ada_95 then + Write_Line ("Ada 95 mode (default)"); + else + Write_Line ("Ada 95 mode"); + end if; - -- Line for -gnat2005 switch + -- Line for -gnat2005 switch - Write_Switch_Char ("2005"); + Write_Switch_Char ("2005"); - if Ada_Version_Default = Ada_2005 then - Write_Line ("Ada 2005 mode (default)"); - else - Write_Line ("Ada 2005 mode"); + if Ada_Version_Default = Ada_2005 then + Write_Line ("Ada 2005 mode (default)"); + else + Write_Line ("Ada 2005 mode"); + end if; end if; -- Line for -gnat2012 switch -- 2.30.2