From cd534f03418434ad665a018ec3ebec44dfe998c0 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 20 Jul 2009 13:56:52 +0000 Subject: [PATCH] 2009-07-20 Bob Duff * sem_ch13.adb (Analyze_Record_Representation_Clause): Use "and then" instead of "and", because otherwise Parent_Last_Bit is read uninitialized in the case where it's not a tagged type, or the tagged parent does not have a complete rep clause. 2009-07-20 Robert Dewar * stylesw.ads: Minor documentation change. * types.ads: Minor reformatting 2009-07-20 Javier Miranda * exp_disp.ads (Apply_Access_Checks): New subprogram that takes care of generating the tag checks associated with dispatching calls. * exp_disp.adb (Apply_Access_Checks): New subprogram. (New_Value): This routine was previously local to expand dispatching calls but it is now used also by Apply_Access_Checks. (Expand_Dispatching_Calls): Cleanup code because the functionality of tag checks is now provided by Apply_Access_Checks. * exp_ch6.adb (Expand_Call): Incorporate generation of tag checks in case of dispatching calls. 2009-07-20 Arnaud Charlet * gnat1drv.adb (Gnat1drv): Also disable Elaboration_Check in CodePeer_Mode. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149821 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 30 ++++++ gcc/ada/exp_ch6.adb | 12 ++- gcc/ada/exp_disp.adb | 276 +++++++++++++++++++++++++++++++++++++-------------- gcc/ada/exp_disp.ads | 3 + gcc/ada/gnat1drv.adb | 18 ++-- gcc/ada/sem_ch13.adb | 2 +- gcc/ada/stylesw.ads | 138 +++++++++++++------------- gcc/ada/types.ads | 10 +- 8 files changed, 327 insertions(+), 162 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a3aeec64f2a..41b24fd986e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2009-07-20 Bob Duff + + * sem_ch13.adb (Analyze_Record_Representation_Clause): Use "and then" + instead of "and", because otherwise Parent_Last_Bit is read + uninitialized in the case where it's not a tagged type, or the tagged + parent does not have a complete rep clause. + +2009-07-20 Robert Dewar + + * stylesw.ads: Minor documentation change. + + * types.ads: Minor reformatting + +2009-07-20 Javier Miranda + + * exp_disp.ads (Apply_Access_Checks): New subprogram that takes care of + generating the tag checks associated with dispatching calls. + * exp_disp.adb (Apply_Access_Checks): New subprogram. + (New_Value): This routine was previously local to expand dispatching + calls but it is now used also by Apply_Access_Checks. + (Expand_Dispatching_Calls): Cleanup code because the functionality of + tag checks is now provided by Apply_Access_Checks. + * exp_ch6.adb (Expand_Call): Incorporate generation of tag checks in + case of dispatching calls. + +2009-07-20 Arnaud Charlet + + * gnat1drv.adb (Gnat1drv): Also disable Elaboration_Check in + CodePeer_Mode. + 2009-07-20 Gary Dismukes * exp_prag.adb (Expand_Pragma_Import_Export_Exception): When compiling diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8530816c9b3..dfcf37c7d51 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2612,12 +2612,14 @@ package body Exp_Ch6 is return; - -- Expansion of a dispatching call results in an indirect call, which - -- in turn causes current values to be killed (see Resolve_Call), so - -- on VM targets we do the call here to ensure consistent warnings - -- between VM and non-VM targets. - else + Apply_Tag_Checks (N); + + -- Expansion of a dispatching call results in an indirect call, + -- which in turn causes current values to be killed (see + -- Resolve_Call), so on VM targets we do the call here to ensure + -- consistent warnings between VM and non-VM targets. + Kill_Current_Values; end if; end if; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index f60e7bc2db9..165d9080383 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -80,6 +80,11 @@ package body Exp_Disp is -- Returns true if Prim is not a predefined dispatching primitive but it is -- an alias of a predefined dispatching primitive (i.e. through a renaming) + function New_Value (From : Node_Id) return Node_Id; + -- From is the original Expression. New_Value is equivalent to a call + -- to Duplicate_Subexpr with an explicit dereference when From is an + -- access parameter. + function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean; -- Check if the type has a private view or if the public view appears -- in the visible part of a package spec. @@ -95,6 +100,182 @@ package body Exp_Disp is -- Ada 2005 (AI-345): Determine the tagged kind of T and return a reference -- to an RE_Tagged_Kind enumeration value. + ---------------------- + -- Apply_Tag_Checks -- + ---------------------- + + procedure Apply_Tag_Checks (Call_Node : Node_Id) is + Loc : constant Source_Ptr := Sloc (Call_Node); + Ctrl_Arg : constant Node_Id := Controlling_Argument (Call_Node); + Ctrl_Typ : constant Entity_Id := Base_Type (Etype (Ctrl_Arg)); + Param_List : constant List_Id := Parameter_Associations (Call_Node); + + Subp : Entity_Id; + CW_Typ : Entity_Id; + Param : Node_Id; + Typ : Entity_Id; + Eq_Prim_Op : Entity_Id := Empty; + + begin + if No_Run_Time_Mode then + Error_Msg_CRT ("tagged types", Call_Node); + return; + end if; + + -- Apply_Tag_Checks is called directly from the semantics, so we need + -- a check to see whether expansion is active before proceeding. In + -- addition, there is no need to expand the call when compiling under + -- restriction No_Dispatching_Calls; the semantic analyzer has + -- previously notified the violation of this restriction. + + if not Expander_Active + or else Restriction_Active (No_Dispatching_Calls) + then + return; + end if; + + -- Set subprogram. If this is an inherited operation that was + -- overridden, the body that is being called is its alias. + + Subp := Entity (Name (Call_Node)); + + if Present (Alias (Subp)) + and then Is_Inherited_Operation (Subp) + and then No (DTC_Entity (Subp)) + then + Subp := Alias (Subp); + end if; + + -- Definition of the class-wide type and the tagged type + + -- If the controlling argument is itself a tag rather than a tagged + -- object, then use the class-wide type associated with the subprogram's + -- controlling type. This case can occur when a call to an inherited + -- primitive has an actual that originated from a default parameter + -- given by a tag-indeterminate call and when there is no other + -- controlling argument providing the tag (AI-239 requires dispatching). + -- This capability of dispatching directly by tag is also needed by the + -- implementation of AI-260 (for the generic dispatching constructors). + + if Ctrl_Typ = RTE (RE_Tag) + or else (RTE_Available (RE_Interface_Tag) + and then Ctrl_Typ = RTE (RE_Interface_Tag)) + then + CW_Typ := Class_Wide_Type (Find_Dispatching_Type (Subp)); + + -- Class_Wide_Type is applied to the expressions used to initialize + -- CW_Typ, to ensure that CW_Typ always denotes a class-wide type, since + -- there are cases where the controlling type is resolved to a specific + -- type (such as for designated types of arguments such as CW'Access). + + elsif Is_Access_Type (Ctrl_Typ) then + CW_Typ := Class_Wide_Type (Designated_Type (Ctrl_Typ)); + + else + CW_Typ := Class_Wide_Type (Ctrl_Typ); + end if; + + Typ := Root_Type (CW_Typ); + + if Ekind (Typ) = E_Incomplete_Type then + Typ := Non_Limited_View (Typ); + end if; + + if not Is_Limited_Type (Typ) then + Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq); + end if; + + -- Dispatching call to C++ primitive + + if Is_CPP_Class (Typ) then + null; + + -- Dispatching call to Ada primitive + + elsif Present (Param_List) then + + -- Generate the Tag checks when appropriate + + Param := First_Actual (Call_Node); + while Present (Param) loop + + -- No tag check with itself + + if Param = Ctrl_Arg then + null; + + -- No tag check for parameter whose type is neither tagged nor + -- access to tagged (for access parameters) + + elsif No (Find_Controlling_Arg (Param)) then + null; + + -- No tag check for function dispatching on result if the + -- Tag given by the context is this one + + elsif Find_Controlling_Arg (Param) = Ctrl_Arg then + null; + + -- "=" is the only dispatching operation allowed to get + -- operands with incompatible tags (it just returns false). + -- We use Duplicate_Subexpr_Move_Checks instead of calling + -- Relocate_Node because the value will be duplicated to + -- check the tags. + + elsif Subp = Eq_Prim_Op then + null; + + -- No check in presence of suppress flags + + elsif Tag_Checks_Suppressed (Etype (Param)) + or else (Is_Access_Type (Etype (Param)) + and then Tag_Checks_Suppressed + (Designated_Type (Etype (Param)))) + then + null; + + -- Optimization: no tag checks if the parameters are identical + + elsif Is_Entity_Name (Param) + and then Is_Entity_Name (Ctrl_Arg) + and then Entity (Param) = Entity (Ctrl_Arg) + then + null; + + -- Now we need to generate the Tag check + + else + -- Generate code for tag equality check + -- Perhaps should have Checks.Apply_Tag_Equality_Check??? + + Insert_Action (Ctrl_Arg, + Make_Implicit_If_Statement (Call_Node, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => + Make_Selected_Component (Loc, + Prefix => New_Value (Ctrl_Arg), + Selector_Name => + New_Reference_To + (First_Tag_Component (Typ), Loc)), + + Right_Opnd => + Make_Selected_Component (Loc, + Prefix => + Unchecked_Convert_To (Typ, New_Value (Param)), + Selector_Name => + New_Reference_To + (First_Tag_Component (Typ), Loc))), + + Then_Statements => + New_List (New_Constraint_Error (Loc)))); + end if; + + Next_Actual (Param); + end loop; + end if; + end Apply_Tag_Checks; + ------------------------ -- Building_Static_DT -- ------------------------ @@ -469,8 +650,9 @@ package body Exp_Disp is -- Dispatching call to C++ primitive. Create a new parameter list -- with no tag checks. + New_Params := New_List; + if Is_CPP_Class (Typ) then - New_Params := New_List; Param := First_Actual (Call_Node); while Present (Param) loop Append_To (New_Params, Relocate_Node (Param)); @@ -480,86 +662,19 @@ package body Exp_Disp is -- Dispatching call to Ada primitive elsif Present (Param_List) then + Apply_Tag_Checks (Call_Node); - -- Generate the Tag checks when appropriate - - New_Params := New_List; Param := First_Actual (Call_Node); while Present (Param) loop + -- Cases in which we may have generated runtime checks - -- No tag check with itself - - if Param = Ctrl_Arg then - Append_To (New_Params, - Duplicate_Subexpr_Move_Checks (Param)); - - -- No tag check for parameter whose type is neither tagged nor - -- access to tagged (for access parameters) - - elsif No (Find_Controlling_Arg (Param)) then - Append_To (New_Params, Relocate_Node (Param)); - - -- No tag check for function dispatching on result if the - -- Tag given by the context is this one - - elsif Find_Controlling_Arg (Param) = Ctrl_Arg then - Append_To (New_Params, Relocate_Node (Param)); - - -- "=" is the only dispatching operation allowed to get - -- operands with incompatible tags (it just returns false). - -- We use Duplicate_Subexpr_Move_Checks instead of calling - -- Relocate_Node because the value will be duplicated to - -- check the tags. - - elsif Subp = Eq_Prim_Op then + if Param = Ctrl_Arg + or else Subp = Eq_Prim_Op + then Append_To (New_Params, Duplicate_Subexpr_Move_Checks (Param)); - -- No check in presence of suppress flags - - elsif Tag_Checks_Suppressed (Etype (Param)) - or else (Is_Access_Type (Etype (Param)) - and then Tag_Checks_Suppressed - (Designated_Type (Etype (Param)))) - then - Append_To (New_Params, Relocate_Node (Param)); - - -- Optimization: no tag checks if the parameters are identical - - elsif Is_Entity_Name (Param) - and then Is_Entity_Name (Ctrl_Arg) - and then Entity (Param) = Entity (Ctrl_Arg) - then - Append_To (New_Params, Relocate_Node (Param)); - - -- Now we need to generate the Tag check - else - -- Generate code for tag equality check - -- Perhaps should have Checks.Apply_Tag_Equality_Check??? - - Insert_Action (Ctrl_Arg, - Make_Implicit_If_Statement (Call_Node, - Condition => - Make_Op_Ne (Loc, - Left_Opnd => - Make_Selected_Component (Loc, - Prefix => New_Value (Ctrl_Arg), - Selector_Name => - New_Reference_To - (First_Tag_Component (Typ), Loc)), - - Right_Opnd => - Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To (Typ, New_Value (Param)), - Selector_Name => - New_Reference_To - (First_Tag_Component (Typ), Loc))), - - Then_Statements => - New_List (New_Constraint_Error (Loc)))); - Append_To (New_Params, Relocate_Node (Param)); end if; @@ -6192,6 +6307,21 @@ package body Exp_Disp is return Result; end Make_Tags; + --------------- + -- New_Value -- + --------------- + + function New_Value (From : Node_Id) return Node_Id is + Res : constant Node_Id := Duplicate_Subexpr (From); + begin + if Is_Access_Type (Etype (From)) then + return Make_Explicit_Dereference (Sloc (From), + Prefix => Res); + else + return Res; + end if; + end New_Value; + ----------------------------------- -- Original_View_In_Visible_Part -- ----------------------------------- diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index 978f0e65f31..18f751d978d 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -170,6 +170,9 @@ package Exp_Disp is -- Exp_Disp.Default_Prim_Op_Position - indirect use -- Exp_Disp.Set_All_DT_Position - direct use + procedure Apply_Tag_Checks (Call_Node : Node_Id); + -- Generate checks required on dispatching calls + function Building_Static_DT (Typ : Entity_Id) return Boolean; pragma Inline (Building_Static_DT); -- Returns true when building statically allocated dispatch tables diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 3117f996164..0e7fd15b74b 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -158,20 +158,22 @@ procedure Gnat1drv is ASIS_Mode := False; - -- Turn off dynamic elaboration checks: generates inconsitencies in + -- Suppress overflow checks and access checks since they are handled + -- implicitely by CodePeer. + + -- Turn off dynamic elaboration checks: generates inconsistencies in -- trees between specs compiled as part of a main unit or as part of -- a with-clause. - Dynamic_Elaboration_Checks := False; - - -- Suppress overflow checks and access checks since they are handled - -- implicitely by CodePeer. Enable all other language checks. + -- Enable all other language checks Suppress_Options := - (Overflow_Check => True, - Access_Check => True, - others => False); + (Overflow_Check => True, + Access_Check => True, + Elaboration_Check => True, + others => False); Enable_Overflow_Checks := False; + Dynamic_Elaboration_Checks := False; -- Kill debug of generated code, since it messes up sloc values diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ef778a2ced3..059abe3f9f7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2623,7 +2623,7 @@ package body Sem_Ch13 is -- this component might overlap a parent field. if Present (Tagged_Parent) - and Fbit <= Parent_Last_Bit + and then Fbit <= Parent_Last_Bit then Pcomp := First_Entity (Tagged_Parent); while Present (Pcomp) loop diff --git a/gcc/ada/stylesw.ads b/gcc/ada/stylesw.ads index 5822ce9f018..37154c05045 100644 --- a/gcc/ada/stylesw.ads +++ b/gcc/ada/stylesw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -48,28 +48,28 @@ package Stylesw is -- other manner. Style_Check_Array_Attribute_Index : Boolean := False; - -- This can be set True by using -gnatg or -gnatyA switches. If it is True - -- then index numbers for array attributes (like Length) are required to - -- be absent for one-dimensional arrays and present for multi-dimensional + -- This can be set True by using the -gnatyA switch. If it is True then + -- index numbers for array attributes (like Length) are required to be + -- absent for one-dimensional arrays and present for multi-dimensional -- array attribute references. Style_Check_Attribute_Casing : Boolean := False; - -- This can be set True by using the -gnatg or -gnatya switches. If it is - -- True, then attribute names (including keywords such as digits used as - -- attribute names) must be in mixed case. + -- This can be set True by using the -gnatya switch. If it is True, then + -- attribute names (including keywords such as digits used as attribute + -- names) must be in mixed case. Style_Check_Blanks_At_End : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyb switches. If it is - -- True, then spaces at the end of lines are not permitted. + -- This can be set True by using the -gnatyb switch. If it is True, then + -- spaces at the end of lines are not permitted. Style_Check_Blank_Lines : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyu switches. If it is - -- True, then multiple blank lines are not permitted, and there may not be - -- a blank line at the end of the file. + -- This can be set True by using the -gnatyu switch. If it is True, then + -- multiple blank lines are not permitted, and there may not be a blank + -- line at the end of the file. Style_Check_Comments : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyc switches. If it is - -- True, then comments are style checked as follows: + -- This can be set True by using the -gnatyc switch. If it is True, then + -- comments are style checked as follows: -- -- All comments must be at the start of the line, or the first minus must -- be preceded by at least one space. @@ -96,27 +96,26 @@ package Stylesw is -- comments where only a single space separates the comment characters. Style_Check_DOS_Line_Terminator : Boolean := False; - -- This can be set true by using the -gnatg or -gnatyd switches. If it - -- is True, then the line terminator must be a single LF, without an - -- associated CR (e.g. DOS line terminator sequence CR/LF not allowed). + -- This can be set true by using the -gnatyd switch. If it is True, then + -- the line terminator must be a single LF, without an associated CR (e.g. + -- DOS line terminator sequence CR/LF not allowed). Style_Check_End_Labels : Boolean := False; - -- This can be set True by using the -gnatg or -gnatye switches. If it is - -- True, then optional END labels must always be present. + -- This can be set True by using the -gnatye switch. If it is True, then + -- optional END labels must always be present. Style_Check_Form_Feeds : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyf switches. If it is - -- True, then form feeds and vertical tabs are not allowed in the source - -- text. + -- This can be set True by using the -gnatyf switch. If it is True, then + -- form feeds and vertical tabs are not allowed in the source text. Style_Check_Horizontal_Tabs : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyh switches. If it is - -- True, then horizontal tabs are not allowed in source text. + -- This can be set True by using the -gnatyh switch. If it is True, then + -- horizontal tabs are not allowed in source text. Style_Check_If_Then_Layout : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyi switches. If it is - -- True, then a THEN keyword may not appear on the line that immediately - -- follows the line containing the corresponding IF. + -- This can be set True by using the -gnatyi switch. If it is True, then a + -- THEN keyword may not appear on the line that immediately follows the + -- line containing the corresponding IF. -- -- This permits one of two styles for IF-THEN layout. Either the IF and -- THEN keywords are on the same line, where the condition is short enough, @@ -137,28 +136,27 @@ package Stylesw is -- is not allowed. Style_Check_Indentation : Column_Number range 0 .. 9 := 0; - -- This can be set non-zero by using the -gnatg or -gnatyn (n a digit) - -- switches. If it is non-zero it activates indentation checking with the - -- indicated indentation value. A value of zero turns off checking. The - -- requirement is that any new statement, line comment, declaration or - -- keyword such as END, start on a column that is a multiple of the - -- indentation value. + -- This can be set non-zero by using the -gnatyn (n a digit) switch. If + -- it is non-zero it activates indentation checking with the indicated + -- indentation value. A value of zero turns off checking. The requirement + -- is that any new statement, line comment, declaration or keyword such + -- as END, start on a column that is a multiple of the indentation value. Style_Check_Keyword_Casing : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyk switches. If it is - -- True, then keywords are required to be in all lower case. This rule does - -- not apply to keywords such as digits appearing as an attribute name. + -- This can be set True by using the -gnatyk switch. If it is True, then + -- keywords are required to be in all lower case. This rule does not apply + -- to keywords such as digits appearing as an attribute name. Style_Check_Layout : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyl switches. If it is - -- True, it activates checks that constructs are indented as suggested by - -- the examples in the RM syntax, e.g. that the ELSE keyword must line up + -- This can be set True by using the -gnatyl switch. If it is True, it + -- activates checks that constructs are indented as suggested by the + -- examples in the RM syntax, e.g. that the ELSE keyword must line up -- with the IF keyword. Style_Check_Max_Line_Length : Boolean := False; - -- This can be set True by using the -gnatg or -gnatym/M switches. - -- If it is True, it activates checking for a maximum line length of - -- Style_Max_Line_Length characters. + -- This can be set True by using the -gnatym/M switches. If it is True, it + -- activates checking for a maximum line length of Style_Max_Line_Length + -- characters. Style_Check_Max_Nesting_Level : Boolean := False; -- This can be set True by using -gnatyLnnn with a value other than zero @@ -175,44 +173,44 @@ package Stylesw is -- that mode IN is not used on its own (since it is the default). Style_Check_Order_Subprograms : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyo switch. If it is - -- True, then names of subprogram bodies must be in alphabetical order - -- (not taking casing into account). + -- This can be set True by using the -gnatyo switch. If it is True, then + -- names of subprogram bodies must be in alphabetical order (not taking + -- casing into account). Style_Check_Pragma_Casing : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyp switches. If it is - -- True, then pragma names must use mixed case. + -- This can be set True by using the -gnatyp switch. If it is True, then + -- pragma names must use mixed case. Style_Check_References : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyr switches. If it is - -- True, then all references to declared identifiers are checked. The - -- requirement is that casing of the reference be the same as the casing - -- of the corresponding declaration. + -- This can be set True by using the -gnatyr switch. If it is True, then + -- all references to declared identifiers are checked. The requirement + -- is that casing of the reference be the same as the casing of the + -- corresponding declaration. Style_Check_Separate_Stmt_Lines : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyS switches. If it is - -- TRUE, then for the case of keywords THEN (not preceded by AND) or ELSE - -- (not preceded by OR) which introduce a conditionally executed statement + -- This can be set True by using the -gnatyS switch. If it is TRUE, + -- then for the case of keywords THEN (not preceded by AND) or ELSE (not + -- preceded by OR) which introduce a conditionally executed statement -- sequence, there must be no tokens on the same line as the keyword, so -- that coverage testing can clearly identify execution of the statement -- sequence. A comment is permitted, as is THEN ABORT or a PRAGMA keyword -- after ELSE (a common style to specify the condition for the ELSE). Style_Check_Specs : Boolean := False; - -- This can be set True by using the -gnatg or -gnatys switches. If it is - -- True, then separate specs are required to be present for all procedures - -- except parameterless library level procedures. The exception means that - -- typical main programs do not require separate specs. + -- This can be set True by using the -gnatys switches. If it is True, then + -- separate specs are required to be present for all procedures except + -- parameterless library level procedures. The exception means that typical + -- main programs do not require separate specs. Style_Check_Standard : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyn switches. If it is - -- True, then any references to names in Standard have to be in mixed case - -- mode (e.g. Integer, Boolean). + -- This can be set True by using the -gnatyn switch. If it is True, then + -- any references to names in Standard have to be in mixed case mode (e.g. + -- Integer, Boolean). Style_Check_Tokens : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyt switches. If it is - -- True, then the style check that requires canonical spacing between - -- various punctuation tokens as follows: + -- This can be set True by using the -gnatyt switch. If it is True, then + -- the style check that requires canonical spacing between various + -- punctuation tokens as follows: -- -- ABS and NOT must be followed by a space -- @@ -254,14 +252,14 @@ package Stylesw is -- for a space. Style_Check_Xtra_Parens : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyx switch. If true, - -- then it is not allowed to enclose entire conditional expressions in - -- parentheses (C style). + -- This can be set True by using the -gnatyx switch. If true, then it is + -- not allowed to enclose entire conditional expressions in parentheses + -- (C style). Style_Max_Line_Length : Int := 0; - -- Value used to check maximum line length. Gets reset as a result of use - -- of -gnatym or -gnatyMnnn switches (or by use of -gnatg). This value is - -- only read if Style_Check_Max_Line_Length is True. + -- Value used to check maximum line length. Gets reset as a result of + -- use of -gnatym or -gnatyMnnn switches. This value is only read if + -- Style_Check_Max_Line_Length is True. Style_Max_Nesting_Level : Int := 0; -- Value used to check maximum nesting level. Gets reset as a result diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 98bcbdbf9a2..714018d1ff6 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -384,10 +384,10 @@ package Types is -- Type used to identify nodes in the tree subtype Entity_Id is Node_Id; - -- A synonym for node types, used in the entity package to refer to - -- nodes that are entities (i.e. nodes with an Nkind of N_Defining_xxx) - -- All such nodes are extended nodes and these are the only extended - -- nodes, so that in practice entity and extended nodes are synonymous. + -- A synonym for node types, used in the entity package to refer to nodes + -- that are entities (i.e. nodes with an Nkind of N_Defining_xxx) All such + -- nodes are extended nodes and these are the only extended nodes, so that + -- in practice entity and extended nodes are synonymous. subtype Node_Or_Entity_Id is Node_Id; -- A synonym for node types, used in cases where a given value may be used -- 2.11.0