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.



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

9 files changed, 170 insertions, 75 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bf7b6c7c2c4..eb2e98be938 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,33 @@
+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>
 
 	* gcc-interface/gigi.h (end_subprog_body): Tweak comment.
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 955d3f6a898..acf96b057d8 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4039,8 +4039,10 @@ package body Exp_Ch4 is
       --  and replace the conditional expression by a reference to Cnn
 
       --  ??? 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
-      --  following expansion:
+      --  a copy of a limited value. Similarly it's wrong for unconstrained or
+      --  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;
       --      if cond then
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 3a7fa25065d..526a2dd552c 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -53,6 +53,7 @@ with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch11; use Sem_Ch11;
 with Sem_Elab; use Sem_Elab;
+with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
@@ -7522,7 +7523,7 @@ package body Exp_Ch9 is
       Loc      : constant Source_Ptr := Sloc (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
 
       Rec_Decl     : Node_Id;
@@ -7547,6 +7548,13 @@ package body Exp_Ch9 is
       --  to the internal body, for possible inlining later on. The source
       --  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;
       --  For a protected operation that is an interrupt handler, add the
       --  freeze action that will register it as such.
@@ -7563,6 +7571,40 @@ package body Exp_Ch9 is
          end if;
       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 --
       ----------------------
@@ -7754,6 +7796,24 @@ package body Exp_Ch9 is
          while Present (Priv) loop
 
             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,
                --  or (in Ada 2005) an access definition. Make a copy of the
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index cd05d75f1f3..fcf3878f61d 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1320,15 +1320,15 @@ package body Exp_Util is
 
          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
       --  is an unchecked union.
 
       elsif Is_Private_Type (Unc_Type)
         and then Has_Unknown_Discriminants (Unc_Type)
         and then (not Is_Composite_Type (Underlying_Type (Unc_Type))
-                  or else Is_Constrained (Underlying_Type (Unc_Type))
-                  or else Is_Unchecked_Union (Underlying_Type (Unc_Type)))
+                   or else Is_Constrained (Underlying_Type (Unc_Type))
+                   or else Is_Unchecked_Union (Underlying_Type (Unc_Type)))
       then
          null;
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index d3ed3458203..bffbf8be689 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -20953,19 +20953,24 @@ the @option{-U} option followed by the name of the main unit:
 @cindex Rule exemption (for @command{gnatcheck})
 
 @noindent
-@command{gnatcheck} can be used to inforce a coding standard. It may be
-appropriate, in some circumstances, to accept violations of the coding
-standard. In such a case, it is a good idea to justify the violation within
-the sources themselves. It makes it possible to maintain the justification
-for such violations along with the sources containing them.
-@command{gnatcheck} supports such justified violations with the notion of
-``exemption'' covering a specific source code section. Usually,
-@command{gnatcheck} issues rule violation messages both on @file{stderr}
-and in a report file. Exempted violations are not reported at all on
-@file{stderr} so that users using @command{gnatcheck} in interactive mode
+One of the most useful applications of @command{gnatcheck} is to
+automate the enforcement of project-specific coding standards,
+for example in safety-critical systems where particular features
+must be restricted in order to simplify the certification effort.
+However, it may sometimes be appropriate to violate a coding standard rule,
+and in such cases the rationale for the violation should be provided
+in the source program itself so that the individuals
+reviewing or maintaining the program can immediately understand the intent.
+
+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
-justified violations. The @command{gnatcheck} report includes exempted
-violations in a special section along with their justification.
+justified violations. However, exempted violations along with their
+justification are documented in a special section of the report file that
+@command{gnatcheck} generates.
 
 @menu
 * Using pragma Annotate to Control Rule Exemption::
@@ -20977,33 +20982,36 @@ violations in a special section along with their justification.
 @cindex Using pragma Annotate to control rule exemption
 
 @noindent
-Rule exemption is controlled by pragma @code{Annotate} when its first parameter is
-``gnatcheck''. Here is the syntax of @command{gnatcheck} annotations:
+Rule exemption is controlled by pragma @code{Annotate} when its first
+argument is ``gnatcheck''. The syntax of @command{gnatcheck}'s
+exemption control annotations is as follows:
 
 @smallexample @c ada
-pragma Annotate (gnatcheck, exemption_control, Rule_Name, [justification]);
-
-exemption_control ::= "Exempt_On" | "Exempt_Off"
+@group
+pragma Annotate (gnatcheck, @i{exemption_control}, @i{Rule_Name}, [@i{justification}]);
 
-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
 
 @noindent
-When a @command{gnatcheck} annotatation has more then four parameters,
-@command{gnatcheck} issues a warning and ignore additional parameters.
-If the additional parameters do not follow the syntax above,
+When a @command{gnatcheck} annotatation has more then four arguments,
+@command{gnatcheck} issues a warning and ignores the additional arguments.
+If the additional arguments do not follow the syntax above,
 @command{gnatcheck} emits a warning and ignores the annotation.
 
-@code{Rule_Name} should be the name of some existing @command{gnatcheck} rule.
-If this is not the case, the warning message is generated and the pragma is
+The @i{@code{Rule_Name}} argument should be the name of some existing
+@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
-@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
-an extempt_on annotation and terminates with an exempt_off one:
+A source code section where an exemption is active for a given rule is
+delimited by an @code{exempt_on} and @code{exempt_off} annotation pair:
 
 @smallexample @c ada
 pragma Annotate (gnatcheck, "Exempt_On", Rule_Name, "justification");
@@ -21019,34 +21027,32 @@ pragma Annotate (gnatcheck, "Exempt_Off", Rule_Name);
 @itemize @bullet
 
 @item
-an ``Exempt_Off'' annotation can only appear after a corresponding
-``Exempt_On'' annotation in order to create a properly formed exempted source
-code section;
+An ``Exempt_Off'' annotation can only appear after a corresponding
+``Exempt_On'' annotation.
 
 @item
-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 is part of the exempted source code section;
+Exempted source code sections are only based on the source location of the
+annotations. Any source construct between the two
+annotations is part of the exempted source code section.
 
 @item
-exempted source code sections for different rules are independent. They can
-be nested or intersect with one another without limitation. It is not allowed
-to create nested or intersecting source code sections for the same rule;
+Exempted source code sections for different rules are independent. They can
+be nested or intersect with one another without limitation.
+Creating nested or intersecting source code sections for the same rule is
+not allowed.
 
 @item
-malformed exempted source code sections are reported by a warning and
-the corresponding rule exemption is ignored;
+Malformed exempted source code sections are reported by a warning, and
+the corresponding rule exemptions are ignored.
 
 @item
-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
-maintenance of exempted source code sections;
+When an exempted source code section does not contain at least one violation
+of the exempted rule, a warning is emitted on @file{stderr}.
 
 @item
-if an exempted source code section reaches the end of the compilation unit
-source and there is no @code{Annotate} pragma closing this section, then the
-exemption for the given rule is turned off and a warning is issued.
-
+If an ``Exempt_On'' annotation pragma does not have a matching
+``Exempt_Off'' annotation pragma in the same compilation unit, then the
+exemption for the given rule is ignored and a warning is issued.
 @end itemize
 
 
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index d01a329945b..6f9b37128ba 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -1812,13 +1812,13 @@ package body MLib.Prj is
                      Canonical_Case_File_Name (Name (1 .. Last));
                      Delete := False;
 
-                     if (The_Build_Mode = Static and then
-                           Name (1 .. Last) =  Archive_Name)
+                     if (The_Build_Mode = Static
+                          and then Name (1 .. Last) =  Archive_Name)
                        or else
-                         ((The_Build_Mode = Dynamic or else
-                             The_Build_Mode = Relocatable)
-                          and then
-                            Name (1 .. Last) = DLL_Name)
+                         ((The_Build_Mode = Dynamic
+                            or else
+                           The_Build_Mode = Relocatable)
+                          and then Name (1 .. Last) = DLL_Name)
                      then
                         Delete := True;
 
@@ -1835,17 +1835,19 @@ package body MLib.Prj is
                            while Unit /= No_Unit_Index loop
                               if Unit.File_Names (Impl) /= null
                                 and then Unit.File_Names (Impl).Project /=
-                                No_Project
+                                                                 No_Project
                               then
                                  if Ultimate_Extending_Project_Of
-                                   (Unit.File_Names (Impl).Project) =
-                                    For_Project
+                                      (Unit.File_Names (Impl).Project) =
+                                                                 For_Project
                                  then
                                     Get_Name_String
                                       (Unit.File_Names (Impl).File);
-                                    Name_Len := Name_Len -
-                                      File_Extension
-                                        (Name (1 .. Name_Len))'Length;
+                                    Name_Len :=
+                                      Name_Len -
+                                        File_Extension
+                                          (Name (1 .. Name_Len))'Length;
+
                                     if Name_Buffer (1 .. Name_Len) =
                                       Name (1 .. Last - 4)
                                     then
@@ -1856,18 +1858,16 @@ package body MLib.Prj is
 
                               elsif Unit.File_Names (Spec) /= null
                                 and then Ultimate_Extending_Project_Of
-                                  (Unit.File_Names (Spec).Project) =
-                                   For_Project
+                                           (Unit.File_Names (Spec).Project) =
+                                                                   For_Project
                               then
-                                 Get_Name_String
-                                   (Unit.File_Names (Spec).File);
+                                 Get_Name_String (Unit.File_Names (Spec).File);
                                  Name_Len :=
                                    Name_Len -
-                                   File_Extension
-                                     (Name (1 .. Name_Len))'Length;
+                                     File_Extension (Name (1 .. Last))'Length;
 
                                  if Name_Buffer (1 .. Name_Len) =
-                                   Name (1 .. Last - 4)
+                                      Name (1 .. Last - 4)
                                  then
                                     Delete := True;
                                     exit;
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index e893ee87c8e..9258cd4c5de 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -675,7 +675,6 @@ package body Prj.Conf is
                Name_Len := 0;
                Add_Str_To_Name_Buffer
                  (Get_Name_String (Project.Directory.Name));
-               Add_Char_To_Name_Buffer (Directory_Separator);
                Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
             end if;
          end if;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index bac147c96b9..071d38fdb45 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1978,9 +1978,7 @@ package body Sem is
                   --  See if it belongs to current unit, and if so, include its
                   --  with_clauses. Do not process main unit prematurely.
 
-                  if Pnode = CU
-                    and then CU /= Cunit (Main_Unit)
-                  then
+                  if Pnode = CU and then CU /= Cunit (Main_Unit) then
                      Walk_Immediate (Cunit (S), Include_Limited);
                   end if;
                end;
diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb
index d78201d3016..b8cc154c88c 100644
--- a/gcc/ada/targparm.adb
+++ b/gcc/ada/targparm.adb
@@ -510,7 +510,7 @@ package body Targparm is
 
             goto Line_Loop_Continue;
 
-         --  Next See if we have a configuration parameter
+         --  Next see if we have a configuration parameter
 
          else
             Config_Param_Loop : for K in Targparm_Tags loop