[multiple changes]

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb: Sloc of wrapper is that of instantiation.

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* sem_ch11.adb: Minor reformatting.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Get_Assoc_Expr): New routine internal to
	Build_Array_Aggr_Code, used to initialized components covered
	by a box association. If the component type is scalar and has
	a default aspect, use it to initialize such components.

2015-01-06  Pascal Obry  <obry@adacore.com>

	* rtinit.c (__gnat_runtime_initialize): Add a parameter to
	control the setup of the exception handler.
	* initialize.c: Remove unused declaration.
	* bindgen.adb: Always call __gnat_runtime_initialize and pass
	whether the exeception handler must be set or not.

From-SVN: r219251

gcc/ada/ChangeLog

+2015-01-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb: Sloc of wrapper is that of instantiation.
+
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch11.adb: Minor reformatting.
+
+2015-01-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb (Get_Assoc_Expr): New routine internal to
+	Build_Array_Aggr_Code, used to initialized components covered
+	by a box association. If the component type is scalar and has
+	a default aspect, use it to initialize such components.
+
+2015-01-06  Pascal Obry  <obry@adacore.com>
+
+	* rtinit.c (__gnat_runtime_initialize): Add a parameter to
+	control the setup of the exception handler.
+	* initialize.c: Remove unused declaration.
+	* bindgen.adb: Always call __gnat_runtime_initialize and pass
+	whether the exeception handler must be set or not.
+
 2015-01-06  Thomas Quinot  <quinot@adacore.com>
 
 	* freeze.adb (Set_SSO_From_Defaults): When setting scalar storage

gcc/ada/bindgen.adb

@@ -606,7 +606,8 @@ package body Bindgen is
          --  installation, and indication of if it's been called previously.
 
          WBI ("");
-         WBI ("      procedure Runtime_Initialize;");
+         WBI ("      procedure Runtime_Initialize " &
+              "(Install_Handler : Integer);");
          WBI ("      pragma Import (C, Runtime_Initialize, " &
               """__gnat_runtime_initialize"");");
 
@@ -838,9 +839,14 @@ package body Bindgen is
          --  In .NET, when binding with -z, we don't install the signal handler
          --  to let the caller handle the last exception handler.
 
-         if Bind_Main_Program then
-            WBI ("");
-            WBI ("      Runtime_Initialize;");
+         WBI ("");
+
+         if VM_Target /= CLI_Target
+           or else Bind_Main_Program
+         then
+            WBI ("      Runtime_Initialize (1);");
+         else
+            WBI ("      Runtime_Initialize (0);");
          end if;
       end if;
 

gcc/ada/exp_aggr.adb

@@ -785,6 +785,10 @@ package body Exp_Aggr is
       --
       --  Otherwise we call Build_Code recursively
 
+      function Get_Assoc_Expr (Assoc : Node_Id) return Node_Id;
+      --  For an association with a box, use default aspect of component type
+      --  if present, to initialize one or more components.
+
       function Local_Compile_Time_Known_Value (E : Node_Id) return Boolean;
       function Local_Expr_Value               (E : Node_Id) return Uint;
       --  These two Local routines are used to replace the corresponding ones
@@ -1524,6 +1528,26 @@ package body Exp_Aggr is
          return S;
       end Gen_While;
 
+      --------------------
+      -- Get_Assoc_Expr --
+      --------------------
+
+      function Get_Assoc_Expr (Assoc : Node_Id) return Node_Id is
+      begin
+         if Box_Present (Assoc) then
+            if Is_Scalar_Type (Ctype)
+              and then Present (Default_Aspect_Value (Ctype))
+            then
+               return Default_Aspect_Value (Ctype);
+            else
+               return Empty;
+            end if;
+
+         else
+            return Expression (Assoc);
+         end if;
+      end Get_Assoc_Expr;
+
       ---------------------
       -- Index_Base_Name --
       ---------------------
@@ -1566,8 +1590,7 @@ package body Exp_Aggr is
       Expr   : Node_Id;
       Typ    : Entity_Id;
 
-      Others_Expr        : Node_Id := Empty;
-      Others_Box_Present : Boolean := False;
+      Others_Assoc        : Node_Id := Empty;
 
       Aggr_L : constant Node_Id := Low_Bound (Aggregate_Bounds (N));
       Aggr_H : constant Node_Id := High_Bound (Aggregate_Bounds (N));
@@ -1637,12 +1660,7 @@ package body Exp_Aggr is
             while Present (Choice) loop
                if Nkind (Choice) = N_Others_Choice then
                   Set_Loop_Actions (Assoc, New_List);
-
-                  if Box_Present (Assoc) then
-                     Others_Box_Present := True;
-                  else
-                     Others_Expr := Expression (Assoc);
-                  end if;
+                  Others_Assoc := Assoc;
                   exit;
                end if;
 
@@ -1653,15 +1671,12 @@ package body Exp_Aggr is
                end if;
 
                Nb_Choices := Nb_Choices + 1;
-               if Box_Present (Assoc) then
-                  Table (Nb_Choices) := (Choice_Lo   => Low,
-                                         Choice_Hi   => High,
-                                         Choice_Node => Empty);
-               else
-                  Table (Nb_Choices) := (Choice_Lo   => Low,
-                                         Choice_Hi   => High,
-                                         Choice_Node => Expression (Assoc));
-               end if;
+
+               Table (Nb_Choices) :=
+                  (Choice_Lo   => Low,
+                   Choice_Hi   => High,
+                   Choice_Node => Get_Assoc_Expr (Assoc));
+
                Next (Choice);
             end loop;
 
@@ -1689,7 +1704,7 @@ package body Exp_Aggr is
          --  We don't need to generate loops over empty gaps, but if there is
          --  a single empty range we must analyze the expression for semantics
 
-         if Present (Others_Expr) or else Others_Box_Present then
+         if Present (Others_Assoc) then
             declare
                First : Boolean := True;
 
@@ -1730,7 +1745,8 @@ package body Exp_Aggr is
                   then
                      First := False;
                      Append_List
-                       (Gen_Loop (Low, High, Others_Expr), To => New_Code);
+                       (Gen_Loop (Low, High,
+                          Get_Assoc_Expr (Others_Assoc)), To => New_Code);
                   end if;
                end loop;
             end;
@@ -1760,19 +1776,10 @@ package body Exp_Aggr is
 
             --  Ada 2005 (AI-287)
 
-            if Box_Present (Assoc) then
-               Append_List (Gen_While (Add (Nb_Elements, To => Aggr_L),
-                                       Aggr_High,
-                                       Empty),
-                            To => New_Code);
-            else
-               Expr  := Expression (Assoc);
-
-               Append_List (Gen_While (Add (Nb_Elements, To => Aggr_L),
-                                       Aggr_High,
-                                       Expr), --  AI-287
-                            To => New_Code);
-            end if;
+            Append_List (Gen_While (Add (Nb_Elements, To => Aggr_L),
+                                    Aggr_High,
+                                    Get_Assoc_Expr (Assoc)), --  AI-287
+                         To => New_Code);
          end if;
       end if;
 

gcc/ada/initialize.c

@@ -62,8 +62,6 @@ extern "C" {
 /* __gnat_initialize (NT-mingw32 Version) */
 /******************************************/
 
-extern void __gnat_install_handler(void);
-
 #if defined (__MINGW32__)
 
 extern void __gnat_install_SEH_handler (void *);

gcc/ada/rtinit.c

@@ -76,7 +76,6 @@ int __gnat_rt_init_count = 0;
 #include <windows.h>
 
 extern void __gnat_init_float (void);
-extern void __gnat_install_SEH_handler (void *);
 
 extern int gnat_argc;
 extern char **gnat_argv;
@@ -138,7 +137,7 @@ append_arg (int *index, LPWSTR dir, LPWSTR value,
 #endif
 
 void
-__gnat_runtime_initialize(void)
+__gnat_runtime_initialize(int install_handler)
 {
   /*  increment the reference counter */
 
@@ -302,7 +301,8 @@ __gnat_runtime_initialize(void)
    }
 #endif
 
-   __gnat_install_handler();
+  if (install_handler)
+    __gnat_install_handler();
 }
 
 /**************************************************/
@@ -315,7 +315,7 @@ __gnat_runtime_initialize(void)
 extern void __gnat_init_float (void);
 
 void
-__gnat_runtime_initialize(void)
+__gnat_runtime_initialize(int install_handler)
 {
   /*  increment the reference counter */
 
@@ -327,7 +327,8 @@ __gnat_runtime_initialize(void)
 
    __gnat_init_float ();
 
-   __gnat_install_handler();
+  if (install_handler)
+    __gnat_install_handler();
 }
 
 /***********************************************/
@@ -339,7 +340,7 @@ __gnat_runtime_initialize(void)
 extern void __gnat_init_float (void);
 
 void
-__gnat_runtime_initialize(void)
+__gnat_runtime_initialize(int install_handler)
 {
   /*  increment the reference counter */
 
@@ -351,7 +352,8 @@ __gnat_runtime_initialize(void)
 
   __gnat_init_float ();
 
-  __gnat_install_handler();
+  if (install_handler)
+    __gnat_install_handler();
 }
 
 #else
@@ -361,7 +363,7 @@ __gnat_runtime_initialize(void)
 /***********************************************/
 
 void
-__gnat_runtime_initialize(void)
+__gnat_runtime_initialize(int install_handler)
 {
   /*  increment the reference counter */
 
@@ -371,7 +373,8 @@ __gnat_runtime_initialize(void)
   if (__gnat_rt_init_count > 1)
     return;
 
-  __gnat_install_handler();
+  if (install_handler)
+    __gnat_install_handler();
 }
 
 #endif

gcc/ada/sem_ch11.adb

@@ -121,12 +121,11 @@ package body Sem_Ch11 is
                elsif Nkind (Id1) /= N_Others_Choice
                  and then
                    (Id_Entity = Entity (Id1)
-                      or else (Id_Entity = Renamed_Entity (Entity (Id1))))
+                     or else (Id_Entity = Renamed_Entity (Entity (Id1))))
                then
                   if Handler /= Parent (Id) then
                      Error_Msg_Sloc := Sloc (Id1);
-                     Error_Msg_NE
-                       ("exception choice duplicates &#", Id, Id1);
+                     Error_Msg_NE ("exception choice duplicates &#", Id, Id1);
 
                   else
                      if Ada_Version = Ada_83
@@ -348,7 +347,7 @@ package body Sem_Ch11 is
               and then Nkind (First (Statements (Handler))) = N_Raise_Statement
               and then No (Name (First (Statements (Handler))))
               and then (not Others_Present
-                          or else Nkind (First (Exception_Choices (Handler))) =
+                         or else Nkind (First (Exception_Choices (Handler))) =
                                               N_Others_Choice)
             then
                Error_Msg_N
@@ -534,9 +533,7 @@ package body Sem_Ch11 is
 
             --  See if preceding statement is an assignment
 
-            if Present (P)
-              and then Nkind (P) = N_Assignment_Statement
-            then
+            if Present (P) and then Nkind (P) = N_Assignment_Statement then
                L := Name (P);
 
                --  Give warning for assignment to scalar formal
@@ -549,7 +546,7 @@ package body Sem_Ch11 is
                  --  This avoids some false positives for the nested case.
 
                  and then Nearest_Dynamic_Scope (Current_Scope) =
-                            Scope (Entity (L))
+                                                        Scope (Entity (L))
 
                then
                   --  Don't give warning if we are covered by an exception
@@ -571,11 +568,11 @@ package body Sem_Ch11 is
 
                   if No (Exception_Handlers (Par)) then
                      Error_Msg_N
-                       ("assignment to pass-by-copy formal " &
-                        "may have no effect??", P);
+                       ("assignment to pass-by-copy formal "
+                        & "may have no effect??", P);
                      Error_Msg_N
-                       ("\RAISE statement may result in abnormal return" &
-                        " (RM 6.4.1(17))??", P);
+                       ("\RAISE statement may result in abnormal return "
+                        & "(RM 6.4.1(17))??", P);
                   end if;
                end if;
             end if;

gcc/ada/sem_ch12.adb

@@ -5112,7 +5112,7 @@ package body Sem_Ch12 is
      (Formal_Subp : Entity_Id;
       Actual_Subp : Entity_Id) return Node_Id
    is
-      Loc       : constant Source_Ptr := Sloc (Formal_Subp);
+      Loc       : constant Source_Ptr := Sloc (Current_Scope);
       Ret_Type  : constant Entity_Id  := Get_Instance_Of (Etype (Formal_Subp));
       Actuals   : List_Id;
       Decl      : Node_Id;
@@ -5187,11 +5187,12 @@ package body Sem_Ch12 is
      (Formal_Subp : Entity_Id;
       Actual_Subp : Entity_Id) return Node_Id
    is
-      Loc       : constant Source_Ptr := Sloc (Formal_Subp);
-      Ret_Type  : constant Entity_Id := Get_Instance_Of (Etype (Formal_Subp));
-      Op_Type   : constant Entity_Id := Get_Instance_Of
-                                          (Etype (First_Formal (Formal_Subp)));
-      Is_Binary : constant Boolean :=
+      Loc       : constant Source_Ptr := Sloc (Current_Scope);
+      Ret_Type  : constant Entity_Id  :=
+                    Get_Instance_Of (Etype (Formal_Subp));
+      Op_Type   : constant Entity_Id  :=
+                    Get_Instance_Of (Etype (First_Formal (Formal_Subp)));
+      Is_Binary : constant Boolean    :=
                     Present (Next_Formal (First_Formal (Formal_Subp)));
 
       Decl    : Node_Id;