diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 71 | ||||
| -rwxr-xr-x | gcc/ada/aspects.adb | 1 | ||||
| -rwxr-xr-x | gcc/ada/aspects.ads | 55 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 60 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_intr.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 21 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 20 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/s-tasren.adb | 55 | ||||
| -rw-r--r-- | gcc/ada/s-tasren.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sinput-p.adb | 47 | ||||
| -rw-r--r-- | gcc/ada/snames.adb-tmpl | 3 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 3 | ||||
| -rw-r--r-- | gcc/ada/warnsw.adb | 3 |
21 files changed, 287 insertions, 101 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4d0daf49753..937fbee3d8d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,74 @@ +2012-02-08 Yannick Moy <moy@adacore.com> + + * gnat_rm.texi: Minor reshuffling to place restriction at + appropriate place. + +2012-02-08 Bob Duff <duff@adacore.com> + + * warnsw.adb (Set_Warning_Switch): Set Warn_On_Suspicious_Modulus_Value + False for '-gnatwA', to suppress these warnings. + +2012-02-08 Vincent Celier <celier@adacore.com> + + * sinput-p.adb (Source_File_Is_Subunit): Check for BOM before + starting to scan, so that UTF8 encoding is taken into account. + +2012-02-08 Arnaud Charlet <charlet@adacore.com> + + * s-tasren.adb, s-tasren.ads (Internal_Complete_Rendezvous): New + function. + (Complete_Rendezvous): Now call Internal_Complete_Rendezvous. + (Exceptional_Complete_Rendezvous): Mark No_Return. + +2012-02-08 Eric Botcazou <ebotcazou@adacore.com> + + * exp_aggr.adb (Compile_Time_Known_Composite_Value): + New predicate to compute whether a composite value can be + evaluated at compile time. + (Component_Not_OK_For_Backend): Use Compile_Time_Known_Value for all + expressions of elementary type and Compile_Time_Known_Composite_Value + for all other expressions. + (Expand_Record_Aggregate): Convert to assignments in the case + of a type with mutable components if the aggregate cannot be + built statically. + +2012-02-08 Gary Dismukes <dismukes@adacore.com> + + * aspects.ads (type Aspect_Id): Add Simple_Storage_Pool_Type. + (Impl_Defined_Aspects): Add association for + Aspect_Simple_Storage_Pool_Type. + (Aspect_Names): Add + association for Aspect_Simple_Storage_Pool_Type. + * aspects.adb: + (Canonical_Aspect): Add association for Simple_Storage_Pool_Type. + * exp_attr.adb (Expand_N_Attribute_Reference): + Change name to Name_Simple_Storage_Pool_Type. + * exp_ch4.adb (Expand_N_Allocator): Change + name to Name_Simple_Storage_Pool_Type. + * exp_intr.adb (Expand_Unc_Deallocation): Change name to + Name_Simple_Storage_Pool_Type. * freeze.adb (Freeze_Entity): + Change names to Name_Simple_Storage_Pool_Type. * par-prag.adb: + Change names to Name_Simple_Storage_Pool_Type. * sem_attr.adb: + (Analyze_Attribute): Change name to Name_Simple_Storage_Pool_Type. + * sem_ch13.adb (Analyze_Attribute_Definition_Clause): + Change name to Name_Simple_Storage_Pool_Type. + * sem_prag.adb: + (Analyze_Pragma): Change name to Name_Simple_Storage_Pool_Type. + (Sig_Flags): Change name to Name_Simple_Storage_Pool_Type. + * sem_res.adb (Resolve_Allocator): Change name to + Name_Simple_Storage_Pool_Type. * snames.ads-tmpl: + (Name_Simple_Storage_Pool_Type): New name constant. + (type Pragma_Id): Change name to Name_Simple_Storage_Pool_Type and + move to main pragma section because it no longer matches the + attribute name. + * snames.adb-tmpl (Get_Pragma_Id): Remove test for + Name_Simple_Storage_Pool. + (Is_Pragma_Name): Remove test for Name_Simple_Storage_Pool. + +2012-02-08 Robert Dewar <dewar@adacore.com> + + * gnat_ugn.texi: Add some clarification to -gnatwA and -gnatws. + 2012-02-08 Pascal Obry <obry@adacore.com> * prj.adb (Compute_All_Imported_Projects): Use new diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index d78ce81427a..69a789cc829 100755 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -299,6 +299,7 @@ package body Aspects is Aspect_Read => Aspect_Read, Aspect_Shared => Aspect_Atomic, Aspect_Simple_Storage_Pool => Aspect_Simple_Storage_Pool, + Aspect_Simple_Storage_Pool_Type => Aspect_Simple_Storage_Pool_Type, Aspect_Size => Aspect_Size, Aspect_Small => Aspect_Small, Aspect_Static_Predicate => Aspect_Predicate, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index bb713a42758..3c28af83b8f 100755 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -132,6 +132,7 @@ package Aspects is Aspect_Pure_Function, -- GNAT Aspect_Remote_Access_Type, -- GNAT Aspect_Shared, -- GNAT (equivalent to Atomic) + Aspect_Simple_Storage_Pool_Type, -- GNAT Aspect_Suppress_Debug_Info, -- GNAT Aspect_Unchecked_Union, Aspect_Universal_Aliasing, -- GNAT @@ -171,32 +172,33 @@ package Aspects is -- The following array identifies all implementation defined aspects Impl_Defined_Aspects : constant array (Aspect_Id) of Boolean := - (Aspect_Ada_2005 => True, - Aspect_Ada_2012 => True, - Aspect_Compiler_Unit => True, - Aspect_Dimension => True, - Aspect_Dimension_System => True, - Aspect_Favor_Top_Level => True, - Aspect_Inline_Always => True, - Aspect_Object_Size => True, - Aspect_Persistent_BSS => True, - Aspect_Predicate => True, - Aspect_Preelaborate_05 => True, - Aspect_Pure_05 => True, - Aspect_Pure_12 => True, - Aspect_Pure_Function => True, - Aspect_Remote_Access_Type => True, - Aspect_Shared => True, - Aspect_Simple_Storage_Pool => True, - Aspect_Suppress_Debug_Info => True, - Aspect_Test_Case => True, - Aspect_Universal_Data => True, - Aspect_Universal_Aliasing => True, - Aspect_Unmodified => True, - Aspect_Unreferenced => True, - Aspect_Unreferenced_Objects => True, - Aspect_Value_Size => True, - others => False); + (Aspect_Ada_2005 => True, + Aspect_Ada_2012 => True, + Aspect_Compiler_Unit => True, + Aspect_Dimension => True, + Aspect_Dimension_System => True, + Aspect_Favor_Top_Level => True, + Aspect_Inline_Always => True, + Aspect_Object_Size => True, + Aspect_Persistent_BSS => True, + Aspect_Predicate => True, + Aspect_Preelaborate_05 => True, + Aspect_Pure_05 => True, + Aspect_Pure_12 => True, + Aspect_Pure_Function => True, + Aspect_Remote_Access_Type => True, + Aspect_Shared => True, + Aspect_Simple_Storage_Pool => True, + Aspect_Simple_Storage_Pool_Type => True, + Aspect_Suppress_Debug_Info => True, + Aspect_Test_Case => True, + Aspect_Universal_Data => True, + Aspect_Universal_Aliasing => True, + Aspect_Unmodified => True, + Aspect_Unreferenced => True, + Aspect_Unreferenced_Objects => True, + Aspect_Value_Size => True, + others => False); -- The following array indicates aspects for which multiple occurrences of -- the same aspect attached to the same declaration are allowed. @@ -368,6 +370,7 @@ package Aspects is Aspect_Shared => Name_Shared, Aspect_Shared_Passive => Name_Shared_Passive, Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool, + Aspect_Simple_Storage_Pool_Type => Name_Simple_Storage_Pool_Type, Aspect_Size => Name_Size, Aspect_Small => Name_Small, Aspect_Static_Predicate => Name_Static_Predicate, diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 94f2c3dd68d..10cb04c1628 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5115,6 +5115,14 @@ package body Exp_Aggr is -- and the aggregate can be constructed statically and handled by -- the back-end. + function Compile_Time_Known_Composite_Value (N : Node_Id) return Boolean; + -- Returns true if N is an expression of composite type which can be + -- fully evaluated at compile time without raising constraint error. + -- Such expressions can be passed as is to Gigi without any expansion. + -- + -- This returns true for N_Aggregate with Compile_Time_Known_Aggregate + -- set and constants whose expression is such an aggregate, recursively. + function Component_Not_OK_For_Backend return Boolean; -- Check for presence of component which makes it impossible for the -- backend to process the aggregate, thus requiring the use of a series @@ -5145,6 +5153,46 @@ package body Exp_Aggr is -- For nested aggregates return the ultimate enclosing aggregate; for -- non-nested aggregates return N. + ---------------------------------------- + -- Compile_Time_Known_Composite_Value -- + ---------------------------------------- + + function Compile_Time_Known_Composite_Value (N : Node_Id) return Boolean + is + + begin + -- If we have an entity name, then see if it is the name of a + -- constant and if so, test the corresponding constant value. + + if Is_Entity_Name (N) then + declare + E : constant Entity_Id := Entity (N); + V : Node_Id; + + begin + if Ekind (E) /= E_Constant then + return False; + end if; + + V := Constant_Value (E); + return Present (V) + and then Compile_Time_Known_Composite_Value (V); + end; + + -- We have a value, see if it is compile time known + + else + if Nkind (N) = N_Aggregate then + return Compile_Time_Known_Aggregate (N); + end if; + + -- All other types of values are not known at compile time + + return False; + end if; + + end Compile_Time_Known_Composite_Value; + ---------------------------------- -- Component_Not_OK_For_Backend -- ---------------------------------- @@ -5201,14 +5249,12 @@ package body Exp_Aggr is return True; end if; - if Is_Scalar_Type (Etype (Expr_Q)) then + if Is_Elementary_Type (Etype (Expr_Q)) then if not Compile_Time_Known_Value (Expr_Q) then Static_Components := False; end if; - elsif Nkind (Expr_Q) /= N_Aggregate - or else not Compile_Time_Known_Aggregate (Expr_Q) - then + elsif not Compile_Time_Known_Composite_Value (Expr_Q) then Static_Components := False; if Is_Private_Type (Etype (Expr_Q)) @@ -5374,12 +5420,14 @@ package body Exp_Aggr is -- may be distinct from the default size of the type component, so -- we need to expand to insure that the back-end copies the proper -- size of the data. However, if the aggregate is the initial value of - -- a constant, the target is immutable and may be built statically. + -- a constant, the target is immutable and might be built statically + -- if components are appropriate. elsif Has_Mutable_Components (Typ) and then (Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration - or else not Constant_Present (Parent (Top_Level_Aggr))) + or else not Constant_Present (Parent (Top_Level_Aggr)) + or else not Static_Components) then Convert_To_Assignments (N, Typ); diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index a2651545871..4e0c60cdb57 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4518,7 +4518,7 @@ package body Exp_Attr is -- then the result will default to zero. if Present (Get_Rep_Pragma (Root_Type (Ptyp), - Name_Simple_Storage_Pool)) + Name_Simple_Storage_Pool_Type)) then declare Pool_Type : constant Entity_Id := diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 605de764254..53529ddbb04 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3569,7 +3569,7 @@ package body Exp_Ch4 is -- and save a reference to the pool type's Allocate routine. elsif Present (Get_Rep_Pragma - (Etype (Pool), Name_Simple_Storage_Pool)) + (Etype (Pool), Name_Simple_Storage_Pool_Type)) then declare Alloc_Op : Entity_Id := Get_Name_Entity_Id (Name_Allocate); diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 2707d7a2a06..ad7f253244c 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -1091,7 +1091,7 @@ package body Exp_Intr is -- to null. elsif Present (Get_Rep_Pragma - (Etype (Pool), Name_Simple_Storage_Pool)) + (Etype (Pool), Name_Simple_Storage_Pool_Type)) then declare Dealloc_Op : Entity_Id := Get_Name_Entity_Id (Name_Deallocate); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 9d3dd171bb9..a34517bb5be 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4111,13 +4111,13 @@ package body Freeze is -- two are optional). We also verify that the full type for a -- private type is allowed to be a simple storage pool type. - if Present (Get_Rep_Pragma (E, Name_Simple_Storage_Pool)) + if Present (Get_Rep_Pragma (E, Name_Simple_Storage_Pool_Type)) and then (Is_Base_Type (E) or else Has_Private_Declaration (E)) then -- If the type is marked Has_Private_Declaration, then this is -- a full type for a private type that was specified with the - -- pragma Simple_Storage_Pool, and here we ensure that the + -- pragma Simple_Storage_Pool_Type, and here we ensure that the -- pragma is allowed for the full type (for example, it can't -- be an array type, or a nonlimited record type). @@ -4126,7 +4126,7 @@ package body Freeze is or else not Is_Immutably_Limited_Type (E)) and then not Is_Private_Type (E) then - Error_Msg_Name_1 := Name_Simple_Storage_Pool; + Error_Msg_Name_1 := Name_Simple_Storage_Pool_Type; Error_Msg_N ("pragma% can only apply to full type that is an " & diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 72feb258c08..6155a8c94c7 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9079,17 +9079,6 @@ The compiler no longer generates code to initialize, finalize or adjust an object or a nested component, either declared on the stack or on the heap. The deallocation of a controlled object no longer finalizes its contents. -@item No_Implicit_Aliasing -@findex No_Implicit_Aliasing - -This restriction, which is not required to be partition-wide consistent, -requires an explicit aliased keyword for an object to which 'Access, -'Unchecked_Access, or 'Address is applied, and forbids entirely the use of -the 'Unrestricted_Access attribute for objects. Note: the reason that -Unrestricted_Access is forbidden is that it would require the prefix -to be aliased, and in such cases, it can always be replaced by -the standard attribute Unchecked_Access which is preferable. - @item No_Implicit_Conditionals @findex No_Implicit_Conditionals This restriction ensures that the generated code does not contain any @@ -9322,6 +9311,16 @@ identifiers (other than @code{No_Implementation_Restrictions} itself) are present. With this restriction, the only other restriction identifiers that can be used are those defined in the Ada Reference Manual. +@item No_Implicit_Aliasing +@findex No_Implicit_Aliasing +This restriction, which is not required to be partition-wide consistent, +requires an explicit aliased keyword for an object to which 'Access, +'Unchecked_Access, or 'Address is applied, and forbids entirely the use of +the 'Unrestricted_Access attribute for objects. Note: the reason that +Unrestricted_Access is forbidden is that it would require the prefix +to be aliased, and in such cases, it can always be replaced by +the standard attribute Unchecked_Access which is preferable. + @item No_Wide_Characters @findex No_Wide_Characters This restriction ensures at compile time that no uses of the types diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 913fa44b37b..6a28dbf533a 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -5105,7 +5105,15 @@ All other optional warnings are turned on. @cindex @option{-gnatwA} (@command{gcc}) This switch suppresses all optional warning messages, see remaining list in this section for details on optional warning messages that can be -individually controlled. +individually controlled. Note that unlike switch @option{-gnatws}, the +use of switch @option{-gnatwA} does not suppress warnings that are +normally given unconditionally and cannot be individually controlled +(for example, the warning about a missing exit path in a function). +Also, again unlike switch @option{-gnatws}, warnings suppressed by +the use of switch @option{-gnatwA} can be individually turned back +on. For example the use of switch @option{-gnatwA} followed by +switch @option{-gnatwd} will suppress all optional warnings except +the warnings for implicit dereferencing. @item -gnatw.a @emph{Activate warnings on failing assertions.} @@ -5632,8 +5640,14 @@ This switch suppresses warnings for object renaming function. @emph{Suppress all warnings.} @cindex @option{-gnatws} (@command{gcc}) This switch completely suppresses the -output of all warning messages from the GNAT front end. -Note that it does not suppress warnings from the @command{gcc} back end. +output of all warning messages from the GNAT front end, including +both warnings that can be controlled by switches described in this +section, and those that are normally given unconditionally. The +effect of this suppress action can only be cancelled by a subsequent +use of the switch @option{-gnatwn}. + +Note that switch @option{-gnatws} does not suppress +warnings from the @command{gcc} back end. To suppress these back end warnings as well, use the switch @option{-w} in addition to @option{-gnatws}. Also this switch has no effect on the handling of style check messages. diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 6402ff4e880..2e4d9b1332c 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1230,7 +1230,7 @@ begin Pragma_Shared_Passive | Pragma_Short_Circuit_And_Or | Pragma_Short_Descriptors | - Pragma_Simple_Storage_Pool | + Pragma_Simple_Storage_Pool_Type | Pragma_Storage_Size | Pragma_Storage_Unit | Pragma_Static_Elaboration_Desired | diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 04da4919c3f..2d9baadc794 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -107,6 +107,12 @@ package body System.Tasking.Rendezvous is -- debugging it may be wise to modify the above renamings to the -- non-nestable forms. + procedure Local_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id); + -- Internal version of Complete_Rendezvous, used to implement + -- Complete_Rendezvous and Exceptional_Complete_Rendezvous. + -- Should be called holding no locks, generally with abort not yet + -- deferred. + procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id); pragma Inline (Boost_Priority); -- Call this only with abort deferred and holding lock of Acceptor @@ -498,7 +504,7 @@ package body System.Tasking.Rendezvous is procedure Complete_Rendezvous is begin - Exceptional_Complete_Rendezvous (Ada.Exceptions.Null_Id); + Local_Complete_Rendezvous (Ada.Exceptions.Null_Id); end Complete_Rendezvous; ------------------------------------- @@ -508,19 +514,33 @@ package body System.Tasking.Rendezvous is procedure Exceptional_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id) is + procedure Internal_Reraise; + pragma No_Return (Internal_Reraise); + pragma Import (C, Internal_Reraise, "__gnat_reraise"); + + begin + Local_Complete_Rendezvous (Ex); + Internal_Reraise; + + -- ??? Do we need to give precedence to Program_Error that might be + -- raised due to failure of finalization, over Tasking_Error from + -- failure of requeue? + end Exceptional_Complete_Rendezvous; + + ------------------------------- + -- Local_Complete_Rendezvous -- + ------------------------------- + + procedure Local_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id) is Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link := Self_Id.Common.Call; Caller : Task_Id; Called_PO : STPE.Protection_Entries_Access; Acceptor_Prev_Priority : Integer; - Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex; Ceiling_Violation : Boolean; use type Ada.Exceptions.Exception_Id; - procedure Internal_Reraise; - pragma Import (C, Internal_Reraise, "__gnat_reraise"); - procedure Transfer_Occurrence (Target : Ada.Exceptions.Exception_Occurrence_Access; Source : Ada.Exceptions.Exception_Occurrence); @@ -529,18 +549,12 @@ package body System.Tasking.Rendezvous is use type STPE.Protection_Entries_Access; begin - -- Consider phasing out Complete_Rendezvous in favor of direct call to - -- this with Ada.Exceptions.Null_ID. See code expansion examples for - -- Accept_Call and Selective_Wait. Also consider putting an explicit - -- re-raise after this call, in the generated code. That way we could - -- eliminate the code here that reraises the exception. - -- The deferral level is critical here, since we want to raise an -- exception or allow abort to take place, if there is an exception or -- abort pending. pragma Debug - (Debug.Trace (Self_Id, "Exceptional_Complete_Rendezvous", 'R')); + (Debug.Trace (Self_Id, "Local_Complete_Rendezvous", 'R')); if Ex = Ada.Exceptions.Null_Id then @@ -632,9 +646,7 @@ package body System.Tasking.Rendezvous is if Ceiling_Violation then pragma Assert (Ex = Ada.Exceptions.Null_Id); - - Exception_To_Raise := Program_Error'Identity; - Entry_Call.Exception_To_Raise := Exception_To_Raise; + Entry_Call.Exception_To_Raise := Program_Error'Identity; if Single_Lock then Lock_RTS; @@ -692,16 +704,7 @@ package body System.Tasking.Rendezvous is end if; Initialization.Undefer_Abort (Self_Id); - - if Exception_To_Raise /= Ada.Exceptions.Null_Id then - Internal_Reraise; - end if; - - -- ??? Do we need to give precedence to Program_Error that might be - -- raised due to failure of finalization, over Tasking_Error from - -- failure of requeue? - - end Exceptional_Complete_Rendezvous; + end Local_Complete_Rendezvous; ------------------------------------- -- Requeue_Protected_To_Task_Entry -- diff --git a/gcc/ada/s-tasren.ads b/gcc/ada/s-tasren.ads index a9a9a2bbb3a..ea98fe3ccce 100644 --- a/gcc/ada/s-tasren.ads +++ b/gcc/ada/s-tasren.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -308,6 +308,7 @@ package System.Tasking.Rendezvous is procedure Exceptional_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id); + pragma No_Return (Exceptional_Complete_Rendezvous); -- Called by acceptor to mark the end of the current rendezvous and -- propagate an exception to the caller. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index aa798b00973..210e49c0a01 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4549,7 +4549,7 @@ package body Sem_Attr is if Attr_Id = Attribute_Storage_Pool then if Present (Get_Rep_Pragma (Etype (Entity (N)), - Name_Simple_Storage_Pool)) + Name_Simple_Storage_Pool_Type)) then Error_Msg_Name_1 := Aname; Error_Msg_N ("cannot use % attribute for type with simple " & @@ -4570,7 +4570,7 @@ package body Sem_Attr is else if not Present (Get_Rep_Pragma (Etype (Entity (N)), - Name_Simple_Storage_Pool)) + Name_Simple_Storage_Pool_Type)) then Error_Attr_P ("cannot use % attribute for type without simple " & diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5fe669d51f2..9e552ec1118 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3201,14 +3201,14 @@ package body Sem_Ch13 is (Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool))); -- In the Simple_Storage_Pool case, we allow a variable of any - -- Simple_Storage_Pool type, so we Resolve without imposing an + -- simple storage pool type, so we Resolve without imposing an -- expected type. else Analyze_And_Resolve (Expr); if not Present (Get_Rep_Pragma - (Etype (Expr), Name_Simple_Storage_Pool)) + (Etype (Expr), Name_Simple_Storage_Pool_Type)) then Error_Msg_N ("expression must be of a simple storage pool type", Expr); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3268c67b1f9..d564b1e590e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -13150,15 +13150,16 @@ package body Sem_Prag is Check_Valid_Configuration_Pragma; Short_Descriptors := True; - ------------------------- - -- Simple_Storage_Pool -- - ------------------------- + ------------------------------ + -- Simple_Storage_Pool_Type -- + ------------------------------ - -- pragma Simple_Storage_Pool (type_LOCAL_NAME); + -- pragma Simple_Storage_Pool_Type (type_LOCAL_NAME); - when Pragma_Simple_Storage_Pool => Simple_Storage_Pool : declare - Type_Id : Node_Id; - Typ : Entity_Id; + when Pragma_Simple_Storage_Pool_Type => + Simple_Storage_Pool_Type : declare + Type_Id : Node_Id; + Typ : Entity_Id; begin GNAT_Pragma; @@ -13207,7 +13208,7 @@ package body Sem_Prag is end if; Record_Rep_Item (Typ, N); - end Simple_Storage_Pool; + end Simple_Storage_Pool_Type; ---------------------- -- Source_File_Name -- @@ -15176,7 +15177,7 @@ package body Sem_Prag is Pragma_Shared => -1, Pragma_Shared_Passive => -1, Pragma_Short_Descriptors => 0, - Pragma_Simple_Storage_Pool => 0, + Pragma_Simple_Storage_Pool_Type => 0, Pragma_Source_File_Name => -1, Pragma_Source_File_Name_Project => -1, Pragma_Source_Reference => -1, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7c8de23f943..3d693e033bc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4243,8 +4243,9 @@ package body Sem_Res is := Associated_Storage_Pool (Root_Type (Typ)); begin if Present (Pool) - and then Present (Get_Rep_Pragma - (Etype (Pool), Name_Simple_Storage_Pool)) + and then + Present (Get_Rep_Pragma + (Etype (Pool), Name_Simple_Storage_Pool_Type)) then Error_Msg_N ("limited function calls not yet supported in simple " & diff --git a/gcc/ada/sinput-p.adb b/gcc/ada/sinput-p.adb index 156f036d3cf..f8ea812d4ee 100644 --- a/gcc/ada/sinput-p.adb +++ b/gcc/ada/sinput-p.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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,10 +26,15 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; +with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark; + +with Opt; use Opt; +with Output; use Output; with Prj.Err; with Sinput.C; with System; +with System.WCh_Con; use System.WCh_Con; package body Sinput.P is @@ -164,6 +169,46 @@ package body Sinput.P is Prj.Err.Scanner.Set_Special_Character ('#'); Prj.Err.Scanner.Set_Special_Character ('$'); + -- Check for BOM + + declare + BOM : BOM_Kind; + Len : Natural; + Tst : String (1 .. 5); + + begin + for J in 1 .. 5 loop + Tst (J) := Source (Scan_Ptr + Source_Ptr (J) - 1); + end loop; + + Read_BOM (Tst, Len, BOM, False); + + case BOM is + when UTF8_All => + Scan_Ptr := Scan_Ptr + Source_Ptr (Len); + Wide_Character_Encoding_Method := WCEM_UTF8; + Upper_Half_Encoding := True; + + when UTF16_LE | UTF16_BE => + Set_Standard_Error; + Write_Line ("UTF-16 encoding format not recognized"); + Set_Standard_Output; + raise Unrecoverable_Error; + + when UTF32_LE | UTF32_BE => + Set_Standard_Error; + Write_Line ("UTF-32 encoding format not recognized"); + Set_Standard_Output; + raise Unrecoverable_Error; + + when Unknown => + null; + + when others => + raise Program_Error; + end case; + end; + -- We scan past junk to the first interesting compilation unit token, to -- see if it is SEPARATE. We ignore WITH keywords during this and also -- PRIVATE. The reason for ignoring PRIVATE is that it handles some diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index f49e75b5dc6..7abf4ab6845 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -217,8 +217,6 @@ package body Snames is return Pragma_Priority; elsif N = Name_Relative_Deadline then return Pragma_Relative_Deadline; - elsif N = Name_Simple_Storage_Pool then - return Pragma_Simple_Storage_Pool; elsif N = Name_Storage_Size then return Pragma_Storage_Size; elsif N = Name_Storage_Unit then @@ -416,7 +414,6 @@ package body Snames is or else N = Name_Interface or else N = Name_Relative_Deadline or else N = Name_Priority - or else N = Name_Simple_Storage_Pool or else N = Name_Storage_Size or else N = Name_Storage_Unit; end Is_Pragma_Name; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 3bf9f12668c..34761f615ac 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -543,6 +543,7 @@ package Snames is Name_Share_Generic : constant Name_Id := N + $; -- GNAT Name_Shared : constant Name_Id := N + $; -- Ada 83 Name_Shared_Passive : constant Name_Id := N + $; + Name_Simple_Storage_Pool_Type : constant Name_Id := N + $; -- GNAT -- Note: Storage_Size is not in this list because its name matches the name -- of the corresponding attribute. However, it is included in the @@ -1698,6 +1699,7 @@ package Snames is Pragma_Share_Generic, Pragma_Shared, Pragma_Shared_Passive, + Pragma_Simple_Storage_Pool_Type, Pragma_Source_Reference, Pragma_Static_Elaboration_Desired, Pragma_Stream_Convert, @@ -1732,7 +1734,6 @@ package Snames is Pragma_Fast_Math, Pragma_Interface, Pragma_Priority, - Pragma_Simple_Storage_Pool, Pragma_Storage_Size, Pragma_Storage_Unit, diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 3c5776758ca..8e2b1b6a879 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2012, 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- -- @@ -308,6 +308,7 @@ package body Warnsw is Warn_On_Redundant_Constructs := False; Warn_On_Reverse_Bit_Order := False; Warn_On_Suspicious_Contract := False; + Warn_On_Suspicious_Modulus_Value := False; Warn_On_Unchecked_Conversion := False; Warn_On_Unordered_Enumeration_Type := False; Warn_On_Unrecognized_Pragma := False; |