+2010-10-22 Thomas Quinot <quinot@adacore.com>
+
+ * einfo.ads (Declaration_Node): Clarify documentation, in particular
+ regarding what is returned for subprogram entities.
+
+2010-10-22 Arnaud Charlet <charlet@adacore.com>
+
+ * exp_attr.adb (Make_Range_Test): Generate a Range node instead of
+ explicit comparisons, generates simpler expanded code.
+ * a-except-2005.adb (Rcheck_06_Ext): New.
+ * gcc-interface/trans.c (gigi, gnat_to_gnu): Handle validity checks
+ like range checks.
+ * gcc-interface/Make-lang.in: Update dependencies.
+
+2010-10-22 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb (Array_Type_Declaration): Error for subtype wi predicate
+ for index type
+ (Constrain_Index): Error of subtype wi predicate in index constraint
+ * sem_ch9.adb (Analyze_Entry_Declaration): Error of subtype wi
+ predicate in entry family.
+ * sem_res.adb (Resolve_Slice): Error of type wi predicate in slice.
+
+2010-10-22 Javier Miranda <miranda@adacore.com>
+
+ * sem_util.ads, sem_util.adb (Collect_Parents): New subprogram.
+ (Original_Corresponding_Operation): New subprogram.
+ (Visible_Ancestors): New subprogram.
+ * sem_ch6.adb (New_Overloaded_Entity): Handle new case of dispatching
+ operation that overrides a hidden inherited primitive.
+ * sem_disp.adb (Find_Hidden_Overridden_Primitive): New subprogram.
+ (Check_Dispatching_Operation): if the new dispatching operation
+ does not override a visible primtive then check if it overrides
+ some hidden inherited primitive.
+
+2010-10-22 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch10.adb (Analyze_With_Clause): If the parent_unit_name in a with
+ clause is a child unit that denotes a renaming, replace the
+ parent_unit_name with a reference to the renamed unit, because the
+ prefix is irrelevant to subsequent visibility..
+
2010-10-22 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Has_Predicates): Flag is now on all entities
(File : System.Address; Line, Column : Integer);
procedure Rcheck_05_Ext
(File : System.Address; Line, Column, Index, First, Last : Integer);
+ procedure Rcheck_06_Ext
+ (File : System.Address; Line, Column, Index, First, Last : Integer);
procedure Rcheck_12_Ext
(File : System.Address; Line, Column, Index, First, Last : Integer);
pragma Export (C, Rcheck_00_Ext, "__gnat_rcheck_00_ext");
pragma Export (C, Rcheck_05_Ext, "__gnat_rcheck_05_ext");
+ pragma Export (C, Rcheck_06_Ext, "__gnat_rcheck_06_ext");
pragma Export (C, Rcheck_12_Ext, "__gnat_rcheck_12_ext");
-- None of these procedures ever returns (they raise an exception!). By
pragma No_Return (Rcheck_00_Ext);
pragma No_Return (Rcheck_05_Ext);
+ pragma No_Return (Rcheck_06_Ext);
pragma No_Return (Rcheck_12_Ext);
---------------------------------------------
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
end Rcheck_05_Ext;
+ procedure Rcheck_06_Ext
+ (File : System.Address; Line, Column, Index, First, Last : Integer)
+ is
+ Msg : constant String :=
+ Rmsg_06 (Rmsg_06'First .. Rmsg_06'Last - 1) & ASCII.LF &
+ "value " & Image (Index) & " not in " & Image (First) &
+ ".." & Image (Last) & ASCII.NUL;
+ begin
+ Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
+ end Rcheck_06_Ext;
+
procedure Rcheck_12_Ext
(File : System.Address; Line, Column, Index, First, Last : Integer)
is
-- details of the use of this field.
-- Declaration_Node (synthesized)
--- Applies to all entities. Returns the tree node for the declaration
--- that declared the entity. Normally this is just the Parent of the
--- entity. One exception arises with child units, where the parent of
--- the entity is a selected component or a defining program unit name.
--- Another exception is that if the entity is an incomplete type that
--- has been completed, then we obtain the declaration node denoted by
--- the full type, i.e. the full type declaration node.
+-- Applies to all entities. Returns the tree node for the construct that
+-- declared the entity. Normally this is just the Parent of the entity.
+-- One exception arises with child units, where the parent of the entity
+-- is a selected component/defining program unit name. Another exception
+-- is that if the entity is an incomplete type that has been completed,
+-- then we obtain the declaration node denoted by the full type, i.e. the
+-- full type declaration node. Also note that for subprograms, this
+-- returns the {function,procedure}_specification, not the subprogram_
+-- declaration.
-- Default_Expr_Function (Node21)
-- Present in parameters. It holds the entity of the parameterless
function Make_Range_Test return Node_Id;
-- Build the code for a range test of the form
- -- Btyp!(Pref) >= Btyp!(Ptyp'First)
- -- and then
- -- Btyp!(Pref) <= Btyp!(Ptyp'Last)
+ -- Btyp!(Pref) in Btyp!(Ptyp'First) .. Btyp!(Ptyp'Last)
---------------------
-- Make_Range_Test --
end if;
return
- Make_And_Then (Loc,
- Left_Opnd =>
- Make_Op_Ge (Loc,
- Left_Opnd =>
- Unchecked_Convert_To (Btyp, Temp),
-
- Right_Opnd =>
+ Make_In (Loc,
+ Left_Opnd =>
+ Unchecked_Convert_To (Btyp, Temp),
+ Right_Opnd =>
+ Make_Range (Loc,
+ Low_Bound =>
Unchecked_Convert_To (Btyp,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
- Attribute_Name => Name_First))),
-
- Right_Opnd =>
- Make_Op_Le (Loc,
- Left_Opnd =>
- Unchecked_Convert_To (Btyp, Temp),
-
- Right_Opnd =>
+ Attribute_Name => Name_First)),
+ High_Bound =>
Unchecked_Convert_To (Btyp,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
ada/exp_ch13.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
- ada/einfo.adb ada/elists.ads ada/elists.adb ada/exp_ch13.ads \
- ada/exp_ch13.adb ada/exp_ch3.ads ada/exp_ch6.ads ada/exp_imgv.ads \
- ada/exp_tss.ads ada/exp_util.ads ada/gnat.ads ada/g-htable.ads \
- ada/hostparm.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
- ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/rtsfind.ads \
- ada/sem.ads ada/sem_aux.ads ada/sem_ch3.ads ada/sem_ch7.ads \
- ada/sem_ch8.ads ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads \
- ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
- ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
- ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads \
- ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/tbuild.ads ada/tree_io.ads \
- ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
- ada/unchdeal.ads ada/urealp.ads ada/validsw.ads
+ ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
+ ada/errout.ads ada/erroutc.ads ada/exp_ch13.ads ada/exp_ch13.adb \
+ ada/exp_ch3.ads ada/exp_ch6.ads ada/exp_imgv.ads ada/exp_tss.ads \
+ ada/exp_util.ads ada/gnat.ads ada/g-htable.ads ada/hostparm.ads \
+ ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
+ ada/opt.ads ada/output.ads ada/rtsfind.ads ada/sem.ads ada/sem_aux.ads \
+ ada/sem_ch3.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_eval.ads \
+ ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
+ ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
+ ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+ ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
+ ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+ ada/tbuild.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
+ ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
+ ada/validsw.ads
ada/exp_ch2.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
gnat_raise_decls_ext[i]
= build_raise_check (i, t,
i == CE_Index_Check_Failed
- || i == CE_Range_Check_Failed ?
- exception_range : exception_column);
+ || i == CE_Range_Check_Failed
+ || i == CE_Invalid_Data
+ ? exception_range : exception_column);
}
/* Set the types that GCC and Gigi use from the front end. */
gnu_result = build_call_raise_column (reason, gnat_node);
}
else if ((reason == CE_Index_Check_Failed
- || reason == CE_Range_Check_Failed)
+ || reason == CE_Range_Check_Failed
+ || reason == CE_Invalid_Data)
&& Nkind (cond) == N_Op_Not
&& Nkind (Right_Opnd (cond)) == N_In
&& Nkind (Right_Opnd (Right_Opnd (cond))) == N_Range)
Par_Name := Scope (E_Name);
while Nkind (Pref) = N_Selected_Component loop
Change_Selected_Component_To_Expanded_Name (Pref);
+
+ if Present (Entity (Selector_Name (Pref)))
+ and then
+ Present (Renamed_Entity (Entity (Selector_Name (Pref))))
+ and then Entity (Selector_Name (Pref)) /= Par_Name
+ then
+
+ -- The prefix is a child unit that denotes a renaming
+ -- declaration. Replace the prefix directly with the renamed
+ -- unit, because the rest of the prefix is irrelevant to the
+ -- visibility of the real unit.
+
+ Rewrite (Pref, New_Occurrence_Of (Par_Name, Sloc (Pref)));
+ exit;
+ end if;
+
Set_Entity_With_Style_Check (Pref, Par_Name);
Generate_Reference (Par_Name, Pref);
Related_Id : Entity_Id;
Suffix : Character;
Suffix_Index : Nat);
- -- Process an index constraint in a constrained array declaration. The
+ -- Process an index constraint S in a constrained array declaration. The
-- constraint can be a subtype name, or a range with or without an explicit
-- subtype mark. The index is the corresponding index of the unconstrained
-- array. The Related_Id and Suffix parameters are used to build the
end if;
Make_Index (Index, P, Related_Id, Nb_Index);
+
+ -- Check error of subtype with predicate for index type
+
+ if Has_Predicates (Etype (Index)) then
+ Error_Msg_NE
+ ("subtype& has predicate, not allowed as index subtype",
+ Index, Etype (Index));
+ end if;
+
+ -- Move to next index
+
Next_Index (Index);
Nb_Index := Nb_Index + 1;
end loop;
elsif Base_Type (Entity (S)) /= Base_Type (T) then
Wrong_Type (S, Base_Type (T));
+
+ -- Check error of subtype with predicate in index constraint
+
+ elsif Has_Predicates (Entity (S)) then
+ Error_Msg_NE
+ ("subtype& has predicate, not allowed in index consraint",
+ S, Entity (S));
end if;
return;
if Comes_From_Source (S) then
Check_Synchronized_Overriding (S, Overridden_Subp);
+
+ -- (Ada 2012: AI05-0125-1): If S is a dispatching operation then
+ -- it may have overridden some hidden inherited primitive. Update
+ -- Overriden_Subp to avoid spurious errors when checking the
+ -- overriding indicator.
+
+ if Ada_Version >= Ada_2012
+ and then No (Overridden_Subp)
+ and then Is_Dispatching_Operation (S)
+ and then Is_Overriding_Operation (S)
+ then
+ Overridden_Subp := Overridden_Operation (S);
+ end if;
+
Check_Overriding_Indicator
(S, Overridden_Subp, Is_Primitive => Is_Primitive_Subp);
end if;
Generate_Definition (Def_Id);
Tasking_Used := True;
+ -- Case of no discrete subtype definition
+
if No (D_Sdef) then
Set_Ekind (Def_Id, E_Entry);
+
+ -- Processing for discrete subtype definition present
+
else
Enter_Name (Def_Id);
Set_Ekind (Def_Id, E_Entry_Family);
Analyze (D_Sdef);
Make_Index (D_Sdef, N, Def_Id);
+
+ -- Check subtype with predicate in entry family
+
+ if Has_Predicates (Etype (D_Sdef)) then
+ Error_Msg_NE
+ ("subtype& has predicate, not allowed in entry family",
+ D_Sdef, Etype (D_Sdef));
+ end if;
end if;
+ -- Decorate Def_Id
+
Set_Etype (Def_Id, Standard_Void_Type);
Set_Convention (Def_Id, Convention_Entry);
Set_Accept_Address (Def_Id, New_Elmt_List);
+ -- Process formals
+
if Present (Formals) then
Set_Scope (Def_Id, Current_Scope);
Push_Scope (Def_Id);
-- (returning the designated tagged type in the case of an access
-- parameter); otherwise returns empty.
+ function Find_Hidden_Overridden_Primitive (S : Entity_Id) return Entity_Id;
+ -- [Ada 2012:AI-0125] Find an inherited hidden primitive of the dispatching
+ -- type of S that has the same name of S, a type-conformant profile, an
+ -- original corresponding operation O that is a primitive of a visible
+ -- ancestor of the dispatching type of S and O is visible at the point of
+ -- of declaration of S. If the entity is found the Alias of S is set to the
+ -- original corresponding operation S and its Overridden_Operation is set
+ -- to the found entity; otherwise return Empty.
+ --
+ -- This routine does not search for non-hidden primitives since they are
+ -- covered by the normal Ada 2005 rules.
+
-------------------------------
-- Add_Dispatching_Operation --
-------------------------------
procedure Check_Dispatching_Operation (Subp, Old_Subp : Entity_Id) is
Tagged_Type : Entity_Id;
- Has_Dispatching_Parent : Boolean := False;
- Body_Is_Last_Primitive : Boolean := False;
+ Has_Dispatching_Parent : Boolean := False;
+ Body_Is_Last_Primitive : Boolean := False;
+ Ovr_Subp : Entity_Id := Empty;
begin
if not Ekind_In (Subp, E_Procedure, E_Function) then
Check_Controlling_Formals (Tagged_Type, Subp);
+ Ovr_Subp := Old_Subp;
+
+ -- [Ada 2012:AI-0125]: Search for inherited hidden primitive that may be
+ -- overridden by Subp
+
+ if No (Ovr_Subp)
+ and then Ada_Version >= Ada_2012
+ then
+ Ovr_Subp := Find_Hidden_Overridden_Primitive (Subp);
+ end if;
+
-- Now it should be a correct primitive operation, put it in the list
- if Present (Old_Subp) then
+ if Present (Ovr_Subp) then
-- If the type has interfaces we complete this check after we set
-- attribute Is_Dispatching_Operation.
- Check_Subtype_Conformant (Subp, Old_Subp);
+ Check_Subtype_Conformant (Subp, Ovr_Subp);
if (Chars (Subp) = Name_Initialize
or else Chars (Subp) = Name_Adjust
end if;
else
- Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp);
+ Override_Dispatching_Operation (Tagged_Type, Ovr_Subp, Subp);
Set_Is_Overriding_Operation (Subp);
-- Ada 2005 (AI-251): In case of late overriding of a primitive
-- subtype conformance against all the interfaces covered by this
-- primitive.
- if Present (Old_Subp)
+ if Present (Ovr_Subp)
and then Has_Interfaces (Tagged_Type)
then
declare
return Empty;
end Find_Dispatching_Type;
+ --------------------------------------
+ -- Find_Hidden_Overridden_Primitive --
+ --------------------------------------
+
+ function Find_Hidden_Overridden_Primitive (S : Entity_Id) return Entity_Id
+ is
+ Tag_Typ : constant Entity_Id := Find_Dispatching_Type (S);
+ Elmt : Elmt_Id;
+ Orig_Prim : Entity_Id;
+ Prim : Entity_Id;
+ Vis_List : Elist_Id;
+
+ begin
+ -- This Ada 2012 rule is valid only for type extensions or private
+ -- extensions
+
+ if No (Tag_Typ)
+ or else not Is_Record_Type (Tag_Typ)
+ or else Etype (Tag_Typ) = Tag_Typ
+ then
+ return Empty;
+ end if;
+
+ -- Collect the list of visible ancestor of the tagged type
+
+ Vis_List := Visible_Ancestors (Tag_Typ);
+
+ Elmt := First_Elmt (Primitive_Operations (Tag_Typ));
+ while Present (Elmt) loop
+ Prim := Node (Elmt);
+
+ -- Find an inherited hidden dispatching primitive with the name of S
+ -- and a type-conformant profile
+
+ if Present (Alias (Prim))
+ and then Is_Hidden (Alias (Prim))
+ and then Find_Dispatching_Type (Alias (Prim)) /= Tag_Typ
+ and then Primitive_Names_Match (S, Prim)
+ and then Type_Conformant (S, Prim)
+ then
+ declare
+ Vis_Ancestor : Elmt_Id;
+ Elmt : Elmt_Id;
+
+ begin
+ -- The original corresponding operation of Prim must be an
+ -- operation of a visible ancestor of the dispatching type
+ -- of S, and the original corresponding operation of S2 must
+ -- be visible.
+
+ Orig_Prim := Original_Corresponding_Operation (Prim);
+
+ if Orig_Prim /= Prim
+ and then Is_Immediately_Visible (Orig_Prim)
+ then
+ Vis_Ancestor := First_Elmt (Vis_List);
+
+ while Present (Vis_Ancestor) loop
+ Elmt :=
+ First_Elmt (Primitive_Operations (Node (Vis_Ancestor)));
+ while Present (Elmt) loop
+ if Node (Elmt) = Orig_Prim then
+ Set_Overridden_Operation (S, Prim);
+ Set_Alias (Prim, Orig_Prim);
+
+ return Prim;
+ end if;
+
+ Next_Elmt (Elmt);
+ end loop;
+
+ Next_Elmt (Vis_Ancestor);
+ end loop;
+ end if;
+ end;
+ end if;
+
+ Next_Elmt (Elmt);
+ end loop;
+
+ return Empty;
+ end Find_Hidden_Overridden_Primitive;
+
---------------------------------------
-- Find_Primitive_Covering_Interface --
---------------------------------------
Set_Slice_Subtype (N);
- if Nkind (Drange) = N_Range then
+ -- Check bad use of type with predicates
+
+ if Has_Predicates (Etype (Drange)) then
+ Error_Msg_NE
+ ("subtype& has predicate, not allowed in slice",
+ Drange, Etype (Drange));
+
+ -- Otherwise here is where we check suspicious indexes
+
+ elsif Nkind (Drange) = N_Range then
Warn_On_Suspicious_Index (Name, Low_Bound (Drange));
Warn_On_Suspicious_Index (Name, High_Bound (Drange));
end if;
end loop;
end Collect_Interfaces_Info;
+ ---------------------
+ -- Collect_Parents --
+ ---------------------
+
+ procedure Collect_Parents
+ (T : Entity_Id;
+ List : out Elist_Id;
+ Use_Full_View : Boolean := True)
+ is
+ Current_Typ : Entity_Id := T;
+ Parent_Typ : Entity_Id;
+
+ begin
+ List := New_Elmt_List;
+
+ -- No action if the if the type has no parents
+
+ if T = Etype (T) then
+ return;
+ end if;
+
+ loop
+ Parent_Typ := Etype (Current_Typ);
+
+ if Is_Private_Type (Parent_Typ)
+ and then Present (Full_View (Parent_Typ))
+ and then Use_Full_View
+ then
+ Parent_Typ := Full_View (Base_Type (Parent_Typ));
+ end if;
+
+ Append_Elmt (Parent_Typ, List);
+
+ exit when Parent_Typ = Current_Typ;
+ Current_Typ := Parent_Typ;
+ end loop;
+ end Collect_Parents;
+
----------------------------------
-- Collect_Primitive_Operations --
----------------------------------
end if;
end Object_Access_Level;
+ --------------------------------------
+ -- Original_Corresponding_Operation --
+ --------------------------------------
+
+ function Original_Corresponding_Operation (S : Entity_Id) return Entity_Id
+ is
+ Typ : constant Entity_Id := Find_Dispatching_Type (S);
+
+ begin
+ -- If S is an inherited primitive S2 the original corresponding
+ -- operation of S is the original corresponding operation of S2
+
+ if Present (Alias (S))
+ and then Find_Dispatching_Type (Alias (S)) /= Typ
+ then
+ return Original_Corresponding_Operation (Alias (S));
+
+ -- If S overrides an inherted subprogram S2 the original corresponding
+ -- operation of S is the original corresponding operation of S2
+
+ elsif Is_Overriding_Operation (S)
+ and then Present (Overridden_Operation (S))
+ then
+ return Original_Corresponding_Operation (Overridden_Operation (S));
+
+ -- otherwise it is S itself
+
+ else
+ return S;
+ end if;
+ end Original_Corresponding_Operation;
+
-----------------------
-- Private_Component --
-----------------------
end if;
end Unqualify;
+ -----------------------
+ -- Visible_Ancestors --
+ -----------------------
+
+ function Visible_Ancestors (Typ : Entity_Id) return Elist_Id is
+ List_1 : Elist_Id;
+ List_2 : Elist_Id;
+ Elmt : Elmt_Id;
+
+ begin
+ pragma Assert (Is_Record_Type (Typ)
+ and then Is_Tagged_Type (Typ));
+
+ -- Collect all the parents and progenitors of Typ. If the full-view of
+ -- private parents and progenitors is available then it is used to
+ -- generate the list of visible ancestors; otherwise their partial
+ -- view is added to the resulting list.
+
+ Collect_Parents
+ (T => Typ,
+ List => List_1,
+ Use_Full_View => True);
+
+ Collect_Interfaces
+ (T => Typ,
+ Ifaces_List => List_2,
+ Exclude_Parents => True,
+ Use_Full_View => True);
+
+ -- Join the two lists. Avoid duplications because an interface may
+ -- simultaneously be parent and progenitor of a type.
+
+ Elmt := First_Elmt (List_2);
+ while Present (Elmt) loop
+ Append_Unique_Elmt (Node (Elmt), List_1);
+ Next_Elmt (Elmt);
+ end loop;
+
+ return List_1;
+ end Visible_Ancestors;
+
----------------------
-- Within_Init_Proc --
----------------------
-- of elements, and elements at the same position on these tables provide
-- information on the same interface type.
+ procedure Collect_Parents
+ (T : Entity_Id;
+ List : out Elist_Id;
+ Use_Full_View : Boolean := True);
+ -- Collect all the parents of Typ. Use_Full_View is used to collect them
+ -- using the full-view of private parents (if available).
+
function Collect_Primitive_Operations (T : Entity_Id) return Elist_Id;
-- Called upon type derivation and extension. We scan the declarative part
-- in which the type appears, and collect subprograms that have one
-- (e.g. target of assignment, or out parameter), and to False if the
-- modification is only potential (e.g. address of entity taken).
+ function Original_Corresponding_Operation (S : Entity_Id) return Entity_Id;
+ -- [Ada 2012: AI05-0125-1]: If S is an inherited dispatching primitive S2,
+ -- or overrides an inherited dispatching primitive S2, the original
+ -- corresponding operation of S is the original corresponding operation of
+ -- S2. Otherwise, it is S itself.
+
function Object_Access_Level (Obj : Node_Id) return Uint;
-- Return the accessibility level of the view of the object Obj.
-- For convenience, qualified expressions applied to object names
-- Removes any qualifications from Expr. For example, for T1'(T2'(X)), this
-- returns X. If Expr is not a qualified expression, returns Expr.
+ function Visible_Ancestors (Typ : Entity_Id) return Elist_Id;
+ -- [Ada 2012:AI-0125-1]: Collect all the visible parents and progenitors
+ -- of a type extension or private extension declaration. If the full-view
+ -- of private parents and progenitors is available then it is used to
+ -- generate the list of visible ancestors; otherwise their partial
+ -- view is added to the resulting list.
+
function Within_Init_Proc return Boolean;
-- Determines if Current_Scope is within an init proc
projects / gcc.git / commitdiff