git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

sem_ch3.adb: Minor fix to error message. 

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb: Minor fix to error message.
	* a-exexpr-gcc.adb, sem_util.adb, sem_case.adb, exp_ch11.adb: Minor
	reformatting.

From-SVN: r203554
This commit is contained in:
Robert Dewar 2013-10-14 13:42:26 +00:00 committed by Arnaud Charlet
parent 63bb426804
commit 808876a99a
6 changed files with 50 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -1,3 +1,9 @@
2013-10-14 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb: Minor fix to error message.
* a-exexpr-gcc.adb, sem_util.adb, sem_case.adb, exp_ch11.adb: Minor
reformatting.
2013-10-14 Arnaud Charlet <charlet@adacore.com> 2013-10-14 Arnaud Charlet <charlet@adacore.com>
* exp_ch11.adb: Fix typo. * exp_ch11.adb: Fix typo.

35
gcc/ada/a-exexpr-gcc.adb
View File

@ -206,7 +206,7 @@ package body Exception_Propagation is
(GCC_Exception : not null GCC_Exception_Access) return EOA; (GCC_Exception : not null GCC_Exception_Access) return EOA;
pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
-- Write Get_Current_Excep.all from GCC_Exception. Called by the -- Write Get_Current_Excep.all from GCC_Exception. Called by the
-- personnality routine. -- personality routine.
procedure Unhandled_Except_Handler procedure Unhandled_Except_Handler
(GCC_Exception : not null GCC_Exception_Access); (GCC_Exception : not null GCC_Exception_Access);
@ -245,15 +245,16 @@ package body Exception_Propagation is
pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind"); pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
procedure Set_Exception_Parameter procedure Set_Exception_Parameter
(Excep : EOA; (Excep : EOA;
GCC_Exception : not null GCC_Exception_Access); GCC_Exception : not null GCC_Exception_Access);
pragma Export (C, Set_Exception_Parameter, pragma Export
"__gnat_set_exception_parameter"); (C, Set_Exception_Parameter, "__gnat_set_exception_parameter");
-- Called inserted by gigi to initialize the exception parameter -- Called inserted by gigi to initialize the exception parameter
procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address); procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
-- Utility routine to initialize occurrence Excep for a foreign exception -- Utility routine to initialize occurrence Excep from a foreign exception
-- whose machine occurrence is Mo. -- whose machine occurrence is Mo. The message is empty, the backtrace
-- is empty too and the exception identity is Foreign_Exception.
-- Hooks called when entering/leaving an exception handler for a given -- Hooks called when entering/leaving an exception handler for a given
-- occurrence, aimed at handling the stack of active occurrences. The -- occurrence, aimed at handling the stack of active occurrences. The
@ -356,12 +357,12 @@ package body Exception_Propagation is
procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is
begin begin
Excep.Id := Foreign_Exception'Access; Excep.Id := Foreign_Exception'Access;
Excep.Machine_Occurrence := Mo; Excep.Machine_Occurrence := Mo;
Excep.Msg_Length := 0; Excep.Msg_Length := 0;
Excep.Exception_Raised := True; Excep.Exception_Raised := True;
Excep.Pid := Local_Partition_ID; Excep.Pid := Local_Partition_ID;
Excep.Num_Tracebacks := 0; Excep.Num_Tracebacks := 0;
end Set_Foreign_Occurrence; end Set_Foreign_Occurrence;
------------------------- -------------------------
@ -382,14 +383,13 @@ package body Exception_Propagation is
declare declare
GNAT_Occurrence : constant GNAT_GCC_Exception_Access := GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (GCC_Exception); To_GNAT_GCC_Exception (GCC_Exception);
begin begin
Excep.all := GNAT_Occurrence.Occurrence; Excep.all := GNAT_Occurrence.Occurrence;
return GNAT_Occurrence.Occurrence'Access; return GNAT_Occurrence.Occurrence'Access;
end; end;
else
else
-- A default one -- A default one
Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
@ -491,8 +491,9 @@ package body Exception_Propagation is
----------------------------- -----------------------------
procedure Set_Exception_Parameter procedure Set_Exception_Parameter
(Excep : EOA; (Excep : EOA;
GCC_Exception : not null GCC_Exception_Access) is GCC_Exception : not null GCC_Exception_Access)
is
begin begin
-- Setup the exception occurrence -- Setup the exception occurrence
@ -506,8 +507,8 @@ package body Exception_Propagation is
begin begin
Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence); Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
end; end;
else
else
-- A default one -- A default one
Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);

16
gcc/ada/exp_ch11.adb
View File

@ -1044,7 +1044,7 @@ package body Exp_Ch11 is
Save := Save :=
Make_Procedure_Call_Statement (No_Location, Make_Procedure_Call_Statement (No_Location,
Name => Name =>
New_Occurrence_Of New_Occurrence_Of
(RTE (RE_Save_Occurrence), No_Location), (RTE (RE_Save_Occurrence), No_Location),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
@ -1061,20 +1061,18 @@ package body Exp_Ch11 is
Prepend (Save, Statements (Handler)); Prepend (Save, Statements (Handler));
Obj_Decl := Obj_Decl :=
Make_Object_Declaration Make_Object_Declaration (Cloc,
(Cloc, Defining_Identifier => Cparm,
Defining_Identifier => Cparm, Object_Definition =>
Object_Definition => New_Occurrence_Of
New_Occurrence_Of (RTE (RE_Exception_Occurrence), Cloc));
(RTE (RE_Exception_Occurrence), Cloc));
Set_No_Initialization (Obj_Decl, True); Set_No_Initialization (Obj_Decl, True);
Rewrite (Handler, Rewrite (Handler,
Make_Exception_Handler (Hloc, Make_Exception_Handler (Hloc,
Choice_Parameter => Empty, Choice_Parameter => Empty,
Exception_Choices => Exception_Choices (Handler), Exception_Choices => Exception_Choices (Handler),
Statements => New_List (
Statements => New_List (
Make_Block_Statement (Hloc, Make_Block_Statement (Hloc,
Declarations => New_List (Obj_Decl), Declarations => New_List (Obj_Decl),
Handled_Statement_Sequence => Handled_Statement_Sequence =>

2
gcc/ada/sem_case.adb
View File

@ -393,7 +393,7 @@ package body Sem_Case is
Prev_Lo := Choice_Lo; Prev_Lo := Choice_Lo;
Prev_Hi := Choice_Hi; Prev_Hi := Choice_Hi;
-- Check whether predicate set is fully covered by choice -- Check whether predicate set is fully covered by choice
if Pred_Hi = Choice_Hi then if Pred_Hi = Choice_Hi then
Next (Pred); Next (Pred);

28
gcc/ada/sem_ch3.adb
View File

@ -982,7 +982,6 @@ package body Sem_Ch3 is
(T_Name : Entity_Id; (T_Name : Entity_Id;
T_Def : Node_Id) T_Def : Node_Id)
is is
procedure Check_For_Premature_Usage (Def : Node_Id); procedure Check_For_Premature_Usage (Def : Node_Id);
-- Check that type T_Name is not used, directly or recursively, as a -- Check that type T_Name is not used, directly or recursively, as a
-- parameter or a return type in Def. Def is either a subtype, an -- parameter or a return type in Def. Def is either a subtype, an
@ -1001,7 +1000,7 @@ package body Sem_Ch3 is
if Nkind (Def) in N_Has_Etype then if Nkind (Def) in N_Has_Etype then
if Etype (Def) = T_Name then if Etype (Def) = T_Name then
Error_Msg_N Error_Msg_N
("typer cannot be used before end of its declaration", Def); ("type& cannot be used before end of its declaration", Def);
end if; end if;
-- If this is not a subtype, then this is an access_definition -- If this is not a subtype, then this is an access_definition
@ -7341,8 +7340,7 @@ package body Sem_Ch3 is
-- declaration. -- declaration.
if Constraint_Present then if Constraint_Present then
New_Discrs := New_Discrs := Build_Discriminant_Constraints (Parent_Type, Indic);
Build_Discriminant_Constraints (Parent_Type, Indic);
-- If there is no explicit constraint, there might be one that is -- If there is no explicit constraint, there might be one that is
-- inherited from a constrained parent type. In that case verify that -- inherited from a constrained parent type. In that case verify that
@ -7366,8 +7364,7 @@ package body Sem_Ch3 is
-- those given in the partial view. -- those given in the partial view.
declare declare
C1, C2 : Elmt_Id; C1, C2 : Elmt_Id;
Error_Node : Node_Id;
begin begin
C1 := First_Elmt (New_Discrs); C1 := First_Elmt (New_Discrs);
@ -7376,22 +7373,21 @@ package body Sem_Ch3 is
if Fully_Conformant_Expressions (Node (C1), Node (C2)) if Fully_Conformant_Expressions (Node (C1), Node (C2))
or else or else
(Is_OK_Static_Expression (Node (C1)) (Is_OK_Static_Expression (Node (C1))
and then and then Is_OK_Static_Expression (Node (C2))
Is_OK_Static_Expression (Node (C2)) and then
and then Expr_Value (Node (C1)) = Expr_Value (Node (C2)))
Expr_Value (Node (C1)) = Expr_Value (Node (C2)))
then then
null; null;
else else
if Constraint_Present then if Constraint_Present then
Error_Msg_N ( Error_Msg_N
"constraint not conformant to previous declaration", ("constraint not conformant to previous declaration",
Node (C1)); Node (C1));
else else
Error_Msg_N ( Error_Msg_N
"constraint of full view is incompatible " & ("constraint of full view is incompatible "
"with partial view", N); & "with partial view", N);
end if; end if;
end if; end if;

13
gcc/ada/sem_util.adb
View File

@ -10219,14 +10219,14 @@ package body Sem_Util is
S : Entity_Id; S : Entity_Id;
begin begin
if Is_Type (E) then -- E is the current instance of a type
-- E is the current instance of a type.
if Is_Type (E) then
Prot := E; Prot := E;
else -- E is an object
-- E is an object.
else
Prot := Scope (E); Prot := Scope (E);
end if; end if;
@ -10353,9 +10353,8 @@ package body Sem_Util is
or else K = E_In_Out_Parameter or else K = E_In_Out_Parameter
or else K = E_Generic_In_Out_Parameter or else K = E_Generic_In_Out_Parameter
-- Current instance of type. If this is a protected type, check -- Current instance of type. If this is a protected type, check
-- that we are not within the body of one of its protected -- we are not within the body of one of its protected functions.
-- functions.
or else (Is_Type (E) or else (Is_Type (E)
and then In_Open_Scopes (E) and then In_Open_Scopes (E)