diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 70 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 154 | ||||
| -rw-r--r-- | gcc/ada/sem_intr.adb | 15 |
4 files changed, 140 insertions, 120 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 15175d0..89a8830 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2012-01-10 Bob Duff <duff@adacore.com> + + * sem_intr.adb (Check_Shift): Use RM_Size instead of Esize, when + checking that the 'Size is correct. If the type is "mod 2**12", + for example, it's illegal, but Esize is the 'Object_Size, which + will be something like 16 or 32, so the error ('Size = 12) was + not detected. + * gnat_rm.texi: Improve documentation of shift + and rotate intrinsics. + +2012-01-10 Pascal Obry <obry@adacore.com> + + * prj.adb (For_Every_Project_Imported): Fix + implementation to make sure we return each project only once + for aggragte libraries. It is fine to return a project twice for + aggregate projects, this was the case as a Project_Id is different + in each project tree. The new implementation use a table based on + the project name to ensure proper detection of duplicate project + in aggregate library. A new context is then created to continue + retrurning duplicate project for aggregate libraries. + 2012-01-09 Eric Botcazou <ebotcazou@adacore.com> * gcc-interface/trans.c (call_to_gnu): Create the temporary for the diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 908b177..fb2be33 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -10385,11 +10385,7 @@ There are no restrictions on pragma @code{Restrictions}. * Exception_Name:: * File:: * Line:: -* Rotate_Left:: -* Rotate_Right:: -* Shift_Left:: -* Shift_Right:: -* Shift_Right_Arithmetic:: +* Shifts and Rotates:: * Source_Location:: @end menu @@ -10506,61 +10502,35 @@ application program should simply call the function @code{GNAT.Source_Info.Line} to obtain the number of the current source line. -@node Rotate_Left -@section Rotate_Left +@node Shifts and Rotates +@section Shifts and Rotates +@cindex Shift_Left +@cindex Shift_Right +@cindex Shift_Right_Arithmetic @cindex Rotate_Left +@cindex Rotate_Right @noindent -In standard Ada, the @code{Rotate_Left} function is available only +In standard Ada, the shift and rotate functions are available only for the predefined modular types in package @code{Interfaces}. However, in -GNAT it is possible to define a Rotate_Left function for a user -defined modular type or any signed integer type as in this example: +GNAT it is possible to define these functions for any integer +type (signed or modular), as in this example: @smallexample @c ada function Shift_Left - (Value : My_Modular_Type; + (Value : T; Amount : Natural) - return My_Modular_Type; + return T; @end smallexample @noindent -The requirements are that the profile be exactly as in the example -above. The only modifications allowed are in the formal parameter -names, and in the type of @code{Value} and the return type, which -must be the same, and must be either a signed integer type, or -a modular integer type with a binary modulus, and the size must -be 8. 16, 32 or 64 bits. - -@node Rotate_Right -@section Rotate_Right -@cindex Rotate_Right -@noindent -A @code{Rotate_Right} function can be defined for any user defined -binary modular integer type, or signed integer type, as described -above for @code{Rotate_Left}. - -@node Shift_Left -@section Shift_Left -@cindex Shift_Left -@noindent -A @code{Shift_Left} function can be defined for any user defined -binary modular integer type, or signed integer type, as described -above for @code{Rotate_Left}. - -@node Shift_Right -@section Shift_Right -@cindex Shift_Right -@noindent -A @code{Shift_Right} function can be defined for any user defined -binary modular integer type, or signed integer type, as described -above for @code{Rotate_Left}. - -@node Shift_Right_Arithmetic -@section Shift_Right_Arithmetic -@cindex Shift_Right_Arithmetic -@noindent -A @code{Shift_Right_Arithmetic} function can be defined for any user -defined binary modular integer type, or signed integer type, as described -above for @code{Rotate_Left}. +The function name must be one of +Shift_Left, Shift_Right, Shift_Right_Arithmetic, Rotate_Left, or +Rotate_Right. T must be an integer type. T'Size must be +8, 16, 32 or 64 bits; if T is modular, the modulus +must be 2**8, 2**16, 2**32 or 2**64. +The result type must be the same as the type of @code{Value}. +The shift amount must be Natural. +The formal parameter names can be anything. @node Source_Location @section Source_Location diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 06b2d38..32fa2a1 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -34,6 +34,7 @@ with Snames; use Snames; with Uintp; use Uintp; with Ada.Characters.Handling; use Ada.Characters.Handling; +with Ada.Containers.Ordered_Sets; with Ada.Unchecked_Deallocation; with GNAT.Case_Util; use GNAT.Case_Util; @@ -523,101 +524,128 @@ package body Prj is Include_Aggregated : Boolean := True; Imported_First : Boolean := False) is - use Project_Boolean_Htable; - Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; - procedure Recursive_Check + procedure Recursive_Check_Context (Project : Project_Id; Tree : Project_Tree_Ref; In_Aggregate_Lib : Boolean); - -- Check if a project has already been seen. If not seen, mark it - -- as Seen, Call Action, and check all its imported and aggregated - -- projects. + -- Recursively handle the project tree creating a new context for + -- keeping track about already handled projects. - --------------------- - -- Recursive_Check -- - --------------------- + ----------------------------- + -- Recursive_Check_Context -- + ----------------------------- - procedure Recursive_Check + procedure Recursive_Check_Context (Project : Project_Id; Tree : Project_Tree_Ref; In_Aggregate_Lib : Boolean) is - List : Project_List; - T : Project_Tree_Ref; + package Name_Id_Set is + new Ada.Containers.Ordered_Sets (Element_Type => Name_Id); - begin - if not Get (Seen, Project) then + Seen_Name : Name_Id_Set.Set; + -- This set is needed to ensure that we do not haandle the same + -- project twice in the context of aggregate libraries. - -- Even if a project is aggregated multiple times, we will only - -- return it once. + procedure Recursive_Check + (Project : Project_Id; + Tree : Project_Tree_Ref; + In_Aggregate_Lib : Boolean); + -- Check if project has already been seen. If not, mark it as Seen, + -- Call Action, and check all its imported and aggregated projects. - Set (Seen, Project, True); + --------------------- + -- Recursive_Check -- + --------------------- - if not Imported_First then - Action (Project, Tree, In_Aggregate_Lib, With_State); - end if; + procedure Recursive_Check + (Project : Project_Id; + Tree : Project_Tree_Ref; + In_Aggregate_Lib : Boolean) + is + List : Project_List; + T : Project_Tree_Ref; + + begin + if not Seen_Name.Contains (Project.Name) then - -- Visit all extended projects + -- Even if a project is aggregated multiple times in an + -- aggregated library, we will only return it once. - if Project.Extends /= No_Project then - Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib); - end if; + Seen_Name.Include (Project.Name); - -- Visit all imported projects if needed. This is not needed - -- for an aggregate library as imported libraries are just - -- there for dependency support. + if not Imported_First then + Action (Project, Tree, In_Aggregate_Lib, With_State); + end if; + + -- Visit all extended projects + + if Project.Extends /= No_Project then + Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib); + end if; + + -- Visit all imported projects - if Project.Qualifier /= Aggregate_Library - or else not Include_Aggregated - then List := Project.Imported_Projects; while List /= null loop Recursive_Check (List.Project, Tree, In_Aggregate_Lib); List := List.Next; end loop; - end if; - -- Visit all aggregated projects + -- Visit all aggregated projects - if Include_Aggregated - and then Project.Qualifier in Aggregate_Project - then - declare - Agg : Aggregated_Project_List; - begin - Agg := Project.Aggregated_Projects; - while Agg /= null loop - pragma Assert (Agg.Project /= No_Project); - - -- For aggregated libraries, the tree must be the one - -- of the aggregate library. - - if Project.Qualifier = Aggregate_Library then - T := Tree; - else - T := Agg.Tree; - end if; - - Recursive_Check - (Agg.Project, T, Project.Qualifier = Aggregate_Library); - Agg := Agg.Next; - end loop; - end; - end if; + if Include_Aggregated + and then Project.Qualifier in Aggregate_Project + then + declare + Agg : Aggregated_Project_List; + + begin + Agg := Project.Aggregated_Projects; + while Agg /= null loop + pragma Assert (Agg.Project /= No_Project); + + -- For aggregated libraries, the tree must be the one + -- of the aggregate library. + + if Project.Qualifier = Aggregate_Library then + T := Tree; + Recursive_Check (Agg.Project, T, True); + + else + T := Agg.Tree; + + -- Use a new context as we want to returns the same + -- project in different project tree for aggregated + -- projects. - if Imported_First then - Action (Project, Tree, In_Aggregate_Lib, With_State); + Recursive_Check_Context (Agg.Project, T, False); + end if; + + Agg := Agg.Next; + end loop; + end; + end if; + + if Imported_First then + Action (Project, Tree, In_Aggregate_Lib, With_State); + end if; end if; - end if; - end Recursive_Check; + end Recursive_Check; + + -- Start of processing for Recursive_Check_Context + + begin + Recursive_Check (Project, Tree, In_Aggregate_Lib); + end Recursive_Check_Context; -- Start of processing for For_Every_Project_Imported begin - Recursive_Check (Project => By, Tree => Tree, In_Aggregate_Lib => False); - Reset (Seen); + Recursive_Check_Context + (Project => By, Tree => Tree, In_Aggregate_Lib => False); end For_Every_Project_Imported; ----------------- diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index 26f9ff4..f650be9 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -455,12 +455,14 @@ package body Sem_Intr is return; end if; - Size := UI_To_Int (Esize (Typ1)); + -- type'Size (not 'Object_Size!) must be one of the allowed values - if Size /= 8 - and then Size /= 16 - and then Size /= 32 - and then Size /= 64 + Size := UI_To_Int (RM_Size (Typ1)); + + if Size /= 8 and then + Size /= 16 and then + Size /= 32 and then + Size /= 64 then Errint ("first argument for shift must have size 8, 16, 32 or 64", @@ -469,8 +471,7 @@ package body Sem_Intr is elsif Non_Binary_Modulus (Typ1) then Errint - ("shifts not allowed for non-binary modular types", - Ptyp1, N); + ("shifts not allowed for non-binary modular types", Ptyp1, N); elsif Etype (Arg1) /= Etype (E) then Errint |