[multiple changes]

2012-04-02  Yannick Moy  <moy@adacore.com>

	* osint.adb, osint.ads (Add_Default_Search_Dirs): Add library
	search dirs in file specified with option -gnateO.

2012-04-02  Robert Dewar  <dewar@adacore.com>

	* sem_ch5.adb, exp_util.adb, sem_util.adb, exp_ch4.adb: Minor
	reformatting.

2012-04-02  Olivier Hainque  <hainque@adacore.com>

	* g-sse.ads: Add x86-solaris and x86_64-darwin to the set of
	platforms where the use of this spec is supported. Add current
	year to the copyright notice.
	* gcc-interfaces/Makefile.in: Add g-sse.o and g-ssvety.o to
	EXTRA_GNATRTL_NONTASKING_OBJS on x86 32/64 targets that support
	it and where they were missing (x86-solaris, x86-freebsd,
	x86_64-freebsd, and x86-darwin).

2012-04-02  Gary Dismukes  <dismukes@adacore.com>

	* bindgen.adb (Gen_Ada_Init): When compiling for the AAMP small
	library, where we no longer suppress the Standard_Library,
	generate an empty body rather than the usual generation of
	assignments to imported globals, since those aren't present in
	the small library.

2012-04-02  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads: Minor documentation fix.

2012-04-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Conditional_Expression): Add local variables
	Else_Typ and Then_Typ. Add missing type conversions to the "then" and
	"else" expressions when their respective types are scalar.

2012-04-02  Vincent Pucci  <pucci@adacore.com>

	* exp_ch9.adb: Reordering of the local subprograms. New Table
	for the lock free implementation that maps each protected
	subprograms with the protected component it references.
	(Allow_Lock_Free_Implementation): New routine. Check if
	the protected body enables the lock free implementation.
	(Build_Lock_Free_Protected_Subprogram_Body): New routine.
	(Build_Lock_Free_Unprotected_Subprogram_Body): New routine.
	(Comp_Of): New routine.
	* Makefile.rtl: Add s-atopri.o
	* debug.adb: New compiler debug flag -gnatd9 for lock free
	implementation.
	* rtsfind.ads: RE_Atomic_Compare_Exchange_8,
	RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32,
	RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8,
	RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64, RE_Uint8,
	RE_Uint16, RE_Uint32, RE_Uint64 added.
	* s-atropi.ads: New file. Defines atomic primitives used
	by the lock free implementation.

From-SVN: r186076

gcc/ada/ChangeLog

+2012-04-02  Yannick Moy  <moy@adacore.com>
+
+	* osint.adb, osint.ads (Add_Default_Search_Dirs): Add library
+	search dirs in file specified with option -gnateO.
+
+2012-04-02  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch5.adb, exp_util.adb, sem_util.adb, exp_ch4.adb: Minor
+	reformatting.
+
+2012-04-02  Olivier Hainque  <hainque@adacore.com>
+
+	* g-sse.ads: Add x86-solaris and x86_64-darwin to the set of
+	platforms where the use of this spec is supported. Add current
+	year to the copyright notice.
+	* gcc-interfaces/Makefile.in: Add g-sse.o and g-ssvety.o to
+	EXTRA_GNATRTL_NONTASKING_OBJS on x86 32/64 targets that support
+	it and where they were missing (x86-solaris, x86-freebsd,
+	x86_64-freebsd, and x86-darwin).
+
+2012-04-02  Gary Dismukes  <dismukes@adacore.com>
+
+	* bindgen.adb (Gen_Ada_Init): When compiling for the AAMP small
+	library, where we no longer suppress the Standard_Library,
+	generate an empty body rather than the usual generation of
+	assignments to imported globals, since those aren't present in
+	the small library.
+
+2012-04-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* sinfo.ads: Minor documentation fix.
+
+2012-04-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_res.adb (Resolve_Conditional_Expression): Add local variables
+	Else_Typ and Then_Typ. Add missing type conversions to the "then" and
+	"else" expressions when their respective types are scalar.
+
+2012-04-02  Vincent Pucci  <pucci@adacore.com>
+
+	* exp_ch9.adb: Reordering of the local subprograms. New Table
+	for the lock free implementation that maps each protected
+	subprograms with the protected component it references.
+	(Allow_Lock_Free_Implementation): New routine. Check if
+	the protected body enables the lock free implementation.
+	(Build_Lock_Free_Protected_Subprogram_Body): New routine.
+	(Build_Lock_Free_Unprotected_Subprogram_Body): New routine.
+	(Comp_Of): New routine.
+	* Makefile.rtl: Add s-atopri.o
+	* debug.adb: New compiler debug flag -gnatd9 for lock free
+	implementation.
+	* rtsfind.ads: RE_Atomic_Compare_Exchange_8,
+	RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32,
+	RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8,
+	RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64, RE_Uint8,
+	RE_Uint16, RE_Uint32, RE_Uint64 added.
+	* s-atropi.ads: New file. Defines atomic primitives used
+	by the lock free implementation.
+
 2012-04-02  Emmanuel Briot  <briot@adacore.com>
 
 	* g-expect.adb (Expect_Internal): Fix leak of the input file descriptor.

gcc/ada/Makefile.rtl

@@ -479,6 +479,7 @@ GNATRTL_NONTASKING_OBJS= \
   s-assert$(objext) \
   s-atacco$(objext) \
   s-atocou$(objext) \
+  s-atopri$(objext) \
   s-auxdec$(objext) \
   s-bitops$(objext) \
   s-boarop$(objext) \

gcc/ada/bindgen.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -511,6 +511,14 @@ package body Bindgen is
       if CodePeer_Mode then
          WBI ("   begin");
 
+      --  When compiling for the AAMP small library, where the standard library
+      --  is no longer suppressed, we still want to exclude the setting of the
+      --  various imported globals, which aren't present for that library.
+
+      elsif AAMP_On_Target and then Configurable_Run_Time_On_Target then
+         WBI ("   begin");
+         WBI ("      null;");
+
       --  If the standard library is suppressed, then the only global variables
       --  that might be needed (by the Ravenscar profile) are the priority and
       --  the processor for the environment task.

gcc/ada/debug.adb

@@ -153,7 +153,7 @@ package body Debug is
    --  d6   Default access unconstrained to thin pointers
    --  d7   Do not output version & file time stamp in -gnatv or -gnatl mode
    --  d8   Force opposite endianness in packed stuff
-   --  d9
+   --  d9   Allow lock free implementation
 
    --  Debug flags for binder (GNATBIND)
 
@@ -710,6 +710,9 @@ package body Debug is
    --       opposite endianness from the actual correct value. Useful in
    --       testing out code generation from the packed routines.
 
+   --  d9   This allows lock free implementation for protected objects
+   --       (see Exp_Ch9).
+
    ------------------------------------------
    -- Documentation for Binder Debug Flags --
    ------------------------------------------

gcc/ada/exp_ch4.adb

@@ -7832,9 +7832,7 @@ package body Exp_Ch4 is
    begin
       --  Do validity check if validity checking operands
 
-      if Validity_Checks_On
-        and then Validity_Check_Operands
-      then
+      if Validity_Checks_On and then Validity_Check_Operands then
          Ensure_Valid (Operand);
       end if;
 
@@ -7866,7 +7864,7 @@ package body Exp_Ch4 is
    --           end if;
    --        end loop;
 
-   --  Conversely, an existentially quantified expression:
+   --  Similarly, an existentially quantified expression:
 
    --    for some X in range => Cond
 
@@ -7957,7 +7955,6 @@ package body Exp_Ch4 is
         Make_Expression_With_Actions (Loc,
           Expression => New_Occurrence_Of (Flag, Loc),
           Actions    => Actions));
-
       Analyze_And_Resolve (N, Standard_Boolean);
    end Expand_N_Quantified_Expression;
 

gcc/ada/exp_util.adb

@@ -3948,8 +3948,7 @@ package body Exp_Util is
      (Obj_Id : Entity_Id) return Boolean
    is
       function Is_Controlled_Function_Call (N : Node_Id) return Boolean;
-      --  Determine whether a particular node denotes a controlled function
-      --  call.
+      --  Determine if particular node denotes a controlled function call
 
       function Is_Displace_Call (N : Node_Id) return Boolean;
       --  Determine whether a particular node is a call to Ada.Tags.Displace.
@@ -4065,7 +4064,7 @@ package body Exp_Util is
           and then Is_Displace_Call (Renamed_Object (Obj_Id))
           and then
             (Is_Controlled_Function_Call (Expression (Orig_Decl))
-               or else Is_Source_Object (Expression (Orig_Decl)));
+              or else Is_Source_Object (Expression (Orig_Decl)));
    end Is_Displacement_Of_Object_Or_Function_Result;
 
    ------------------------------

gcc/ada/g-sse.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---             Copyright (C) 2009, Free Software Foundation, Inc.           --
+--          Copyright (C) 2009-2012, 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- --
@@ -40,6 +40,8 @@
 
 --     GNU/Linux x86 and x86_64
 --     Windows XP/Vista x86 and x86_64
+--     Solaris x86
+--     Darwin x86_64
 
 --  This unit exposes vector _component_ types together with general comments
 --  on the binding contents.

gcc/ada/gcc-interface/Makefile.in

@@ -1083,6 +1083,8 @@ ifeq ($(strip $(filter-out %86 %x86_64 solaris2%,$(arch) $(osys))),)
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-specific-solaris.adb
 
+  EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
+
   EH_MECHANISM=-gcc
   THREADSLIB = -lposix4 -lthread
   MISCLIB = -lposix4 -lnsl -lsocket
@@ -1175,6 +1177,8 @@ ifeq ($(strip $(filter-out %86 kfreebsd%,$(arch) $(osys))),)
     mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
     indepsw.adb<indepsw-gnu.adb
 
+  EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
+
   EH_MECHANISM=-gcc
   THREADSLIB = -lpthread
   GNATLIB_SHARED = gnatlib-shared-dual
@@ -1231,6 +1235,8 @@ ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
   mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb
   GNATLIB_SHARED = gnatlib-shared-dual
 
+  EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
+
   EH_MECHANISM=-gcc
   THREADSLIB= -lpthread
   GMEM_LIB = gmemlib
@@ -1259,6 +1265,8 @@ ifeq ($(strip $(filter-out %86_64 freebsd%,$(arch) $(osys))),)
   mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb
   GNATLIB_SHARED = gnatlib-shared-dual
 
+  EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
+
   EH_MECHANISM=-gcc
   THREADSLIB= -lpthread
   GMEM_LIB = gmemlib
@@ -2160,6 +2168,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
         $(X86_TARGET_PAIRS) \
         system.ads<system-darwin-x86.ads
     endif
+
+    EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
   endif
 
   ifeq ($(strip $(filter-out %x86_64,$(arch))),)
@@ -2178,6 +2188,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
         $(X86_64_TARGET_PAIRS) \
         system.ads<system-darwin-x86_64.ads
     endif
+
+    EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
   endif
 
   ifeq ($(strip $(filter-out powerpc%,$(arch))),)

gcc/ada/osint.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -444,6 +444,15 @@ package body Osint is
    --  Start of processing for Add_Default_Search_Dirs
 
    begin
+      --  If there was a -gnateO switch, add all object directories from the
+      --  file given in argument to the library search list.
+
+      if Object_Path_File_Name /= null then
+         Path_File_Name := String_Access (Object_Path_File_Name);
+         pragma Assert (Path_File_Name'Length > 0);
+         Get_Dirs_From_File (Additional_Source_Dir => False);
+      end if;
+
       --  After the locations specified on the command line, the next places
       --  to look for files are the directories specified by the appropriate
       --  environment variable. Get this value, extract the directory names

gcc/ada/osint.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -324,7 +324,8 @@ package Osint is
 
    procedure Add_Default_Search_Dirs;
    --  This routine adds the default search dirs indicated by the environment
-   --  variables and sdefault package.
+   --  variables and sdefault package, as well as the library search dirs set
+   --  by option -gnateO for GNAT2WHY.
 
    procedure Add_Lib_Search_Dir (Dir : String);
    --  Add Dir at the end of the library file search path

gcc/ada/rtsfind.ads

@@ -211,6 +211,7 @@ package Rtsfind is
       System_Arith_64,
       System_AST_Handling,
       System_Assertions,
+      System_Atomic_Primitives,
       System_Aux_DEC,
       System_Bit_Ops,
       System_Boolean_Array_Operations,
@@ -730,6 +731,19 @@ package Rtsfind is
      RE_Assert_Failure,                  -- System.Assertions
      RE_Raise_Assert_Failure,            -- System.Assertions
 
+     RE_Atomic_Compare_Exchange_8,       -- System.Atomic_Primitives
+     RE_Atomic_Compare_Exchange_16,      -- System.Atomic_Primitives
+     RE_Atomic_Compare_Exchange_32,      -- System.Atomic_Primitives
+     RE_Atomic_Compare_Exchange_64,      -- System.Atomic_Primitives
+     RE_Atomic_Load_8,                   -- System.Atomic_Primitives
+     RE_Atomic_Load_16,                  -- System.Atomic_Primitives
+     RE_Atomic_Load_32,                  -- System.Atomic_Primitives
+     RE_Atomic_Load_64,                  -- System.Atomic_Primitives
+     RE_Uint8,                           -- System.Atomic_Primitives
+     RE_Uint16,                          -- System.Atomic_Primitives
+     RE_Uint32,                          -- System.Atomic_Primitives
+     RE_Uint64,                          -- System.Atomic_Primitives
+
      RE_AST_Handler,                     -- System.Aux_DEC
      RE_Import_Value,                    -- System.Aux_DEC
      RE_No_AST_Handler,                  -- System.Aux_DEC
@@ -1938,6 +1952,19 @@ package Rtsfind is
      RE_Assert_Failure                   => System_Assertions,
      RE_Raise_Assert_Failure             => System_Assertions,
 
+     RE_Atomic_Compare_Exchange_8        => System_Atomic_Primitives,
+     RE_Atomic_Compare_Exchange_16       => System_Atomic_Primitives,
+     RE_Atomic_Compare_Exchange_32       => System_Atomic_Primitives,
+     RE_Atomic_Compare_Exchange_64       => System_Atomic_Primitives,
+     RE_Atomic_Load_8                    => System_Atomic_Primitives,
+     RE_Atomic_Load_16                   => System_Atomic_Primitives,
+     RE_Atomic_Load_32                   => System_Atomic_Primitives,
+     RE_Atomic_Load_64                   => System_Atomic_Primitives,
+     RE_Uint8                            => System_Atomic_Primitives,
+     RE_Uint16                           => System_Atomic_Primitives,
+     RE_Uint32                           => System_Atomic_Primitives,
+     RE_Uint64                           => System_Atomic_Primitives,
+
      RE_AST_Handler                      => System_Aux_DEC,
      RE_Import_Value                     => System_Aux_DEC,
      RE_No_AST_Handler                   => System_Aux_DEC,

gcc/ada/s-atopri.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--               S Y S T E M . A T O M I C _ P R I M I T I V E S            --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--              Copyright (C) 2012, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package System.Atomic_Primitives is
+   pragma Preelaborate;
+
+   type uint8  is mod 2**8
+     with Size => 8;
+
+   type uint16 is mod 2**16
+     with Size => 16;
+
+   type uint32 is mod 2**32
+     with Size => 32;
+
+   type uint64 is mod 2**64
+     with Size => 64;
+
+   Relaxed : constant := 0;
+   Consume : constant := 1;
+   Acquire : constant := 2;
+   Release : constant := 3;
+   Acq_Rel : constant := 4;
+   Seq_Cst : constant := 5;
+   Last    : constant := 6;
+
+   subtype Mem_Model is Integer range Relaxed .. Last;
+
+   function Atomic_Compare_Exchange_8
+     (X             : Address;
+      X_Old         : uint8;
+      X_Copy        : uint8) return Boolean;
+   pragma Import (Intrinsic,
+                  Atomic_Compare_Exchange_8,
+                  "__sync_bool_compare_and_swap_1");
+
+   --  ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
+   --  function Atomic_Compare_Exchange_8
+   --    (X             : Address;
+   --     X_Old         : Address;
+   --     X_Copy        : uint8;
+   --     Success_Model : Mem_Model := Seq_Cst;
+   --     Failure_Model : Mem_Model := Seq_Cst) return Boolean;
+   --  pragma Import (Intrinsic,
+   --                 Atomic_Compare_Exchange_8,
+   --                 "__atomic_compare_exchange_1");
+
+   function Atomic_Compare_Exchange_16
+     (X             : Address;
+      X_Old         : uint16;
+      X_Copy        : uint16) return Boolean;
+   pragma Import (Intrinsic,
+                  Atomic_Compare_Exchange_16,
+                  "__sync_bool_compare_and_swap_2");
+
+   function Atomic_Compare_Exchange_32
+     (X             : Address;
+      X_Old         : uint32;
+      X_Copy        : uint32) return Boolean;
+   pragma Import (Intrinsic,
+                  Atomic_Compare_Exchange_32,
+                  "__sync_bool_compare_and_swap_4");
+
+   function Atomic_Compare_Exchange_64
+     (X             : Address;
+      X_Old         : uint64;
+      X_Copy        : uint64) return Boolean;
+   pragma Import (Intrinsic,
+                  Atomic_Compare_Exchange_64,
+                  "__sync_bool_compare_and_swap_8");
+
+   function Atomic_Load_8
+     (X     : Address;
+      Model : Mem_Model := Seq_Cst) return uint8;
+   pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
+
+   function Atomic_Load_16
+     (X     : Address;
+      Model : Mem_Model := Seq_Cst) return uint16;
+   pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
+
+   function Atomic_Load_32
+     (X     : Address;
+      Model : Mem_Model := Seq_Cst) return uint32;
+   pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
+
+   function Atomic_Load_64
+     (X     : Address;
+      Model : Mem_Model := Seq_Cst) return uint64;
+   pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
+
+end System.Atomic_Primitives;

gcc/ada/sem_ch5.adb

@@ -1666,6 +1666,9 @@ package body Sem_Ch5 is
 
       if not Is_Entity_Name (Iter_Name)
         and then (Nkind (Parent (N)) /= N_Quantified_Expression
+
+                   --  The following two tests need comments ???
+
                    or else Operating_Mode = Check_Semantics
                    or else Alfa_Mode)
       then

gcc/ada/sem_res.adb

@@ -2624,10 +2624,10 @@ package body Sem_Res is
          --  an error. We can't do this earlier, because it would cause legal
          --  cases to get errors (when some other type has an abstract "+").
 
-         if Ada_Version >= Ada_2005 and then
-           Nkind (N) in N_Op and then
-           Is_Overloaded (N) and then
-           Is_Universal_Numeric_Type (Etype (Entity (N)))
+         if Ada_Version >= Ada_2005
+           and then Nkind (N) in N_Op
+           and then Is_Overloaded (N)
+           and then Is_Universal_Numeric_Type (Etype (Entity (N)))
          then
             Get_First_Interp (N, I, It);
             while Present (It.Typ) loop
@@ -6118,15 +6118,36 @@ package body Sem_Res is
       Condition : constant Node_Id := First (Expressions (N));
       Then_Expr : constant Node_Id := Next (Condition);
       Else_Expr : Node_Id          := Next (Then_Expr);
+      Else_Typ  : Entity_Id;
+      Then_Typ  : Entity_Id;
 
    begin
       Resolve (Condition, Any_Boolean);
       Resolve (Then_Expr, Typ);
+      Then_Typ := Etype (Then_Expr);
+
+      --  When the "then" and "else" expressions are of a scalar type, insert
+      --  a conversion to ensure the generation of a constraint check.
+
+      if Is_Scalar_Type (Then_Typ)
+        and then Then_Typ /= Typ
+      then
+         Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
+         Analyze_And_Resolve (Then_Expr, Typ);
+      end if;
 
       --  If ELSE expression present, just resolve using the determined type
 
       if Present (Else_Expr) then
          Resolve (Else_Expr, Typ);
+         Else_Typ := Etype (Else_Expr);
+
+         if Is_Scalar_Type (Else_Typ)
+           and then Else_Typ /= Typ
+         then
+            Rewrite (Else_Expr, Convert_To (Typ, Else_Expr));
+            Analyze_And_Resolve (Else_Expr, Typ);
+         end if;
 
       --  If no ELSE expression is present, root type must be Standard.Boolean
       --  and we provide a Standard.True result converted to the appropriate

gcc/ada/sem_util.adb

@@ -740,15 +740,16 @@ package body Sem_Util is
       N : Node_Id) return Entity_Id
    is
       Loc  : constant Source_Ptr := Sloc (N);
-      Bas  : Entity_Id;
-      --  The base type that is to be constrained by the defaults.
-
       Disc : Entity_Id;
 
+      Bas : Entity_Id;
+      --  The base type that is to be constrained by the defaults
+
    begin
       if not Has_Discriminants (T) or else Is_Constrained (T) then
          return T;
       end if;
+
       Bas := Base_Type (T);
 
       --  If T is non-private but its base type is private, this is
@@ -757,9 +758,7 @@ package body Sem_Util is
       --  proper discriminants are to be found in the full view of
       --  the base.
 
-      if Is_Private_Type (Bas)
-        and then Present (Full_View (Bas))
-      then
+      if Is_Private_Type (Bas) and then Present (Full_View (Bas)) then
          Bas := Full_View (Bas);
       end if;
 

gcc/ada/sinfo.ads

@@ -1252,7 +1252,7 @@ package Sinfo is
    --    to the node for the spec of the instance, inserted as part of the
    --    semantic processing for instantiations in Sem_Ch12.
 
-   --  Is_Accessibility_Actual (Flag12-Sem)
+   --  Is_Accessibility_Actual (Flag13-Sem)
    --    Present in N_Parameter_Association nodes. True if the parameter is
    --    an extra actual that carries the accessibility level of the actual
    --    for an access parameter, in a function that dispatches on result and