OSDN Git Service

2009-11-30 Vincent Celier <celier@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 13:58:01 +0000 (13:58 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 13:58:01 +0000 (13:58 +0000)
* gnatcmd.adb (Check_Files): Recognize documented switches that have a
separate parameter.

2009-11-30  Robert Dewar  <dewar@adacore.com>

* sem_util.ads: Minor reformatting
* errout.adb: Minor reformatting
Minor code reorganization (use N_Subprogram_Specification to simplify)
* exp_ch7.adb: Add comment.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154802 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/errout.adb
gcc/ada/exp_ch7.adb
gcc/ada/gnatcmd.adb
gcc/ada/sem_util.ads

index b30003b..a93eedf 100644 (file)
@@ -1,3 +1,15 @@
+2009-11-30  Vincent Celier  <celier@adacore.com>
+
+       * gnatcmd.adb (Check_Files): Recognize documented switches that have a
+       separate parameter.
+
+2009-11-30  Robert Dewar  <dewar@adacore.com>
+
+       * sem_util.ads: Minor reformatting
+       * errout.adb: Minor reformatting
+       Minor code reorganization (use N_Subprogram_Specification to simplify)
+       * exp_ch7.adb: Add comment.
+
 2009-11-30  Thomas Quinot  <quinot@adacore.com>
 
        * put_scos.adb (Put_SCOs): Do not generate a SCO unit header for a unit
index 3ab5326..651b43d 100644 (file)
@@ -2851,14 +2851,12 @@ package body Errout is
                   if Is_Itype (Ent) then
                      declare
                         Assoc : constant Node_Id :=
-                          Associated_Node_For_Itype (Ent);
+                                  Associated_Node_For_Itype (Ent);
 
                      begin
-                        if Nkind (Assoc) = N_Procedure_Specification
-                          or else Nkind (Assoc) = N_Function_Specification
-                        then
+                        if Nkind (Assoc) in N_Subprogram_Specification then
 
-                           --  Anonymous access to subprogram in a signature
+                           --  Anonymous access to subprogram in a signature.
                            --  Indicate the enclosing subprogram.
 
                            Ent :=
@@ -2878,6 +2876,7 @@ package body Errout is
                else
                   Set_Msg_Str ("access to procedure ");
                end if;
+
                exit;
 
             --  Type is access to object, named or anonymous
index 980acf6..db3cd20 100644 (file)
@@ -3288,9 +3288,10 @@ package body Exp_Ch7 is
 
    begin
       --  Class-wide types must be treated as controlled because they may
-      --  contain an extension that has controlled components
+      --  contain an extension that has controlled components.
 
-      --  We can skip this if finalization is not available
+      --  We can skip this if finalization is not available.
+      --  or if it is a value type (because ???)
 
       return (Is_Class_Wide_Type (T)
                 and then not In_Finalization_Root (T)
index e0ccc22..1588d4e 100644 (file)
@@ -318,8 +318,31 @@ procedure GNATCmd is
 
       for Index in 1 .. Last_Switches.Last loop
          if Last_Switches.Table (Index) (1) /= '-' then
-            Add_Sources := False;
-            exit;
+            if Index = 1
+              or else
+                (The_Command = Check
+                   and then
+                     Last_Switches.Table (Index - 1).all /= "-o")
+              or else
+                (The_Command = Pretty
+                   and then
+                     Last_Switches.Table (Index - 1).all /= "-o"  and then
+                     Last_Switches.Table (Index - 1).all /= "-of")
+              or else
+                (The_Command = Metric
+                   and then
+                     Last_Switches.Table (Index - 1).all /= "-o"  and then
+                     Last_Switches.Table (Index - 1).all /= "-og" and then
+                     Last_Switches.Table (Index - 1).all /= "-ox" and then
+                     Last_Switches.Table (Index - 1).all /= "-d")
+              or else
+                (The_Command /= Check  and then
+                 The_Command /= Pretty and then
+                 The_Command /= Metric)
+            then
+               Add_Sources := False;
+               exit;
+            end if;
          end if;
       end loop;
 
index c1d534a..1a11cb9 100644 (file)
@@ -619,10 +619,9 @@ package Sem_Util is
    --  corresponding private part must not.
 
    procedure Insert_Explicit_Dereference (N : Node_Id);
-   --  In a context that requires a composite or subprogram type and
-   --  where a prefix is an access type, rewrite the access type node
-   --  N (which is the prefix, e.g. of an indexed component) as an
-   --  explicit dereference.
+   --  In a context that requires a composite or subprogram type and where a
+   --  prefix is an access type, rewrite the access type node N (which is the
+   --  prefix, e.g. of an indexed component) as an explicit dereference.
 
    procedure Inspect_Deferred_Constant_Completion (Decls : List_Id);
    --  Examine all deferred constants in the declaration list Decls and check
@@ -630,13 +629,12 @@ package Sem_Util is
    --  Import pragma. Emit the error message if that is not the case.
 
    function Is_AAMP_Float (E : Entity_Id) return Boolean;
-   --  Defined for all type entities. Returns True only for the base type
-   --  of float types with AAMP format. The particular format is determined
-   --  by the Digits_Value value which is 6 for the 32-bit floating point type,
-   --  or 9 for the 48-bit type. This is not an attribute function (like
-   --  VAX_Float) in order to not use up an extra flag and to prevent
-   --  the dependency of Einfo on Targparm which would be required for a
-   --  synthesized attribute.
+   --  Defined for all type entities. Returns True only for the base type of
+   --  float types with AAMP format. The particular format is determined by the
+   --  Digits_Value value which is 6 for the 32-bit floating point type, or 9
+   --  for the 48-bit type. This is not an attribute function (like VAX_Float)
+   --  in order to not use up an extra flag and to prevent the dependency of
+   --  Einfo on Targparm which would be required for a synthesized attribute.
 
    function Is_Actual_Out_Parameter (N : Node_Id) return Boolean;
    --  Determines if N is an actual parameter of out mode in a subprogram call
@@ -677,10 +675,10 @@ package Sem_Util is
    --  False. The nodes passed to this function are assumed to denote objects.
 
    function Is_Dereferenced (N : Node_Id) return Boolean;
-   --  N is a subexpression node of an access type. This function returns
-   --  true if N appears as the prefix of a node that does a dereference
-   --  of the access value (selected/indexed component, explicit dereference
-   --  or a slice), and false otherwise.
+   --  N is a subexpression node of an access type. This function returns true
+   --  if N appears as the prefix of a node that does a dereference of the
+   --  access value (selected/indexed component, explicit dereference or a
+   --  slice), and false otherwise.
 
    function Is_Descendent_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
    --  Returns True if type T1 is a descendent of type T2, and false otherwise.
@@ -721,8 +719,8 @@ package Sem_Util is
    --  i.e. a library unit or an entity declared in a library package.
 
    function Is_Local_Variable_Reference (Expr : Node_Id) return Boolean;
-   --  Determines whether Expr is a reference to a variable or IN OUT
-   --  mode parameter of the current enclosing subprogram.
+   --  Determines whether Expr is a reference to a variable or IN OUT mode
+   --  parameter of the current enclosing subprogram.
    --  Why are OUT parameters not considered here ???
 
    function Is_Object_Reference (N : Node_Id) return Boolean;
@@ -737,12 +735,11 @@ package Sem_Util is
    --  target are considered view conversions and hence variables.
 
    function Is_Partially_Initialized_Type (Typ : Entity_Id) return Boolean;
-   --  Typ is a type entity. This function returns true if this type is
-   --  partly initialized, meaning that an object of the type is at least
-   --  partly initialized (in particular in the record case, that at least
-   --  one component has an initialization expression). Note that
-   --  initialization resulting from the use of pragma Normalized_Scalars does
-   --  not count.
+   --  Typ is a type entity. This function returns true if this type is partly
+   --  initialized, meaning that an object of the type is at least partly
+   --  initialized (in particular in the record case, that at least one
+   --  component has an initialization expression). Note that initialization
+   --  resulting from the use of pragma Normalized_Scalars does not count.
 
    function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean;
    --  Determines if type T is a potentially persistent type. A potentially
@@ -799,37 +796,35 @@ package Sem_Util is
 
    function Is_Value_Type (T : Entity_Id) return Boolean;
    --  Returns true if type T represents a value type. This is only relevant to
-   --  CIL, will always return false for other targets.
-   --  A value type is a CIL object that is accessed directly, as opposed to
-   --  the other CIL objects that are accessed through managed pointers.
+   --  CIL, will always return false for other targets. A value type is a CIL
+   --  object that is accessed directly, as opposed to the other CIL objects
+   --  that are accessed through managed pointers.
 
    function Is_Delegate (T : Entity_Id) return Boolean;
    --  Returns true if type T represents a delegate. A Delegate is the CIL
-   --  object used to represent access-to-subprogram types.
-   --  This is only relevant to CIL, will always return false for other
-   --  targets.
+   --  object used to represent access-to-subprogram types. This is only
+   --  relevant to CIL, will always return false for other targets.
 
    function Is_Variable (N : Node_Id) return Boolean;
-   --  Determines if the tree referenced by N represents a variable, i.e.
-   --  can appear on the left side of an assignment. There is one situation,
-   --  namely formal parameters, in which non-tagged type conversions are
-   --  also considered variables, but Is_Variable returns False for such
-   --  cases, since it has no knowledge of the context. Note that this is
-   --  the point at which Assignment_OK is checked, and True is returned
-   --  for any tree thus marked.
+   --  Determines if the tree referenced by N represents a variable, i.e. can
+   --  appear on the left side of an assignment. There is one situation (formal
+   --  parameters) in which non-tagged type conversions are also considered
+   --  variables, but Is_Variable returns False for such cases, since it has
+   --  no knowledge of the context. Note that this is the point at which
+   --  Assignment_OK is checked, and True is returned for any tree thus marked.
 
    function Is_Visibly_Controlled (T : Entity_Id) return Boolean;
-   --  Check whether T is derived from a visibly controlled type.
-   --  This is true if the root type is declared in Ada.Finalization.
-   --  If T is derived instead from a private type whose full view
-   --  is controlled, an explicit Initialize/Adjust/Finalize subprogram
-   --  does not override the inherited one.
+   --  Check whether T is derived from a visibly controlled type. This is true
+   --  if the root type is declared in Ada.Finalization. If T is derived
+   --  instead from a private type whose full view is controlled, an explicit
+   --  Initialize/Adjust/Finalize subprogram does not override the inherited
+   --  one.
 
    function Is_Volatile_Object (N : Node_Id) return Boolean;
-   --  Determines if the given node denotes an volatile object in the sense
-   --  of the legality checks described in RM C.6(12). Note that the test
-   --  here is for something actually declared as volatile, not for an object
-   --  that gets treated as volatile (see Einfo.Treat_As_Volatile).
+   --  Determines if the given node denotes an volatile object in the sense of
+   --  the legality checks described in RM C.6(12). Note that the test here is
+   --  for something actually declared as volatile, not for an object that gets
+   --  treated as volatile (see Einfo.Treat_As_Volatile).
 
    procedure Kill_Current_Values (Last_Assignment_Only : Boolean := False);
    --  This procedure is called to clear all constant indications from all
@@ -867,8 +862,8 @@ package Sem_Util is
    procedure Kill_Size_Check_Code (E : Entity_Id);
    --  Called when an address clause or pragma Import is applied to an entity.
    --  If the entity is a variable or a constant, and size check code is
-   --  present, this size check code is killed, since the object will not
-   --  be allocated by the program.
+   --  present, this size check code is killed, since the object will not be
+   --  allocated by the program.
 
    function Known_To_Be_Assigned (N : Node_Id) return Boolean;
    --  The node N is an entity reference. This function determines whether the