diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 19 | ||||
| -rw-r--r-- | gcc/ada/Makefile.rtl | 1 | ||||
| -rw-r--r-- | gcc/ada/a-convec.adb | 46 | ||||
| -rw-r--r-- | gcc/ada/a-convec.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch9.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/sysdep.c | 3 |
12 files changed, 82 insertions, 68 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7ce57e9..f0a7da8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2011-10-13 Robert Dewar <dewar@adacore.com> + + * sem_ch9.adb, sem_util.adb, sem_util.ads, exp_ch6.adb, sem_ch4.adb, + sem_ch6.adb, exp_ch3.adb: Minor reformatting. + +2011-10-13 Arnaud Charlet <charlet@adacore.com> + + * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add a-ngcoar.o. + +2011-10-13 Jerome Guitton <guitton@adacore.com> + + * sysdep.c (__gnat_get_task_options): Re-enable VX_SPE_TASK on vThreads + +2011-10-13 Eric Botcazou <ebotcazou@adacore.com> + + * a-convec.ads (Cursor): Minor reformatting. + * a-convec.adb (Next): Fix minor inconsistencies. + (Previous): Likewise. + 2011-10-13 Ed Schonberg <schonberg@adacore.com> * sem_util.ads, sem_util.adb (Available_Full_View_Of_Component): diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index d70583c..4e03c9e 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -186,6 +186,7 @@ GNATRTL_NONTASKING_OBJS= \ a-locale$(objext) \ a-ncelfu$(objext) \ a-ngcefu$(objext) \ + a-ngcoar$(objext) \ a-ngcoty$(objext) \ a-ngelfu$(objext) \ a-ngrear$(objext) \ diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index a357cec..0fd8dee 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -2204,24 +2204,18 @@ package body Ada.Containers.Vectors is function Next (Object : Iterator; Position : Cursor) return Cursor is begin - if Position.Index = Object.Container.Last then - return No_Element; - else + if Position.Index < Object.Container.Last then return (Object.Container, Position.Index + 1); + else + return No_Element; end if; end Next; - ---------- - -- Next -- - ---------- - procedure Next (Position : in out Cursor) is begin if Position.Container = null then return; - end if; - - if Position.Index < Position.Container.Last then + elsif Position.Index < Position.Container.Last then Position.Index := Position.Index + 1; else Position := No_Element; @@ -2253,30 +2247,15 @@ package body Ada.Containers.Vectors is -- Previous -- -------------- - procedure Previous (Position : in out Cursor) is - begin - if Position.Container = null then - return; - end if; - - if Position.Index > Index_Type'First then - Position.Index := Position.Index - 1; - else - Position := No_Element; - end if; - end Previous; - function Previous (Position : Cursor) return Cursor is begin if Position.Container = null then return No_Element; - end if; - - if Position.Index > Index_Type'First then + elsif Position.Index > Index_Type'First then return (Position.Container, Position.Index - 1); + else + return No_Element; end if; - - return No_Element; end Previous; function Previous (Object : Iterator; Position : Cursor) return Cursor is @@ -2288,6 +2267,17 @@ package body Ada.Containers.Vectors is end if; end Previous; + procedure Previous (Position : in out Cursor) is + begin + if Position.Container = null then + return; + elsif Position.Index > Index_Type'First then + Position.Index := Position.Index - 1; + else + Position := No_Element; + end if; + end Previous; + ------------------- -- Query_Element -- ------------------- diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads index c6815d3..c90cf01 100644 --- a/gcc/ada/a-convec.ads +++ b/gcc/ada/a-convec.ads @@ -409,8 +409,8 @@ private for Vector_Access'Storage_Size use 0; type Cursor is record - Container : Vector_Access; - Index : Index_Type := Index_Type'First; + Container : Vector_Access; + Index : Index_Type := Index_Type'First; end record; procedure Write diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index dc3eb4b..5f413e3 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4156,20 +4156,20 @@ package body Exp_Ch3 is elsif Is_Limited_Class_Wide_Type (Desig_Typ) and then Tasking_Allowed - -- Do not create a class-wide master for types whose convention is - -- Java since these types cannot embed Ada tasks anyway. Note that - -- the following test cannot catch the following case: + -- Do not create a class-wide master for types whose convention is + -- Java since these types cannot embed Ada tasks anyway. Note that + -- the following test cannot catch the following case: - -- package java.lang.Object is - -- type Typ is tagged limited private; - -- type Ref is access all Typ'Class; - -- private - -- type Typ is tagged limited ...; - -- pragma Convention (Typ, Java) - -- end; + -- package java.lang.Object is + -- type Typ is tagged limited private; + -- type Ref is access all Typ'Class; + -- private + -- type Typ is tagged limited ...; + -- pragma Convention (Typ, Java) + -- end; - -- Because the convention appears after we have done the - -- processing for type Ref. + -- Because the convention appears after we have done the + -- processing for type Ref. and then Convention (Desig_Typ) /= Convention_Java and then Convention (Desig_Typ) /= Convention_CIL @@ -5178,12 +5178,13 @@ package body Exp_Ch3 is --------------------------------- procedure Expand_Previous_Access_Type (Def_Id : Entity_Id) is - Ptr_Typ : Entity_Id := First_Entity (Current_Scope); + Ptr_Typ : Entity_Id; begin -- Find all access types in the current scope whose designated type is -- Def_Id and build master renamings for them. + Ptr_Typ := First_Entity (Current_Scope); while Present (Ptr_Typ) loop if Is_Access_Type (Ptr_Typ) and then Designated_Type (Ptr_Typ) = Def_Id diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 811c3fc..581b524 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -479,7 +479,7 @@ package body Exp_Ch6 is is Loc : constant Source_Ptr := Sloc (Function_Call); Result_Subt : constant Entity_Id := Available_View (Etype (Function_Id)); - Actual : Node_Id := Master_Actual; + Actual : Node_Id := Master_Actual; begin -- No such extra parameters are needed if there are no tasks @@ -504,11 +504,11 @@ package body Exp_Ch6 is declare Master_Formal : Node_Id; + begin -- Locate implicit master parameter in the called function Master_Formal := Build_In_Place_Formal (Function_Id, BIP_Master); - Analyze_And_Resolve (Actual, Etype (Master_Formal)); -- Build the parameter association for the new actual and add it to diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 8fc5045..ed949cb 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -5554,7 +5554,7 @@ package body Sem_Ch4 is and then not Is_Limited_Composite (T1)) or else - (Is_Array_Type (T1) + (Is_Array_Type (T1) and then not Is_Limited_Type (Component_Type (T1)) and then Available_Full_View_Of_Component (T1))) then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a92f7e0..8675a2b 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6462,10 +6462,10 @@ package body Sem_Ch6 is declare Result_Subt : constant Entity_Id := Etype (E); Full_Subt : constant Entity_Id := Available_View (Result_Subt); + Formal_Typ : Entity_Id; - Discard : Entity_Id; + Discard : Entity_Id; pragma Warnings (Off, Discard); - Formal_Typ : Entity_Id; begin -- In the case of functions with unconstrained result subtypes, diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 3677a7b..4b284cd 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1163,6 +1163,7 @@ package body Sem_Ch9 is begin if No_Run_Time_Mode then Error_Msg_CRT ("protected type", N); + if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Def_Id); end if; @@ -1209,6 +1210,13 @@ package body Sem_Ch9 is Set_Is_Constrained (T, not Has_Discriminants (T)); + -- If aspects are present, analyze them now. They can make references + -- to the discriminants of the type, but not to any components. + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Def_Id); + end if; + Analyze (Protected_Definition (N)); -- In the case where the protected type is declared at a nested level @@ -1260,13 +1268,6 @@ package body Sem_Ch9 is Next_Entity (E); end loop; - -- If aspects are present, analyze them now. They can make references - -- to the discriminants of the type. - - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Def_Id); - end if; - End_Scope; -- Case of a completion of a private declaration @@ -2052,6 +2053,10 @@ package body Sem_Ch9 is Set_Is_Constrained (T, not Has_Discriminants (T)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Def_Id); + end if; + if Present (Task_Definition (N)) then Analyze_Task_Definition (Task_Definition (N)); end if; @@ -2106,10 +2111,6 @@ package body Sem_Ch9 is Process_Full_View (N, T, Def_Id); end if; end if; - - if Has_Aspects (N) then - Analyze_Aspect_Specifications (N, Def_Id); - end if; end Analyze_Task_Type_Declaration; ----------------------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 660611d..366be68 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -333,10 +333,13 @@ package body Sem_Util is end if; end Apply_Compile_Time_Constraint_Error; + -------------------------------------- + -- Available_Full_View_Of_Component -- + -------------------------------------- + function Available_Full_View_Of_Component (T : Entity_Id) return Boolean is ST : constant Entity_Id := Scope (T); SCT : constant Entity_Id := Scope (Component_Type (T)); - begin return In_Open_Scopes (ST) and then In_Open_Scopes (SCT) @@ -7360,9 +7363,9 @@ package body Sem_Util is ---------------------------- function Is_Inherited_Operation (E : Entity_Id) return Boolean is + pragma Assert (Is_Overloadable (E)); Kind : constant Node_Kind := Nkind (Parent (E)); begin - pragma Assert (Is_Overloadable (E)); return Kind = N_Full_Type_Declaration or else Kind = N_Private_Extension_Declaration or else Kind = N_Subtype_Declaration @@ -7375,7 +7378,8 @@ package body Sem_Util is ------------------------------------- function Is_Inherited_Operation_For_Type - (E : Entity_Id; Typ : Entity_Id) return Boolean + (E : Entity_Id; + Typ : Entity_Id) return Boolean is begin return Is_Inherited_Operation (E) diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 32e6ae6..eb3528a 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -845,8 +845,8 @@ package Sem_Util is -- by the derived type declaration for type Typ. function Is_Iterator (Typ : Entity_Id) return Boolean; - -- AI05-0139-2 : check whether Typ is one of the predefined interfaces - -- in Ada.Iterator_Interfaces, or it is derived from one. + -- AI05-0139-2: Check whether Typ is one of the predefined interfaces in + -- Ada.Iterator_Interfaces, or it is derived from one. function Is_LHS (N : Node_Id) return Boolean; -- Returns True iff N is used as Name in an assignment statement @@ -856,8 +856,7 @@ package Sem_Util is -- i.e. a library unit or an entity declared in a library package. function Is_Limited_Class_Wide_Type (Typ : Entity_Id) return Boolean; - -- Given an arbitrary type, determine whether it is a limited class-wide - -- type. + -- Determine whether a given arbitrary type is a limited class-wide type function Is_Local_Variable_Reference (Expr : Node_Id) return Boolean; -- Determines whether Expr is a reference to a variable or IN OUT mode diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index 696630e..4d383fd 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -911,8 +911,7 @@ __gnat_get_task_options (void) /* Force VX_FP_TASK because it is almost always required */ options |= VX_FP_TASK; -#if defined (__SPE__) && (! defined (__VXWORKSMILS__)) \ - && (! defined (VTHREADS)) +#if defined (__SPE__) && (! defined (__VXWORKSMILS__)) options |= VX_SPE_TASK; #endif |