[multiple changes]

2014-01-24  Doug Rupp  <rupp@adacore.com>

	* init.c: Add a handler section for Android.

2014-01-24  Arnaud Charlet  <charlet@adacore.com>

	* i-cexten.ads (Unsigned_33..64, Unsigned_33..64): New types.

2014-01-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Operator_Check): If one operand is a
	Raise_Expression, set its type to that of the other operand.
	* sem_res.adb (Resolve_Raise_Expression): new procedure.
	(Resolve_Actuals): For an actual that is a Raise_Expression,
	set the type to that of the formal.
	* sem_type.adb (Find_Unique_Type): If one of the operands is a
	Raise_Expression, return type of the other operand.

2014-01-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Record_Aggregate): If a scalar
	component of the record has a type with a default aspect, and
	the corresponding aggregate component is initiaized with a box,
	use the default value in the rewritten aggregate.

2014-01-24  Tristan Gingold  <gingold@adacore.com>

	* s-interr.ads, s-interr.adb, s-interr-hwint.adb, s-interr-vms.adb,
	s-interr-sigaction.adb,
	s-interr-dummy.adb (Install_Restricted_Handlers): Add Prio parameter.
	* exp_ch9.adb (Make_Initialize_Protection): Add Prio parameter
	to the call to Install_Restricted_Handlers.

2014-01-24  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Check_File): Add protection when the source is
	not fully initialized.

From-SVN: r207033

gcc/ada/ChangeLog

+2014-01-24  Doug Rupp  <rupp@adacore.com>
+
+	* init.c: Add a handler section for Android.
+
+2014-01-24  Arnaud Charlet  <charlet@adacore.com>
+
+	* i-cexten.ads (Unsigned_33..64, Unsigned_33..64): New types.
+
+2014-01-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Operator_Check): If one operand is a
+	Raise_Expression, set its type to that of the other operand.
+	* sem_res.adb (Resolve_Raise_Expression): new procedure.
+	(Resolve_Actuals): For an actual that is a Raise_Expression,
+	set the type to that of the formal.
+	* sem_type.adb (Find_Unique_Type): If one of the operands is a
+	Raise_Expression, return type of the other operand.
+
+2014-01-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb (Resolve_Record_Aggregate): If a scalar
+	component of the record has a type with a default aspect, and
+	the corresponding aggregate component is initiaized with a box,
+	use the default value in the rewritten aggregate.
+
+2014-01-24  Tristan Gingold  <gingold@adacore.com>
+
+	* s-interr.ads, s-interr.adb, s-interr-hwint.adb, s-interr-vms.adb,
+	s-interr-sigaction.adb,
+	s-interr-dummy.adb (Install_Restricted_Handlers): Add Prio parameter.
+	* exp_ch9.adb (Make_Initialize_Protection): Add Prio parameter
+	to the call to Install_Restricted_Handlers.
+
+2014-01-24  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-nmsc.adb (Check_File): Add protection when the source is
+	not fully initialized.
+
 2014-01-24  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_util.adb (Is_Post_State): In a postcondition, a selected

gcc/ada/exp_ch9.adb

@@ -13451,6 +13451,7 @@ package body Exp_Ch9 is
       L           : constant List_Id := New_List;
       Has_Entry   : constant Boolean := Has_Entries (Ptyp);
       Prio_Type   : Entity_Id;
+      Prio_Var    : Entity_Id := Empty;
       Restricted  : constant Boolean := Restricted_Profile;
 
    begin
@@ -13509,7 +13510,6 @@ package body Exp_Ch9 is
                                  (Ptyp, Name_Priority, Check_Parents => False);
 
                Prio : Node_Id;
-               Temp : Entity_Id;
 
             begin
                --  Pragma Priority
@@ -13539,37 +13539,21 @@ package body Exp_Ch9 is
                   Prio := Expression (Prio_Clause);
                end if;
 
-               --  If priority is a static expression, then we can duplicate it
-               --  with no problem and simply append it to the argument list.
-               --  However, it has only be pre-analyzed, so we need to check
-               --  now that it is in the bounds of the priority type.
+               --  Always create a locale variable to capture the priority.
+               --  The priority is also passed to Install_Restriced_Handlers.
+               --  Note that it is really necessary to create this variable
+               --  explicitly. It might be thought that removing side effects
+               --  would the appropriate approach, but that could generate
+               --  declarations improperly placed in the enclosing scope.
 
-               if Is_Static_Expression (Prio) then
-                  Set_Analyzed (Prio, False);
-                  Append_To (Args,
-                    Make_Type_Conversion (Loc,
-                      Subtype_Mark => New_Occurrence_Of (Prio_Type, Loc),
-                      Expression   => Duplicate_Subexpr (Prio)));
-
-               --  Otherwise, the priority may be a per-object expression, if
-               --  it depends on a discriminant of the type. In this case,
-               --  create local variable to capture the expression. Note that
-               --  it is really necessary to create this variable explicitly.
-               --  It might be thought that removing side effects would the
-               --  appropriate approach, but that could generate declarations
-               --  improperly placed in the enclosing scope.
+               Prio_Var := Make_Temporary (Loc, 'R', Prio);
+               Append_To (L,
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Prio_Var,
+                   Object_Definition   => New_Occurrence_Of (Prio_Type,  Loc),
+                   Expression          => Relocate_Node (Prio)));
 
-               else
-                  Temp := Make_Temporary (Loc, 'R', Prio);
-                  Append_To (L,
-                     Make_Object_Declaration (Loc,
-                        Defining_Identifier => Temp,
-                        Object_Definition   =>
-                          New_Occurrence_Of (Prio_Type,  Loc),
-                        Expression          => Relocate_Node (Prio)));
-
-                  Append_To (Args, New_Occurrence_Of (Temp, Loc));
-               end if;
+               Append_To (Args, New_Occurrence_Of (Prio_Var, Loc));
             end;
 
          --  When no priority is specified but an xx_Handler pragma is, we
@@ -13714,7 +13698,7 @@ package body Exp_Ch9 is
          --  or, in the case of Ravenscar:
 
          --  Install_Restricted_Handlers
-         --    ((Expr1, Proc1'access), ...., (ExprN, ProcN'access));
+         --    (Prio, (Expr1, Proc1'access), ...., (ExprN, ProcN'access));
 
          declare
             Args  : constant List_Id := New_List;
@@ -13722,6 +13706,24 @@ package body Exp_Ch9 is
             Ritem : Node_Id          := First_Rep_Item (Ptyp);
 
          begin
+            --  Build the Priority parameter (only for ravenscar)
+
+            if Restricted then
+
+               --  Priority comes from a pragma
+
+               if Present (Prio_Var) then
+                  Append_To (Args, New_Occurrence_Of (Prio_Var, Loc));
+
+               --  Priority is the default one
+
+               else
+                  Append_To (Args,
+                    New_Reference_To
+                      (RTE (RE_Default_Interrupt_Priority), Loc));
+               end if;
+            end if;
+
             --  Build the Attach_Handler table argument
 
             while Present (Ritem) loop

gcc/ada/i-cexten.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -170,6 +170,102 @@ package Interfaces.C.Extensions is
    type Unsigned_32 is mod 2 ** 32;
    for Unsigned_32'Size use 32;
 
+   type Unsigned_33 is mod 2 ** 33;
+   for Unsigned_33'Size use 33;
+
+   type Unsigned_34 is mod 2 ** 34;
+   for Unsigned_34'Size use 34;
+
+   type Unsigned_35 is mod 2 ** 35;
+   for Unsigned_35'Size use 35;
+
+   type Unsigned_36 is mod 2 ** 36;
+   for Unsigned_36'Size use 36;
+
+   type Unsigned_37 is mod 2 ** 37;
+   for Unsigned_37'Size use 37;
+
+   type Unsigned_38 is mod 2 ** 38;
+   for Unsigned_38'Size use 38;
+
+   type Unsigned_39 is mod 2 ** 39;
+   for Unsigned_39'Size use 39;
+
+   type Unsigned_40 is mod 2 ** 40;
+   for Unsigned_40'Size use 40;
+
+   type Unsigned_41 is mod 2 ** 41;
+   for Unsigned_41'Size use 41;
+
+   type Unsigned_42 is mod 2 ** 42;
+   for Unsigned_42'Size use 42;
+
+   type Unsigned_43 is mod 2 ** 43;
+   for Unsigned_43'Size use 43;
+
+   type Unsigned_44 is mod 2 ** 44;
+   for Unsigned_44'Size use 44;
+
+   type Unsigned_45 is mod 2 ** 45;
+   for Unsigned_45'Size use 45;
+
+   type Unsigned_46 is mod 2 ** 46;
+   for Unsigned_46'Size use 46;
+
+   type Unsigned_47 is mod 2 ** 47;
+   for Unsigned_47'Size use 47;
+
+   type Unsigned_48 is mod 2 ** 48;
+   for Unsigned_48'Size use 48;
+
+   type Unsigned_49 is mod 2 ** 49;
+   for Unsigned_49'Size use 49;
+
+   type Unsigned_50 is mod 2 ** 50;
+   for Unsigned_50'Size use 50;
+
+   type Unsigned_51 is mod 2 ** 51;
+   for Unsigned_51'Size use 51;
+
+   type Unsigned_52 is mod 2 ** 52;
+   for Unsigned_52'Size use 52;
+
+   type Unsigned_53 is mod 2 ** 53;
+   for Unsigned_53'Size use 53;
+
+   type Unsigned_54 is mod 2 ** 54;
+   for Unsigned_54'Size use 54;
+
+   type Unsigned_55 is mod 2 ** 55;
+   for Unsigned_55'Size use 55;
+
+   type Unsigned_56 is mod 2 ** 56;
+   for Unsigned_56'Size use 56;
+
+   type Unsigned_57 is mod 2 ** 57;
+   for Unsigned_57'Size use 57;
+
+   type Unsigned_58 is mod 2 ** 58;
+   for Unsigned_58'Size use 58;
+
+   type Unsigned_59 is mod 2 ** 59;
+   for Unsigned_59'Size use 59;
+
+   type Unsigned_60 is mod 2 ** 60;
+   for Unsigned_60'Size use 60;
+
+   type Unsigned_61 is mod 2 ** 61;
+   for Unsigned_61'Size use 61;
+
+   type Unsigned_62 is mod 2 ** 62;
+   for Unsigned_62'Size use 62;
+
+   type Unsigned_63 is mod 2 ** 63;
+   for Unsigned_63'Size use 63;
+
+   type Unsigned_64 is mod 2 ** 64;
+   for Unsigned_64'Size use 64;
+
    type Signed_2 is range -2 ** 1 .. 2 ** 1 - 1;
    for Signed_2'Size use 2;
 
@@ -263,4 +359,100 @@ package Interfaces.C.Extensions is
    type Signed_32 is range -2 ** 31 .. 2 ** 31 - 1;
    for Signed_32'Size use 32;
 
+   type Signed_33 is range -2 ** 32 .. 2 ** 32 - 1;
+   for Signed_33'Size use 33;
+
+   type Signed_34 is range -2 ** 33 .. 2 ** 33 - 1;
+   for Signed_34'Size use 34;
+
+   type Signed_35 is range -2 ** 34 .. 2 ** 34 - 1;
+   for Signed_35'Size use 35;
+
+   type Signed_36 is range -2 ** 35 .. 2 ** 35 - 1;
+   for Signed_36'Size use 36;
+
+   type Signed_37 is range -2 ** 36 .. 2 ** 36 - 1;
+   for Signed_37'Size use 37;
+
+   type Signed_38 is range -2 ** 37 .. 2 ** 37 - 1;
+   for Signed_38'Size use 38;
+
+   type Signed_39 is range -2 ** 38 .. 2 ** 38 - 1;
+   for Signed_39'Size use 39;
+
+   type Signed_40 is range -2 ** 39 .. 2 ** 39 - 1;
+   for Signed_40'Size use 40;
+
+   type Signed_41 is range -2 ** 40 .. 2 ** 40 - 1;
+   for Signed_41'Size use 41;
+
+   type Signed_42 is range -2 ** 41 .. 2 ** 41 - 1;
+   for Signed_42'Size use 42;
+
+   type Signed_43 is range -2 ** 42 .. 2 ** 42 - 1;
+   for Signed_43'Size use 43;
+
+   type Signed_44 is range -2 ** 43 .. 2 ** 43 - 1;
+   for Signed_44'Size use 44;
+
+   type Signed_45 is range -2 ** 44 .. 2 ** 44 - 1;
+   for Signed_45'Size use 45;
+
+   type Signed_46 is range -2 ** 45 .. 2 ** 45 - 1;
+   for Signed_46'Size use 46;
+
+   type Signed_47 is range -2 ** 46 .. 2 ** 46 - 1;
+   for Signed_47'Size use 47;
+
+   type Signed_48 is range -2 ** 47 .. 2 ** 47 - 1;
+   for Signed_48'Size use 48;
+
+   type Signed_49 is range -2 ** 48 .. 2 ** 48 - 1;
+   for Signed_49'Size use 49;
+
+   type Signed_50 is range -2 ** 49 .. 2 ** 49 - 1;
+   for Signed_50'Size use 50;
+
+   type Signed_51 is range -2 ** 50 .. 2 ** 50 - 1;
+   for Signed_51'Size use 51;
+
+   type Signed_52 is range -2 ** 51 .. 2 ** 51 - 1;
+   for Signed_52'Size use 52;
+
+   type Signed_53 is range -2 ** 52 .. 2 ** 52 - 1;
+   for Signed_53'Size use 53;
+
+   type Signed_54 is range -2 ** 53 .. 2 ** 53 - 1;
+   for Signed_54'Size use 54;
+
+   type Signed_55 is range -2 ** 54 .. 2 ** 54 - 1;
+   for Signed_55'Size use 55;
+
+   type Signed_56 is range -2 ** 55 .. 2 ** 55 - 1;
+   for Signed_56'Size use 56;
+
+   type Signed_57 is range -2 ** 56 .. 2 ** 56 - 1;
+   for Signed_57'Size use 57;
+
+   type Signed_58 is range -2 ** 57 .. 2 ** 57 - 1;
+   for Signed_58'Size use 58;
+
+   type Signed_59 is range -2 ** 58 .. 2 ** 58 - 1;
+   for Signed_59'Size use 59;
+
+   type Signed_60 is range -2 ** 59 .. 2 ** 59 - 1;
+   for Signed_60'Size use 60;
+
+   type Signed_61 is range -2 ** 60 .. 2 ** 60 - 1;
+   for Signed_61'Size use 61;
+
+   type Signed_62 is range -2 ** 61 .. 2 ** 61 - 1;
+   for Signed_62'Size use 62;
+
+   type Signed_63 is range -2 ** 62 .. 2 ** 62 - 1;
+   for Signed_63'Size use 63;
+
+   type Signed_64 is range -2 ** 63 .. 2 ** 63 - 1;
+   for Signed_64'Size use 64;
+
 end Interfaces.C.Extensions;

gcc/ada/init.c

@@ -2320,6 +2320,83 @@ __gnat_install_handler (void)
   __gnat_handler_installed = 1;
 }
 
+#elif defined(__ANDROID__)
+
+/*******************/
+/* Android Section */
+/*******************/
+
+#include <signal.h>
+#include <stdlib.h>
+
+static void
+__gnat_error_handler (int sig,
+		      siginfo_t *si ATTRIBUTE_UNUSED,
+		      void *ucontext ATTRIBUTE_UNUSED)
+{
+  struct Exception_Data *exception;
+  const char *msg;
+
+  switch (sig)
+    {
+    case SIGSEGV:
+      exception = &storage_error;
+      msg = "stack overflow or erroneous memory access";
+      break;
+
+    case SIGBUS:
+      exception = &constraint_error;
+      msg = "SIGBUS";
+      break;
+
+    case SIGFPE:
+      exception = &constraint_error;
+      msg = "SIGFPE";
+      break;
+
+    default:
+      exception = &program_error;
+      msg = "unhandled signal";
+    }
+
+  Raise_From_Signal_Handler (exception, msg);
+}
+
+/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.  */
+char __gnat_alternate_stack[16 * 1024];
+
+void
+__gnat_install_handler (void)
+{
+  struct sigaction act;
+
+  /* Set up signal handler to map synchronous signals to appropriate
+     exceptions.  Make sure that the handler isn't interrupted by another
+     signal that might cause a scheduling event!  Also setup an alternate
+     stack region for the handler execution so that stack overflows can be
+     handled properly, avoiding a SEGV generation from stack usage by the
+     handler itself.  */
+
+  stack_t stack;
+  stack.ss_sp = __gnat_alternate_stack;
+  stack.ss_size = sizeof (__gnat_alternate_stack);
+  stack.ss_flags = 0;
+  sigaltstack (&stack, NULL);
+
+  act.sa_sigaction = __gnat_error_handler;
+  act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
+  sigemptyset (&act.sa_mask);
+
+  sigaction (SIGABRT, &act, NULL);
+  sigaction (SIGFPE,  &act, NULL);
+  sigaction (SIGILL,  &act, NULL);
+  sigaction (SIGBUS,  &act, NULL);
+  act.sa_flags |= SA_ONSTACK;
+  sigaction (SIGSEGV, &act, NULL);
+
+  __gnat_handler_installed = 1;
+}
+
 #else
 
 /* For all other versions of GNAT, the handler does nothing.  */

gcc/ada/prj-nmsc.adb

@@ -7051,7 +7051,9 @@ package body Prj.Nmsc is
             --  Check if it is OK to have the same file name in several
             --  source directories.
 
-            if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
+            if Name_Loc.Source /= No_Source
+              and then Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank
+            then
                Error_Msg_File_1 := File_Name;
                Error_Msg
                  (Data.Flags,

gcc/ada/s-interr-dummy.adb

@@ -7,7 +7,7 @@
 --                                  B o d y                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---                     Copyright (C) 1995-2010, AdaCore                     --
+--                     Copyright (C) 1995-2013, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -187,7 +187,10 @@ package body System.Interrupts is
    -- Install_Restricted_Handlers --
    ---------------------------------
 
-   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   procedure Install_Restricted_Handlers
+     (Prio     : Any_Priority;
+      Handlers : New_Handler_Array)
+   is
    begin
       Unimplemented;
    end Install_Restricted_Handlers;

gcc/ada/s-interr-hwint.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2013, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -476,7 +476,11 @@ package body System.Interrupts is
    -- Install_Restricted_Handlers --
    ---------------------------------
 
-   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   procedure Install_Restricted_Handlers
+      (Prio     : Any_Priority;
+       Handlers : New_Handler_Array)
+   is
+      pragma Unreferenced (Prio);
    begin
       for N in Handlers'Range loop
          Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);

gcc/ada/s-interr-sigaction.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1998-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -292,7 +292,11 @@ package body System.Interrupts is
    -- Install_Restricted_Handlers --
    ---------------------------------
 
-   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   procedure Install_Restricted_Handlers
+      (Prio     : Any_Priority;
+       Handlers : New_Handler_Array)
+   is
+      pragma Unreferenced (Prio);
    begin
       for N in Handlers'Range loop
          Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);

gcc/ada/s-interr-vms.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2013, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -1098,7 +1098,11 @@ package body System.Interrupts is
    -- Install_Restricted_Handlers --
    ---------------------------------
 
-   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   procedure Install_Restricted_Handlers
+      (Prio     : Any_Priority;
+       Handlers : New_Handler_Array)
+   is
+      pragma Unreferenced (Prio);
    begin
       for N in Handlers'Range loop
          Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);

gcc/ada/s-interr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2013, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -469,7 +469,11 @@ package body System.Interrupts is
    -- Install_Restricted_Handlers --
    ---------------------------------
 
-   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   procedure Install_Restricted_Handlers
+     (Prio     : Any_Priority;
+      Handlers : New_Handler_Array)
+   is
+      pragma Unreferenced (Prio);
    begin
       for N in Handlers'Range loop
          Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);

gcc/ada/s-interr.ads

@@ -266,11 +266,13 @@ package System.Interrupts is
    --  Store the old handlers in Object.Previous_Handlers and install
    --  the new static handlers.
 
-   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array);
-   --  Install the static Handlers for the given interrupts and do not store
-   --  previously installed handlers. This procedure is used when the Ravenscar
-   --  restrictions are in place since in that case there are only
-   --  library-level protected handlers that will be installed at
-   --  initialization and never be replaced.
+   procedure Install_Restricted_Handlers
+     (Prio     : Any_Priority;
+      Handlers : New_Handler_Array);
+   --  Install the static Handlers for the given interrupts and do not
+   --  store previously installed handlers. This procedure is used when
+   --  the Ravenscar restrictions are in place since in that case there
+   --  are only library-level protected handlers that will be installed
+   --  at initialization and never be replaced.
 
 end System.Interrupts;

gcc/ada/sem_aggr.adb

@@ -4204,6 +4204,17 @@ package body Sem_Aggr is
                      end;
                   end if;
 
+               --  Ada 2012: If component is scalar with default value, use it
+
+               elsif Is_Scalar_Type (Ctyp)
+                 and then Has_Default_Aspect (Ctyp)
+               then
+                  Add_Association
+                    (Component  => Component,
+                     Expr       => Default_Aspect_Value
+                                     (First_Subtype (Underlying_Type (Ctyp))),
+                     Assoc_List => New_Assoc_List);
+
                elsif Has_Non_Null_Base_Init_Proc (Ctyp)
                  or else not Expander_Active
                then

gcc/ada/sem_ch4.adb

@@ -6298,6 +6298,19 @@ package body Sem_Ch4 is
               or else Etype (R) = Any_Type
               or else (Nkind (N) in N_Binary_Op and then Etype (L) = Any_Type)
             then
+               --  For the rather unusual case where one of the operands is
+               --  a Raise_Expression, whose initial type is Any_Type, use
+               --  the type of the other operand.
+
+               if Nkind (L) = N_Raise_Expression then
+                  Set_Etype (L, Etype (R));
+                  Set_Etype (N, Etype (R));
+
+               elsif Nkind (R) = N_Raise_Expression then
+                  Set_Etype (R, Etype (L));
+                  Set_Etype (N, Etype (L));
+               end if;
+
                return;
 
             --  We explicitly check for the case of concatenation of component

gcc/ada/sem_res.adb

@@ -193,6 +193,7 @@ package body Sem_Res is
    procedure Resolve_Op_Expon                  (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Op_Not                    (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Qualified_Expression      (N : Node_Id; Typ : Entity_Id);
+   procedure Resolve_Raise_Expression          (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Range                     (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Real_Literal              (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Reference                 (N : Node_Id; Typ : Entity_Id);
@@ -2876,11 +2877,8 @@ package body Sem_Res is
             when N_Quantified_Expression
                              => null;
 
-            --  Nothing to do for Raise_Expression, since we took care of
-            --  setting the Etype earlier, and no other processing is needed.
-
             when N_Raise_Expression
-                             => null;
+                             => Resolve_Raise_Expression         (N, Ctx_Type);
 
             when N_Raise_xxx_Error
                              => Set_Etype (N, Ctx_Type);
@@ -3453,13 +3451,16 @@ package body Sem_Res is
 
          --  If we have an error in any actual or formal, indicated by a type
          --  of Any_Type, then abandon resolution attempt, and set result type
-         --  to Any_Type.
+         --  to Any_Type. Skip this if the actual is a Raise_Expression, whose
+         --  type is imposed from context.
 
          elsif (Present (A) and then Etype (A) = Any_Type)
            or else Etype (F) = Any_Type
          then
-            Set_Etype (N, Any_Type);
-            return;
+            if Nkind (A) /= N_Raise_Expression then
+               Set_Etype (N, Any_Type);
+               return;
+            end if;
          end if;
 
          --  Case where actual is present
@@ -8751,6 +8752,15 @@ package body Sem_Res is
       Eval_Qualified_Expression (N);
    end Resolve_Qualified_Expression;
 
+   ------------------------------
+   -- Resolve_Raise_Expression --
+   ------------------------------
+
+   procedure Resolve_Raise_Expression (N : Node_Id; Typ : Entity_Id) is
+   begin
+      Set_Etype (N, Typ);
+   end Resolve_Raise_Expression;
+
    -------------------
    -- Resolve_Range --
    -------------------

gcc/ada/sem_type.adb

@@ -2221,6 +2221,11 @@ package body Sem_Type is
       then
          return Etype (R);
 
+      --  If one operand is a raise_expression, use type of other operand
+
+      elsif Nkind (L) = N_Raise_Expression then
+         return Etype (R);
+
       else
          return Specific_Type (T, Etype (R));
       end if;