[multiple changes]

2009-06-22  Jose Ruiz  <ruiz@adacore.com>

	* sysdep.c (__gnat_localtime_tzoff for RTX):
	SystemTimeToTzSpecificLocalTime is not supported by RTX. Use
	GetTimeZoneInformation instead.

2009-06-22  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Check_No_Direct_Boolean_Operators): New procedure

2009-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Collect_Previous_Instances): Do not collect
	instantiations declared in a previous generic package body.

2009-06-22  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Add doc that X=True and X=False is allowed for the
	restriction No_Direct_Boolean_Operators.

2009-06-22  Thomas Quinot  <quinot@adacore.com>

	* bindusg.adb: Minor fixes to gnatbind usage message

	* sem_eval.adb: Minor reformatting

From-SVN: r148794

gcc/ada/ChangeLog

+2009-06-22  Jose Ruiz  <ruiz@adacore.com>
+
+	* sysdep.c (__gnat_localtime_tzoff for RTX):
+	SystemTimeToTzSpecificLocalTime is not supported by RTX. Use
+	GetTimeZoneInformation instead.
+
+2009-06-22  Robert Dewar  <dewar@adacore.com>
+
+	* sem_res.adb (Check_No_Direct_Boolean_Operators): New procedure
+
+2009-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Collect_Previous_Instances): Do not collect
+	instantiations declared in a previous generic package body.
+
+2009-06-22  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Add doc that X=True and X=False is allowed for the
+	restriction No_Direct_Boolean_Operators.
+
+2009-06-22  Thomas Quinot  <quinot@adacore.com>
+
+	* bindusg.adb: Minor fixes to gnatbind usage message
+
+	* sem_eval.adb: Minor reformatting
+
 2009-06-22  Javier Miranda  <miranda@adacore.com>
 
 	* sem_ch3.adb (Analyze_Object_Declaration, Freeze_Entity): Move to the

gcc/ada/bindusg.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          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- --
@@ -99,7 +99,7 @@ package body Bindusg is
       --  Line for D switch
 
       Write_Line ("  -Dnn[k|m] Default secondary stack " &
-                  "size = nnn [kilo|mega] bytes");
+                  "size = nn [kilo|mega] bytes");
 
       --  Line for -e switch
 
@@ -108,7 +108,7 @@ package body Bindusg is
 
       --  Line for -E switch
 
-      Write_Line ("  -E        Store tracebacks in Exception occurrences");
+      Write_Line ("  -E        Store tracebacks in exception occurrences");
 
       --  The -f switch is voluntarily omitted, because it is obsolete
 

gcc/ada/gnat_rm.texi

@@ -8431,7 +8431,9 @@ This restriction ensures that no logical (and/or/xor) or comparison
 operators are used on operands of type Boolean (or any type derived
 from Boolean). This is intended for use in safety critical programs
 where the certification protocol requires the use of short-circuit
-(and then, or else) forms for all composite boolean operations.
+(and then, or else) forms for all composite boolean operations. An
+exception is that an explicit equality test with True or False as the
+right operand is not considered to violate this restriction.
 
 @item No_Dispatching_Calls
 @findex No_Dispatching_Calls

gcc/ada/sem_ch12.adb

@@ -10465,15 +10465,16 @@ package body Sem_Ch12 is
             --  declared without a box (see Instantiate_Formal_Package). Such
             --  an instantiation does not generate any code (the actual code
             --  comes from actual) and thus does not need to be analyzed here.
+            --  If the instantiation appears with a generic package body it is
+            --  not analyzed here either.
 
             elsif Nkind (Decl) = N_Package_Instantiation
               and then not Is_Internal (Defining_Entity (Decl))
             then
                Append_Elmt (Decl, Previous_Instances);
 
-            --  For a subprogram instantiation, omit instantiations of
-            --  intrinsic operations (Unchecked_Conversions, etc.) that
-            --  have no bodies.
+            --  For a subprogram instantiation, omit instantiations intrinsic
+            --  operations (Unchecked_Conversions, etc.) that have no bodies.
 
             elsif Nkind_In (Decl, N_Function_Instantiation,
                                   N_Procedure_Instantiation)
@@ -10487,7 +10488,9 @@ package body Sem_Ch12 is
                Collect_Previous_Instances
                  (Private_Declarations (Specification (Decl)));
 
-            elsif Nkind (Decl) = N_Package_Body then
+            elsif Nkind (Decl) = N_Package_Body
+              and then Ekind (Corresponding_Spec (Decl)) /= E_Generic_Package
+            then
                Collect_Previous_Instances (Declarations (Decl));
             end if;
 
@@ -10520,8 +10523,8 @@ package body Sem_Ch12 is
            and then Nkind (True_Parent) /= N_Compilation_Unit
          loop
             if Nkind (True_Parent) = N_Package_Declaration
-              and then
-                Nkind (Original_Node (True_Parent)) = N_Package_Instantiation
+                 and then
+               Nkind (Original_Node (True_Parent)) = N_Package_Instantiation
             then
                --  Parent is a compilation unit that is an instantiation.
                --  Instantiation node has been replaced with package decl.
@@ -10572,9 +10575,9 @@ package body Sem_Ch12 is
                Set_Unit (Parent (True_Parent), Inst_Node);
             end if;
 
-            --  Now complete instantiation of enclosing body, if it appears
-            --  in some other unit. If it appears in the current unit, the
-            --  body will have been instantiated already.
+            --  Now complete instantiation of enclosing body, if it appears in
+            --  some other unit. If it appears in the current unit, the body
+            --  will have been instantiated already.
 
             if No (Corresponding_Body (Instance_Spec (Inst_Node))) then
 
@@ -10605,8 +10608,8 @@ package body Sem_Ch12 is
                      Scop := Scope (Scop);
                   end loop;
 
-                  --  Collect previous instantiations in the unit that
-                  --  contains the desired generic.
+                  --  Collect previous instantiations in the unit that contains
+                  --  the desired generic.
 
                   if Nkind (Parent (True_Parent)) /= N_Compilation_Unit
                     and then not Body_Optional
@@ -10635,7 +10638,7 @@ package body Sem_Ch12 is
                              (Private_Declarations (Specification (Par)));
 
                         else
-                           --  Enclosing unit is a subprogram body, In this
+                           --  Enclosing unit is a subprogram body. In this
                            --  case all instance bodies are processed in order
                            --  and there is no need to collect them separately.
 
@@ -10753,9 +10756,7 @@ package body Sem_Ch12 is
 
       E1 := First_Entity (Form);
       E2 := First_Entity (Act);
-      while Present (E1)
-        and then E1 /= First_Private_Entity (Form)
-      loop
+      while Present (E1) and then E1 /= First_Private_Entity (Form) loop
          --  Could this test be a single condition???
          --  Seems like it could, and isn't FPE (Form) a constant anyway???
 
@@ -10764,9 +10765,7 @@ package body Sem_Ch12 is
            and then not Is_Class_Wide_Type (E1)
            and then not Is_Internal_Name (Chars (E1))
          then
-            while Present (E2)
-              and then Chars (E2) /= Chars (E1)
-            loop
+            while Present (E2) and then Chars (E2) /= Chars (E1) loop
                Next_Entity (E2);
             end loop;
 
@@ -10775,21 +10774,15 @@ package body Sem_Ch12 is
             else
                Set_Instance_Of (E1, E2);
 
-               if Is_Type (E1)
-                 and then Is_Tagged_Type (E2)
-               then
-                  Set_Instance_Of
-                    (Class_Wide_Type (E1), Class_Wide_Type (E2));
+               if Is_Type (E1) and then Is_Tagged_Type (E2) then
+                  Set_Instance_Of (Class_Wide_Type (E1), Class_Wide_Type (E2));
                end if;
 
                if Is_Constrained (E1) then
-                  Set_Instance_Of
-                    (Base_Type (E1), Base_Type (E2));
+                  Set_Instance_Of (Base_Type (E1), Base_Type (E2));
                end if;
 
-               if Ekind (E1) = E_Package
-                 and then No (Renamed_Object (E1))
-               then
+               if Ekind (E1) = E_Package and then No (Renamed_Object (E1)) then
                   Map_Formal_Package_Entities (E1, E2);
                end if;
             end if;
@@ -10881,24 +10874,23 @@ package body Sem_Ch12 is
          --  recurse. Nested generic packages will have been processed from the
          --  inside out.
 
-         if Nkind (Decl) = N_Package_Declaration then
-            Spec := Specification (Decl);
+         case Nkind (Decl) is
+            when N_Package_Declaration =>
+               Spec := Specification (Decl);
 
-         elsif Nkind (Decl) = N_Task_Type_Declaration then
-            Spec := Task_Definition (Decl);
+            when N_Task_Type_Declaration =>
+               Spec := Task_Definition (Decl);
 
-         elsif Nkind (Decl) = N_Protected_Type_Declaration then
-            Spec := Protected_Definition (Decl);
+            when N_Protected_Type_Declaration =>
+               Spec := Protected_Definition (Decl);
 
-         else
-            Spec := Empty;
-         end if;
+            when others =>
+               Spec := Empty;
+         end case;
 
          if Present (Spec) then
-            Move_Freeze_Nodes (Out_Of, Next_Node,
-              Visible_Declarations (Spec));
-            Move_Freeze_Nodes (Out_Of, Next_Node,
-              Private_Declarations (Spec));
+            Move_Freeze_Nodes (Out_Of, Next_Node, Visible_Declarations (Spec));
+            Move_Freeze_Nodes (Out_Of, Next_Node, Private_Declarations (Spec));
          end if;
 
          Next (Decl);
@@ -11054,9 +11046,9 @@ package body Sem_Ch12 is
 
    procedure Remove_Parent (In_Body : Boolean := False) is
       S : Entity_Id := Current_Scope;
-      --  S is the scope containing the instantiation just completed. The
-      --  scope stack contains the parent instances of the instantiation,
-      --  followed by the original S.
+      --  S is the scope containing the instantiation just completed. The scope
+      --  stack contains the parent instances of the instantiation, followed by
+      --  the original S.
 
       E      : Entity_Id;
       P      : Entity_Id;
@@ -11084,19 +11076,18 @@ package body Sem_Ch12 is
                  and then P /= Current_Scope
                then
                   --  We are within an instance of some sibling. Retain
-                  --  visibility of parent, for proper subsequent cleanup,
-                  --  and reinstall private declarations as well.
+                  --  visibility of parent, for proper subsequent cleanup, and
+                  --  reinstall private declarations as well.
 
                   Set_In_Private_Part (P);
                   Install_Private_Declarations (P);
                end if;
 
             --  If the ultimate parent is a top-level unit recorded in
-            --  Instance_Parent_Unit, then reset its visibility to what
-            --  it was before instantiation. (It's not clear what the
-            --  purpose is of testing whether Scope (P) is In_Open_Scopes,
-            --  but that test was present before the ultimate parent test
-            --  was added.???)
+            --  Instance_Parent_Unit, then reset its visibility to what is was
+            --  before instantiation. (It's not clear what the purpose is of
+            --  testing whether Scope (P) is In_Open_Scopes, but that test was
+            --  present before the ultimate parent test was added.???)
 
             elsif not In_Open_Scopes (Scope (P))
               or else (P = Instance_Parent_Unit
@@ -11111,9 +11102,7 @@ package body Sem_Ch12 is
             --  subunit of a generic contains an instance of a child unit of
             --  its generic parent unit.
 
-            elsif S = Current_Scope
-              and then Is_Generic_Instance (S)
-            then
+            elsif S = Current_Scope and then Is_Generic_Instance (S) then
                declare
                   Par : constant Entity_Id :=
                           Generic_Parent
@@ -11141,9 +11130,9 @@ package body Sem_Ch12 is
          end loop;
 
       else
-         --  Each body is analyzed separately, and there is no context
-         --  that needs preserving from one body instance to the next,
-         --  so remove all parent scopes that have been installed.
+         --  Each body is analyzed separately, and there is no context that
+         --  needs preserving from one body instance to the next, so remove all
+         --  parent scopes that have been installed.
 
          while Present (S) loop
             End_Package_Scope (S);
@@ -11163,7 +11152,6 @@ package body Sem_Ch12 is
 
    begin
       if No (Current_Instantiated_Parent.Act_Id) then
-
          --  Restore environment after subprogram inlining
 
          Restore_Private_Views (Empty);
@@ -11196,8 +11184,8 @@ package body Sem_Ch12 is
       Dep_Typ  : Node_Id;
 
       procedure Restore_Nested_Formal (Formal : Entity_Id);
-      --  Hide the generic formals of formal packages declared with box
-      --  which were reachable in the current instantiation.
+      --  Hide the generic formals of formal packages declared with box which
+      --  were reachable in the current instantiation.
 
       ---------------------------
       -- Restore_Nested_Formal --
@@ -11241,9 +11229,9 @@ package body Sem_Ch12 is
 
          --  Subtypes of types whose views have been exchanged, and that
          --  are defined within the instance, were not on the list of
-         --  Private_Dependents on entry to the instance, so they have to
-         --  be exchanged explicitly now, in order to remain consistent with
-         --  the view of the parent type.
+         --  Private_Dependents on entry to the instance, so they have to be
+         --  exchanged explicitly now, in order to remain consistent with the
+         --  view of the parent type.
 
          if Ekind (Typ) = E_Private_Type
            or else Ekind (Typ) = E_Limited_Private_Type
@@ -11272,8 +11260,8 @@ package body Sem_Ch12 is
          return;
       end if;
 
-      --  Make the generic formal parameters private, and make the formal
-      --  types into subtypes of the actuals again.
+      --  Make the generic formal parameters private, and make the formal types
+      --  into subtypes of the actuals again.
 
       E := First_Entity (Pack_Id);
       while Present (E) loop

gcc/ada/sem_eval.adb

@@ -706,7 +706,7 @@ package body Sem_Eval is
          return Unknown;
 
       --  For access types, the only time we know the result at compile time
-      --  (apart from identical operands, which we handled already, is if we
+      --  (apart from identical operands, which we handled already) is if we
       --  know one operand is null and the other is not, or both operands are
       --  known null.
 
@@ -720,9 +720,7 @@ package body Sem_Eval is
                return Unknown;
             end if;
 
-         elsif Known_Non_Null (L)
-           and then Known_Null (R)
-         then
+         elsif Known_Non_Null (L) and then Known_Null (R) then
             return NE;
 
          else
@@ -792,7 +790,7 @@ package body Sem_Eval is
 
          --  For remaining scalar cases we know exactly (note that this does
          --  include the fixed-point case, where we know the run time integer
-         --  values now)
+         --  values now).
 
          else
             declare

gcc/ada/sem_res.adb

@@ -119,6 +119,11 @@ package body Sem_Res is
    --  initialization of individual components within the init proc itself.
    --  Could be optimized away perhaps?
 
+   procedure Check_No_Direct_Boolean_Operators (N : Node_Id);
+   --  N is the node for a comparison or logical operator. If the operator
+   --  is predefined, and the root type of the operands is Standard.Boolean,
+   --  then a check is made for restriction No_Direct_Boolean_Operators.
+
    function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
    --  Determine whether E is an access type declared by an access
    --  declaration, and not an (anonymous) allocator type.
@@ -926,6 +931,38 @@ package body Sem_Res is
       end if;
    end Check_Initialization_Call;
 
+   ---------------------------------------
+   -- Check_No_Direct_Boolean_Operators --
+   ---------------------------------------
+
+   procedure Check_No_Direct_Boolean_Operators (N : Node_Id) is
+   begin
+      if Scope (Entity (N)) = Standard_Standard
+        and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
+      then
+         --  Restriction does not apply to generated code
+
+         if not Comes_From_Source (N) then
+            null;
+
+         --  Restriction does not apply for A=False, A=True
+
+         elsif Nkind (N) = N_Op_Eq
+           and then (Is_Entity_Name (Right_Opnd (N))
+                      and then (Entity (Right_Opnd (N)) = Standard_True
+                                 or else
+                                Entity (Right_Opnd (N)) = Standard_False))
+         then
+            null;
+
+         --  Otherwise restriction applies
+
+         else
+            Check_Restriction (No_Direct_Boolean_Operators, N);
+         end if;
+      end if;
+   end Check_No_Direct_Boolean_Operators;
+
    ------------------------------
    -- Check_Parameterless_Call --
    ------------------------------
@@ -5431,6 +5468,8 @@ package body Sem_Res is
       T : Entity_Id;
 
    begin
+      Check_No_Direct_Boolean_Operators (N);
+
       --  If this is an intrinsic operation which is not predefined, use the
       --  types of its declared arguments to resolve the possibly overloaded
       --  operands. Otherwise the operands are unambiguous and specify the
@@ -6154,6 +6193,8 @@ package body Sem_Res is
    --  Start of processing for Resolve_Equality_Op
 
    begin
+      Check_No_Direct_Boolean_Operators (N);
+
       Set_Etype (N, Base_Type (Typ));
       Generate_Reference (T, N, ' ');
 
@@ -6609,9 +6650,10 @@ package body Sem_Res is
 
    procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id) is
       B_Typ : Entity_Id;
-      N_Opr : constant Node_Kind := Nkind (N);
 
    begin
+      Check_No_Direct_Boolean_Operators (N);
+
       --  Predefined operations on scalar types yield the base type. On the
       --  other hand, logical operations on arrays yield the type of the
       --  arguments (and the context).
@@ -6654,15 +6696,6 @@ package body Sem_Res is
       Set_Etype (N, B_Typ);
       Generate_Operator_Reference (N, B_Typ);
       Eval_Logical_Op (N);
-
-      --  Check for violation of restriction No_Direct_Boolean_Operators
-      --  if the operator was not eliminated by the Eval_Logical_Op call.
-
-      if Nkind (N) = N_Opr
-        and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
-      then
-         Check_Restriction (No_Direct_Boolean_Operators, N);
-      end if;
    end Resolve_Logical_Op;
 
    ---------------------------

gcc/ada/sysdep.c

@@ -764,6 +764,22 @@ __gnat_localtime_tzoff (const time_t *timer, long *off)
 
   (*Lock_Task) ();
 
+#ifdef RTX
+
+  tzi_status = GetTimeZoneInformation (&tzi);
+  *off = tzi.Bias;
+  if (tzi_status == TIME_ZONE_ID_STANDARD)
+     /* The system is operating in the range covered by the StandardDate
+        member. */
+     *off = *off + tzi.StandardBias;
+  else if (tzi_status == TIME_ZONE_ID_DAYLIGHT)
+     /* The system is operating in the range covered by the DaylightDate
+        member. */
+     *off = *off + tzi.DaylightBias;
+  *off = *off * -60;
+
+#else
+
   /* First convert unix time_t structure to windows FILETIME format.  */
   utc_time.ull_time = ((unsigned long long) *timer + w32_epoch_offset)
                       * 10000000ULL;
@@ -792,6 +808,8 @@ __gnat_localtime_tzoff (const time_t *timer, long *off)
      else
         *off = - (long) ((utc_time.ull_time - local_time.ull_time) / 10000000ULL);
 
+#endif
+
   (*Unlock_Task) ();
 }