+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.
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
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;
-- 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
(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
("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;
-- all the clarification messages produces by Output_Calls must be
-- emitted unconditionally.
+ <<Output>>
+
Output_Calls (N, Check_Elab_Flag => False);
end if;
end if;
projects / gcc.git / commitdiff