Commit 2fcc44fa by Arnaud Charlet

[multiple changes]

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.

From-SVN: r179915
parent 9b62eb32
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):
......
......@@ -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) \
......
......@@ -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 --
-------------------
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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,
......
......@@ -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;
-----------------------------------
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment