+2016-07-07 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch3.adb, sem_prag.adb, sem_prag.ads, prj-ext.adb, freeze.adb,
+ sem_attr.adb: Minor reformatting, fix typos.
+
+2016-07-07 Justin Squirek <squirek@adacore.com>
+
+ * sem_ch12.adb (In_Same_Scope): Created this function to check
+ a generic package definition against an instantiation for scope
+ dependancies.
+ (Install_Body): Add function In_Same_Scope and
+ amend conditional in charge of delaying the package instance.
+ (Is_In_Main_Unit): Add guard to check if parent is present in
+ assignment of Current_Unit.
+
2016-07-07 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Remove redundant test,
procedure Check_Inherited_Conditions (R : Entity_Id);
-- For a tagged derived type, create wrappers for inherited operations
- -- that have a classwide condition, so it can be properly rewritten if
+ -- that have a class-wide condition, so it can be properly rewritten if
-- it involves calls to other overriding primitives.
procedure Check_Strict_Alignment (E : Entity_Id);
-- In SPARK mode this is where we can collect the inherited
-- conditions, because we do not create the Check pragmas that
- -- normally convey the the modified classwide conditions on
+ -- normally convey the the modified class-wide conditions on
-- overriding operations.
if SPARK_Mode = On then
A_Pre := Find_Aspect (Par_Prim, Aspect_Pre);
if Present (A_Pre) and then Class_Present (A_Pre) then
- Build_Classwide_Expression
+ Build_Class_Wide_Expression
(Expression (A_Pre), Prim, Par_Prim, Adjust_Sloc => False);
end if;
A_Post := Find_Aspect (Par_Prim, Aspect_Post);
if Present (A_Post) and then Class_Present (A_Post) then
- Build_Classwide_Expression
+ Build_Class_Wide_Expression
(Expression (A_Post), Prim, Par_Prim, Adjust_Sloc => False);
end if;
end if;
end if;
-- For a derived tagged type, check whether inherited primitives
- -- might require a wrapper to handle classwide conditions.
+ -- might require a wrapper to handle class-wide conditions.
if Is_Tagged_Type (Rec) and then Is_Derived_Type (Rec) then
Check_Inherited_Conditions (Rec);
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2016, 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- --
then
if not Silent then
Debug_Output
- ("Not overridding existing external reference '"
+ ("Not overriding existing external reference '"
& External_Name & "', value was defined in "
& N.Source'Img);
end if;
P_Type := Underlying_Type (P_Type);
end if;
- -- Must have discriminants or be an access type designating
- -- a type with discriminants. If it is a classwide type it
- -- has unknown discriminants.
+ -- Must have discriminants or be an access type designating a type
+ -- with discriminants. If it is a class-wide type it has unknown
+ -- discriminants.
if Has_Discriminants (P_Type)
or else Has_Unknown_Discriminants (P_Type)
else
Error_Attr_P
- ("prefix of% attribute must be remote access to classwide");
+ ("prefix of% attribute must be remote access-to-class-wide");
end if;
----------
Must_Delay : Boolean;
- function In_Same_Enclosing_Subp return Boolean;
- -- Check whether instance and generic body are within same subprogram.
+ function In_Same_Scope (Generic_Id, Actual_Id : Node_Id) return Boolean;
+ -- Check if the generic definition's scope tree and the instantiation's
+ -- scope tree share a dependency.
function True_Sloc (N : Node_Id) return Source_Ptr;
-- If the instance is nested inside a generic unit, the Sloc of the
-- origin of a node by finding the maximum sloc of any ancestor node.
-- Why is this not equivalent to Top_Level_Location ???
- ----------------------------
- -- In_Same_Enclosing_Subp --
- ----------------------------
-
- function In_Same_Enclosing_Subp return Boolean is
- Scop : Entity_Id;
- Subp : Entity_Id;
+ -------------------
+ -- In_Same_Scope --
+ -------------------
+ function In_Same_Scope (Generic_Id, Actual_Id : Node_Id) return Boolean
+ is
+ Act_Scop : Entity_Id := Scope (Actual_Id);
+ Gen_Scop : Entity_Id := Scope (Generic_Id);
begin
- Scop := Scope (Act_Id);
- while Scop /= Standard_Standard
- and then not Is_Overloadable (Scop)
+ while Scope_Depth_Value (Act_Scop) > 0
+ and then Scope_Depth_Value (Gen_Scop) > 0
loop
- Scop := Scope (Scop);
- end loop;
-
- if Scop = Standard_Standard then
- return False;
- else
- Subp := Scop;
- end if;
-
- Scop := Scope (Gen_Id);
- while Scop /= Standard_Standard loop
- if Scop = Subp then
+ if Act_Scop = Gen_Scop then
return True;
- else
- Scop := Scope (Scop);
end if;
+ Act_Scop := Scope (Act_Scop);
+ Gen_Scop := Scope (Gen_Scop);
end loop;
-
return False;
- end In_Same_Enclosing_Subp;
+ end In_Same_Scope;
---------------
-- True_Sloc --
N_Generic_Package_Declaration)
or else (Gen_Unit = Body_Unit
and then True_Sloc (N) < Sloc (Orig_Body)))
- and then Is_In_Main_Unit (Gen_Unit)
- and then (Scope (Act_Id) = Scope (Gen_Id)
- or else In_Same_Enclosing_Subp));
+ and then Is_In_Main_Unit (Original_Node (Gen_Unit))
+ and then (In_Same_Scope (Gen_Id, Act_Id)));
-- If this is an early instantiation, the freeze node is placed after
-- the generic body. Otherwise, if the generic appears in an instance,
end if;
Current_Unit := Parent (N);
+
while Present (Current_Unit)
and then Nkind (Current_Unit) /= N_Compilation_Unit
loop
return
Current_Unit = Cunit (Main_Unit)
or else Current_Unit = Library_Unit (Cunit (Main_Unit))
- or else (Present (Library_Unit (Current_Unit))
+ or else (Present (Current_Unit)
+ and then Present (Library_Unit (Current_Unit))
and then Is_In_Main_Unit (Library_Unit (Current_Unit)));
end Is_In_Main_Unit;
elsif Is_Class_Wide_Type (Full_Desig) and then Etype (Full_Desig) = T
then
Error_Msg_N
- ("access type cannot designate its own classwide type", S);
+ ("access type cannot designate its own class-wide type", S);
-- Clean up indication of tagged status to prevent cascaded errors
-- type, rewrite the declaration as a renaming of the result of the
-- call. The exceptions below are cases where the copy is expected,
-- either by the back end (Aliased case) or by the semantics, as for
- -- initializing controlled types or copying tags for classwide types.
+ -- initializing controlled types or copying tags for class-wide types.
if Present (E)
and then Nkind (E) = N_Explicit_Dereference
Set_Ekind (Id, Ekind (Prev)); -- will be reset later
Set_Class_Wide_Type (Id, Class_Wide_Type (Prev));
- -- The type of the classwide type is the current Id. Previously
+ -- Type of the class-wide type is the current Id. Previously
-- this was not done for private declarations because of order-
- -- of elaboration issues in the back-end, but gigi now handles
+ -- of-elaboration issues in the back end, but gigi now handles
-- this properly.
Set_Etype (Class_Wide_Type (Id), Id);
Table_Increment => 100,
Table_Name => "Name_Externals");
- --------------------------------------------------------
- -- Handling of inherited classwide pre/postconditions --
- --------------------------------------------------------
+ ---------------------------------------------------------
+ -- Handling of inherited class-wide pre/postconditions --
+ ---------------------------------------------------------
- -- Following AI12-0113, the expression for a classwide condition is
+ -- Following AI12-0113, the expression for a class-wide condition is
-- transformed for a subprogram that inherits it, by replacing calls
-- to primitive operations of the original controlling type into the
-- corresponding overriding operations of the derived type. The following
else
Error_Pragma_Arg
- ("pragma% applies only to formal access to classwide types",
+ ("pragma% applies only to formal access-to-class-wide types",
Arg1);
end if;
end Remote_Access_Type;
return False;
end Appears_In;
- --------------------------------
- -- Build_Classwide_Expression --
- --------------------------------
+ ---------------------------------
+ -- Build_Class_Wide_Expression --
+ ---------------------------------
- procedure Build_Classwide_Expression
+ procedure Build_Class_Wide_Expression
(Prag : Node_Id;
Subp : Entity_Id;
Par_Subp : Entity_Id;
function Replace_Entity (N : Node_Id) return Traverse_Result;
-- Replace reference to formal of inherited operation or to primitive
-- operation of root type, with corresponding entity for derived type,
- -- when constructing the classwide condition of an overridding
+ -- when constructing the class-wide condition of an overriding
-- subprogram.
--------------------
procedure Replace_Condition_Entities is
new Traverse_Proc (Replace_Entity);
- -- Start of processing for Build_Classwide_Expression
+ -- Start of processing for Build_Class_Wide_Expression
begin
- -- Add mapping from old formals to new formals.
+ -- Add mapping from old formals to new formals
Par_Formal := First_Formal (Par_Subp);
Subp_Formal := First_Formal (Subp);
end loop;
Replace_Condition_Entities (Prag);
- end Build_Classwide_Expression;
+ end Build_Class_Wide_Expression;
-----------------------------------
-- Build_Pragma_Check_Equivalent --
(Unit_Declaration_Node (Subp_Id), Inher_Id);
Check_Prag := New_Copy_Tree (Source => Prag);
- -- Build the inherited classwide condition.
+ -- Build the inherited class-wide condition
- Build_Classwide_Expression
+ Build_Class_Wide_Expression
(Check_Prag, Subp_Id, Inher_Id, Adjust_Sloc => True);
-- If not an inherited condition simply copy the original pragma
procedure Analyze_Test_Case_In_Decl_Part (N : Node_Id);
-- Perform preanalysis of pragma Test_Case
- procedure Build_Classwide_Expression
+ procedure Build_Class_Wide_Expression
(Prag : Node_Id;
Subp : Entity_Id;
Par_Subp : Entity_Id;
Adjust_Sloc : Boolean);
- -- Build the expression for an inherited classwide condition. Prag is
+ -- Build the expression for an inherited class-wide condition. Prag is
-- the pragma constructed from the corresponding aspect of the parent
- -- subprogram, and Subp is the overridding operation and Par_Subp is
+ -- subprogram, and Subp is the overriding operation and Par_Subp is
-- the overridden operation that has the condition. Adjust_Sloc is True
-- when the sloc of nodes traversed should be adjusted for the inherited
-- pragma. The routine is also called to check whether an inherited
-- operation that is not overridden but has inherited conditions need
-- a wrapper, because the inherited condition includes calls to other
-- primitives that have been overridden. In that case the first argument
- -- is the expression of the original classwide aspect. In SPARK_Mode, such
+ -- is the expression of the original class-wide aspect. In SPARK_Mode, such
-- operation which are just inherited but have modified pre/postconditions
-- are illegal.
projects / gcc.git / commitdiff