Commit 0a69df7c by Arnaud Charlet

[multiple changes]

2009-08-07  Thomas Quinot  <quinot@adacore.com>

	* targparm.adb: Minor reformatting
	* sem.adb: Minor reformatting
	* exp_ch4.adb (Expand_N_Conditional_Expression): Add comment.

2009-08-07  Emmanuel Briot  <briot@adacore.com>

	* prj-conf.adb: Remove duplicate directory separator in the output when
	an object directory does not exist.

2009-08-07  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Minor reformatting

2009-08-07  Vincent Celier  <celier@adacore.com>

	* mlib-prj.adb (Build_Library): Fixed bug in name of ALI file (wrong
	length used).

2009-08-07  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): In Ravenscar mode,
	detect non-static private components that will violate restriction
	No_Implicit_Heap_Allocation.

2009-08-07  Ben Brosgol  <brosgol@adacore.com>

	* gnat_ugn.texi: Edited Rule Exemption section of gnatcheck chapter.

From-SVN: r150562
parent b84b6ee6
2009-08-07 Thomas Quinot <quinot@adacore.com>
* targparm.adb: Minor reformatting
* sem.adb: Minor reformatting
* exp_ch4.adb (Expand_N_Conditional_Expression): Add comment.
2009-08-07 Emmanuel Briot <briot@adacore.com>
* prj-conf.adb: Remove duplicate directory separator in the output when
an object directory does not exist.
2009-08-07 Robert Dewar <dewar@adacore.com>
* exp_util.adb: Minor reformatting
2009-08-07 Vincent Celier <celier@adacore.com>
* mlib-prj.adb (Build_Library): Fixed bug in name of ALI file (wrong
length used).
2009-08-07 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): In Ravenscar mode,
detect non-static private components that will violate restriction
No_Implicit_Heap_Allocation.
2009-08-07 Ben Brosgol <brosgol@adacore.com>
* gnat_ugn.texi: Edited Rule Exemption section of gnatcheck chapter.
2009-08-02 Eric Botcazou <ebotcazou@adacore.com> 2009-08-02 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (end_subprog_body): Tweak comment. * gcc-interface/gigi.h (end_subprog_body): Tweak comment.
......
...@@ -4039,8 +4039,10 @@ package body Exp_Ch4 is ...@@ -4039,8 +4039,10 @@ package body Exp_Ch4 is
-- and replace the conditional expression by a reference to Cnn -- and replace the conditional expression by a reference to Cnn
-- ??? Note: this expansion is wrong for limited types, since it does -- ??? Note: this expansion is wrong for limited types, since it does
-- a copy of a limited value. The proper fix would be to do the -- a copy of a limited value. Similarly it's wrong for unconstrained or
-- following expansion: -- class-wide types since in neither case can we have an uninitialized
-- object declaration The proper fix would be to do the following
-- expansion:
-- Cnn : access typ; -- Cnn : access typ;
-- if cond then -- if cond then
......
...@@ -53,6 +53,7 @@ with Sem_Ch6; use Sem_Ch6; ...@@ -53,6 +53,7 @@ with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8; with Sem_Ch8; use Sem_Ch8;
with Sem_Ch11; use Sem_Ch11; with Sem_Ch11; use Sem_Ch11;
with Sem_Elab; use Sem_Elab; with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res; with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
...@@ -7522,7 +7523,7 @@ package body Exp_Ch9 is ...@@ -7522,7 +7523,7 @@ package body Exp_Ch9 is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Prot_Typ : constant Entity_Id := Defining_Identifier (N); Prot_Typ : constant Entity_Id := Defining_Identifier (N);
Pdef : constant Node_Id := Protected_Definition (N); Pdef : constant Node_Id := Protected_Definition (N);
-- This contains two lists; one for visible and one for private decls -- This contains two lists; one for visible and one for private decls
Rec_Decl : Node_Id; Rec_Decl : Node_Id;
...@@ -7547,6 +7548,13 @@ package body Exp_Ch9 is ...@@ -7547,6 +7548,13 @@ package body Exp_Ch9 is
-- to the internal body, for possible inlining later on. The source -- to the internal body, for possible inlining later on. The source
-- operation is invisible to the back-end and is never actually called. -- operation is invisible to the back-end and is never actually called.
function Static_Component_Size (Comp : Entity_Id) return Boolean;
-- When compiling under the Ravenscar profile, private components must
-- have a static size, or else a protected object will require heap
-- allocation, violating the corresponding restriction. It is preferable
-- to make this check here, because it provides a better error message
-- than the back-end, which refers to the object as a whole.
procedure Register_Handler; procedure Register_Handler;
-- For a protected operation that is an interrupt handler, add the -- For a protected operation that is an interrupt handler, add the
-- freeze action that will register it as such. -- freeze action that will register it as such.
...@@ -7563,6 +7571,40 @@ package body Exp_Ch9 is ...@@ -7563,6 +7571,40 @@ package body Exp_Ch9 is
end if; end if;
end Check_Inlining; end Check_Inlining;
---------------------------------
-- Check_Static_Component_Size --
---------------------------------
function Static_Component_Size (Comp : Entity_Id) return Boolean is
Typ : constant Entity_Id := Etype (Comp);
C : Entity_Id;
begin
if Is_Scalar_Type (Typ) then
return True;
elsif Is_Array_Type (Typ) then
return Compile_Time_Known_Bounds (Typ);
elsif Is_Record_Type (Typ) then
C := First_Component (Typ);
while Present (C) loop
if not Static_Component_Size (C) then
return False;
end if;
Next_Component (C);
end loop;
return True;
-- Any other types will be checked by the back-end
else
return True;
end if;
end Static_Component_Size;
---------------------- ----------------------
-- Register_Handler -- -- Register_Handler --
---------------------- ----------------------
...@@ -7754,6 +7796,24 @@ package body Exp_Ch9 is ...@@ -7754,6 +7796,24 @@ package body Exp_Ch9 is
while Present (Priv) loop while Present (Priv) loop
if Nkind (Priv) = N_Component_Declaration then if Nkind (Priv) = N_Component_Declaration then
if not Static_Component_Size (Defining_Identifier (Priv)) then
-- When compiling for a restricted profile, the private
-- components must have a static size. If not, this is an
-- error for a single protected declaration, and rates a
-- warning on a protected type declaration.
if not Comes_From_Source (Prot_Typ) then
Check_Restriction (No_Implicit_Heap_Allocations, Priv);
elsif Restriction_Active (No_Implicit_Heap_Allocations) then
Error_Msg_N ("component has non-static size?", Priv);
Error_Msg_NE
("\creation of protected object of type& will violate"
& " restriction No_Implicit_Heap_Allocations?",
Priv, Prot_Typ);
end if;
end if;
-- The component definition consists of a subtype indication, -- The component definition consists of a subtype indication,
-- or (in Ada 2005) an access definition. Make a copy of the -- or (in Ada 2005) an access definition. Make a copy of the
......
...@@ -1320,15 +1320,15 @@ package body Exp_Util is ...@@ -1320,15 +1320,15 @@ package body Exp_Util is
Rewrite (Subtype_Indic, New_Reference_To (T, Loc)); Rewrite (Subtype_Indic, New_Reference_To (T, Loc));
-- nothing needs to be done for private types with unknown discriminants -- Nothing needs to be done for private types with unknown discriminants
-- if the underlying type is not an unconstrained composite type or it -- if the underlying type is not an unconstrained composite type or it
-- is an unchecked union. -- is an unchecked union.
elsif Is_Private_Type (Unc_Type) elsif Is_Private_Type (Unc_Type)
and then Has_Unknown_Discriminants (Unc_Type) and then Has_Unknown_Discriminants (Unc_Type)
and then (not Is_Composite_Type (Underlying_Type (Unc_Type)) and then (not Is_Composite_Type (Underlying_Type (Unc_Type))
or else Is_Constrained (Underlying_Type (Unc_Type)) or else Is_Constrained (Underlying_Type (Unc_Type))
or else Is_Unchecked_Union (Underlying_Type (Unc_Type))) or else Is_Unchecked_Union (Underlying_Type (Unc_Type)))
then then
null; null;
......
...@@ -20953,19 +20953,24 @@ the @option{-U} option followed by the name of the main unit: ...@@ -20953,19 +20953,24 @@ the @option{-U} option followed by the name of the main unit:
@cindex Rule exemption (for @command{gnatcheck}) @cindex Rule exemption (for @command{gnatcheck})
@noindent @noindent
@command{gnatcheck} can be used to inforce a coding standard. It may be One of the most useful applications of @command{gnatcheck} is to
appropriate, in some circumstances, to accept violations of the coding automate the enforcement of project-specific coding standards,
standard. In such a case, it is a good idea to justify the violation within for example in safety-critical systems where particular features
the sources themselves. It makes it possible to maintain the justification must be restricted in order to simplify the certification effort.
for such violations along with the sources containing them. However, it may sometimes be appropriate to violate a coding standard rule,
@command{gnatcheck} supports such justified violations with the notion of and in such cases the rationale for the violation should be provided
``exemption'' covering a specific source code section. Usually, in the source program itself so that the individuals
@command{gnatcheck} issues rule violation messages both on @file{stderr} reviewing or maintaining the program can immediately understand the intent.
and in a report file. Exempted violations are not reported at all on
@file{stderr} so that users using @command{gnatcheck} in interactive mode The @command{gnatcheck} tool supports this practice with the notion of
a ``rule exemption'' covering a specific source code section. Normally
rule violation messages are issued both on @file{stderr}
and in a report file. In contrast, exempted violations are not listed on
@file{stderr}; thus users invoking @command{gnatcheck} interactively
(e.g. in its GPS interface) do not need to pay attention to known and (e.g. in its GPS interface) do not need to pay attention to known and
justified violations. The @command{gnatcheck} report includes exempted justified violations. However, exempted violations along with their
violations in a special section along with their justification. justification are documented in a special section of the report file that
@command{gnatcheck} generates.
@menu @menu
* Using pragma Annotate to Control Rule Exemption:: * Using pragma Annotate to Control Rule Exemption::
...@@ -20977,33 +20982,36 @@ violations in a special section along with their justification. ...@@ -20977,33 +20982,36 @@ violations in a special section along with their justification.
@cindex Using pragma Annotate to control rule exemption @cindex Using pragma Annotate to control rule exemption
@noindent @noindent
Rule exemption is controlled by pragma @code{Annotate} when its first parameter is Rule exemption is controlled by pragma @code{Annotate} when its first
``gnatcheck''. Here is the syntax of @command{gnatcheck} annotations: argument is ``gnatcheck''. The syntax of @command{gnatcheck}'s
exemption control annotations is as follows:
@smallexample @c ada @smallexample @c ada
pragma Annotate (gnatcheck, exemption_control, Rule_Name, [justification]); @group
pragma Annotate (gnatcheck, @i{exemption_control}, @i{Rule_Name}, [@i{justification}]);
exemption_control ::= "Exempt_On" | "Exempt_Off"
Rule_Name ::= string_literal @i{exemption_control} ::= "Exempt_On" | "Exempt_Off"
justification ::= string_literal @i{Rule_Name} ::= string_literal
@i{justification} ::= string_literal
@end group
@end smallexample @end smallexample
@noindent @noindent
When a @command{gnatcheck} annotatation has more then four parameters, When a @command{gnatcheck} annotatation has more then four arguments,
@command{gnatcheck} issues a warning and ignore additional parameters. @command{gnatcheck} issues a warning and ignores the additional arguments.
If the additional parameters do not follow the syntax above, If the additional arguments do not follow the syntax above,
@command{gnatcheck} emits a warning and ignores the annotation. @command{gnatcheck} emits a warning and ignores the annotation.
@code{Rule_Name} should be the name of some existing @command{gnatcheck} rule. The @i{@code{Rule_Name}} argument should be the name of some existing
If this is not the case, the warning message is generated and the pragma is @command{gnatcheck} rule.
Otherwise a warning message is generated and the pragma is
ignored. If @code{Rule_Name} denotes a rule that is not activated by the given ignored. If @code{Rule_Name} denotes a rule that is not activated by the given
@command{gnatcheck} call, the pragma is ignored silently. @command{gnatcheck} call, the pragma is ignored and no warning is issued.
A source code section where an exemption is active for a given rule starts with A source code section where an exemption is active for a given rule is
an extempt_on annotation and terminates with an exempt_off one: delimited by an @code{exempt_on} and @code{exempt_off} annotation pair:
@smallexample @c ada @smallexample @c ada
pragma Annotate (gnatcheck, "Exempt_On", Rule_Name, "justification"); pragma Annotate (gnatcheck, "Exempt_On", Rule_Name, "justification");
...@@ -21019,34 +21027,32 @@ pragma Annotate (gnatcheck, "Exempt_Off", Rule_Name); ...@@ -21019,34 +21027,32 @@ pragma Annotate (gnatcheck, "Exempt_Off", Rule_Name);
@itemize @bullet @itemize @bullet
@item @item
an ``Exempt_Off'' annotation can only appear after a corresponding An ``Exempt_Off'' annotation can only appear after a corresponding
``Exempt_On'' annotation in order to create a properly formed exempted source ``Exempt_On'' annotation.
code section;
@item @item
exempted source code sections are only based on the source location of the Exempted source code sections are only based on the source location of the
annotations. Any source construct having a source location in between the two annotations. Any source construct between the two
annotations is part of the exempted source code section; annotations is part of the exempted source code section.
@item @item
exempted source code sections for different rules are independent. They can Exempted source code sections for different rules are independent. They can
be nested or intersect with one another without limitation. It is not allowed be nested or intersect with one another without limitation.
to create nested or intersecting source code sections for the same rule; Creating nested or intersecting source code sections for the same rule is
not allowed.
@item @item
malformed exempted source code sections are reported by a warning and Malformed exempted source code sections are reported by a warning, and
the corresponding rule exemption is ignored; the corresponding rule exemptions are ignored.
@item @item
when an exempted source code section does not contain at least one violation When an exempted source code section does not contain at least one violation
of the exempted rule, a warning is emitted on @file{stderr}. This allow proper of the exempted rule, a warning is emitted on @file{stderr}.
maintenance of exempted source code sections;
@item @item
if an exempted source code section reaches the end of the compilation unit If an ``Exempt_On'' annotation pragma does not have a matching
source and there is no @code{Annotate} pragma closing this section, then the ``Exempt_Off'' annotation pragma in the same compilation unit, then the
exemption for the given rule is turned off and a warning is issued. exemption for the given rule is ignored and a warning is issued.
@end itemize @end itemize
...@@ -1812,13 +1812,13 @@ package body MLib.Prj is ...@@ -1812,13 +1812,13 @@ package body MLib.Prj is
Canonical_Case_File_Name (Name (1 .. Last)); Canonical_Case_File_Name (Name (1 .. Last));
Delete := False; Delete := False;
if (The_Build_Mode = Static and then if (The_Build_Mode = Static
Name (1 .. Last) = Archive_Name) and then Name (1 .. Last) = Archive_Name)
or else or else
((The_Build_Mode = Dynamic or else ((The_Build_Mode = Dynamic
The_Build_Mode = Relocatable) or else
and then The_Build_Mode = Relocatable)
Name (1 .. Last) = DLL_Name) and then Name (1 .. Last) = DLL_Name)
then then
Delete := True; Delete := True;
...@@ -1835,17 +1835,19 @@ package body MLib.Prj is ...@@ -1835,17 +1835,19 @@ package body MLib.Prj is
while Unit /= No_Unit_Index loop while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /= and then Unit.File_Names (Impl).Project /=
No_Project No_Project
then then
if Ultimate_Extending_Project_Of if Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = (Unit.File_Names (Impl).Project) =
For_Project For_Project
then then
Get_Name_String Get_Name_String
(Unit.File_Names (Impl).File); (Unit.File_Names (Impl).File);
Name_Len := Name_Len - Name_Len :=
File_Extension Name_Len -
(Name (1 .. Name_Len))'Length; File_Extension
(Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) = if Name_Buffer (1 .. Name_Len) =
Name (1 .. Last - 4) Name (1 .. Last - 4)
then then
...@@ -1856,18 +1858,16 @@ package body MLib.Prj is ...@@ -1856,18 +1858,16 @@ package body MLib.Prj is
elsif Unit.File_Names (Spec) /= null elsif Unit.File_Names (Spec) /= null
and then Ultimate_Extending_Project_Of and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) = (Unit.File_Names (Spec).Project) =
For_Project For_Project
then then
Get_Name_String Get_Name_String (Unit.File_Names (Spec).File);
(Unit.File_Names (Spec).File);
Name_Len := Name_Len :=
Name_Len - Name_Len -
File_Extension File_Extension (Name (1 .. Last))'Length;
(Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) = if Name_Buffer (1 .. Name_Len) =
Name (1 .. Last - 4) Name (1 .. Last - 4)
then then
Delete := True; Delete := True;
exit; exit;
......
...@@ -675,7 +675,6 @@ package body Prj.Conf is ...@@ -675,7 +675,6 @@ package body Prj.Conf is
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Get_Name_String (Project.Directory.Name)); (Get_Name_String (Project.Directory.Name));
Add_Char_To_Name_Buffer (Directory_Separator);
Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value)); Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
end if; end if;
end if; end if;
......
...@@ -1978,9 +1978,7 @@ package body Sem is ...@@ -1978,9 +1978,7 @@ package body Sem is
-- See if it belongs to current unit, and if so, include its -- See if it belongs to current unit, and if so, include its
-- with_clauses. Do not process main unit prematurely. -- with_clauses. Do not process main unit prematurely.
if Pnode = CU if Pnode = CU and then CU /= Cunit (Main_Unit) then
and then CU /= Cunit (Main_Unit)
then
Walk_Immediate (Cunit (S), Include_Limited); Walk_Immediate (Cunit (S), Include_Limited);
end if; end if;
end; end;
......
...@@ -510,7 +510,7 @@ package body Targparm is ...@@ -510,7 +510,7 @@ package body Targparm is
goto Line_Loop_Continue; goto Line_Loop_Continue;
-- Next See if we have a configuration parameter -- Next see if we have a configuration parameter
else else
Config_Param_Loop : for K in Targparm_Tags loop Config_Param_Loop : for K in Targparm_Tags loop
......
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