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

	* exp_attr.adb (Expand_Attribute_Reference, case 'Valid): Reset the
	Is_Known_Valid flag on the temporary created for the value whose
	validity is being checked.

	* sem.adb (Do_Unit_And_Dependents): Further code reorganization to
	handle properly main units that are package specifications.

2009-07-27  Geert Bosch  <bosch@adacore.com>

	* einfo.ads (Checks_May_Be_Suppressed): Fix typo in comment
	* sem_aux.ads: Fix typo in comment
	* sem_util.ads (Is_LHS): Adjust comment to match body

2009-07-27  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi (gnatcheck Complex_Inlined_Subprograms rule): Update
	rule definition.

2009-07-27  Olivier Hainque  <hainque@adacore.com>

	* g-sse.ads, g-ssvety.ads: Update comments.



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

8 files changed, 167 insertions, 112 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5e68e47219b..45ce028e78c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2009-07-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_attr.adb (Expand_Attribute_Reference, case 'Valid): Reset the
+	Is_Known_Valid flag on the temporary created for the value whose
+	validity is being checked.
+
+	* sem.adb (Do_Unit_And_Dependents): Further code reorganization to
+	handle properly main units that are package specifications.
+
+2009-07-27  Geert Bosch  <bosch@adacore.com>
+
+	* einfo.ads (Checks_May_Be_Suppressed): Fix typo in comment
+	* sem_aux.ads: Fix typo in comment
+	* sem_util.ads (Is_LHS): Adjust comment to match body
+
+2009-07-27  Sergey Rybin  <rybin@adacore.com>
+
+	* gnat_ugn.texi (gnatcheck Complex_Inlined_Subprograms rule): Update
+	rule definition.
+
+2009-07-27  Olivier Hainque  <hainque@adacore.com>
+
+	* g-sse.ads, g-ssvety.ads: Update comments.
+
 2009-07-27  Sergey Rybin  <rybin@adacore.com>
 
 	* gnat_ugn.texi: Update gnatcheck doc.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7a17efd9f7a..e2f1cbe0575 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -491,7 +491,7 @@ package Einfo is
 --       Present in all entities. Set if a pragma Suppress or Unsuppress
 --       mentions the entity specifically in the second argument. If this
 --       flag is set the Global_Entity_Suppress and Local_Entity_Suppress
---       tables must be consulted to determine if the is actually an active
+--       tables must be consulted to determine if there actually is an active
 --       Suppress or Unsuppress pragma that applies to the entity.
 
 --    Class_Wide_Type (Node9)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 2df553c4585..599d0ca5323 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -4682,13 +4682,23 @@ package body Exp_Attr is
          ---------------------
 
          function Make_Range_Test return Node_Id is
+            Temp : constant Node_Id := Duplicate_Subexpr (Pref);
+
          begin
+            --  The value whose validity is being checked has been captured in
+            --  an object declaration. We certainly don't want this object to
+            --  appear valid because the declaration initializes it!
+
+            if Is_Entity_Name (Temp) then
+               Set_Is_Known_Valid (Entity (Temp), False);
+            end if;
+
             return
               Make_And_Then (Loc,
                 Left_Opnd =>
                   Make_Op_Ge (Loc,
                     Left_Opnd =>
-                      Unchecked_Convert_To (Btyp, Duplicate_Subexpr (Pref)),
+                      Unchecked_Convert_To (Btyp, Temp),
 
                     Right_Opnd =>
                       Unchecked_Convert_To (Btyp,
@@ -4699,8 +4709,7 @@ package body Exp_Attr is
                 Right_Opnd =>
                   Make_Op_Le (Loc,
                     Left_Opnd =>
-                      Unchecked_Convert_To (Btyp,
-                        Duplicate_Subexpr_No_Checks (Pref)),
+                      Unchecked_Convert_To (Btyp, Temp),
 
                     Right_Opnd =>
                       Unchecked_Convert_To (Btyp,
diff --git a/gcc/ada/g-sse.ads b/gcc/ada/g-sse.ads
index d7b01a991be..8ce2b5d902d 100644
--- a/gcc/ada/g-sse.ads
+++ b/gcc/ada/g-sse.ads
@@ -44,43 +44,68 @@
 --  This unit exposes vector _component_ types together with general comments
 --  on the binding contents.
 
---  As of today, one other unit is offered: GNAT.SSE.Vector__Types, which
+--  One other unit is offered as of today: GNAT.SSE.Vector_Types, which
 --  exposes Ada types corresponding to the reference types (__m128 and the
---  like) over which GCC builtins will operate. The exposed Ada types are
---  private. Object initializations or value observations may be performed
---  with unchecked conversions or address overlays, for example:
+--  like) over which a binding to the SSE GCC builtins may operate.
+
+--  The exposed Ada types are private. Object initializations or value
+--  observations may be performed with unchecked conversions or address
+--  overlays, for example:
 
 --  with Ada.Unchecked_Conversion;
---  with GNAT.SSE.Vector_Types; use GNAT.SSE; use GNAT.SSE.Vector_Types;
+--  with GNAT.SSE.Vector_Types; use GNAT.SSE, GNAT.SSE.Vector_Types;
 
 --  procedure SSE_Base is
 
 --     --  Core operations
 
---     function mm_add_ss (A, B : M128) return M128;
---     pragma Import (Intrinsic, mm_add_ss, "__builtin_ia32_addss");
+--     function ia32_addps (A, B : m128) return m128;
+--     pragma Import (Intrinsic, ia32_addps, "__builtin_ia32_addps");
 
---     --  User views / conversions or overlays
+--     --  User views & conversions
 
---     type Vf32_View is array (1 .. 4) of Float;
+--     type Vf32_View is array (1 .. 4) of GNAT.SSE.Float32;
 --     for Vf32_View'Alignment use VECTOR_ALIGN;
 
---     function To_M128 is new Ada.Unchecked_Conversion (Vf32_View, M128);
+--     function To_m128 is new Ada.Unchecked_Conversion (Vf32_View, m128);
 
---     X, Y, Z : M128;
+--     Xf32 : constant Vf32_View := (1.0, 1.0, 2.0, 2.0);
+--     Yf32 : constant Vf32_View := (2.0, 2.0, 1.0, 1.0);
 
---     Vz : Vf32_View;
---     for Vz'Address use Z'Address;
+--     X128 : constant m128 := To_m128 (Xf32);
+--     Y128 : constant m128 := To_m128 (Yf32);
 
 --  begin
---     X := To_M128 ((1.0, 1.0, 2.0, 2.0));
---     Y := To_M128 ((2.0, 2.0, 1.0, 1.0));
---     Z := mm_add_ss (X, Y);
-
---     if vz /= (3.0, 1.0, 2.0, 2.0) then
---        raise Program_Error;
---     end if;
---  end;
+--     --  Operations & overlays
+
+--     declare
+--        Z128 : m128;
+--        Zf32 : Vf32_View;
+--        for Zf32'Address use Z128'Address;
+--     begin
+--        Z128 := ia32_addps (X128, Y128);
+--        if Zf32 /= (3.0, 3.0, 3.0, 3.0) then
+--           raise Program_Error;
+--        end if;
+--     end;
+
+--     declare
+--        type m128_View_Kind is (SSE, F32);
+--        type m128_Object (View : m128_View_Kind := F32) is record
+--           case View is
+--              when SSE  => V128 : m128;
+--              when F32  => Vf32 : Vf32_View;
+--           end case;
+--        end record;
+--        pragma Unchecked_Union (m128_Object);
+
+--        O1 : constant m128_Object := (View => SSE, V128 => X128);
+--     begin
+--        if O1.Vf32 /= Xf32 then
+--           raise Program_Error;
+--        end if;
+--     end;
+--  end SSE_Base;
 
 package GNAT.SSE is
    type Float32 is new Float;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index bec5bbb6f38..a1bb7bf306c 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -21209,20 +21209,23 @@ This rule has no parameters.
 @cindex @code{Complex_Inlined_Subprograms} rule (for @command{gnatcheck})
 
 @noindent
-Flags the body of a subprogram (or generic subprogram) if
-pragma Inline has been applied to the subprogram but the body
-is too complex to be expanded inline.
-
-A subprogram (or generic subprogram) is considered too complex for inline
-expansion if its body meets at least one of the following conditions:
+Flags a subprogram (or generic subprogram) if
+pragma Inline is applied to the subprogram and at least one of the following
+conditions is met:
 
 @itemize @bullet
 @item
-The number of local declarations and statements exceeds
-a value specified by the @option{N} rule parameter;
+it contains at least one complex declaration such as a subprogram body,
+package, task, protected object declaration, or a generic instantiation
+(except instantiation of @code{Ada.Unchecked_Conversion});
 
 @item
-The body contains a @code{loop}, @code{if} or @code{case} statement;
+it contains at least one complex statement such as a loop, a case
+or a if statement, or a short circuit control form;
+
+@item
+the number of statements exceeds
+a value specified by the @option{N} rule parameter;
 @end itemize
 
 @noindent
@@ -21230,8 +21233,8 @@ This rule has the following (mandatory) parameter for the @option{+R} option:
 
 @table @emph
 @item N
-Positive integer specifying the maximum allowed total number of local
-declarations and statements in the subprogram body.
+Positive integer specifying the maximum allowed total number of statements
+in the subprogram body.
 @end table
 
 
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 94b2acf3a48..69c4497f135 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1691,104 +1691,102 @@ package body Sem is
       begin
          if not Seen (Unit_Num) then
 
-            Seen (Unit_Num) := True;
-
-            --  Process corresponding spec of body first
-
-            if Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
-               declare
-                  Spec_Unit : constant Node_Id := Library_Unit (CU);
-               begin
-                  if Spec_Unit = CU then  --  ???Why needed?
-                     pragma Assert (Acts_As_Spec (CU));
-                     null;
-                  else
-                     Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit));
-                  end if;
-               end;
-            end if;
-
             --  Process the with clauses
 
             Do_Withed_Units (CU, Include_Limited => False);
 
-            --  Process the unit itself
+            --  Process the unit if it is a spec. If it is the main unit,
+            --  process it only if we have done all other units.
 
             if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
               or else Acts_As_Spec (CU)
-              or else (CU = Cunit (Main_Unit) and then Do_Main)
             then
-               Do_Action (CU, Item);
-               Done (Unit_Num) := True;
+               if CU = Cunit (Main_Unit) and then not Do_Main then
+                  Seen (Unit_Num) := False;
+
+               else
+                  Seen (Unit_Num) := True;
+                  Do_Action (CU, Item);
+                  Done (Unit_Num) := True;
+               end if;
             end if;
          end if;
 
-         --  Process corresponding body of spec last. This is either the main
-         --  unit, or the body of a spec that is in the context of the main
-         --  unit, and that is instantiated, or else contains a generic that
-         --  is instantiated, or a subprogram that is inlined in the main unit.
+         --  Process bodies. The spec, if present, has been processed already.
+         --  A body appears if it is the main, or the body of a spec that is
+         --  in the context of the main unit, and that is instantiated, or else
+         --  contains a generic that is instantiated, or a subprogram that is
+         --  or a subprogram that is inlined in the main unit.
 
          --  We exclude bodies that may appear in a circular dependency list,
          --  where spec A depends on spec B and body of B depends on spec A.
          --  This is not an elaboration issue, but body B must be excluded
          --  from the processing.
 
-         if Nkind (Item) = N_Package_Declaration then
-            declare
-               Body_Unit : constant Node_Id := Library_Unit (CU);
+         declare
+            Body_Unit :  Node_Id := Empty;
+            Body_Num  : Unit_Number_Type;
 
-               function Circular_Dependence (B : Node_Id) return Boolean;
-               --  Check whether this body depends on a spec that is pending,
-               --  that is to say has been seen but not processed yet.
+            function Circular_Dependence (B : Node_Id) return Boolean;
+            --  Check whether this body depends on a spec that is pending,
+            --  that is to say has been seen but not processed yet.
 
-               -------------------------
-               -- Circular_Dependence --
-               -------------------------
+            -------------------------
+            -- Circular_Dependence --
+            -------------------------
 
-               function Circular_Dependence (B : Node_Id) return Boolean is
-                  Item : Node_Id;
-                  UN   : Unit_Number_Type;
+            function Circular_Dependence (B : Node_Id) return Boolean is
+               Item : Node_Id;
+               UN   : Unit_Number_Type;
 
-               begin
-                  Item := First (Context_Items (B));
-                  while Present (Item) loop
-                     if Nkind (Item) = N_With_Clause then
-                        UN := Get_Cunit_Unit_Number (Library_Unit (Item));
-
-                        if Seen (UN)
-                          and then not Done (UN)
-                        then
-                           return True;
-                        end if;
+            begin
+               Item := First (Context_Items (B));
+               while Present (Item) loop
+                  if Nkind (Item) = N_With_Clause then
+                     UN := Get_Cunit_Unit_Number (Library_Unit (Item));
+
+                     if Seen (UN)
+                       and then not Done (UN)
+                     then
+                        return True;
                      end if;
+                  end if;
 
-                     Next (Item);
-                  end loop;
+                  Next (Item);
+               end loop;
 
-                  return False;
-               end Circular_Dependence;
+               return False;
+            end Circular_Dependence;
 
-            begin
-               if Present (Body_Unit)
+         begin
+            if Nkind (Item) = N_Package_Declaration then
+               Body_Unit := Library_Unit (CU);
 
-                 --  Since specs and bodies are not done at the same time,
-                 --  guard against listing a body more than once.
+            elsif Nkind (Item) = N_Package_Body then
+               Body_Unit := CU;
+            end if;
 
-                 and then not Seen (Get_Cunit_Unit_Number (Body_Unit))
+            if Present (Body_Unit)
 
-                 --  Would be good to comment each of these tests ???
+              --  Since specs and bodies are not done at the same time,
+              --  guard against listing a body more than once. Bodies are
+              --  only processed when the main unit is being processed,
+              --  after all other units in the list. The DEC extension
+              --  to System is excluded because of circularities.
 
-                 and then Body_Unit /= Cunit (Main_Unit)
-                 and then Unit_Num /= Get_Source_Unit (System_Aux_Id)
-                 and then not Circular_Dependence (Body_Unit)
-                 and then Do_Main
-               then
-                  Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit));
-                  Do_Action (Body_Unit, Unit (Body_Unit));
-                  Done (Get_Cunit_Unit_Number (Body_Unit)) := True;
-               end if;
-            end;
-         end if;
+              and then not Seen (Get_Cunit_Unit_Number (Body_Unit))
+              and then
+                (No (System_Aux_Id)
+                   or else Unit_Num /= Get_Source_Unit (System_Aux_Id))
+              and then not Circular_Dependence (Body_Unit)
+              and then Do_Main
+            then
+               Body_Num := Get_Cunit_Unit_Number (Body_Unit);
+               Seen (Body_Num) := True;
+               Do_Action (Body_Unit, Unit (Body_Unit));
+               Done (Body_Num) := True;
+            end if;
+         end;
       end Do_Unit_And_Dependents;
 
       --  Local Declarations
diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index f8467446130..464a764a3e3 100755
--- a/gcc/ada/sem_aux.ads
+++ b/gcc/ada/sem_aux.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- --
@@ -36,7 +36,7 @@
 --  Historical note. Many of the routines here were originally in Einfo, but
 --  Einfo is supposed to be a relatively low level package dealing with the
 --  content of entities in the tree, so this package is used for routines that
---  require more than minimal semantic knowldge.
+--  require more than minimal semantic knowledge.
 
 with Alloc; use Alloc;
 with Table;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 5906d98677b..81dcf1f216c 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -705,11 +705,7 @@ package Sem_Util is
    --  by a derived type declarations.
 
    function Is_LHS (N : Node_Id) return Boolean;
-   --  Returns True iff N is an identifier used as Name in an assignment
-   --  statement.
-   --  Which is true, the spec or the body???
-   --  The body does not restrict N to be an identifier, it can be any
-   --  expression on the left side of an assignment ???
+   --  Returns True iff N is used as Name in an assignment statement.
 
    function Is_Library_Level_Entity (E : Entity_Id) return Boolean;
    --  A library-level declaration is one that is accessible from Standard,