+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):
a-locale$(objext) \
a-ncelfu$(objext) \
a-ngcefu$(objext) \
+ a-ngcoar$(objext) \
a-ngcoty$(objext) \
a-ngelfu$(objext) \
a-ngrear$(objext) \
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;
-- 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
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 --
-------------------
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
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
---------------------------------
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
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
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
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
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,
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;
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
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
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;
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;
-----------------------------------
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)
----------------------------
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
-------------------------------------
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)
-- 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
-- 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
/* 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
projects / gcc.git / commitdiff