procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2012-07-16  Robert Dewar  <dewar@adacore.com>

	* a-exexpr.adb, freeze.adb, a-exexpr-gcc.adb, a-except-2005.adb,
	sem_eval.adb, s-fileio.adb: Minor reformatting.

2012-07-16  Javier Miranda  <miranda@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Remove support for obsolescent
	pragma CPP_Class.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add missing error on Ada
	derivations of CPP types.  Found updating the tests affected by
	the removal of pragma CPP_Class.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* back_end.adb: Minor reformatting.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb (Expand_N_Selective_Accept.Process_Accept_Alternative):
	Remove junk test that was always true. For the case of no statements
	following the ACCEPT, jump directly to End_Lab instead of
	introducing an intermediate jump.
	(Expand_N_Selective_Accept.Process_Delay_Alternative): Fix
	predicate testing for presence of statements following the DELAY.
	that was always true. For the case of no statements following
	the ACCEPT, jump directly to End_Lab instead of introducing an
	intermediate jump.
	(Expand_N_Selective_Accept): Fix incorrect insertion point for
	end label.

From-SVN: r189534
This commit is contained in:
Arnaud Charlet 2012-07-16 15:00:24 +02:00
parent be93c38658
commit 70805b8834
11 changed files with 285 additions and 367 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
gcc/ada/ChangeLog
View file

@ -1,3 +1,34 @@
2012-07-16 Robert Dewar <dewar@adacore.com>
* a-exexpr.adb, freeze.adb, a-exexpr-gcc.adb, a-except-2005.adb,
sem_eval.adb, s-fileio.adb: Minor reformatting.
2012-07-16 Javier Miranda <miranda@adacore.com>
* sem_prag.adb (Analyze_Pragma): Remove support for obsolescent
pragma CPP_Class.
* sem_ch13.adb (Analyze_Freeze_Entity): Add missing error on Ada
derivations of CPP types. Found updating the tests affected by
the removal of pragma CPP_Class.
2012-07-16 Thomas Quinot <quinot@adacore.com>
* back_end.adb: Minor reformatting.
2012-07-16 Thomas Quinot <quinot@adacore.com>
* exp_ch9.adb (Expand_N_Selective_Accept.Process_Accept_Alternative):
Remove junk test that was always true. For the case of no statements
following the ACCEPT, jump directly to End_Lab instead of
introducing an intermediate jump.
(Expand_N_Selective_Accept.Process_Delay_Alternative): Fix
predicate testing for presence of statements following the DELAY.
that was always true. For the case of no statements following
the ACCEPT, jump directly to End_Lab instead of introducing an
intermediate jump.
(Expand_N_Selective_Accept): Fix incorrect insertion point for
end label.
2012-07-16 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi: Minor documentation improvements.

16
gcc/ada/a-except-2005.adb
View file

@ -274,22 +274,21 @@ package body Ada.Exceptions is
function Create_Occurrence_From_Signal_Handler
(E : Exception_Id;
M : System.Address)
return EOA;
M : System.Address) return EOA;
-- Create and build an exception occurrence using exception id E and
-- nul-terminated message M.
function Create_Machine_Occurrence_From_Signal_Handler
(E : Exception_Id;
M : System.Address)
return System.Address;
M : System.Address) return System.Address;
pragma Export (C, Create_Machine_Occurrence_From_Signal_Handler,
"__gnat_create_machine_occurrence_from_signal_handler");
-- Create and build an exception occurrence using exception id E and
-- nul-terminated message M. Return the machine occurrence.
procedure Raise_Exception_No_Defer
(E : Exception_Id; Message : String := "");
(E : Exception_Id;
Message : String := "");
pragma Export
(Ada, Raise_Exception_No_Defer,
"ada__exceptions__raise_exception_no_defer");
@ -1051,10 +1050,10 @@ package body Ada.Exceptions is
function Create_Occurrence_From_Signal_Handler
(E : Exception_Id;
M : System.Address)
return EOA
M : System.Address) return EOA
is
X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
Exception_Data.Set_Exception_C_Msg (X, E, M);
@ -1072,8 +1071,7 @@ package body Ada.Exceptions is
function Create_Machine_Occurrence_From_Signal_Handler
(E : Exception_Id;
M : System.Address)
return System.Address
M : System.Address) return System.Address
is
begin
return Create_Occurrence_From_Signal_Handler (E, M).Machine_Occurrence;

7
gcc/ada/a-exexpr-gcc.adb
View file

@ -203,8 +203,7 @@ package body Exception_Propagation is
-- directly from gigi.
function Setup_Current_Excep
(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");
-- Write Get_Current_Excep.all from GCC_Exception
@ -344,8 +343,7 @@ package body Exception_Propagation is
-------------------------
function Setup_Current_Excep
(GCC_Exception : not null GCC_Exception_Access)
return EOA
(GCC_Exception : not null GCC_Exception_Access) return EOA
is
Excep : constant EOA := Get_Current_Excep.all;
@ -427,6 +425,7 @@ package body Exception_Propagation is
(GCC_Exception : not null GCC_Exception_Access)
is
Excep : EOA;
begin
-- Perform a standard raise first. If a regular handler is found, it
-- will be entered after all the intermediate cleanups have run. If

1
gcc/ada/a-exexpr.adb
View file

@ -65,6 +65,7 @@ package body Exception_Propagation is
procedure Propagate_Exception (Excep : EOA) is
Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
begin
-- If the jump buffer pointer is non-null, transfer control using
-- it. Otherwise announce an unhandled exception (note that this

2
gcc/ada/back_end.adb
View file

@ -237,7 +237,7 @@ package body Back_End is
elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
Opt.Suppress_Control_Flow_Optimizations := True;
-- Back end switcg -fdump-scos, which exists primarily for C, is
-- Back end switch -fdump-scos, which exists primarily for C, is
-- also accepted for Ada as a synonym of -gnateS.
elsif Switch_Chars (First .. Last) = "fdump-scos" then

421
gcc/ada/exp_ch9.adb
View file

File diff suppressed because it is too large Load diff

5
gcc/ada/freeze.adb
View file

@ -1041,8 +1041,9 @@ package body Freeze is
Comp_Type := Etype (Comp);
Comp_Def := Component_Definition (Parent (Comp));
Comp_Byte_Aligned := Present (Component_Clause (Comp))
and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
Comp_Byte_Aligned :=
Present (Component_Clause (Comp))
and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
-- Array case

1
gcc/ada/s-fileio.adb
View file

@ -626,7 +626,6 @@ package body System.File_IO is
then
Start := J + 1;
Stop := Start - 1;
while Form (Stop + 1) /= ASCII.NUL
and then Form (Stop + 1) /= ','
loop

41
gcc/ada/sem_ch13.adb
View file

@ -48,6 +48,7 @@ with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch9; use Sem_Ch9;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
@ -4322,6 +4323,46 @@ package body Sem_Ch13 is
end;
end if;
-- Check Ada derivation of CPP type
if Expander_Active
and then Tagged_Type_Expansion
and then Ekind (E) = E_Record_Type
and then Etype (E) /= E
and then Is_CPP_Class (Etype (E))
and then CPP_Num_Prims (Etype (E)) > 0
and then not Is_CPP_Class (E)
and then not Has_CPP_Constructors (Etype (E))
then
-- If the parent has C++ primitives but it has no constructor then
-- check that all the primitives are overridden in this derivation;
-- otherwise the constructor of the parent is needed to build the
-- dispatch table.
declare
Elmt : Elmt_Id;
Prim : Node_Id;
begin
Elmt := First_Elmt (Primitive_Operations (E));
while Present (Elmt) loop
Prim := Node (Elmt);
if not Is_Abstract_Subprogram (Prim)
and then No (Interface_Alias (Prim))
and then Find_Dispatching_Type (Ultimate_Alias (Prim)) /= E
then
Error_Msg_Name_1 := Chars (Etype (E));
Error_Msg_N
("'C'P'P constructor required for parent type %", E);
exit;
end if;
Next_Elmt (Elmt);
end loop;
end;
end if;
Inside_Freezing_Actions := Inside_Freezing_Actions - 1;
-- If we have a type with predicates, build predicate function

10
gcc/ada/sem_eval.adb
View file

@ -218,12 +218,12 @@ package body Sem_Eval is
-- If Fold and Stat are both set to False then this routine performs also
-- the following extra actions:
--
-- * If either operand is Any_Type then propagate it to result to
-- prevent cascaded errors.
-- If either operand is Any_Type then propagate it to result to
-- prevent cascaded errors.
--
-- * If some operand raises constraint error, then replace the node N
-- with the raise constraint error node. This replacement inherits the
-- Is_Static_Expression flag from the operands.
-- If some operand raises constraint error, then replace the node N
-- with the raise constraint error node. This replacement inherits the
-- Is_Static_Expression flag from the operands.
procedure Test_Expression_Is_Foldable
(N : Node_Id;

117
gcc/ada/sem_prag.adb
View file

@ -4690,6 +4690,12 @@ package body Sem_Prag is
Get_Pragma_Arg (Arg2));
end if;
if Etype (Def_Id) /= Def_Id
and then not Is_CPP_Class (Root_Type (Def_Id))
then
Error_Msg_N ("root type must be a 'C'P'P type", Arg1);
end if;
Set_Is_CPP_Class (Def_Id);
-- Imported CPP types must not have discriminants (because C++
@ -7651,108 +7657,13 @@ package body Sem_Prag is
-- pragma CPP_Class ([Entity =>] local_NAME)
when Pragma_CPP_Class => CPP_Class : declare
Arg : Node_Id;
Typ : Entity_Id;
begin
GNAT_Pragma;
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("'G'N'A'T pragma cpp'_class is now obsolete; replace it" &
" by pragma import?", N);
end if;
GNAT_Pragma;
Check_Arg_Count (1);
Check_Optional_Identifier (Arg1, Name_Entity);
Check_Arg_Is_Local_Name (Arg1);
Arg := Get_Pragma_Arg (Arg1);
Analyze (Arg);
if Etype (Arg) = Any_Type then
return;
end if;
if not Is_Entity_Name (Arg)
or else not Is_Type (Entity (Arg))
then
Error_Pragma_Arg ("pragma% requires a type mark", Arg1);
end if;
Typ := Entity (Arg);
if not Is_Tagged_Type (Typ) then
Error_Pragma_Arg ("pragma% applicable to tagged types ", Arg1);
end if;
-- Types treated as CPP classes must be declared limited (note:
-- this used to be a warning but there is no real benefit to it
-- since we did effectively intend to treat the type as limited
-- anyway).
if not Is_Limited_Type (Typ) then
Error_Msg_N
("imported 'C'P'P type must be limited",
Get_Pragma_Arg (Arg1));
end if;
Set_Is_CPP_Class (Typ);
Set_Convention (Typ, Convention_CPP);
-- Imported CPP types must not have discriminants (because C++
-- classes do not have discriminants).
if Has_Discriminants (Typ) then
Error_Msg_N
("imported 'C'P'P type cannot have discriminants",
First (Discriminant_Specifications
(Declaration_Node (Typ))));
end if;
-- Components of imported CPP types must not have default
-- expressions because the constructor (if any) is in the
-- C++ side.
if Is_Incomplete_Or_Private_Type (Typ)
and then No (Underlying_Type (Typ))
then
-- It should be an error to apply pragma CPP to a private
-- type if the underlying type is not visible (as it is
-- for any representation item). For now, for backward
-- compatibility we do nothing but we cannot check components
-- because they are not available at this stage. All this code
-- will be removed when we cleanup this obsolete GNAT pragma???
null;
else
declare
Tdef : constant Node_Id :=
Type_Definition (Declaration_Node (Typ));
Clist : Node_Id;
Comp : Node_Id;
begin
if Nkind (Tdef) = N_Record_Definition then
Clist := Component_List (Tdef);
else
pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
Clist := Component_List (Record_Extension_Part (Tdef));
end if;
if Present (Clist) then
Comp := First (Component_Items (Clist));
while Present (Comp) loop
if Present (Expression (Comp)) then
Error_Msg_N
("component of imported 'C'P'P type cannot have" &
" default expression", Expression (Comp));
end if;
Next (Comp);
end loop;
end if;
end;
("'G'N'A'T pragma cpp'_class is now obsolete and has no " &
"effect; replace it by pragma import?", N);
end if;
end CPP_Class;
@ -7802,6 +7713,12 @@ package body Sem_Prag is
and then
Is_CPP_Class (Root_Type (Etype (Def_Id)))))
then
if Scope (Def_Id) /= Scope (Etype (Def_Id)) then
Error_Msg_N
("'C'P'P constructor must be defined in the scope of " &
"its returned type", Arg1);
end if;
if Arg_Count >= 2 then
Set_Imported (Def_Id);
Set_Is_Public (Def_Id);
@ -7822,8 +7739,8 @@ package body Sem_Prag is
if Is_Tagged_Type (Etype (Def_Id))
and then not Is_Class_Wide_Type (Etype (Def_Id))
and then Is_Dispatching_Operation (Def_Id)
then
pragma Assert (Is_Dispatching_Operation (Def_Id));
Tag_Typ := Etype (Def_Id);
Elmt := First_Elmt (Primitive_Operations (Tag_Typ));