diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-11-30 14:58:01 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-11-30 14:58:01 +0100 |
commit | 1e0e653424a1e7b9f6743ff4c81f64810b0c01e4 (patch) | |
tree | 8365653ba4acf1a5f451aa845485ec769d8c1798 /gcc | |
parent | c5ff22e7b3ffc1e45b043e1bd35bb3b0bad90817 (diff) | |
download | gcc-1e0e653424a1e7b9f6743ff4c81f64810b0c01e4.zip gcc-1e0e653424a1e7b9f6743ff4c81f64810b0c01e4.tar.gz gcc-1e0e653424a1e7b9f6743ff4c81f64810b0c01e4.tar.bz2 |
[multiple changes]
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.
From-SVN: r154802
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/ada/errout.adb | 9 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.adb | 5 | ||||
-rw-r--r-- | gcc/ada/gnatcmd.adb | 27 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 89 |
5 files changed, 86 insertions, 56 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b30003b..a93eedf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 3ab5326..651b43d 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -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 diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 980acf6..db3cd20 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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) diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index e0ccc228..1588d4e 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -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; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c1d534a..1a11cb9 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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 |