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

[multiple changes] 

2015-05-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Process_Formals): A non-private formal type that
	is a limited view does not have a list of private dependents.

2015-05-27  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Case_Statement): If the expression in
	the case statement is a compile-time known value, we look for a
	corresponding alternative to optimize the case statement into a
	single case. If the type has a static predicate and the expression
	does not satisfy the predicate, there is no legal alternative and
	this optimization is not applicable.  Excecution is erroneous,
	or else if assertions are enabled, an exception will be raised
	earlier, at the point the expression is elaborated.

2015-05-27  Robert Dewar  <dewar@adacore.com>

	* sem_elab.adb (Check_Internal_Call_Continue): Suppress
	warning on Finalize, Adjust, or Initialize if type involved has
	Warnings_Off set.

2015-05-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_aux.adb, sem_aux.ads (First_Discriminant): Return empty when
	applied to a type with no known discriminants.

From-SVN: r223752
This commit is contained in:
Arnaud Charlet 2015-05-27 15:21:36 +02:00
parent 0c6826a523
commit 66371f94f5
6 changed files with 77 additions and 8 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 @@
2015-05-27 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Process_Formals): A non-private formal type that
is a limited view does not have a list of private dependents.
2015-05-27 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_N_Case_Statement): If the expression in
the case statement is a compile-time known value, we look for a
corresponding alternative to optimize the case statement into a
single case. If the type has a static predicate and the expression
does not satisfy the predicate, there is no legal alternative and
this optimization is not applicable. Excecution is erroneous,
or else if assertions are enabled, an exception will be raised
earlier, at the point the expression is elaborated.
2015-05-27 Robert Dewar <dewar@adacore.com>
* sem_elab.adb (Check_Internal_Call_Continue): Suppress
warning on Finalize, Adjust, or Initialize if type involved has
Warnings_Off set.
2015-05-27 Ed Schonberg <schonberg@adacore.com>
* sem_aux.adb, sem_aux.ads (First_Discriminant): Return empty when
applied to a type with no known discriminants.
2015-05-26 Robert Dewar <dewar@adacore.com>
* errout.ads, sem_ch4.adb, sem_ch6.adb: Minor reformatting.

11
gcc/ada/exp_ch5.adb
View File

@ -2586,9 +2586,16 @@ package body Exp_Ch5 is
begin
-- Check for the situation where we know at compile time which branch
-- will be taken
-- will be taken.
if Compile_Time_Known_Value (Expr) then
-- If the value is static but its subtype is predicated and the value
-- does not obey the predicate, the value is marked non-static, and
-- there can be no corresponding static alternative.
if Compile_Time_Known_Value (Expr)
and then (not Has_Predicates (Etype (Expr))
or else Is_Static_Expression (Expr))
then
Alt := Find_Static_Alternative (N);
-- Do not consider controlled objects found in a case statement which

7
gcc/ada/sem_aux.adb
View File

@ -246,7 +246,12 @@ package body Sem_Aux is
Ent := Next_Entity (Ent);
end loop;
pragma Assert (Ekind (Ent) = E_Discriminant);
-- Call may be on a private type with unknown discriminants, in which
-- case Ent is Empty, and as per the spec, we return Empty in this case.
-- Historical note: The revious assertion that Ent is a discriminant
-- was overly cautious and prevented application of this function in
-- SPARK applications.
return Ent;
end First_Discriminant;

6
gcc/ada/sem_aux.ads
View File

@ -119,9 +119,9 @@ package Sem_Aux is
-- First_Entity. The exception arises for tagged types, where the tag
-- itself is prepended to the front of the entity chain, so the
-- First_Discriminant function steps past the tag if it is present.
-- The caller is responsible for checking that the type has discriminants,
-- so for example it is improper to call this function on a private
-- type with unknown discriminants.
-- The caller is responsible for checking that the type has discriminants.
-- When called on a private type with unknown discriminants, the function
-- always returns Empty.
function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id;
-- Typ is a type with discriminants. Gives the first discriminant stored

8
gcc/ada/sem_ch6.adb
View File

@ -10117,9 +10117,13 @@ package body Sem_Ch6 is
(Parent (T), N_Access_Function_Definition,
N_Access_Procedure_Definition)
then
if not Is_Class_Wide_Type (Formal_Type) then
-- A limited view has no private dependents
if not Is_Class_Wide_Type (Formal_Type)
and then not From_Limited_With (Formal_Type)
then
Append_Elmt (Current_Scope,
Private_Dependents (Base_Type (Formal_Type)));
Private_Dependents (Base_Type (Formal_Type)));
end if;
-- Freezing is delayed to ensure that Register_Prim

26
gcc/ada/sem_elab.adb
View File

@ -2447,6 +2447,30 @@ package body Sem_Elab is
("instantiation of& may occur before body is seen<l<",
N, Orig_Ent);
else
-- A rather specific check. For Finalize/Adjust/Initialize,
-- if the type has Warnings_Off set, suppress the warning.
if Nam_In (Chars (E), Name_Adjust,
Name_Finalize,
Name_Initialize)
and then Present (First_Formal (E))
then
declare
T : constant Entity_Id := Etype (First_Formal (E));
begin
if Is_Controlled (T) then
if Warnings_Off (T)
or else (Ekind (T) = E_Private_Type
and then Warnings_Off (Full_View (T)))
then
goto Output;
end if;
end if;
end;
end if;
-- Go ahead and give warning if not this special case
Error_Msg_NE
("call to& may occur before body is seen<l<", N, Orig_Ent);
end if;
@ -2458,6 +2482,8 @@ package body Sem_Elab is
-- all the clarification messages produces by Output_Calls must be
-- emitted unconditionally.
<<Output>>
Output_Calls (N, Check_Elab_Flag => False);
end if;
end if;