mirror of git://gcc.gnu.org/git/gcc.git
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
Arnaud Charlet
parent
63bb426804
commit
808876a99a
|
|
@ -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>
|
||||
|
||||
* exp_ch11.adb: Fix typo.
|
||||
|
|
|
|||
|
|
@ -206,7 +206,7 @@ package body Exception_Propagation is
|
|||
(GCC_Exception : not null GCC_Exception_Access) return EOA;
|
||||
pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
|
||||
-- Write Get_Current_Excep.all from GCC_Exception. Called by the
|
||||
-- personnality routine.
|
||||
-- personality routine.
|
||||
|
||||
procedure Unhandled_Except_Handler
|
||||
(GCC_Exception : not null GCC_Exception_Access);
|
||||
|
|
@ -245,15 +245,16 @@ package body Exception_Propagation is
|
|||
pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
|
||||
|
||||
procedure Set_Exception_Parameter
|
||||
(Excep : EOA;
|
||||
(Excep : EOA;
|
||||
GCC_Exception : not null GCC_Exception_Access);
|
||||
pragma Export (C, Set_Exception_Parameter,
|
||||
"__gnat_set_exception_parameter");
|
||||
pragma Export
|
||||
(C, Set_Exception_Parameter, "__gnat_set_exception_parameter");
|
||||
-- Called inserted by gigi to initialize the exception parameter
|
||||
|
||||
procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
|
||||
-- Utility routine to initialize occurrence Excep for a foreign exception
|
||||
-- whose machine occurrence is Mo.
|
||||
-- Utility routine to initialize occurrence Excep from a foreign exception
|
||||
-- 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
|
||||
-- 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
|
||||
begin
|
||||
Excep.Id := Foreign_Exception'Access;
|
||||
Excep.Id := Foreign_Exception'Access;
|
||||
Excep.Machine_Occurrence := Mo;
|
||||
Excep.Msg_Length := 0;
|
||||
Excep.Exception_Raised := True;
|
||||
Excep.Pid := Local_Partition_ID;
|
||||
Excep.Num_Tracebacks := 0;
|
||||
Excep.Msg_Length := 0;
|
||||
Excep.Exception_Raised := True;
|
||||
Excep.Pid := Local_Partition_ID;
|
||||
Excep.Num_Tracebacks := 0;
|
||||
end Set_Foreign_Occurrence;
|
||||
|
||||
-------------------------
|
||||
|
|
@ -382,14 +383,13 @@ package body Exception_Propagation is
|
|||
|
||||
declare
|
||||
GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
|
||||
To_GNAT_GCC_Exception (GCC_Exception);
|
||||
To_GNAT_GCC_Exception (GCC_Exception);
|
||||
begin
|
||||
Excep.all := GNAT_Occurrence.Occurrence;
|
||||
|
||||
return GNAT_Occurrence.Occurrence'Access;
|
||||
end;
|
||||
else
|
||||
|
||||
else
|
||||
-- A default one
|
||||
|
||||
Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
|
||||
|
|
@ -491,8 +491,9 @@ package body Exception_Propagation is
|
|||
-----------------------------
|
||||
|
||||
procedure Set_Exception_Parameter
|
||||
(Excep : EOA;
|
||||
GCC_Exception : not null GCC_Exception_Access) is
|
||||
(Excep : EOA;
|
||||
GCC_Exception : not null GCC_Exception_Access)
|
||||
is
|
||||
begin
|
||||
-- Setup the exception occurrence
|
||||
|
||||
|
|
@ -506,8 +507,8 @@ package body Exception_Propagation is
|
|||
begin
|
||||
Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
|
||||
end;
|
||||
else
|
||||
|
||||
else
|
||||
-- A default one
|
||||
|
||||
Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
|
||||
|
|
|
|||
|
|
@ -1044,7 +1044,7 @@ package body Exp_Ch11 is
|
|||
|
||||
Save :=
|
||||
Make_Procedure_Call_Statement (No_Location,
|
||||
Name =>
|
||||
Name =>
|
||||
New_Occurrence_Of
|
||||
(RTE (RE_Save_Occurrence), No_Location),
|
||||
Parameter_Associations => New_List (
|
||||
|
|
@ -1061,20 +1061,18 @@ package body Exp_Ch11 is
|
|||
Prepend (Save, Statements (Handler));
|
||||
|
||||
Obj_Decl :=
|
||||
Make_Object_Declaration
|
||||
(Cloc,
|
||||
Defining_Identifier => Cparm,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of
|
||||
(RTE (RE_Exception_Occurrence), Cloc));
|
||||
Make_Object_Declaration (Cloc,
|
||||
Defining_Identifier => Cparm,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of
|
||||
(RTE (RE_Exception_Occurrence), Cloc));
|
||||
Set_No_Initialization (Obj_Decl, True);
|
||||
|
||||
Rewrite (Handler,
|
||||
Make_Exception_Handler (Hloc,
|
||||
Choice_Parameter => Empty,
|
||||
Exception_Choices => Exception_Choices (Handler),
|
||||
|
||||
Statements => New_List (
|
||||
Statements => New_List (
|
||||
Make_Block_Statement (Hloc,
|
||||
Declarations => New_List (Obj_Decl),
|
||||
Handled_Statement_Sequence =>
|
||||
|
|
|
|||
|
|
@ -393,7 +393,7 @@ package body Sem_Case is
|
|||
Prev_Lo := Choice_Lo;
|
||||
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
|
||||
Next (Pred);
|
||||
|
|
|
|||
|
|
@ -982,7 +982,6 @@ package body Sem_Ch3 is
|
|||
(T_Name : Entity_Id;
|
||||
T_Def : Node_Id)
|
||||
is
|
||||
|
||||
procedure Check_For_Premature_Usage (Def : Node_Id);
|
||||
-- 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
|
||||
|
|
@ -1001,7 +1000,7 @@ package body Sem_Ch3 is
|
|||
if Nkind (Def) in N_Has_Etype then
|
||||
if Etype (Def) = T_Name then
|
||||
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;
|
||||
|
||||
-- If this is not a subtype, then this is an access_definition
|
||||
|
|
@ -7341,8 +7340,7 @@ package body Sem_Ch3 is
|
|||
-- declaration.
|
||||
|
||||
if Constraint_Present then
|
||||
New_Discrs :=
|
||||
Build_Discriminant_Constraints (Parent_Type, Indic);
|
||||
New_Discrs := Build_Discriminant_Constraints (Parent_Type, Indic);
|
||||
|
||||
-- If there is no explicit constraint, there might be one that is
|
||||
-- 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.
|
||||
|
||||
declare
|
||||
C1, C2 : Elmt_Id;
|
||||
Error_Node : Node_Id;
|
||||
C1, C2 : Elmt_Id;
|
||||
|
||||
begin
|
||||
C1 := First_Elmt (New_Discrs);
|
||||
|
|
@ -7376,22 +7373,21 @@ package body Sem_Ch3 is
|
|||
if Fully_Conformant_Expressions (Node (C1), Node (C2))
|
||||
or else
|
||||
(Is_OK_Static_Expression (Node (C1))
|
||||
and then
|
||||
Is_OK_Static_Expression (Node (C2))
|
||||
and then
|
||||
Expr_Value (Node (C1)) = Expr_Value (Node (C2)))
|
||||
and then Is_OK_Static_Expression (Node (C2))
|
||||
and then
|
||||
Expr_Value (Node (C1)) = Expr_Value (Node (C2)))
|
||||
then
|
||||
null;
|
||||
|
||||
else
|
||||
if Constraint_Present then
|
||||
Error_Msg_N (
|
||||
"constraint not conformant to previous declaration",
|
||||
Node (C1));
|
||||
Error_Msg_N
|
||||
("constraint not conformant to previous declaration",
|
||||
Node (C1));
|
||||
else
|
||||
Error_Msg_N (
|
||||
"constraint of full view is incompatible " &
|
||||
"with partial view", N);
|
||||
Error_Msg_N
|
||||
("constraint of full view is incompatible "
|
||||
& "with partial view", N);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -10219,14 +10219,14 @@ package body Sem_Util is
|
|||
S : Entity_Id;
|
||||
|
||||
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;
|
||||
|
||||
else
|
||||
-- E is an object.
|
||||
-- E is an object
|
||||
|
||||
else
|
||||
Prot := Scope (E);
|
||||
end if;
|
||||
|
||||
|
|
@ -10353,9 +10353,8 @@ package body Sem_Util is
|
|||
or else K = E_In_Out_Parameter
|
||||
or else K = E_Generic_In_Out_Parameter
|
||||
|
||||
-- Current instance of type. If this is a protected type, check
|
||||
-- that we are not within the body of one of its protected
|
||||
-- functions.
|
||||
-- Current instance of type. If this is a protected type, check
|
||||
-- we are not within the body of one of its protected functions.
|
||||
|
||||
or else (Is_Type (E)
|
||||
and then In_Open_Scopes (E)
|
||||
|
|
|
|||
Loading…
Reference in New Issue