Skip to content

R
riscv-gcc-1
Commit 5a1ccfb1 by Arnaud Charlet
Options

[multiple changes] 

2009-07-20  Bob Duff  <duff@adacore.com>

	* 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  <dewar@adacore.com>

	* stylesw.ads: Minor documentation change.

	* types.ads: Minor reformatting

2009-07-20  Javier Miranda  <miranda@adacore.com>

	* 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  <charlet@adacore.com>

	* gnat1drv.adb (Gnat1drv): Also disable Elaboration_Check in
	CodePeer_Mode.

From-SVN: r149821
parent 151293b5
Showing with 327 additions and 162 deletions
gcc/ada/ChangeLog
2009-07-20 Bob Duff <duff@adacore.com>
* 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 <dewar@adacore.com>
* stylesw.ads: Minor documentation change.
* types.ads: Minor reformatting
2009-07-20 Javier Miranda <miranda@adacore.com>
* 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 <charlet@adacore.com>
* gnat1drv.adb (Gnat1drv): Also disable Elaboration_Check in
CodePeer_Mode.
2009-07-20 Gary Dismukes <dismukes@adacore.com> 2009-07-20 Gary Dismukes <dismukes@adacore.com>
* exp_prag.adb (Expand_Pragma_Import_Export_Exception): When compiling * exp_prag.adb (Expand_Pragma_Import_Export_Exception): When compiling
......
gcc/ada/exp_ch6.adb
...@@ -2612,12 +2612,14 @@ package body Exp_Ch6 is ...@@ -2612,12 +2612,14 @@ package body Exp_Ch6 is
return; 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 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; Kill_Current_Values;
end if; end if;
end if; end if;
......
gcc/ada/exp_disp.adb
...@@ -80,6 +80,11 @@ package body Exp_Disp is ...@@ -80,6 +80,11 @@ package body Exp_Disp is
-- Returns true if Prim is not a predefined dispatching primitive but it 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) -- 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; 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 -- Check if the type has a private view or if the public view appears
-- in the visible part of a package spec. -- in the visible part of a package spec.
...@@ -95,6 +100,182 @@ package body Exp_Disp is ...@@ -95,6 +100,182 @@ package body Exp_Disp is
-- Ada 2005 (AI-345): Determine the tagged kind of T and return a reference -- Ada 2005 (AI-345): Determine the tagged kind of T and return a reference
-- to an RE_Tagged_Kind enumeration value. -- 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 -- -- Building_Static_DT --
------------------------ ------------------------
...@@ -469,8 +650,9 @@ package body Exp_Disp is ...@@ -469,8 +650,9 @@ package body Exp_Disp is
-- Dispatching call to C++ primitive. Create a new parameter list -- Dispatching call to C++ primitive. Create a new parameter list
-- with no tag checks. -- with no tag checks.
New_Params := New_List;
if Is_CPP_Class (Typ) then if Is_CPP_Class (Typ) then
New_Params := New_List;
Param := First_Actual (Call_Node); Param := First_Actual (Call_Node);
while Present (Param) loop while Present (Param) loop
Append_To (New_Params, Relocate_Node (Param)); Append_To (New_Params, Relocate_Node (Param));
...@@ -480,86 +662,19 @@ package body Exp_Disp is ...@@ -480,86 +662,19 @@ package body Exp_Disp is
-- Dispatching call to Ada primitive -- Dispatching call to Ada primitive
elsif Present (Param_List) then 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); Param := First_Actual (Call_Node);
while Present (Param) loop while Present (Param) loop
-- Cases in which we may have generated runtime checks
-- No tag check with itself if Param = Ctrl_Arg
or else Subp = Eq_Prim_Op
if Param = Ctrl_Arg then 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
Append_To (New_Params, Append_To (New_Params,
Duplicate_Subexpr_Move_Checks (Param)); 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 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)); Append_To (New_Params, Relocate_Node (Param));
end if; end if;
...@@ -6192,6 +6307,21 @@ package body Exp_Disp is ...@@ -6192,6 +6307,21 @@ package body Exp_Disp is
return Result; return Result;
end Make_Tags; 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 -- -- Original_View_In_Visible_Part --
----------------------------------- -----------------------------------
......
gcc/ada/exp_disp.ads
...@@ -170,6 +170,9 @@ package Exp_Disp is ...@@ -170,6 +170,9 @@ package Exp_Disp is
-- Exp_Disp.Default_Prim_Op_Position - indirect use -- Exp_Disp.Default_Prim_Op_Position - indirect use
-- Exp_Disp.Set_All_DT_Position - direct 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; function Building_Static_DT (Typ : Entity_Id) return Boolean;
pragma Inline (Building_Static_DT); pragma Inline (Building_Static_DT);
-- Returns true when building statically allocated dispatch tables -- Returns true when building statically allocated dispatch tables
......
gcc/ada/gnat1drv.adb
...@@ -158,20 +158,22 @@ procedure Gnat1drv is ...@@ -158,20 +158,22 @@ procedure Gnat1drv is
ASIS_Mode := False; 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 -- trees between specs compiled as part of a main unit or as part of
-- a with-clause. -- a with-clause.
Dynamic_Elaboration_Checks := False; -- Enable all other language checks
-- Suppress overflow checks and access checks since they are handled
-- implicitely by CodePeer. Enable all other language checks.
Suppress_Options := Suppress_Options :=
(Overflow_Check => True, (Overflow_Check => True,
Access_Check => True, Access_Check => True,
others => False); Elaboration_Check => True,
others => False);
Enable_Overflow_Checks := False; Enable_Overflow_Checks := False;
Dynamic_Elaboration_Checks := False;
-- Kill debug of generated code, since it messes up sloc values -- Kill debug of generated code, since it messes up sloc values
......
gcc/ada/sem_ch13.adb
...@@ -2623,7 +2623,7 @@ package body Sem_Ch13 is ...@@ -2623,7 +2623,7 @@ package body Sem_Ch13 is
-- this component might overlap a parent field. -- this component might overlap a parent field.
if Present (Tagged_Parent) if Present (Tagged_Parent)
and Fbit <= Parent_Last_Bit and then Fbit <= Parent_Last_Bit
then then
Pcomp := First_Entity (Tagged_Parent); Pcomp := First_Entity (Tagged_Parent);
while Present (Pcomp) loop while Present (Pcomp) loop
......
gcc/ada/stylesw.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -48,28 +48,28 @@ package Stylesw is ...@@ -48,28 +48,28 @@ package Stylesw is
-- other manner. -- other manner.
Style_Check_Array_Attribute_Index : Boolean := False; Style_Check_Array_Attribute_Index : Boolean := False;
-- This can be set True by using -gnatg or -gnatyA switches. If it is True -- This can be set True by using the -gnatyA switch. If it is True then
-- then index numbers for array attributes (like Length) are required to -- index numbers for array attributes (like Length) are required to be
-- be absent for one-dimensional arrays and present for multi-dimensional -- absent for one-dimensional arrays and present for multi-dimensional
-- array attribute references. -- array attribute references.
Style_Check_Attribute_Casing : Boolean := False; Style_Check_Attribute_Casing : Boolean := False;
-- This can be set True by using the -gnatg or -gnatya switches. If it is -- This can be set True by using the -gnatya switch. If it is True, then
-- True, then attribute names (including keywords such as digits used as -- attribute names (including keywords such as digits used as attribute
-- attribute names) must be in mixed case. -- names) must be in mixed case.
Style_Check_Blanks_At_End : Boolean := False; Style_Check_Blanks_At_End : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyb switches. If it is -- This can be set True by using the -gnatyb switch. If it is True, then
-- True, then spaces at the end of lines are not permitted. -- spaces at the end of lines are not permitted.
Style_Check_Blank_Lines : Boolean := False; Style_Check_Blank_Lines : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyu switches. If it is -- This can be set True by using the -gnatyu switch. If it is True, then
-- True, then multiple blank lines are not permitted, and there may not be -- multiple blank lines are not permitted, and there may not be a blank
-- a blank line at the end of the file. -- line at the end of the file.
Style_Check_Comments : Boolean := False; Style_Check_Comments : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyc switches. If it is -- This can be set True by using the -gnatyc switch. If it is True, then
-- True, then comments are style checked as follows: -- comments are style checked as follows:
-- --
-- All comments must be at the start of the line, or the first minus must -- All comments must be at the start of the line, or the first minus must
-- be preceded by at least one space. -- be preceded by at least one space.
...@@ -96,27 +96,26 @@ package Stylesw is ...@@ -96,27 +96,26 @@ package Stylesw is
-- comments where only a single space separates the comment characters. -- comments where only a single space separates the comment characters.
Style_Check_DOS_Line_Terminator : Boolean := False; Style_Check_DOS_Line_Terminator : Boolean := False;
-- This can be set true by using the -gnatg or -gnatyd switches. If it -- This can be set true by using the -gnatyd switch. If it is True, then
-- is True, then the line terminator must be a single LF, without an -- the line terminator must be a single LF, without an associated CR (e.g.
-- associated CR (e.g. DOS line terminator sequence CR/LF not allowed). -- DOS line terminator sequence CR/LF not allowed).
Style_Check_End_Labels : Boolean := False; Style_Check_End_Labels : Boolean := False;
-- This can be set True by using the -gnatg or -gnatye switches. If it is -- This can be set True by using the -gnatye switch. If it is True, then
-- True, then optional END labels must always be present. -- optional END labels must always be present.
Style_Check_Form_Feeds : Boolean := False; Style_Check_Form_Feeds : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyf switches. If it is -- This can be set True by using the -gnatyf switch. If it is True, then
-- True, then form feeds and vertical tabs are not allowed in the source -- form feeds and vertical tabs are not allowed in the source text.
-- text.
Style_Check_Horizontal_Tabs : Boolean := False; Style_Check_Horizontal_Tabs : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyh switches. If it is -- This can be set True by using the -gnatyh switch. If it is True, then
-- True, then horizontal tabs are not allowed in source text. -- horizontal tabs are not allowed in source text.
Style_Check_If_Then_Layout : Boolean := False; Style_Check_If_Then_Layout : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyi switches. If it is -- This can be set True by using the -gnatyi switch. If it is True, then a
-- True, then a THEN keyword may not appear on the line that immediately -- THEN keyword may not appear on the line that immediately follows the
-- follows the line containing the corresponding IF. -- line containing the corresponding IF.
-- --
-- This permits one of two styles for IF-THEN layout. Either the IF and -- 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, -- THEN keywords are on the same line, where the condition is short enough,
...@@ -137,28 +136,27 @@ package Stylesw is ...@@ -137,28 +136,27 @@ package Stylesw is
-- is not allowed. -- is not allowed.
Style_Check_Indentation : Column_Number range 0 .. 9 := 0; Style_Check_Indentation : Column_Number range 0 .. 9 := 0;
-- This can be set non-zero by using the -gnatg or -gnatyn (n a digit) -- This can be set non-zero by using the -gnatyn (n a digit) switch. If
-- switches. If it is non-zero it activates indentation checking with the -- it is non-zero it activates indentation checking with the indicated
-- indicated indentation value. A value of zero turns off checking. The -- indentation value. A value of zero turns off checking. The requirement
-- requirement is that any new statement, line comment, declaration or -- is that any new statement, line comment, declaration or keyword such
-- keyword such as END, start on a column that is a multiple of the -- as END, start on a column that is a multiple of the indentation value.
-- indentation value.
Style_Check_Keyword_Casing : Boolean := False; Style_Check_Keyword_Casing : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyk switches. If it is -- This can be set True by using the -gnatyk switch. If it is True, then
-- True, then keywords are required to be in all lower case. This rule does -- keywords are required to be in all lower case. This rule does not apply
-- not apply to keywords such as digits appearing as an attribute name. -- to keywords such as digits appearing as an attribute name.
Style_Check_Layout : Boolean := False; Style_Check_Layout : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyl switches. If it is -- This can be set True by using the -gnatyl switch. If it is True, it
-- True, it activates checks that constructs are indented as suggested by -- activates checks that constructs are indented as suggested by the
-- the examples in the RM syntax, e.g. that the ELSE keyword must line up -- examples in the RM syntax, e.g. that the ELSE keyword must line up
-- with the IF keyword. -- with the IF keyword.
Style_Check_Max_Line_Length : Boolean := False; Style_Check_Max_Line_Length : Boolean := False;
-- This can be set True by using the -gnatg or -gnatym/M switches. -- This can be set True by using the -gnatym/M switches. If it is True, it
-- If it is True, it activates checking for a maximum line length of -- activates checking for a maximum line length of Style_Max_Line_Length
-- Style_Max_Line_Length characters. -- characters.
Style_Check_Max_Nesting_Level : Boolean := False; Style_Check_Max_Nesting_Level : Boolean := False;
-- This can be set True by using -gnatyLnnn with a value other than zero -- This can be set True by using -gnatyLnnn with a value other than zero
...@@ -175,44 +173,44 @@ package Stylesw is ...@@ -175,44 +173,44 @@ package Stylesw is
-- that mode IN is not used on its own (since it is the default). -- that mode IN is not used on its own (since it is the default).
Style_Check_Order_Subprograms : Boolean := False; Style_Check_Order_Subprograms : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyo switch. If it is -- This can be set True by using the -gnatyo switch. If it is True, then
-- True, then names of subprogram bodies must be in alphabetical order -- names of subprogram bodies must be in alphabetical order (not taking
-- (not taking casing into account). -- casing into account).
Style_Check_Pragma_Casing : Boolean := False; Style_Check_Pragma_Casing : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyp switches. If it is -- This can be set True by using the -gnatyp switch. If it is True, then
-- True, then pragma names must use mixed case. -- pragma names must use mixed case.
Style_Check_References : Boolean := False; Style_Check_References : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyr switches. If it is -- This can be set True by using the -gnatyr switch. If it is True, then
-- True, then all references to declared identifiers are checked. The -- all references to declared identifiers are checked. The requirement
-- requirement is that casing of the reference be the same as the casing -- is that casing of the reference be the same as the casing of the
-- of the corresponding declaration. -- corresponding declaration.
Style_Check_Separate_Stmt_Lines : Boolean := False; Style_Check_Separate_Stmt_Lines : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyS switches. If it is -- This can be set True by using the -gnatyS switch. If it is TRUE,
-- TRUE, then for the case of keywords THEN (not preceded by AND) or ELSE -- then for the case of keywords THEN (not preceded by AND) or ELSE (not
-- (not preceded by OR) which introduce a conditionally executed statement -- preceded by OR) which introduce a conditionally executed statement
-- sequence, there must be no tokens on the same line as the keyword, so -- sequence, there must be no tokens on the same line as the keyword, so
-- that coverage testing can clearly identify execution of the statement -- that coverage testing can clearly identify execution of the statement
-- sequence. A comment is permitted, as is THEN ABORT or a PRAGMA keyword -- 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). -- after ELSE (a common style to specify the condition for the ELSE).
Style_Check_Specs : Boolean := False; Style_Check_Specs : Boolean := False;
-- This can be set True by using the -gnatg or -gnatys switches. If it is -- This can be set True by using the -gnatys switches. If it is True, then
-- True, then separate specs are required to be present for all procedures -- separate specs are required to be present for all procedures except
-- except parameterless library level procedures. The exception means that -- parameterless library level procedures. The exception means that typical
-- typical main programs do not require separate specs. -- main programs do not require separate specs.
Style_Check_Standard : Boolean := False; Style_Check_Standard : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyn switches. If it is -- This can be set True by using the -gnatyn switch. If it is True, then
-- True, then any references to names in Standard have to be in mixed case -- any references to names in Standard have to be in mixed case mode (e.g.
-- mode (e.g. Integer, Boolean). -- Integer, Boolean).
Style_Check_Tokens : Boolean := False; Style_Check_Tokens : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyt switches. If it is -- This can be set True by using the -gnatyt switch. If it is True, then
-- True, then the style check that requires canonical spacing between -- the style check that requires canonical spacing between various
-- various punctuation tokens as follows: -- punctuation tokens as follows:
-- --
-- ABS and NOT must be followed by a space -- ABS and NOT must be followed by a space
-- --
...@@ -254,14 +252,14 @@ package Stylesw is ...@@ -254,14 +252,14 @@ package Stylesw is
-- for a space. -- for a space.
Style_Check_Xtra_Parens : Boolean := False; Style_Check_Xtra_Parens : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyx switch. If true, -- This can be set True by using the -gnatyx switch. If true, then it is
-- then it is not allowed to enclose entire conditional expressions in -- not allowed to enclose entire conditional expressions in parentheses
-- parentheses (C style). -- (C style).
Style_Max_Line_Length : Int := 0; Style_Max_Line_Length : Int := 0;
-- Value used to check maximum line length. Gets reset as a result of use -- Value used to check maximum line length. Gets reset as a result of
-- of -gnatym or -gnatyMnnn switches (or by use of -gnatg). This value is -- use of -gnatym or -gnatyMnnn switches. This value is only read if
-- only read if Style_Check_Max_Line_Length is True. -- Style_Check_Max_Line_Length is True.
Style_Max_Nesting_Level : Int := 0; Style_Max_Nesting_Level : Int := 0;
-- Value used to check maximum nesting level. Gets reset as a result -- Value used to check maximum nesting level. Gets reset as a result
......
gcc/ada/types.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -384,10 +384,10 @@ package Types is ...@@ -384,10 +384,10 @@ package Types is
-- Type used to identify nodes in the tree -- Type used to identify nodes in the tree
subtype Entity_Id is Node_Id; subtype Entity_Id is Node_Id;
-- A synonym for node types, used in the entity package to refer to -- A synonym for node types, used in the entity package to refer to nodes
-- nodes that are entities (i.e. nodes with an Nkind of N_Defining_xxx) -- that are entities (i.e. nodes with an Nkind of N_Defining_xxx) All such
-- All such nodes are extended nodes and these are the only extended -- nodes are extended nodes and these are the only extended nodes, so that
-- nodes, so that in practice entity and extended nodes are synonymous. -- in practice entity and extended nodes are synonymous.
subtype Node_Or_Entity_Id is Node_Id; subtype Node_Or_Entity_Id is Node_Id;
-- A synonym for node types, used in cases where a given value may be used -- A synonym for node types, used in cases where a given value may be used
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment