+2014-06-11 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Contract): Do not attempt
+ analysis if error has been posted on subprogram body.
+
+2014-06-11 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality
+ rule given in RM 13.1 (8/1) for operational attributes to stream
+ attributes: the attribute must apply to a first subtype. Fixes
+ missing errors in ACATS test bdd2004.
+
+2014-06-11 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch3.adb (Build_Record_Init_Proc): Don't build for variant
+ record type if restriction No_Implicit_Conditionals is active.
+ (Expand_N_Object_Declaration): Don't allow default initialization
+ for variant record type if restriction No_Implicit_Condition is active.
+ (Build_Variant_Record_Equality): Don't build for variant
+ record type if restriction No_Implicit_Conditionals is active.
+ * exp_ch4.adb (Expand_N_Op_Eq): Error if variant records with
+ No_Implicit_Conditionals.
+ * sem_aux.ads, sem_aux.adb (Has_Variant_Part): New function.
+
+2014-06-11 Ramon Fernandez <fernandez@adacore.com>
+
+ * i-cstrin.ads: Update comments.
+
+2014-06-11 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_res.adb (Resolve_Selected_Component): Handle properly a
+ selected component whose prefix is overloaded, when none of the
+ interpretations matches the expected type.
+
+2014-06-11 Bob Duff <duff@adacore.com>
+
+ * make.adb (Wait_For_Available_Slot): Give a more
+ informative error message; if the ALI file is not found, print
+ the full path of what it's looking for.
+
2014-06-11 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: add description of gnatstub -W<par>
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Rec_Type := Underlying_Type (Rec_Type);
end if;
+ -- If we have a variant record with restriction No_Implicit_Conditionals
+ -- in effect, then we skip building the procedure. This is safe because
+ -- if we can see the restriction, so can any caller, calls to initialize
+ -- such records are not allowed for variant records if this restriction
+ -- is active.
+
+ if Has_Variant_Part (Rec_Type)
+ and then Restriction_Active (No_Implicit_Conditionals)
+ then
+ return;
+ end if;
+
-- If there are discriminants, build the discriminant map to replace
-- discriminants by their discriminals in complex bound expressions.
-- These only arise for the corresponding records of synchronized types.
Pspecs : constant List_Id := New_List;
begin
+ -- If we have a variant record with restriction No_Implicit_Conditionals
+ -- in effect, then we skip building the procedure. This is safe because
+ -- if we can see the restriction, so can any caller, calls to equality
+ -- test routines are not allowed for variant records if this restriction
+ -- is active.
+
+ if Restriction_Active (No_Implicit_Conditionals) then
+ return;
+ end if;
+
-- Derived Unchecked_Union types no longer inherit the equality function
-- of their parent.
else
Append_To (Stmts,
- Make_Eq_If (Typ,
- Discriminant_Specifications (Def)));
-
- Append_List_To (Stmts,
- Make_Eq_Case (Typ, Comps));
+ Make_Eq_If (Typ, Discriminant_Specifications (Def)));
+ Append_List_To (Stmts, Make_Eq_Case (Typ, Comps));
end if;
Append_To (Stmts,
Def_Id : constant Entity_Id := Defining_Identifier (N);
Expr : constant Node_Id := Expression (N);
Loc : constant Source_Ptr := Sloc (N);
+ Obj_Def : constant Node_Id := Object_Definition (N);
Typ : constant Entity_Id := Etype (Def_Id);
Base_Typ : constant Entity_Id := Base_Type (Typ);
Expr_Q : Node_Id;
and then Is_Entity_Name (Expr_Q)
and then Ekind (Entity (Expr_Q)) = E_Variable
and then OK_To_Rename (Entity (Expr_Q))
- and then Is_Entity_Name (Object_Definition (N));
+ and then Is_Entity_Name (Obj_Def);
end Rewrite_As_Renaming;
-- Start of processing for Expand_N_Object_Declaration
if No (Expr) then
+ -- If we have a type with a variant part, the initialization proc
+ -- will contain implicit tests of the discriminant values, which
+ -- counts as a violation of the restriction No_Implicit_Conditionals.
+
+ if Has_Variant_Part (Typ) then
+ declare
+ Msg : Boolean;
+
+ begin
+ Check_Restriction (Msg, No_Implicit_Conditionals, Obj_Def);
+
+ if Msg then
+ Error_Msg_N
+ ("\initialization of variant record tests discriminants",
+ Obj_Def);
+ return;
+ end if;
+ end;
+ end if;
+
-- For the default initialization case, if we have a private type
-- with invariants, and invariant checks are enabled, then insert an
-- invariant check after the object declaration. Note that it is OK
-- then we've done it already and must not do it again.
and then not
- (Nkind (Object_Definition (N)) = N_Identifier
+ (Nkind (Obj_Def) = N_Identifier
and then
- Present (Equivalent_Type (Entity (Object_Definition (N)))))
+ Present (Equivalent_Type (Entity (Obj_Def))))
then
pragma Assert (Is_Class_Wide_Type (Typ));
Expand_Subtype_From_Expr
(N => N,
Unc_Type => Typ,
- Subtype_Indic => Object_Definition (N),
+ Subtype_Indic => Obj_Def,
Exp => Expr_N);
if not Is_Interface (Etype (Expr_N)) then
else
New_Expr :=
- Unchecked_Convert_To (Etype (Object_Definition (N)),
+ Unchecked_Convert_To (Etype (Obj_Def),
Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (RTE (RE_Tag_Ptr),
Make_Attribute_Reference (Loc,
Make_Object_Declaration (Loc,
Defining_Identifier => Obj_Id,
Object_Definition =>
- New_Occurrence_Of
- (Etype (Object_Definition (N)), Loc),
+ New_Occurrence_Of (Etype (Obj_Def), Loc),
Expression => New_Expr));
-- Rename limited type object since they cannot be copied
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Obj_Id,
Subtype_Mark =>
- New_Occurrence_Of
- (Etype (Object_Definition (N)), Loc),
+ New_Occurrence_Of (Etype (Obj_Def), Loc),
Name =>
Unchecked_Convert_To
- (Etype (Object_Definition (N)), New_Expr)));
+ (Etype (Obj_Def), New_Expr)));
end if;
-- Dynamically reference the tag associated with the
Rewrite (N,
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Defining_Identifier (N),
- Subtype_Mark => Object_Definition (N),
+ Subtype_Mark => Obj_Def,
Name => Expr_Q));
-- We do not analyze this renaming declaration, because all its
end if;
if Nkind (N) = N_Object_Declaration
- and then Nkind (Object_Definition (N)) = N_Access_Definition
+ and then Nkind (Obj_Def) = N_Access_Definition
and then not Is_Local_Anonymous_Access (Etype (Def_Id))
then
-- An Ada 2012 stand-alone object of an anonymous access type
Level_Expr := Dynamic_Accessibility_Level (Expr);
end if;
- Level_Decl := Make_Object_Declaration (Loc,
- Defining_Identifier => Level,
- Object_Definition => New_Occurrence_Of (Standard_Natural, Loc),
- Expression => Level_Expr,
- Constant_Present => Constant_Present (N),
- Has_Init_Expression => True);
+ Level_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Level,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Natural, Loc),
+ Expression => Level_Expr,
+ Constant_Present => Constant_Present (N),
+ Has_Init_Expression => True);
Insert_Action_After (Init_After, Level_Decl);
if Chars (Discr) = External_Name (Node (Elm)) then
return Node (Elm);
end if;
+
Next_Elmt (Elm);
end loop;
end if;
Alt_List := New_List;
-
while Present (Variant) loop
Append_To (Alt_List,
Make_Case_Statement_Alternative (Loc,
Discrete_Choices => New_Copy_List (Discrete_Choices (Variant)),
Statements =>
Make_Eq_Case (E, Component_List (Variant), Discrs)));
-
Next_Non_Pragma (Variant);
end loop;
else
return
Make_Implicit_If_Statement (E,
- Condition => Cond,
+ Condition => Cond,
Then_Statements => New_List (
Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Standard_False, Loc))));
end if;
end Make_Eq_If;
- --------------------
- -- Make_Neq_Body --
- --------------------
+ -------------------
+ -- Make_Neq_Body --
+ -------------------
function Make_Neq_Body (Tag_Typ : Entity_Id) return Node_Id is
projects / gcc.git / commitdiff