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

[multiple changes]

Browse source 
2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Flag286 is now used as Is_Exception_Handler.
	(Is_Exception_Handler): New routine.
	(Set_Is_Exception_Handler): New routine.
	(Write_Entity_Flags): Output the status of Is_Exception_Handler.
	* einfo.ads New attribute Is_Exception_Handler along with
	occurrences in entities.
	(Is_Exception_Handler): New routine along with pragma Inline.
	(Set_Is_Exception_Handler): New routine along with pragma Inline.
	* exp_ch7.adb (Make_Transient_Block): Ignore blocks generated
	for exception handlers with a choice parameter.
	* sem_ch11.adb (Analyze_Exception_Handlers): Mark the scope
	generated for a choice parameter as an exception handler.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Derived_Access_Type): Remove dead code.
	(Constrain_Discriminated_Type): In an instance, if the type has
	unknown discriminants, use its full view.
	(Process_Subtype): Check that the base type is private before
	adding subtype to Private_Dependents list.

2016-04-20  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb: Minor comment fix.

From-SVN: r235264
This commit is contained in:
Arnaud Charlet 2016-04-20 12:45:55 +02:00
parent bc795e3e03
commit 75a957f5db
7 changed files with 101 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/ada/ChangeLog
View file

@ -1,3 +1,30 @@
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb Flag286 is now used as Is_Exception_Handler.
(Is_Exception_Handler): New routine.
(Set_Is_Exception_Handler): New routine.
(Write_Entity_Flags): Output the status of Is_Exception_Handler.
* einfo.ads New attribute Is_Exception_Handler along with
occurrences in entities.
(Is_Exception_Handler): New routine along with pragma Inline.
(Set_Is_Exception_Handler): New routine along with pragma Inline.
* exp_ch7.adb (Make_Transient_Block): Ignore blocks generated
for exception handlers with a choice parameter.
* sem_ch11.adb (Analyze_Exception_Handlers): Mark the scope
generated for a choice parameter as an exception handler.
2016-04-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Access_Type): Remove dead code.
(Constrain_Discriminated_Type): In an instance, if the type has
unknown discriminants, use its full view.
(Process_Subtype): Check that the base type is private before
adding subtype to Private_Dependents list.
2016-04-20 Bob Duff <duff@adacore.com>
* sem_ch13.adb: Minor comment fix.
2016-04-20 Yannick Moy <moy@adacore.com>
* sem_ch4.adb: Fix typos in comments.

27
gcc/ada/einfo.adb
View file

@ -597,7 +597,7 @@ package body Einfo is
-- Is_Uplevel_Referenced_Entity Flag283
-- Is_Unimplemented Flag284
-- Is_Volatile_Full_Access Flag285
-- (unused) Flag286
-- Is_Exception_Handler Flag286
-- Rewritten_For_C Flag287
-- (unused) Flag288
@ -1976,12 +1976,6 @@ package body Einfo is
return Flag146 (Id);
end Is_Abstract_Type;
function Is_Local_Anonymous_Access (Id : E) return B is
begin
pragma Assert (Is_Access_Type (Id));
return Flag194 (Id);
end Is_Local_Anonymous_Access;
function Is_Access_Constant (Id : E) return B is
begin
pragma Assert (Is_Access_Type (Id));
@ -2137,6 +2131,12 @@ package body Einfo is
return Flag52 (Id);
end Is_Entry_Formal;
function Is_Exception_Handler (Id : E) return B is
begin
pragma Assert (Ekind (Id) = E_Block);
return Flag286 (Id);
end Is_Exception_Handler;
function Is_Exported (Id : E) return B is
begin
return Flag99 (Id);
@ -2307,6 +2307,12 @@ package body Einfo is
return Flag25 (Id);
end Is_Limited_Record;
function Is_Local_Anonymous_Access (Id : E) return B is
begin
pragma Assert (Is_Access_Type (Id));
return Flag194 (Id);
end Is_Local_Anonymous_Access;
function Is_Machine_Code_Subprogram (Id : E) return B is
begin
pragma Assert (Is_Subprogram (Id));
@ -5146,6 +5152,12 @@ package body Einfo is
Set_Flag52 (Id, V);
end Set_Is_Entry_Formal;
procedure Set_Is_Exception_Handler (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Block);
Set_Flag286 (Id, V);
end Set_Is_Exception_Handler;
procedure Set_Is_Exported (Id : E; V : B := True) is
begin
Set_Flag99 (Id, V);
@ -8956,6 +8968,7 @@ package body Einfo is
W ("Is_Dispatching_Operation", Flag6 (Id));
W ("Is_Eliminated", Flag124 (Id));
W ("Is_Entry_Formal", Flag52 (Id));
W ("Is_Exception_Handler", Flag286 (Id));
W ("Is_Exported", Flag99 (Id));
W ("Is_First_Subtype", Flag70 (Id));
W ("Is_For_Access_Subtype", Flag118 (Id));

10
gcc/ada/einfo.ads
View file

@ -2428,6 +2428,11 @@ package Einfo is
-- Is_Enumeration_Type (synthesized)
-- Defined in all entities, true for enumeration types and subtypes
-- Is_Exception_Handler (Flag286)
-- Defined in blocks. Set if the block serves only as a scope of an
-- exception handler with a choice parameter. Such a block does not
-- physically appear in the tree.
-- Is_Exported (Flag99)
-- Defined in all entities. Set if the entity is exported. For now we
-- only allow the export of constants, exceptions, functions, procedures
@ -5621,6 +5626,7 @@ package Einfo is
-- Discard_Names (Flag88)
-- Has_Master_Entity (Flag21)
-- Has_Nested_Block_With_Handler (Flag101)
-- Is_Exception_Handler (Flag286)
-- Sec_Stack_Needed_For_Return (Flag167)
-- Uses_Sec_Stack (Flag95)
-- Scope_Depth (synth)
@ -6971,6 +6977,7 @@ package Einfo is
function Is_Dispatching_Operation (Id : E) return B;
function Is_Eliminated (Id : E) return B;
function Is_Entry_Formal (Id : E) return B;
function Is_Exception_Handler (Id : E) return B;
function Is_Exported (Id : E) return B;
function Is_First_Subtype (Id : E) return B;
function Is_For_Access_Subtype (Id : E) return B;
@ -7634,6 +7641,7 @@ package Einfo is
procedure Set_Is_Dispatching_Operation (Id : E; V : B := True);
procedure Set_Is_Eliminated (Id : E; V : B := True);
procedure Set_Is_Entry_Formal (Id : E; V : B := True);
procedure Set_Is_Exception_Handler (Id : E; V : B := True);
procedure Set_Is_Exported (Id : E; V : B := True);
procedure Set_Is_First_Subtype (Id : E; V : B := True);
procedure Set_Is_For_Access_Subtype (Id : E; V : B := True);
@ -8434,6 +8442,7 @@ package Einfo is
pragma Inline (Is_Entry);
pragma Inline (Is_Entry_Formal);
pragma Inline (Is_Enumeration_Type);
pragma Inline (Is_Exception_Handler);
pragma Inline (Is_Exported);
pragma Inline (Is_First_Subtype);
pragma Inline (Is_Fixed_Point_Type);
@ -8923,6 +8932,7 @@ package Einfo is
pragma Inline (Set_Is_Dispatching_Operation);
pragma Inline (Set_Is_Eliminated);
pragma Inline (Set_Is_Entry_Formal);
pragma Inline (Set_Is_Exception_Handler);
pragma Inline (Set_Is_Exported);
pragma Inline (Set_Is_First_Subtype);
pragma Inline (Set_Is_For_Access_Subtype);

18
gcc/ada/exp_ch7.adb
View file

@ -7993,14 +7993,22 @@ package body Exp_Ch7 is
elsif Ekind_In (S, E_Entry, E_Loop) then
exit;
-- In a procedure or a block, we release on exit of the
-- procedure or block. ??? memory leak can be created by
-- recursive calls.
-- In a procedure or a block, release the sec stack on exit
-- from the construct. Note that an exception handler with a
-- choice parameter requires a declarative region in the form
-- of a block. The block does not physically manifest in the
-- tree as it only serves as a scope. Do not consider such a
-- block because it will never release the sec stack.
elsif Ekind_In (S, E_Block, E_Procedure) then
-- ??? Memory leak can be created by recursive calls
elsif Ekind (S) = E_Procedure
or else (Ekind (S) = E_Block
and then not Is_Exception_Handler (S))
then
Set_Uses_Sec_Stack (Current_Scope, False);
Set_Uses_Sec_Stack (S, True);
Check_Restriction (No_Secondary_Stack, Action);
Set_Uses_Sec_Stack (Current_Scope, False);
exit;
else

13
gcc/ada/sem_ch11.adb
View file

@ -214,6 +214,7 @@ package body Sem_Ch11 is
H_Scope :=
New_Internal_Entity
(E_Block, Current_Scope, Sloc (Choice), 'E');
Set_Is_Exception_Handler (H_Scope);
end if;
Push_Scope (H_Scope);
@ -318,11 +319,11 @@ package body Sem_Ch11 is
N_Formal_Package_Declaration
then
Error_Msg_NE
("exception& is declared in " &
"generic formal package", Id, Ent);
("exception& is declared in generic formal "
& "package", Id, Ent);
Error_Msg_N
("\and therefore cannot appear in " &
"handler (RM 11.2(8))", Id);
("\and therefore cannot appear in handler "
& "(RM 11.2(8))", Id);
exit;
-- If the exception is declared in an inner
@ -362,8 +363,8 @@ package body Sem_Ch11 is
Analyze_Statements (Statements (Handler));
-- If a choice was present, we created a special scope for it,
-- so this is where we pop that special scope to get rid of it.
-- If a choice was present, we created a special scope for it, so
-- this is where we pop that special scope to get rid of it.
if Present (Choice) then
End_Scope;

8
gcc/ada/sem_ch13.adb
View file

@ -10847,10 +10847,10 @@ package body Sem_Ch13 is
-- After all forms of overriding have been resolved, a tagged type may
-- be left with a set of implicitly declared and possibly erroneous
-- abstract subprograms, null procedures and subprograms that require
-- overriding. If this set contains fully conformat homographs, then one
-- is chosen arbitrarily (already done during resolution), otherwise all
-- remaining non-fully conformant homographs are hidden from visibility
-- (Ada RM 8.3 12.3/2).
-- overriding. If this set contains fully conformant homographs, then
-- one is chosen arbitrarily (already done during resolution), otherwise
-- all remaining non-fully conformant homographs are hidden from
-- visibility (Ada RM 8.3 12.3/2).
if Is_Tagged_Type (E) then
Hide_Non_Overridden_Subprograms (E);

31
gcc/ada/sem_ch3.adb
View file

@ -5962,16 +5962,6 @@ package body Sem_Ch3 is
if Null_Exclusion_Present (Type_Definition (N)) then
Set_Can_Never_Be_Null (Derived_Type);
-- What is with the "AND THEN FALSE" here ???
if Can_Never_Be_Null (Parent_Type)
and then False
then
Error_Msg_NE
("`NOT NULL` not allowed (& already excludes null)",
N, Parent_Type);
end if;
elsif Can_Never_Be_Null (Parent_Type) then
Set_Can_Never_Be_Null (Derived_Type);
end if;
@ -5983,6 +5973,7 @@ package body Sem_Ch3 is
-- ??? THIS CODE SHOULD NOT BE HERE REALLY.
Desig_Type := Designated_Type (Derived_Type);
if Is_Composite_Type (Desig_Type)
and then (not Is_Array_Type (Desig_Type))
and then Has_Discriminants (Desig_Type)
@ -13048,6 +13039,18 @@ package body Sem_Ch3 is
T := Designated_Type (T);
end if;
-- In an instance it may be necessary to retrieve the full view of a
-- type with unknown discriminants. In other contexts the constraint
-- is illegal.
if In_Instance
and then Is_Private_Type (T)
and then Has_Unknown_Discriminants (T)
and then Present (Full_View (T))
then
T := Full_View (T);
end if;
-- Ada 2005 (AI-412): Constrained incomplete subtypes are illegal.
-- Avoid generating an error for access-to-incomplete subtypes.
@ -20745,7 +20748,13 @@ package body Sem_Ch3 is
when Private_Kind =>
Constrain_Discriminated_Type (Def_Id, S, Related_Nod);
Set_Private_Dependents (Def_Id, New_Elmt_List);
-- The base type may be private but Def_Id may be a full view
-- in an instance.
if Is_Private_Type (Def_Id) then
Set_Private_Dependents (Def_Id, New_Elmt_List);
end if;
-- In case of an invalid constraint prevent further processing
-- since the type constructed is missing expected fields.