OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-01-07  Arnaud Charlet  <charlet@adacore.com>

	* s-osinte-vxworks.adb, s-osinte-vxworks.ads
	(sigwait, sigwaitinfo): Removed, not needed after all on any
	VxWorks configurations.

2015-01-07  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, freeze.adb, exp_disp.adb: Minor reformatting.

From-SVN: r219284
This commit is contained in:
Arnaud Charlet 2015-01-07 09:55:01 +01:00
parent 2ea3ba25c0
commit 95e0ceefa5
6 changed files with 41 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,13 @@
2015-01-07 Arnaud Charlet <charlet@adacore.com>
* s-osinte-vxworks.adb, s-osinte-vxworks.ads
(sigwait, sigwaitinfo): Removed, not needed after all on any
VxWorks configurations.
2015-01-07 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, freeze.adb, exp_disp.adb: Minor reformatting.
2015-01-07 Javier Miranda <miranda@adacore.com> 2015-01-07 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Expand_Interface_Conversion): Adding missing * exp_disp.adb (Expand_Interface_Conversion): Adding missing

8
gcc/ada/exp_disp.adb
View File

@ -1423,15 +1423,15 @@ package body Exp_Disp is
if Is_Access_Type (Etype (Expression (N))) then if Is_Access_Type (Etype (Expression (N))) then
Apply_Accessibility_Check Apply_Accessibility_Check
(N => Expression (N), (N => Expression (N),
Typ => Etype (N), Typ => Etype (N),
Insert_Node => N); Insert_Node => N);
-- Generate: Func (Address!(Expression)) -- Generate: Func (Address!(Expression))
Rewrite (N, Rewrite (N,
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Occurrence_Of (Fent, Loc), Name => New_Occurrence_Of (Fent, Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Unchecked_Convert_To (RTE (RE_Address), Unchecked_Convert_To (RTE (RE_Address),
Relocate_Node (Expression (N)))))); Relocate_Node (Expression (N))))));
@ -1441,7 +1441,7 @@ package body Exp_Disp is
Rewrite (N, Rewrite (N,
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Occurrence_Of (Fent, Loc), Name => New_Occurrence_Of (Fent, Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Unchecked_Convert_To (Operand_Typ, Prefix => Unchecked_Convert_To (Operand_Typ,

12
gcc/ada/freeze.adb
View File

@ -7800,17 +7800,17 @@ package body Freeze is
if (SSO_Set_Low_By_Default (T) or else SSO_Set_High_By_Default (T)) if (SSO_Set_Low_By_Default (T) or else SSO_Set_High_By_Default (T))
-- For a record type, if bit order is specified explicitly, then -- For a record type, if bit order is specified explicitly,
-- do not set SSO from default if not consistent. Note that we -- then do not set SSO from default if not consistent. Note that
-- do not want to look at a Bit_Order attribute definition for -- we do not want to look at a Bit_Order attribute definition
-- a parent: if we were to inherit Bit_Order, then both -- for a parent: if we were to inherit Bit_Order, then both
-- SSO_Set_*_By_Default flags would have been cleared already -- SSO_Set_*_By_Default flags would have been cleared already
-- (by Inherit_Aspects_At_Freeze_Point). -- (by Inherit_Aspects_At_Freeze_Point).
and then not and then not
(Is_Record_Type (T) (Is_Record_Type (T)
and then Has_Rep_Item (T, and then
Name_Bit_Order, Check_Parents => False) Has_Rep_Item (T, Name_Bit_Order, Check_Parents => False)
and then Reverse_Bit_Order (T) /= Reversed) and then Reverse_Bit_Order (T) /= Reversed)
then then
-- If flags cause reverse storage order, then set the result. Note -- If flags cause reverse storage order, then set the result. Note

28
gcc/ada/s-osinte-vxworks.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1997-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -45,32 +45,6 @@ package body System.OS_Interface is
Low_Priority : constant := 255; Low_Priority : constant := 255;
-- VxWorks native (default) lowest scheduling priority -- VxWorks native (default) lowest scheduling priority
-------------
-- sigwait --
-------------
function sigwait
(set : access sigset_t;
sig : access Signal) return int
is
Result : int;
function sigwaitinfo
(set : access sigset_t; sigvalue : System.Address) return int;
pragma Import (C, sigwaitinfo, "sigwaitinfo");
begin
Result := sigwaitinfo (set, System.Null_Address);
if Result /= -1 then
sig.all := Signal (Result);
return OK;
else
sig.all := 0;
return errno;
end if;
end sigwait;
----------------- -----------------
-- To_Duration -- -- To_Duration --
----------------- -----------------

3
gcc/ada/s-osinte-vxworks.ads
View File

@ -192,9 +192,6 @@ package System.OS_Interface is
function c_signal (sig : Signal; handler : isr_address) return isr_address; function c_signal (sig : Signal; handler : isr_address) return isr_address;
pragma Import (C, c_signal, "signal"); pragma Import (C, c_signal, "signal");
function sigwait (set : access sigset_t; sig : access Signal) return int;
pragma Inline (sigwait);
function pthread_sigmask function pthread_sigmask
(how : int; (how : int;
set : access sigset_t; set : access sigset_t;

45
gcc/ada/sem_ch3.adb
View File

@ -15860,8 +15860,8 @@ package body Sem_Ch3 is
Taggd := Is_Tagged_Type (Parent_Type); Taggd := Is_Tagged_Type (Parent_Type);
-- Set the parent type to the class-wide type's specific type -- Set the parent type to the class-wide type's specific type in this
-- in this case to prevent cascading errors -- case to prevent cascading errors
if Present (Extension) and then Is_Class_Wide_Type (Parent_Type) then if Present (Extension) and then Is_Class_Wide_Type (Parent_Type) then
Error_Msg_N ("parent type must not be a class-wide type", Indic); Error_Msg_N ("parent type must not be a class-wide type", Indic);
@ -15913,7 +15913,7 @@ package body Sem_Ch3 is
begin begin
if Nkind (Decl) = N_Formal_Type_Declaration if Nkind (Decl) = N_Formal_Type_Declaration
and then Nkind (Formal_Type_Definition (Decl)) = and then Nkind (Formal_Type_Definition (Decl)) =
N_Formal_Derived_Type_Definition N_Formal_Derived_Type_Definition
and then Synchronized_Present (Formal_Type_Definition (Decl)) and then Synchronized_Present (Formal_Type_Definition (Decl))
and then No (Extension) and then No (Extension)
@ -15988,9 +15988,7 @@ package body Sem_Ch3 is
procedure Diagnose_Interface (N : Node_Id; E : Entity_Id) is procedure Diagnose_Interface (N : Node_Id; E : Entity_Id) is
begin begin
if not Is_Interface (E) if not Is_Interface (E) and then E /= Any_Type then
and then E /= Any_Type
then
Error_Msg_NE ("(Ada 2005) & must be an interface", N, E); Error_Msg_NE ("(Ada 2005) & must be an interface", N, E);
end if; end if;
end Diagnose_Interface; end Diagnose_Interface;
@ -16234,8 +16232,7 @@ package body Sem_Ch3 is
while Present (F_Spec) loop while Present (F_Spec) loop
P_Spec := First (Prev_Aspects); P_Spec := First (Prev_Aspects);
while Present (P_Spec) loop while Present (P_Spec) loop
if if Chars (Identifier (P_Spec)) = Chars (Identifier (F_Spec))
Chars (Identifier (P_Spec)) = Chars (Identifier (F_Spec))
then then
Error_Msg_N Error_Msg_N
("aspect already specified in private declaration", ("aspect already specified in private declaration",
@ -16547,9 +16544,7 @@ package body Sem_Ch3 is
elsif Nkind_In (N, N_Task_Type_Declaration, elsif Nkind_In (N, N_Task_Type_Declaration,
N_Protected_Type_Declaration) N_Protected_Type_Declaration)
then then
if No (Interface_List (N)) if No (Interface_List (N)) and then not Error_Posted (N) then
and then not Error_Posted (N)
then
Tag_Mismatch; Tag_Mismatch;
end if; end if;
@ -16856,6 +16851,7 @@ package body Sem_Ch3 is
-- Check that requested number of digits is not too high. -- Check that requested number of digits is not too high.
if Digs_Val > Max_Digs_Val then if Digs_Val > Max_Digs_Val then
-- The check for Max_Base_Digits may be somewhat expensive, as it -- The check for Max_Base_Digits may be somewhat expensive, as it
-- requires reading System, so only do it when necessary. -- requires reading System, so only do it when necessary.
@ -17105,16 +17101,16 @@ package body Sem_Ch3 is
Result_Entity := Entity (Result); Result_Entity := Entity (Result);
end if; end if;
-- See if this level of derivation actually has discriminants -- See if this level of derivation actually has discriminants because
-- because tagged derivations can add them, hence the lower -- tagged derivations can add them, hence the lower levels need not
-- levels need not have any. -- have any.
if not Has_Discriminants (Ti) then if not Has_Discriminants (Ti) then
return Result; return Result;
end if; end if;
-- Scan Ti's discriminants for Result_Entity, -- Scan Ti's discriminants for Result_Entity, and return its
-- and return its corresponding value, if any. -- corresponding value, if any.
Result_Entity := Original_Record_Component (Result_Entity); Result_Entity := Original_Record_Component (Result_Entity);
@ -17143,7 +17139,7 @@ package body Sem_Ch3 is
end loop; end loop;
-- Could not find it -- Could not find it
--
return Result; return Result;
end Search_Derivation_Levels; end Search_Derivation_Levels;
@ -17471,8 +17467,8 @@ package body Sem_Ch3 is
and then not Is_Tagged and then not Is_Tagged
and then and then
(not Inherit_Discr (not Inherit_Discr
or else First_Discriminant (Parent_Base) /= or else First_Discriminant (Parent_Base) /=
First_Stored_Discriminant (Parent_Base)) First_Stored_Discriminant (Parent_Base))
then then
Stored_Discrim := First_Stored_Discriminant (Parent_Base); Stored_Discrim := First_Stored_Discriminant (Parent_Base);
while Present (Stored_Discrim) loop while Present (Stored_Discrim) loop
@ -17650,6 +17646,7 @@ package body Sem_Ch3 is
end loop; end loop;
return True; return True;
else else
return True; return True;
end if; end if;
@ -18265,9 +18262,7 @@ package body Sem_Ch3 is
Init_Esize (T, System_Max_Binary_Modulus_Power); Init_Esize (T, System_Max_Binary_Modulus_Power);
end if; end if;
if not Non_Binary_Modulus (T) if not Non_Binary_Modulus (T) and then Esize (T) = RM_Size (T) then
and then Esize (T) = RM_Size (T)
then
Set_Is_Known_Valid (T); Set_Is_Known_Valid (T);
end if; end if;
end Set_Modular_Size; end Set_Modular_Size;
@ -18979,9 +18974,9 @@ package body Sem_Ch3 is
null; null;
else else
Error_Msg_N ("access discriminants of nonlimited types", Error_Msg_N
Expression (Discr)); ("access discriminants of nonlimited types cannot "
Error_Msg_N ("\cannot have defaults", Expression (Discr)); & "have defaults", Expression (Discr));
end if; end if;
elsif Present (Expression (Discr)) then elsif Present (Expression (Discr)) then