2003-11-26 Thomas Quinot <quinot@act-europe.fr>

	* g-socket.ads, g-socket.adb:
	Clarify documentation of function Stream. Introduce a Free procedure
	to release the returned Stream once it becomes unused.

	* 5asystem.ads: For Alpha Tru64, enable ZCX by default.

2003-11-26  Arnaud Charlet  <charlet@act-europe.fr>

	(Cond_Timed_Wait): Introduce new constant Time_Out_Max,
	since NT 4 cannot handle timeout values that are too large,
	e.g. DWORD'Last - 1.

2003-11-26  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch4.adb:
	(Expand_N_Slice): Recognize all cases of slices that appear as actuals
	in procedure calls and whose expansion must be deferred.

	* exp_ch6.adb (Add_Call_By_Copy_Node): Remove previous fix. Proper fix
	is in exp_ch4.

	* sem_ch3.adb:
	(Build_Derived_Array_Type): Create operator for unconstrained type
	if ancestor is unconstrained.

2003-11-26  Vincent Celier  <celier@gnat.com>

	* make.adb (Project_Object_Directory): New global variable
	(Change_To_Object_Directory): New procedure
	(Collect_Arguments_And_Compile): Call Change_To_Object_Directory instead
	of Change_Dir directly. Do not change working directory to object
	directory of main project after each compilation.
	(Gnatmake): Use Change_To_Object_Directory instead of Change_Dir
	directly.
	Change to object directory of main project before binding step.
	(Initialize): Initialize Project_Object_Directory to No_Project

	* mlib-prj.adb:
	(Build_Library): Take into account Builder'Default_Switches ("Ada") when
	binding a Stand-Alone Library.

	* output.adb: Update Copyright notice
	(Write_Char): Output buffer when full

2003-11-26  Robert Dewar  <dewar@gnat.com>

	* sem_ch13.adb: (Check_Size): Reset size if size is too small

	* sem_ch13.ads:
	(Check_Size): Fix documentation to include bit-packed array case

	* sem_res.adb: Implement restriction No_Direct_Boolean_Operators

	* s-rident.ads: Put No_Direct_Boolean_Operators in proper order

	* s-rident.ads: Add new restriction No_Direct_Boolean_Operators


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

15 files changed, 286 insertions, 70 deletions

diff --git a/gcc/ada/5asystem.ads b/gcc/ada/5asystem.ads
index 3e445d90b27..f0067b37f84 100644
--- a/gcc/ada/5asystem.ads
+++ b/gcc/ada/5asystem.ads
@@ -138,8 +138,8 @@ private
    Support_Long_Shifts       : constant Boolean := True;
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
-   ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
+   ZCX_By_Default            : constant Boolean := True;
+   GCC_ZCX_Support           : constant Boolean := True;
    Front_End_ZCX_Support     : constant Boolean := False;
 
    --  Obsolete entries, to be removed eventually (bootstrap issues!)
diff --git a/gcc/ada/5wtaprop.adb b/gcc/ada/5wtaprop.adb
index 506ece210c1..aa84c28bfaf 100644
--- a/gcc/ada/5wtaprop.adb
+++ b/gcc/ada/5wtaprop.adb
@@ -296,9 +296,13 @@ package body System.Task_Primitives.Operations is
       Timed_Out : out Boolean;
       Status    : out Integer)
    is
-      Time_Out    : DWORD;
-      Result      : BOOL;
-      Wait_Result : DWORD;
+      Time_Out_Max : constant DWORD := 16#FFFF0000#;
+      --  NT 4 cannot handle timeout values that are too large,
+      --  e.g. DWORD'Last - 1
+
+      Time_Out     : DWORD;
+      Result       : BOOL;
+      Wait_Result  : DWORD;
 
    begin
       --  Must reset Cond BEFORE L is unlocked.
@@ -315,8 +319,8 @@ package body System.Task_Primitives.Operations is
          Wait_Result := 0;
 
       else
-         if Rel_Time >= Duration (DWORD'Last - 1) / 1000 then
-            Time_Out := DWORD'Last - 1;
+         if Rel_Time >= Duration (Time_Out_Max) / 1000 then
+            Time_Out := Time_Out_Max;
          else
             Time_Out := DWORD (Rel_Time * 1000);
          end if;
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cfa7cb39970..0899e22a36c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,62 @@
+2003-11-26  Thomas Quinot  <quinot@act-europe.fr>
+
+	* g-socket.ads, g-socket.adb: 
+	Clarify documentation of function Stream. Introduce a Free procedure
+	to release the returned Stream once it becomes unused.
+
+	* 5asystem.ads: For Alpha Tru64, enable ZCX by default.
+
+2003-11-26  Arnaud Charlet  <charlet@act-europe.fr>
+
+	(Cond_Timed_Wait): Introduce new constant Time_Out_Max,
+	since NT 4 cannot handle timeout values that are too large,
+	e.g. DWORD'Last - 1.
+
+2003-11-26  Ed Schonberg  <schonberg@gnat.com>
+
+	* exp_ch4.adb: 
+	(Expand_N_Slice): Recognize all cases of slices that appear as actuals
+	in procedure calls and whose expansion must be deferred.
+
+	* exp_ch6.adb (Add_Call_By_Copy_Node): Remove previous fix. Proper fix
+	is in exp_ch4.
+
+	* sem_ch3.adb: 
+	(Build_Derived_Array_Type): Create operator for unconstrained type
+	if ancestor is unconstrained.
+
+2003-11-26  Vincent Celier  <celier@gnat.com>
+
+	* make.adb (Project_Object_Directory): New global variable
+	(Change_To_Object_Directory): New procedure
+	(Collect_Arguments_And_Compile): Call Change_To_Object_Directory instead
+	of Change_Dir directly. Do not change working directory to object
+	directory of main project after each compilation.
+	(Gnatmake): Use Change_To_Object_Directory instead of Change_Dir
+	directly.
+	Change to object directory of main project before binding step.
+	(Initialize): Initialize Project_Object_Directory to No_Project
+
+	* mlib-prj.adb: 
+	(Build_Library): Take into account Builder'Default_Switches ("Ada") when
+	binding a Stand-Alone Library.
+
+	* output.adb: Update Copyright notice
+	(Write_Char): Output buffer when full
+
+2003-11-26  Robert Dewar  <dewar@gnat.com>
+
+	* sem_ch13.adb: (Check_Size): Reset size if size is too small
+
+	* sem_ch13.ads: 
+	(Check_Size): Fix documentation to include bit-packed array case
+
+	* sem_res.adb: Implement restriction No_Direct_Boolean_Operators
+
+	* s-rident.ads: Put No_Direct_Boolean_Operators in proper order
+
+	* s-rident.ads: Add new restriction No_Direct_Boolean_Operators
+
 2003-11-24  Arnaud Charlet <charlet@act-europe.fr>
 
 	PR ada/13142
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 85de43395e3..86ff9947620 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5333,11 +5333,36 @@ package body Exp_Ch4 is
       Pfx  : constant Node_Id    := Prefix (N);
       Ptp  : Entity_Id           := Etype (Pfx);
 
+      function Is_Procedure_Actual (N : Node_Id) return Boolean;
+      --  Check whether context is a procedure call, in which case
+      --  expansion of a bit-packed slice is deferred until the call
+      --  itself is expanded.
+
       procedure Make_Temporary;
       --  Create a named variable for the value of the slice, in
       --  cases where the back-end cannot handle it properly, e.g.
       --  when packed types or unaligned slices are involved.
 
+      -------------------------
+      -- Is_Procedure_Actual --
+      -------------------------
+
+      function Is_Procedure_Actual (N : Node_Id) return Boolean is
+         Par : Node_Id := Parent (N);
+      begin
+         while Present (Par)
+           and then Nkind (Par) not in N_Statement_Other_Than_Procedure_Call
+         loop
+            if Nkind (Par) = N_Procedure_Call_Statement then
+               return True;
+            else
+               Par := Parent (Par);
+            end if;
+         end loop;
+
+         return False;
+      end Is_Procedure_Actual;
+
       --------------------
       -- Make_Temporary --
       --------------------
@@ -5422,26 +5447,34 @@ package body Exp_Ch4 is
       --       is caught elsewhere, and the expansion would intefere
       --       with generating the error message).
 
-      if Is_Packed (Typ)
-        and then Nkind (Parent (N)) /= N_Assignment_Statement
-        and then (Nkind (Parent (Parent (N))) /= N_Assignment_Statement
-                     or else
-                  Parent (N) /= Name (Parent (Parent (N))))
-        and then Nkind (Parent (N)) /= N_Indexed_Component
-        and then not Is_Renamed_Object (N)
-        and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
-        and then (Nkind (Parent (N)) /= N_Attribute_Reference
-                    or else
-                  Attribute_Name (Parent (N)) /= Name_Address)
+      if not Is_Packed (Typ) then
+         --  apply transformation for actuals of a function call, where
+         --  Expand_Actuals is not used.
+
+         if Nkind (Parent (N)) = N_Function_Call
+           and then Is_Possibly_Unaligned_Slice (N)
+         then
+            Make_Temporary;
+         end if;
+
+      elsif Nkind (Parent (N)) = N_Assignment_Statement
+        or else (Nkind (Parent (Parent (N))) = N_Assignment_Statement
+                   and then Parent (N) = Name (Parent (Parent (N))))
       then
-         Make_Temporary;
+         return;
 
-      --  Same transformation for actuals in a function call, where
-      --  Expand_Actuals is not used.
+      elsif Nkind (Parent (N)) = N_Indexed_Component
+        or else Is_Renamed_Object (N)
+        or else Is_Procedure_Actual (N)
+      then
+         return;
 
-      elsif Nkind (Parent (N)) = N_Function_Call
-        and then Is_Possibly_Unaligned_Slice (N)
+      elsif (Nkind (Parent (N)) = N_Attribute_Reference
+        and then Attribute_Name (Parent (N)) = Name_Address)
       then
+         return;
+
+      else
          Make_Temporary;
       end if;
    end Expand_N_Slice;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 15730c7d2bf..b0023aa1f44 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -544,24 +544,8 @@ package body Exp_Ch6 is
 
             --  If the formal is an (in-)out parameter, capture the name
             --  of the variable in order to build the post-call assignment.
-            --  The variable itself may have been expanded, for example if
-            --  it is a complex bit-packed array, so we need to recover the
-            --  original to ensure that we have the proper target for the
-            --  assignment. Examine the slocs of the two nodes to determine
-            --  whether the rewriting is an expansion, or a substitution done
-            --  on an inlined body, in which case it must be respected.
 
-            declare
-               Orig : constant Node_Id := Original_Node (Expression (Actual));
-            begin
-               if Orig /= Expression (Actual)
-                 and then Sloc (Orig) = Sloc (Expression (Actual))
-               then
-                  Var := Make_Var (Orig);
-               else
-                  Var := Make_Var (Expression (Actual));
-               end if;
-            end;
+            Var := Make_Var (Expression (Actual));
 
             Crep  := not Same_Representation
                        (Etype (Formal), Etype (Expression (Actual)));
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 5ad723bab26..97967a5b8e7 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -34,6 +34,7 @@
 with Ada.Streams;                use Ada.Streams;
 with Ada.Exceptions;             use Ada.Exceptions;
 with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
 
 with Interfaces.C.Strings;
 
@@ -777,6 +778,17 @@ package body GNAT.Sockets is
       end if;
    end Finalize;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (Stream : in out Stream_Access) is
+      procedure Do_Free is new Ada.Unchecked_Deallocation
+        (Ada.Streams.Root_Stream_Type'Class, Stream_Access);
+   begin
+      Do_Free (Stream);
+   end Free;
+
    ---------
    -- Get --
    ---------
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index 57a83743f1e..f78241c4178 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -885,15 +885,15 @@ package GNAT.Sockets is
    function Stream
      (Socket : Socket_Type)
       return   Stream_Access;
-   --  Associate a stream with a stream-based socket that is already
-   --  connected.
+   --  Create a stream associated with a stream-based socket that is
+   --  already connected.
 
    function Stream
      (Socket  : Socket_Type;
       Send_To : Sock_Addr_Type)
       return    Stream_Access;
-   --  Associate a stream with a datagram-based socket that is already
-   --  bound. Send_To is the socket address to which messages are
+   --  Create a stream associated with a datagram-based socket that is
+   --  already bound. Send_To is the socket address to which messages are
    --  being sent.
 
    function Get_Address
@@ -902,6 +902,11 @@ package GNAT.Sockets is
    --  Return the socket address from which the last message was
    --  received.
 
+   procedure Free (Stream : in out Stream_Access);
+   --  Destroy a stream created by one of the Stream functions above, and
+   --  release associated resources. The user is responsible for calling
+   --  this subprogram when the stream is not needed anymore.
+
    type Socket_Set_Type is limited private;
    --  This type allows to manipulate sets of sockets. It allows to
    --  wait for events on multiple endpoints at one time. This is an
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 1a58a82a1ae..a304f10a2cd 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -312,6 +312,11 @@ package body Make is
    Main_Project : Prj.Project_Id := No_Project;
    --  The project id of the main project file, if any
 
+   Project_Object_Directory : Project_Id := No_Project;
+   --  The object directory of the project for the last compilation.
+   --  Avoid calling Change_Dir if the current working directory is already
+   --  this directory
+
    --  Packages of project files where unknown attributes are errors.
 
    Naming_String   : aliased String := "naming";
@@ -344,6 +349,10 @@ package body Make is
    procedure Add_Object_Directories is
      new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
 
+   procedure Change_To_Object_Directory (Project : Project_Id);
+   --  Change to the object directory of project Project, if this is not
+   --  already the current working directory.
+
    type Bad_Compilation_Info is record
       File  : File_Name_Type;
       Unit  : Unit_Name_Type;
@@ -1107,6 +1116,36 @@ package body Make is
       end if;
    end Bind;
 
+   --------------------------------
+   -- Change_To_Object_Directory --
+   --------------------------------
+
+   procedure Change_To_Object_Directory (Project : Project_Id) is
+   begin
+      --  Nothing to do if the current working directory is alresdy the one
+      --  we want.
+
+      if Project_Object_Directory /= Project then
+         Project_Object_Directory := Project;
+
+         --  If in a real project, set the working directory to the object
+         --  directory of the project.
+
+         if Project /= No_Project then
+            Change_Dir
+              (Get_Name_String (Projects.Table (Project).Object_Directory));
+
+         --  Otherwise, for sources outside of any project, set the working
+         --  directory to the object directory of the main project.
+
+         elsif Main_Project /= No_Project then
+            Change_Dir
+              (Get_Name_String
+                 (Projects.Table (Main_Project).Object_Directory));
+         end if;
+      end if;
+   end Change_To_Object_Directory;
+
    -----------
    -- Check --
    -----------
@@ -2204,28 +2243,23 @@ package body Make is
                end;
             end if;
 
-            --  Change to the object directory of the project file, if it is
-            --  not the main project file.
+            --  Change to the object directory of the project file,
+            --  if necessary.
 
-            if Arguments_Project /= Main_Project then
-               Change_Dir
-                 (Get_Name_String
-                    (Projects.Table (Arguments_Project).Object_Directory));
-            end if;
+            Change_To_Object_Directory (Arguments_Project);
 
             Pid := Compile (Arguments_Path_Name, Lib_File,
                             Arguments (1 .. Last_Argument));
 
-            --  Change back to the object directory of the main project file,
-            --  if necessary.
+         else
+            --  If this is a source outside of any project file, make sure
+            --  it will be compiled in the object directory of the main project
+            --  file.
 
-            if Arguments_Project /= Main_Project then
-               Change_Dir
-                 (Get_Name_String
-                    (Projects.Table (Main_Project).Object_Directory));
+            if Main_Project /= No_Project then
+               Change_To_Object_Directory (Arguments_Project);
             end if;
 
-         else
             Pid := Compile (Full_Source_File, Lib_File,
                             Arguments (1 .. Last_Argument));
          end if;
@@ -3761,9 +3795,8 @@ package body Make is
          --  project.
 
          begin
-            Change_Dir
-              (Get_Name_String
-                 (Projects.Table (Main_Project).Object_Directory));
+            Project_Object_Directory := No_Project;
+            Change_To_Object_Directory (Main_Project);
 
          exception
             when Directory_Error =>
@@ -4623,6 +4656,13 @@ package body Make is
             end Recursive_Compilation_Step;
          end if;
 
+         --  For binding and linking, we need to be in the object directory of
+         --  the main project.
+
+         if Main_Project /= No_Project then
+            Change_To_Object_Directory (Main_Project);
+         end if;
+
          --  If we are here, it means that we need to rebuilt the current
          --  main. So we set Executable_Obsolete to True to make sure that
          --  the subsequent mains will be rebuilt.
@@ -5713,6 +5753,10 @@ package body Make is
          end;
       end if;
 
+      --  Make sure no project object directory is recorded
+
+      Project_Object_Directory := No_Project;
+
       --  Set the marking label to a value that is not zero
 
       Marking_Label := 1;
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index c1c45c5ba69..70fefe57a62 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -806,6 +806,42 @@ package body MLib.Prj is
               (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
             Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
 
+            --  Check if Binder'Default_Switches ("Ada) is defined. If it is,
+            --  add these switches to call gnatbind.
+
+            declare
+               Binder_Package : constant Package_Id :=
+                 Value_Of
+                   (Name        => Name_Binder,
+                    In_Packages => Data.Decl.Packages);
+            begin
+               if Binder_Package /= No_Package then
+                  declare
+                     Defaults : constant Array_Element_Id :=
+                                  Value_Of
+                                    (Name      => Name_Default_Switches,
+                                     In_Arrays =>
+                                       Packages.Table
+                                         (Binder_Package).Decl.Arrays);
+                     Switches : Variable_Value :=
+                                  Value_Of
+                                    (Index => Name_Ada, In_Array => Defaults);
+                     Switch : String_List_Id := Nil_String;
+                  begin
+                     if not Switches.Default then
+                        Switch := Switches.Values;
+
+                        while Switch /= Nil_String loop
+                           Add_Argument
+                             (Get_Name_String
+                                (String_Elements.Table (Switch).Value));
+                           Switch := String_Elements.Table (Switch).Next;
+                        end loop;
+                     end if;
+                  end;
+               end if;
+            end;
+
             --  Get all the ALI files of the project file
 
             declare
diff --git a/gcc/ada/output.adb b/gcc/ada/output.adb
index 78f80f45c6f..ea52af636bf 100644
--- a/gcc/ada/output.adb
+++ b/gcc/ada/output.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2003, 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- --
@@ -236,10 +236,12 @@ package body Output is
 
    procedure Write_Char (C : Character) is
    begin
-      if Next_Column < Buffer'Length then
-         Buffer (Natural (Next_Column)) := C;
-         Next_Column := Next_Column + 1;
+      if Next_Column = Buffer'Length then
+         Write_Eol;
       end if;
+
+      Buffer (Natural (Next_Column)) := C;
+      Next_Column := Next_Column + 1;
    end Write_Char;
 
    ---------------
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index cd4004c834a..6b07f9190af 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -56,6 +56,7 @@ package System.Rident is
       No_Asynchronous_Control,                 -- (RM D.7(10))
       No_Calendar,                             -- GNAT
       No_Delay,                                -- (RM H.4(21))
+      No_Direct_Boolean_Operators,             -- GNAT
       No_Dispatch,                             -- (RM H.4(19))
       No_Dynamic_Interrupts,                   -- GNAT
       No_Dynamic_Priorities,                   -- (RM D.9(9))
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ca9bb01355c..ca7ca0fb6c8 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2898,6 +2898,8 @@ package body Sem_Ch13 is
                Error_Msg_Uint_1 := Asiz;
                Error_Msg_NE
                  ("size for& too small, minimum allowed is ^", N, T);
+               Set_Esize   (T, Asiz);
+               Set_RM_Size (T, Asiz);
             end if;
          end;
 
@@ -2939,6 +2941,8 @@ package body Sem_Ch13 is
                Error_Msg_Uint_1 := M;
                Error_Msg_NE
                  ("size for& too small, minimum allowed is ^", N, T);
+               Set_Esize (T, M);
+               Set_RM_Size (T, M);
             else
                Biased := True;
             end if;
diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads
index 2f520cd5e3a..3abdffb8073 100644
--- a/gcc/ada/sem_ch13.ads
+++ b/gcc/ada/sem_ch13.ads
@@ -79,14 +79,17 @@ package Sem_Ch13 is
       Biased : out Boolean);
    --  Called when size Siz is specified for subtype T. This subprogram checks
    --  that the size is appropriate, posting errors on node N as required.
-   --  For non-elementary types, a check is only made if an explicit size
-   --  has been given for the type (and the specified size must match). The
-   --  parameter Biased is set False if the size specified did not require
+   --  This check is effective for elementary types and bit-packed arrays.
+   --  For other non-elementary types, a check is only made if an explicit
+   --  size has been given for the type (and the specified size must match).
+   --  The parameter Biased is set False if the size specified did not require
    --  the use of biased representation, and True if biased representation
    --  was required to meet the size requirement. Note that Biased is only
    --  set if the type is not currently biased, but biasing it is the only
    --  way to meet the requirement. If the type is currently biased, then
    --  this biased size is used in the initial check, and Biased is False.
+   --  If the size is too small, and an error message is given, then both
+   --  Esize and RM_Size are reset to the allowed minimum value in T.
 
    procedure Record_Rep_Item (T : Entity_Id; N : Node_Id);
    --  N is the node for either a representation pragma or an attribute
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index b798fd51538..f74480cb34c 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3061,14 +3061,21 @@ package body Sem_Ch3 is
       --  declared in a closed scope (e.g., a subprogram), then we
       --  need to explicitly introduce the new type's concatenation
       --  operator since Derive_Subprograms will not inherit the
-      --  parent's operator.
+      --  parent's operator. If the parent type is unconstrained, the
+      --  operator is of the unconstrained base type.
 
       if Number_Dimensions (Parent_Type) = 1
         and then not Is_Limited_Type (Parent_Type)
         and then not Is_Derived_Type (Parent_Type)
         and then not Is_Package (Scope (Base_Type (Parent_Type)))
       then
-         New_Concatenation_Op (Derived_Type);
+         if not Is_Constrained (Parent_Type)
+           and then Is_Constrained (Derived_Type)
+         then
+            New_Concatenation_Op (Implicit_Base);
+         else
+            New_Concatenation_Op (Derived_Type);
+         end if;
       end if;
    end Build_Derived_Array_Type;
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ed3adbd051b..3b95b97c29c 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -88,6 +88,11 @@ package body Sem_Res is
    --  Give list of candidate interpretations when a character literal cannot
    --  be resolved.
 
+   procedure Check_Direct_Boolean_Op (N : Node_Id);
+   --  N is a binary operator node which may possibly operate on Boolean
+   --  operands. If the operator does have Boolean operands, then a call is
+   --  made to check the restriction No_Direct_Boolean_Operators.
+
    procedure Check_Discriminant_Use (N : Node_Id);
    --  Enforce the restrictions on the use of discriminants when constraining
    --  a component of a discriminated type (record or concurrent type).
@@ -342,6 +347,17 @@ package body Sem_Res is
       end if;
    end Analyze_And_Resolve;
 
+   -----------------------------
+   -- Check_Direct_Boolean_Op --
+   -----------------------------
+
+   procedure Check_Direct_Boolean_Op (N : Node_Id) is
+   begin
+      if Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean then
+         Check_Restriction (No_Direct_Boolean_Operators, N);
+      end if;
+   end Check_Direct_Boolean_Op;
+
    ----------------------------
    -- Check_Discriminant_Use --
    ----------------------------
@@ -3852,6 +3868,8 @@ package body Sem_Res is
       T : Entity_Id;
 
    begin
+      Check_Direct_Boolean_Op (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
@@ -4591,6 +4609,8 @@ package body Sem_Res is
    --  Start of processing for Resolve_Equality_Op
 
    begin
+      Check_Direct_Boolean_Op (N);
+
       Set_Etype (N, Base_Type (Typ));
       Generate_Reference (T, N, ' ');
 
@@ -4972,6 +4992,8 @@ package body Sem_Res is
       B_Typ : Entity_Id;
 
    begin
+      Check_Direct_Boolean_Op (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).