+2011-08-05 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Is_Init_Call): Reimplemented to avoid character
+ comparison and rely on concrete entities instead.
+
+2011-08-05 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.ads, einfo.adb (Has_Implicit_Dereference): new flag on types
+ and discriminants, to indicate that the type has an access discriminant
+ that supports implicit dereference.
+ * snames.ads-tmpl: Add names of aspects and attributes related to
+ Ada2012 iterators: constant_indexing, default_iterator,
+ iterator_element, implicit_dereference, variable_indexing.
+ * aspects.ads, aspects.adb: entries for iterator-related aspects.
+ * sem_ch13.adb (Analyze_aspect_specifications): dummy entries for
+ iterator-related aspects.
+ * sem_attr.adb, exp_attr.adb Dummy entries for iterator-related aspects.
+
+2011-08-05 Sergey Rybin <rybin@adacore.com>
+
+ * gnat_ugn.texi, vms_data.ads: Extend the subsection about coupling
+ metrics in gnatmetric to cover new kinds of coupling mentrics.
+
+2011-08-05 Steve Baird <baird@adacore.com>
+
+ * bindgen.adb (Gen_CodePeer_Wrapper): Call Ada_Main_Program instead
+ of calling the user-defined main subprogram.
+ (Gen_Main): Declare Ada_Main_Program and (if CodePeer_Mode
+ is set) Call_Main_Subprogram ahead of, as opposed to
+ inside of, Main.
+ (Gen_Output_File_Ada): Remove CodePeer_Mode-conditional
+ generation of a "with" of the user-defined main subprogram.
+ Remove CodePeer_Mode-conditional call to Gen_CodePeer_Wrapper
+ (which is now called from Gen_Main instead).
+
2011-08-05 Emmanuel Briot <briot@adacore.com>
* projects.texi: Added reference to the Makefile package.
Aspect_Atomic_Components => Aspect_Atomic_Components,
Aspect_Bit_Order => Aspect_Bit_Order,
Aspect_Component_Size => Aspect_Component_Size,
+ Aspect_Constant_Indexing => Aspect_Constant_Indexing,
Aspect_Default_Component_Value => Aspect_Default_Component_Value,
+ Aspect_Default_Iterator => Aspect_Default_Iterator,
Aspect_Default_Value => Aspect_Default_Value,
Aspect_Discard_Names => Aspect_Discard_Names,
Aspect_Dynamic_Predicate => Aspect_Predicate,
Aspect_External_Tag => Aspect_External_Tag,
Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
+ Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
Aspect_Inline => Aspect_Inline,
Aspect_Inline_Always => Aspect_Inline,
+ Aspect_Iterator_Element => Aspect_Iterator_Element,
Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
Aspect_Compiler_Unit => Aspect_Compiler_Unit,
Aspect_Elaborate_Body => Aspect_Elaborate_Body,
Aspect_Unreferenced => Aspect_Unreferenced,
Aspect_Unreferenced_Objects => Aspect_Unreferenced_Objects,
Aspect_Unsuppress => Aspect_Unsuppress,
+ Aspect_Variable_Indexing => Aspect_Variable_Indexing,
Aspect_Value_Size => Aspect_Value_Size,
Aspect_Volatile => Aspect_Volatile,
Aspect_Volatile_Components => Aspect_Volatile_Components,
Aspect_Alignment,
Aspect_Bit_Order,
Aspect_Component_Size,
+ Aspect_Constant_Indexing,
Aspect_Default_Component_Value,
+ Aspect_Default_Iterator,
Aspect_Default_Value,
Aspect_Dynamic_Predicate,
Aspect_External_Tag,
+ Aspect_Implicit_Dereference,
Aspect_Input,
Aspect_Invariant,
+ Aspect_Iterator_Element,
Aspect_Machine_Radix,
Aspect_Object_Size, -- GNAT
Aspect_Output,
Aspect_Type_Invariant,
Aspect_Unsuppress,
Aspect_Value_Size, -- GNAT
+ Aspect_Variable_Indexing,
Aspect_Warnings,
Aspect_Write,
Aspect_Alignment => Expression,
Aspect_Bit_Order => Expression,
Aspect_Component_Size => Expression,
+ Aspect_Constant_Indexing => Name,
Aspect_Default_Component_Value => Expression,
+ Aspect_Default_Iterator => Name,
Aspect_Default_Value => Expression,
Aspect_Dynamic_Predicate => Expression,
Aspect_External_Tag => Expression,
+ Aspect_Implicit_Dereference => Name,
Aspect_Input => Name,
Aspect_Invariant => Expression,
+ Aspect_Iterator_Element => Name,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Output => Name,
Aspect_Type_Invariant => Expression,
Aspect_Unsuppress => Name,
Aspect_Value_Size => Expression,
+ Aspect_Variable_Indexing => Name,
Aspect_Warnings => Name,
Aspect_Write => Name,
Aspect_Bit_Order => Name_Bit_Order,
Aspect_Compiler_Unit => Name_Compiler_Unit,
Aspect_Component_Size => Name_Component_Size,
+ Aspect_Constant_Indexing => Name_Constant_Indexing,
+ Aspect_Default_Iterator => Name_Default_Iterator,
Aspect_Default_Value => Name_Default_Value,
Aspect_Default_Component_Value => Name_Default_Component_Value,
Aspect_Discard_Names => Name_Discard_Names,
Aspect_Elaborate_Body => Name_Elaborate_Body,
Aspect_External_Tag => Name_External_Tag,
Aspect_Favor_Top_Level => Name_Favor_Top_Level,
+ Aspect_Implicit_Dereference => Name_Implicit_Dereference,
Aspect_Inline => Name_Inline,
Aspect_Inline_Always => Name_Inline_Always,
Aspect_Input => Name_Input,
Aspect_Invariant => Name_Invariant,
+ Aspect_Iterator_Element => Name_Iterator_Element,
Aspect_Machine_Radix => Name_Machine_Radix,
Aspect_No_Return => Name_No_Return,
Aspect_Object_Size => Name_Object_Size,
Aspect_Unreferenced_Objects => Name_Unreferenced_Objects,
Aspect_Unsuppress => Name_Unsuppress,
Aspect_Value_Size => Name_Value_Size,
+ Aspect_Variable_Indexing => Name_Variable_Indexing,
Aspect_Volatile => Name_Volatile,
Aspect_Volatile_Components => Name_Volatile_Components,
Aspect_Warnings => Name_Warnings,
--------------------------
procedure Gen_CodePeer_Wrapper is
+ Callee_Name : constant String := "Ada_Main_Program";
begin
- Get_Name_String (Units.Table (First_Unit_Entry).Uname);
-
- declare
- -- Bypass Ada_Main_Program; its Import pragma confuses CodePeer
-
- Callee_Name : String renames Name_Buffer (1 .. Name_Len - 2);
- -- Strip trailing "%b"
-
- begin
- if ALIs.Table (ALIs.First).Main_Program = Proc then
- WBI (" procedure " & CodePeer_Wrapper_Name & " is ");
- WBI (" begin");
- WBI (" " & Callee_Name & ";");
+ if ALIs.Table (ALIs.First).Main_Program = Proc then
+ WBI (" procedure " & CodePeer_Wrapper_Name & " is ");
+ WBI (" begin");
+ WBI (" " & Callee_Name & ";");
- else
- WBI
- (" function " & CodePeer_Wrapper_Name & " return Integer is");
- WBI (" begin");
- WBI (" return " & Callee_Name & ";");
- end if;
- end;
+ else
+ WBI (" function " & CodePeer_Wrapper_Name & " return Integer is");
+ WBI (" begin");
+ WBI (" return " & Callee_Name & ";");
+ end if;
WBI (" end " & CodePeer_Wrapper_Name & ";");
WBI ("");
procedure Gen_Main is
begin
+ if not No_Main_Subprogram then
+ -- To call the main program, we declare it using a pragma Import
+ -- Ada with the right link name.
+
+ -- It might seem more obvious to "with" the main program, and call
+ -- it in the normal Ada manner. We do not do this for three
+ -- reasons:
+
+ -- 1. It is more efficient not to recompile the main program
+ -- 2. We are not entitled to assume the source is accessible
+ -- 3. We don't know what options to use to compile it
+
+ -- It is really reason 3 that is most critical (indeed we used
+ -- to generate the "with", but several regression tests failed).
+
+ if ALIs.Table (ALIs.First).Main_Program = Func then
+ WBI (" function Ada_Main_Program return Integer;");
+
+ else
+ WBI (" procedure Ada_Main_Program;");
+ end if;
+
+ Set_String (" pragma Import (Ada, Ada_Main_Program, """);
+ Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+ Set_Main_Program_Name;
+ Set_String (""");");
+
+ Write_Statement_Buffer;
+ WBI ("");
+
+ -- For CodePeer, declare a wrapper for the user-defined main program
+ if CodePeer_Mode then
+ Gen_CodePeer_Wrapper;
+ end if;
+ end if;
+
if Exit_Status_Supported_On_Target then
Set_String (" function ");
else
-- Deal with declarations for main program case
if not No_Main_Subprogram then
- if CodePeer_Mode then
- if ALIs.Table (ALIs.First).Main_Program = Func then
- WBI (" Result : Integer;");
- end if;
-
- else
- -- To call the main program, we declare it using a pragma Import
- -- Ada with the right link name.
-
- -- It might seem more obvious to "with" the main program, and call
- -- it in the normal Ada manner. We do not do this for three
- -- reasons:
-
- -- 1. It is more efficient not to recompile the main program
- -- 2. We are not entitled to assume the source is accessible
- -- 3. We don't know what options to use to compile it
-
- -- It is really reason 3 that is most critical (indeed we used
- -- to generate the "with", but several regression tests failed).
-
+ if ALIs.Table (ALIs.First).Main_Program = Func then
+ WBI (" Result : Integer;");
WBI ("");
+ end if;
- if ALIs.Table (ALIs.First).Main_Program = Func then
- WBI (" Result : Integer;");
- WBI ("");
- WBI (" function Ada_Main_Program return Integer;");
-
- else
- WBI (" procedure Ada_Main_Program;");
- end if;
-
- Set_String (" pragma Import (Ada, Ada_Main_Program, """);
- Get_Name_String (Units.Table (First_Unit_Entry).Uname);
- Set_Main_Program_Name;
- Set_String (""");");
-
- Write_Statement_Buffer;
+ if Bind_Main_Program
+ and then not Suppress_Standard_Library_On_Target
+ and then not CodePeer_Mode
+ then
+ WBI (" SEH : aliased array (1 .. 2) of Integer;");
WBI ("");
-
- if Bind_Main_Program
- and then not Suppress_Standard_Library_On_Target
- then
- WBI (" SEH : aliased array (1 .. 2) of Integer;");
- WBI ("");
- end if;
end if;
end if;
WBI ("with Ada.Exceptions;");
end if;
- if CodePeer_Mode then
-
- -- For CodePeer, main program is not called via an Import pragma
-
- Get_Name_String (Units.Table (First_Unit_Entry).Uname);
-
- -- Note: trailing "%b" is stripped.
-
- WBI ("with " & Name_Buffer (1 .. Name_Len - 2) & ";");
- end if;
-
WBI ("");
WBI ("package body " & Ada_Main & " is");
WBI (" pragma Warnings (Off);");
Gen_Adainit;
if Bind_Main_Program and then VM_Target = No_VM then
-
- -- For CodePeer, declare a wrapper for the user-defined main program
-
- if CodePeer_Mode then
- Gen_CodePeer_Wrapper;
- end if;
-
Gen_Main;
end if;
-- Is_Processed_Transient Flag252
-- Is_Postcondition_Proc Flag253
- -- (unused) Flag151
- -- (unused) Flag251
+ -- (Has_Implicit_Dereference) Flag251
-- (unused) Flag254
-----------------------
return Flag56 (Id);
end Has_Homonym;
+ function Has_Implicit_Dereference (Id : E) return B is
+ begin
+ return Flag251 (Id);
+ end Has_Implicit_Dereference;
+
function Has_Inheritable_Invariants (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
Set_Flag56 (Id, V);
end Set_Has_Homonym;
+ procedure Set_Has_Implicit_Dereference (Id : E; V : B := True) is
+ begin
+ Set_Flag251 (Id, V);
+ end Set_Has_Implicit_Dereference;
+
procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id));
W ("Has_Fully_Qualified_Name", Flag173 (Id));
W ("Has_Gigi_Rep_Item", Flag82 (Id));
W ("Has_Homonym", Flag56 (Id));
+ W ("Has_Implicit_Dereference", Flag251 (Id));
W ("Has_Inheritable_Invariants", Flag248 (Id));
W ("Has_Initial_Value", Flag219 (Id));
W ("Has_Invariants", Flag232 (Id));
-- Present in all entities. Set if an entity has a homonym in the same
-- scope. Used by Gigi to generate unique names for such entities.
+-- Has_Implicit_Dereference (Flag251)
+-- Present in types and discriminants. Set if the type has an aspect
+-- Implicit_Dereference. Set also on the discriminant named in the aspect
+-- clause, to simplify type resolution.
+
-- Has_Initial_Value (Flag219)
-- Present in entities for variables and out parameters. Set if there
-- is an explicit initial value expression in the declaration of the
function Has_Fully_Qualified_Name (Id : E) return B;
function Has_Gigi_Rep_Item (Id : E) return B;
function Has_Homonym (Id : E) return B;
+ function Has_Implicit_Dereference (Id : E) return B;
function Has_Inheritable_Invariants (Id : E) return B;
function Has_Initial_Value (Id : E) return B;
function Has_Invariants (Id : E) return B;
procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True);
procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True);
procedure Set_Has_Homonym (Id : E; V : B := True);
+ procedure Set_Has_Implicit_Dereference (Id : E; V : B := True);
procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True);
procedure Set_Has_Initial_Value (Id : E; V : B := True);
procedure Set_Has_Invariants (Id : E; V : B := True);
pragma Inline (Has_Fully_Qualified_Name);
pragma Inline (Has_Gigi_Rep_Item);
pragma Inline (Has_Homonym);
+ pragma Inline (Has_Implicit_Dereference);
pragma Inline (Has_Inheritable_Invariants);
pragma Inline (Has_Initial_Value);
pragma Inline (Has_Invariants);
pragma Inline (Set_Has_Fully_Qualified_Name);
pragma Inline (Set_Has_Gigi_Rep_Item);
pragma Inline (Set_Has_Homonym);
+ pragma Inline (Set_Has_Implicit_Dereference);
pragma Inline (Set_Has_Inheritable_Invariants);
pragma Inline (Set_Has_Initial_Value);
pragma Inline (Set_Has_Invariants);
case Id is
+ -- Attributes related to Ada2012 iterators (Placeholder)
+
+ when Attribute_Constant_Indexing => null;
+ when Attribute_Default_Iterator => null;
+ when Attribute_Implicit_Dereference => null;
+ when Attribute_Iterator_Element => null;
+ when Attribute_Variable_Indexing => null;
+
------------
-- Access --
------------
and then Nkind (Name (N)) = N_Identifier
then
declare
- Call_Nam : constant Name_Id := Chars (Entity (Name (N)));
+ Call_Ent : constant Entity_Id := Entity (Name (N));
Deep_Init : constant Entity_Id :=
TSS (Typ, TSS_Deep_Initialize);
Init : Entity_Id := Empty;
return
(Present (Deep_Init)
- and then Chars (Deep_Init) = Call_Nam)
+ and then Call_Ent = Deep_Init)
or else
(Present (Init)
- and then Chars (Init) = Call_Nam);
+ and then Call_Ent = Init);
end;
end if;
* Line Metrics Control::
* Syntax Metrics Control::
* Complexity Metrics Control::
-* Object-Oriented Metrics Control::
+* Coupling Metrics Control::
@end menu
@node Line Metrics Control
@end table
-@node Object-Oriented Metrics Control
-@subsubsection Object-Oriented Metrics Control
-@cindex Object-Oriented metrics control in @command{gnatmetric}
+@node Coupling Metrics Control
+@subsubsection Coupling Metrics Control
+@cindex Coupling metrics control in @command{gnatmetric}
@noindent
@cindex Coupling metrics (in in @command{gnatmetric})
-Coupling metrics are object-oriented metrics that measure the
-dependencies between a given class (or a group of classes) and the
-``external world'' (that is, the other classes in the program). In this
-subsection the term ``class'' is used in its
-traditional object-oriented programming sense
-(an instantiable module that contains data and/or method members).
-A @emph{category} (of classes)
-is a group of closely related classes that are reused and/or
-modified together.
-
-A class @code{K}'s @emph{efferent coupling} is the number of classes
+Coupling metrics measure the dependencies between a given entity and other
+entities the program consists of. The goal of these metrics is to estimate the
+stability of the whole program considered as the collection of entities
+(modules, classes etc.).
+
+Gnatmetric computes the following coupling metrics:
+
+@itemize @bullet
+
+@item
+@emph{object-oriented coupling} - for classes in traditional object-oriented
+sense;
+
+@item
+emph{unit coupling} - for all the program units making up a program;
+
+@item
+emph{control coupling} - this metric counts dependencies between a unit and
+only those units that define subprograms;
+@end itemize
+
+@noindent
+Two kinds of coupling metrics are computed:
+
+@table @asis
+@item fan-out coupling (efferent coupling)
+@cindex fan-out coupling
+@cindex efferent coupling
+the number of entities the given entity depends upon. It
+estimates in what extent the given entity depends on the changes in
+``external world''
+
+@item fan-in coupling (afferent coupling)
+@cindex fan-in coupling
+@cindex afferent coupling
+the number of entities that depend on a given entity.
+It estimates in what extent the ``external world'' depends on the changes in a
+given entity
+@end table
+
+@noindent
+
+Object-oriented coupling metrics are metrics that measure the dependencies
+between a given class (or a group of classes) and the other classes in the
+program. In this subsection the term ``class'' is used in its traditional
+object-oriented programming sense (an instantiable module that contains data
+and/or method members). A @emph{category} (of classes) is a group of closely
+related classes that are reused and/or modified together.
+
+A class @code{K}'s fan-out coupling is the number of classes
that @code{K} depends upon.
-A category's efferent coupling is the number of classes outside the
+A category's fan-out coupling is the number of classes outside the
category that the classes inside the category depend upon.
-A class @code{K}'s @emph{afferent coupling} is the number of classes
+A class @code{K}'s fan-in coupling is the number of classes
that depend upon @code{K}.
-A category's afferent coupling is the number of classes outside the
+A category's fan-in coupling is the number of classes outside the
category that depend on classes belonging to the category.
Ada's implementation of the object-oriented paradigm does not use the
considered to be a class. A category consists of a library package (or
a library generic package) that defines a tagged or an interface type,
together with all its descendant (generic) packages that define tagged
-or interface types. For any package counted as a class,
-its body and subunits (if any) are considered
-together with its spec when counting the dependencies, and coupling
-metrics are reported for spec units only. For dependencies
-between classes, the Ada semantic dependencies are considered.
-For coupling metrics, only dependencies on units that are considered as
-classes, are considered.
+or interface types. That is a
+category is an Ada hierarchy of library-level program units. So class coupling
+in case of Ada is called as tagged coupling, and category coupling - as
+hierarchy coupling.
+
+For any package counted as a class, its body and subunits (if any) are
+considered together with its spec when counting the dependencies, and coupling
+metrics are reported for spec units only. For dependencies between classes,
+the Ada semantic dependencies are considered. For object-oriented coupling
+metrics, only dependencies on units that are considered as classes, are
+considered.
+
+For unit and control coupling also not compilation units but program units are
+counted. That is, for a package, its spec, its body and its subunits (if any)
+are considered as making up one unit, and the dependencies that are counted
+are the dependencies of all these compilation units collected together as
+the dependencies as a (whole) unit. And metrics are reported for spec
+compilation units only (or for a subprogram body unit in case if there is no
+separate spec for the given subprogram).
+
+For unit coupling, dependencies between all kinds of program units are
+considered. For control coupling, for each unit the dependencies of this unit
+upon units that define subprograms are counted, so control fan-out coupling
+is reported for all units, but control fan-in coupling - only for the units
+that define subprograms.
+
+
+
+
+
When computing coupling metrics, @command{gnatmetric} counts only
dependencies between units that are arguments of the gnatmetric call.
get a valid result, you should call @command{gnatmetric} for
the whole set of sources that make up your program. It can be done
by calling @command{gnatmetric} from the GNAT driver with @option{-U}
-option (see See @ref{The GNAT Driver and Project Files} for details.
+option (see @ref{The GNAT Driver and Project Files} for details).
By default, all the coupling metrics are disabled. You can use the following
switches to specify the coupling metrics to be computed and reported:
@table @option
@ifclear vms
-@cindex @option{--package@var{x}} (@command{gnatmetric})
-@cindex @option{--no-package@var{x}} (@command{gnatmetric})
-@cindex @option{--category@var{x}} (@command{gnatmetric})
-@cindex @option{--no-category@var{x}} (@command{gnatmetric})
+@cindex @option{--tagged-coupling@var{x}} (@command{gnatmetric})
+@cindex @option{--hierarchy-coupling@var{x}} (@command{gnatmetric})
+@cindex @option{--unit-coupling@var{x}} (@command{gnatmetric})
+@cindex @option{--control-coupling@var{x}} (@command{gnatmetric})
@end ifclear
@ifset vms
@item ^--coupling-all^/COUPLING_METRICS=ALL^
Report all the coupling metrics
-@item ^--no-coupling-all^/COUPLING_METRICS=NONE^
-Do not report any of metrics
-
-@item ^--package-efferent-coupling^/COUPLING_METRICS=PACKAGE_EFFERENT^
-Report package efferent coupling
-
-@item ^--no-package-efferent-coupling^/COUPLING_METRICS=NOPACKAGE_EFFERENT^
-Do not report package efferent coupling
+@item ^--tagged-coupling-out^/COUPLING_METRICS=TAGGED_OUT^
+Report tagged (class) fan-out coupling
-@item ^--package-afferent-coupling^/COUPLING_METRICS=PACKAGE_AFFERENT^
-Report package afferent coupling
+@item ^--tagged-coupling-in^/COUPLING_METRICS=TAGGED_IN^
+Report tagged (class) fan-in coupling
-@item ^--no-package-afferent-coupling^/COUPLING_METRICS=NOPACKAGE_AFFERENT^
-Do not report package afferent coupling
+@item ^--hierarchy-coupling-out^/COUPLING_METRICS=HIERARCHY_OUT^
+Report hierarchy (category) fan-out coupling
-@item ^--category-efferent-coupling^/COUPLING_METRICS=CATEGORY_EFFERENT^
-Report category efferent coupling
+@item ^--hierarchy-coupling-in^/COUPLING_METRICS=HIERARCHY_IN^
+Report hierarchy (category) fan-in coupling
-@item ^--no-category-efferent-coupling^/COUPLING_METRICS=NOCATEGORY_EFFERENT^
-Do not report category efferent coupling
+@item ^--unit-coupling-out^/COUPLING_METRICS=UNIT_OUT^
+Report unit fan-out coupling
-@item ^--category-afferent-coupling^/COUPLING_METRICS=CATEGORY_AFFERENT^
-Report category afferent coupling
+@item ^--unit-coupling-in^/COUPLING_METRICS=UNIT_IN^
+Report unit fan-in coupling
-@item ^--no-category-afferent-coupling^/COUPLING_METRICS=NOCATEGORY_AFFERENT^
-Do not report category afferent coupling
+@item ^--control-coupling-out^/COUPLING_METRICS=CONTROL_OUT^
+Report control fan-out coupling
+@item ^--control-coupling-in^/COUPLING_METRICS=CONTROL_IN^
+Report control fan-in coupling
@end table
@node Other gnatmetric Switches
case Attr_Id is
+ -- Attributes related to Ada2012 iterators (Placeholder).
+
+ when Attribute_Constant_Indexing => null;
+ when Attribute_Default_Iterator => null;
+ when Attribute_Implicit_Dereference => null;
+ when Attribute_Iterator_Element => null;
+ when Attribute_Variable_Indexing => null;
+
------------------
-- Abort_Signal --
------------------
case Id is
+ -- Attributes related to Ada2012 iterators (Placeholder).
+
+ when Attribute_Constant_Indexing => null;
+ when Attribute_Default_Iterator => null;
+ when Attribute_Implicit_Dereference => null;
+ when Attribute_Iterator_Element => null;
+ when Attribute_Variable_Indexing => null;
+
--------------
-- Adjacent --
--------------
Delay_Required := False;
+ -- Aspects related to container iterators.
+
+ when Aspect_Constant_Indexing |
+ Aspect_Default_Iterator |
+ Aspect_Iterator_Element |
+ Aspect_Variable_Indexing =>
+ null;
+
+ when Aspect_Implicit_Dereference =>
+
+ if not Is_Type (E)
+ or else not Has_Discriminants (E)
+ then
+ Error_Msg_N
+ ("Aspect must apply to a type with discriminants", N);
+ goto Continue;
+
+ else
+ declare
+ Disc : Entity_Id;
+
+ begin
+ Disc := First_Discriminant (E);
+ while Present (Disc) loop
+ if Chars (Expr) = Chars (Disc)
+ and then Ekind (Etype (Disc)) =
+ E_Anonymous_Access_Type
+ then
+ Set_Has_Implicit_Dereference (E);
+ Set_Has_Implicit_Dereference (Disc);
+ goto Continue;
+ end if;
+ Next_Discriminant (Disc);
+ end loop;
+
+ -- Error if no proper access discriminant.
+
+ Error_Msg_NE
+ ("not an access discriminant of&", Expr, E);
+ end;
+
+ goto Continue;
+ end if;
+
-- Aspects corresponding to attribute definition clauses
when Aspect_Address |
end if;
end External_Tag;
+ --------------------------
+ -- Implicit_Dereference --
+ --------------------------
+ when Attribute_Implicit_Dereference =>
+ -- Legality checks already performed above.
+ null; -- TBD
+
-----------
-- Input --
-----------
Aspect_Value_Size =>
T := Any_Integer;
+ when Aspect_Constant_Indexing |
+ Aspect_Default_Iterator |
+ Aspect_Iterator_Element |
+ Aspect_Implicit_Dereference |
+ Aspect_Variable_Indexing =>
+ null;
+
-- Stream attribute. Special case, the expression is just an entity
-- that does not need any resolution, so just analyze.
Name_Compiler_Version : constant Name_Id := N + $; -- GNAT
Name_Component_Size : constant Name_Id := N + $;
Name_Compose : constant Name_Id := N + $;
+ Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT
Name_Constrained : constant Name_Id := N + $;
Name_Count : constant Name_Id := N + $;
Name_Default_Bit_Order : constant Name_Id := N + $; -- GNAT
+ Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
Name_Definite : constant Name_Id := N + $;
Name_Delta : constant Name_Id := N + $;
Name_Denorm : constant Name_Id := N + $;
Name_Has_Tagged_Values : constant Name_Id := N + $; -- GNAT
Name_Identity : constant Name_Id := N + $;
Name_Img : constant Name_Id := N + $; -- GNAT
+ Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT
Name_Integer_Value : constant Name_Id := N + $; -- GNAT
Name_Invalid_Value : constant Name_Id := N + $; -- GNAT
+ Name_Iterator_Element : constant Name_Id := N + $; -- GNAT
Name_Large : constant Name_Id := N + $; -- Ada 83
Name_Last : constant Name_Id := N + $;
Name_Last_Bit : constant Name_Id := N + $;
Name_Val : constant Name_Id := N + $;
Name_Valid : constant Name_Id := N + $;
Name_Value_Size : constant Name_Id := N + $; -- GNAT
+ Name_Variable_Indexing : constant Name_Id := N + $; -- GNAT
Name_Version : constant Name_Id := N + $;
Name_Wchar_T_Size : constant Name_Id := N + $; -- GNAT
Name_Wide_Wide_Width : constant Name_Id := N + $; -- Ada 05
Attribute_Compiler_Version,
Attribute_Component_Size,
Attribute_Compose,
+ Attribute_Constant_Indexing,
Attribute_Constrained,
Attribute_Count,
Attribute_Default_Bit_Order,
+ Attribute_Default_Iterator,
Attribute_Definite,
Attribute_Delta,
Attribute_Denorm,
Attribute_Has_Tagged_Values,
Attribute_Identity,
Attribute_Img,
+ Attribute_Implicit_Dereference,
Attribute_Integer_Value,
Attribute_Invalid_Value,
+ Attribute_Iterator_Element,
Attribute_Large,
Attribute_Last,
Attribute_Last_Bit,
Attribute_Val,
Attribute_Valid,
Attribute_Value_Size,
+ Attribute_Variable_Indexing,
Attribute_Version,
Attribute_Wchar_T_Size,
Attribute_Wide_Wide_Width,
S_Metric_Coupling : aliased constant S := "/COUPLING_METRICS=" &
"ALL " &
"--coupling-all " &
- "NONE " &
- "--no-coupling-all " &
- "PACKAGE_EFFERENT " &
- "--package-efferent-coupling " &
- "NOPACKAGE_EFFERENT " &
- "--no-package-efferent-coupling " &
- "PACKAGE_AFFERENT " &
- "--package-afferent-coupling " &
- "NOPACKAGE_AFFERENT " &
- "--no-package-afferent-coupling " &
- "CATEGORY_EFFERENT " &
- "--category-efferent-coupling " &
- "NOCATEGORY_EFFERENT " &
- "--no-category-efferent-coupling " &
- "CATEGORY_AFFERENT " &
- "--category-afferent-coupling " &
- "NOCATEGORY_AFFERENT " &
- "--no-category-afferent-coupling";
+ "TAGGED_OUT " &
+ "--tagged-coupling-out " &
+ "TAGGED_IN " &
+ "--tagged-coupling-in " &
+ "HIERARCHY_OUT " &
+ "--hierarchy-coupling-out " &
+ "HIERARCHY_IN " &
+ "--hierarchy-coupling-in " &
+ "UNIT_OUT " &
+ "--unit-coupling-out " &
+ "UNIT_IN " &
+ "--unit-coupling-in " &
+ "CONTROL_OUT " &
+ "--control-coupling-out " &
+ "CONTROL_IN " &
+ "--control-coupling-in";
-- /COUPLING_METRICS=(option, option ...)
--
-- option may be one of the following:
--
- -- ALL All the coupling metrics are computed
- -- NONE (D) None of coupling metrics is computed
- -- PACKAGE_EFFERENT Compute package efferent coupling
- -- NOPACKAGE_EFFERENT Do not compute package efferent coupling
- -- PACKAGE_AFFERENT Compute package afferent coupling
- -- NOPACKAGE_AFFERENT Do not compute package afferent coupling
- -- CATEGORY_EFFERENT Compute category efferent coupling
- -- NOCATEGORY_EFFERENT Do not compute category efferent coupling
- -- CATEGORY_AFFERENT Compute category afferent coupling
- -- NOCATEGORY_AFFERENT Do not compute category afferent coupling
+ -- ALL All the coupling metrics are computed
+ -- NOALL (D) None of coupling metrics is computed
+ -- TAGGED_OUT Compute tagged (class) far-out coupling
+ -- TAGGED_IN Compute tagged (class) far-in coupling
+ -- HIERARCHY_OUT Compute hieraqrchy (category) far-out coupling
+ -- HIERARCHY_IN Compute hieraqrchy (category) far-in coupling
+ -- UNIT_OUT Compute unit far-out coupling
+ -- UNIT_IN Compute unit far-in coupling
+ -- CONTROL_OUT Compute control far-out coupling
+ -- CONTROL_IN Compute control far-in coupling
+
--
-- All combinations of coupling metrics options are allowed.
projects / platform / upstream / gcc.git / commitdiff