2011-11-21 Tristan Gingold <gingold@adacore.com>

	* env.c: Remove unused declaration.

2011-11-21  Pascal Obry  <obry@adacore.com>

	* s-os_lib.ads: Minor style fix.

2011-11-21  Pascal Obry  <obry@adacore.com>

	* adaint.c (__gnat_dup2): When fd are stdout, stdin or stderr and
	identical, do nothing on Windows XP.

2011-11-21  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb (Constrain_Index, Process_Range_Expr_In_Decl):
	Use Full_Expander_Active instead of Expander_Active to control
	the forced evaluation of expressions for the sake of generating
	checks.

2011-11-21  Thomas Quinot  <quinot@adacore.com>

	* init.c: On FreeBSD, stack checking failures may raise SIGBUS.

2011-11-21  Tristan Gingold  <gingold@adacore.com>

	* sysdep.c (mode_read_text, mode_write_text, mode_append_text,
	mode_read_binary, mode_write_binary, mode_append_binary,
	mode_read_text_plus, mode_write_text_plus, mode_append_text_plus,
	mode_read_binary_plus, mode_write_binary_plus,
	mode_append_binary_plus): Remove unused declarations.

2011-11-21  Yannick Moy  <moy@adacore.com>

	* gnat_rm.texi: Minor rewording.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_imgv.adb (Expand_Width_Attribute): Emit
	an error message rather than a warning when pragma Discard_Names
	prevents the computation of 'Width. Do not emit an error through
	the use of RE_Null.

2011-11-21  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add
	implicit type conversion when the type of the allocator is an
	interface. Done to force generation of displacement of the "this"
	pointer when required.

2011-11-21  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo.adb: Corresponding_Spec applies to expression
	functions, and is set when the expression is a completion of a
	previous declaration.
	* sem_ch6.adb (Analyze_Expression_Function): To determine properly
	whether an expression function completes a previous declaration,
	use Find_Corresponding_Spec, as when analyzing a subprogram body.

2011-11-21  Steve Baird  <baird@adacore.com>

	* sem_util.adb (Deepest_Type_Access_Level): Improve comment.
	(Type_Access_Level): Improve comment.



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

14 files changed, 157 insertions, 116 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c8d6cce99d5..8549dd1d264 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,67 @@
+2011-11-21  Tristan Gingold  <gingold@adacore.com>
+
+	* env.c: Remove unused declaration.
+
+2011-11-21  Pascal Obry  <obry@adacore.com>
+
+	* s-os_lib.ads: Minor style fix.
+
+2011-11-21  Pascal Obry  <obry@adacore.com>
+
+	* adaint.c (__gnat_dup2): When fd are stdout, stdin or stderr and
+	identical, do nothing on Windows XP.
+
+2011-11-21  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb (Constrain_Index, Process_Range_Expr_In_Decl):
+	Use Full_Expander_Active instead of Expander_Active to control
+	the forced evaluation of expressions for the sake of generating
+	checks.
+
+2011-11-21  Thomas Quinot  <quinot@adacore.com>
+
+	* init.c: On FreeBSD, stack checking failures may raise SIGBUS.
+
+2011-11-21  Tristan Gingold  <gingold@adacore.com>
+
+	* sysdep.c (mode_read_text, mode_write_text, mode_append_text,
+	mode_read_binary, mode_write_binary, mode_append_binary,
+	mode_read_text_plus, mode_write_text_plus, mode_append_text_plus,
+	mode_read_binary_plus, mode_write_binary_plus,
+	mode_append_binary_plus): Remove unused declarations.
+
+2011-11-21  Yannick Moy  <moy@adacore.com>
+
+	* gnat_rm.texi: Minor rewording.
+
+2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_imgv.adb (Expand_Width_Attribute): Emit
+	an error message rather than a warning when pragma Discard_Names
+	prevents the computation of 'Width. Do not emit an error through
+	the use of RE_Null.
+
+2011-11-21  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add
+	implicit type conversion when the type of the allocator is an
+	interface. Done to force generation of displacement of the "this"
+	pointer when required.
+
+2011-11-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sinfo.ads, sinfo.adb: Corresponding_Spec applies to expression
+	functions, and is set when the expression is a completion of a
+	previous declaration.
+	* sem_ch6.adb (Analyze_Expression_Function): To determine properly
+	whether an expression function completes a previous declaration,
+	use Find_Corresponding_Spec, as when analyzing a subprogram body.
+
+2011-11-21  Steve Baird  <baird@adacore.com>
+
+	* sem_util.adb (Deepest_Type_Access_Level): Improve comment.
+	(Type_Access_Level): Improve comment.
+
 2011-11-21  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/Makefile.in (INCLUDES_FOR_SUBDIR): Add $(fsrcdir) by
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 7e701f53c14..dde33429575 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -2449,6 +2449,14 @@ __gnat_dup2 (int oldfd, int newfd)
   /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
      RTPs.  */
   return -1;
+#elif defined (_WIN32)
+  /* Special case when oldfd and newfd are identical and are the standard
+     input, output or error as this makes Windows XP hangs. Note that we
+     do that only for standard file descriptors that are known to be valid. */
+  if (oldfd == newfd && newfd >= 0 && newfd <= 2)
+    return newfd;
+  else
+    return dup2 (oldfd, newfd);
 #else
   return dup2 (oldfd, newfd);
 #endif
diff --git a/gcc/ada/env.c b/gcc/ada/env.c
index 1719684034a..31c878e7795 100644
--- a/gcc/ada/env.c
+++ b/gcc/ada/env.c
@@ -110,8 +110,6 @@ __gnat_getenv (char *name, int *len, char **value)
 
 #ifdef VMS
 
-static char *to_host_path_spec (char *);
-
 typedef struct _ile3
 {
   unsigned short len, code;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 6673328acaf..93396525dde 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7805,6 +7805,15 @@ package body Exp_Ch6 is
       --  to the object created by the allocator).
 
       Rewrite (Allocator, Make_Reference (Loc, Relocate_Node (Function_Call)));
+
+      --  Ada 2005 (AI-251): If the type of the allocator is an interface then
+      --  generate an implicit conversion to force displacement of the "this"
+      --  pointer.
+
+      if Is_Interface (Designated_Type (Acc_Type)) then
+         Rewrite (Allocator, Convert_To (Acc_Type, Relocate_Node (Allocator)));
+      end if;
+
       Analyze_And_Resolve (Allocator, Acc_Type);
    end Make_Build_In_Place_Call_In_Allocator;
 
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index d66824bc35f..1c46950a952 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -1156,31 +1156,27 @@ package body Exp_Imgv is
       else
          pragma Assert (Is_Enumeration_Type (Rtyp));
 
-         if Discard_Names (Rtyp) then
+         --  Whenever pragma Discard_Names is in effect, it suppresses the
+         --  generation of string literals for enumeration types. Since the
+         --  literals are required to evaluate the 'Width of an enumeration
+         --  type, emit an error.
+
+         --  ??? This is fine for configurable runtimes, but dubious in the
+         --  general case. For now keep both error messages until this issue
+         --  has been verified with the ARG.
 
-            --  Emit a detailed warning in configurable run-time mode because
-            --  loading RE_Null does not give a precise indication of the real
-            --  issue.
+         if Discard_Names (Rtyp) then
+            Error_Msg_Name_1 := Attribute_Name (N);
 
-            if Configurable_Run_Time_Mode
-              and then not Has_Warnings_Off (Rtyp)
-            then
-               Error_Msg_Name_1 := Attribute_Name (N);
-               Error_Msg_N ("?attribute % not supported in configurable " &
+            if Configurable_Run_Time_Mode then
+               Error_Msg_N ("attribute % not supported in configurable " &
                             "run-time mode", N);
+            else
+               Error_Msg_N ("attribute % not supported when pragma " &
+                            "Discard_Names is in effect", N);
             end if;
 
-            --  This is a configurable run-time, or else a restriction is in
-            --  effect. In either case the attribute cannot be supported. Force
-            --  a load error from Rtsfind to generate an appropriate message,
-            --  as is done with other ZFP violations.
-
-            declare
-               Discard : constant Entity_Id := RTE (RE_Null);
-               pragma Unreferenced (Discard);
-            begin
-               return;
-            end;
+            return;
          end if;
 
          Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 00e0543e3d8..ffe4358fb40 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -6372,12 +6372,11 @@ refer to the value of the prefix on entry. So for
 example if you have an argument of a record type X called Arg1,
 you can refer to Arg1.Field'Old which yields the value of
 Arg1.Field on entry. The implementation simply involves generating
-an object declaration which captures the value on entry. Any
-prefix is allowed except one of a limited type (since limited
-types cannot be copied to capture their values) or an expression
-which references a local variable
-(since local variables do not exist at subprogram entry time).
-
+an object declaration which captures the value on entry.
+The prefix must denote an object of a nonlimited type (since limited types
+cannot be copied to capture their values) and it must not reference a local
+variable (since local variables do not exist at subprogram entry time). Note
+that the variable introduced by a quantified expression is a local variable.
 The following example shows the use of 'Old to implement
 a test of a postcondition:
 
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index b6d6e6a57e1..cc6c1d2c50b 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1808,8 +1808,8 @@ __gnat_error_handler (int sig,
       break;
 
     case SIGBUS:
-      exception = &constraint_error;
-      msg = "SIGBUS";
+      exception = &storage_error;
+      msg = "SIGBUS: possible stack overflow";
       break;
 
     default:
diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads
index 1c63e386ea9..3599261498c 100755
--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -174,7 +174,7 @@ package System.OS_Lib is
    --  File descriptors for standard input output files
 
    Invalid_FD : constant File_Descriptor := -1;
-   --  File descriptor returned when error in opening/creating file;
+   --  File descriptor returned when error in opening/creating file
 
    type Mode is (Binary, Text);
    for Mode'Size use Integer'Size;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 92e1b9da994..16147713712 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -11786,7 +11786,7 @@ package body Sem_Ch3 is
          --  needed, since checks may cause duplication of the expressions
          --  which must not be reevaluated.
 
-         if Expander_Active then
+         if Full_Expander_Active then
             Force_Evaluation (Low_Bound (R));
             Force_Evaluation (High_Bound (R));
          end if;
@@ -18326,7 +18326,7 @@ package body Sem_Ch3 is
             --  if needed, before applying checks, since checks may cause
             --  duplication of the expression without forcing evaluation.
 
-            if Expander_Active then
+            if Full_Expander_Active then
                Force_Evaluation (Lo);
                Force_Evaluation (Hi);
             end if;
@@ -18436,7 +18436,7 @@ package body Sem_Ch3 is
 
       --  Case of other than an explicit N_Range node
 
-      elsif Expander_Active then
+      elsif Full_Expander_Active then
          Get_Index_Bounds (R, Lo, Hi);
          Force_Evaluation (Lo);
          Force_Evaluation (Hi);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 56c10748403..25ee63ec29f 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -268,16 +268,22 @@ package body Sem_Ch6 is
    procedure Analyze_Expression_Function (N : Node_Id) is
       Loc      : constant Source_Ptr := Sloc (N);
       LocX     : constant Source_Ptr := Sloc (Expression (N));
-      Def_Id   : constant Entity_Id  := Defining_Entity (Specification (N));
       Expr     : constant Node_Id    := Expression (N);
-      New_Body : Node_Id;
-      New_Decl : Node_Id;
+      Spec     : constant Node_Id    := Specification (N);
+
+      Def_Id   :  Entity_Id;
+      pragma Unreferenced (Def_Id);
 
-      Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
+      Prev     :  Entity_Id;
       --  If the expression is a completion, Prev is the entity whose
-      --  declaration is completed.
+      --  declaration is completed. Def_Id is needed to analyze the spec.
+
+      New_Body : Node_Id;
+      New_Decl : Node_Id;
+      New_Spec : Node_Id;
 
    begin
+
       --  This is one of the occasions on which we transform the tree during
       --  semantic analysis. If this is a completion, transform the expression
       --  function into an equivalent subprogram body, and analyze it.
@@ -286,10 +292,22 @@ package body Sem_Ch6 is
       --  determine whether this is possible.
 
       Inline_Processing_Required := True;
+      New_Spec := Copy_Separate_Tree (Spec);
+      Prev     := Current_Entity_In_Scope (Defining_Entity (Spec));
+
+      --  If there are previous overloadable entities with the same name,
+      --  check whether any of them is completed by the expression function.
+
+      if Present (Prev)
+        and then Is_Overloadable (Prev)
+      then
+         Def_Id   := Analyze_Subprogram_Specification (Spec);
+         Prev     := Find_Corresponding_Spec (N);
+      end if;
 
       New_Body :=
         Make_Subprogram_Body (Loc,
-          Specification              => Copy_Separate_Tree (Specification (N)),
+          Specification              => New_Spec,
           Declarations               => Empty_List,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (LocX,
@@ -307,6 +325,7 @@ package body Sem_Ch6 is
 
          Insert_After (N, New_Body);
          Rewrite (N, Make_Null_Statement (Loc));
+         Set_Has_Completion (Prev, False);
          Analyze (N);
          Analyze (New_Body);
          Set_Is_Inlined (Prev);
@@ -314,6 +333,7 @@ package body Sem_Ch6 is
       elsif Present (Prev)
         and then Comes_From_Source (Prev)
       then
+         Set_Has_Completion (Prev, False);
          Rewrite (N, New_Body);
          Analyze (N);
 
@@ -333,8 +353,7 @@ package body Sem_Ch6 is
 
       else
          New_Decl :=
-           Make_Subprogram_Declaration (Loc,
-             Specification => Specification (N));
+           Make_Subprogram_Declaration (Loc, Specification => Spec);
 
          Rewrite (N, New_Decl);
          Analyze (N);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8e6a2a2fa36..edf1fecbfe6 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2437,7 +2437,8 @@ package body Sem_Util is
                          (Defining_Identifier
                            (Associated_Node_For_Itype (Typ))));
 
-      --  For generic formal type, return Int'Last (infinite) (why ???)
+      --  For generic formal type, return Int'Last (infinite).
+      --  See comment preceding Is_Generic_Type call in Type_Access_Level.
 
       elsif Is_Generic_Type (Root_Type (Typ)) then
          return UI_From_Int (Int'Last);
@@ -12719,7 +12720,20 @@ package body Sem_Util is
          end if;
       end if;
 
-      --  Return library level for a generic formal type (why???)
+      --  Return library level for a generic formal type. This is done because
+      --  RM(10.3.2) says that "The statically deeper relationship does not
+      --  apply to ... a descendant of a generic formal type". Rather than
+      --  checking at each point where a static accessibility check is
+      --  performed to see if we are dealing with a formal type, this rule is
+      --  implemented by having Type_Access_Level and Deepest_Type_Access_Level
+      --  return extreme values for a formal type; Deepest_Type_Access_Level
+      --  returns Int'Last. By calling the appropriate function from among the
+      --  two, we ensure that the static accessibility check will pass if we
+      --  happen to run into a formal type. More specifically, we should call
+      --  Deepest_Type_Access_Level instead of Type_Access_Level whenever the
+      --  call occurs as part of a static accessibility check and the error
+      --  case is the case where the type's level is too shallow (as opposed
+      --  to too deep).
 
       if Is_Generic_Type (Root_Type (Btyp)) then
          return Scope_Depth (Standard_Standard);
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index b36b930b8c4..22b44e56f27 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -657,6 +657,7 @@ package body Sinfo is
       (N : Node_Id) return Node_Id is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Expression_Function
         or else NT (N).Nkind = N_Package_Body
         or else NT (N).Nkind = N_Protected_Body
         or else NT (N).Nkind = N_Subprogram_Body
@@ -3729,6 +3730,7 @@ package body Sinfo is
       (N : Node_Id; Val : Node_Id) is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Expression_Function
         or else NT (N).Nkind = N_Package_Body
         or else NT (N).Nkind = N_Protected_Body
         or else NT (N).Nkind = N_Subprogram_Body
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 3379faef038..cfa8a11b592 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -760,6 +760,8 @@ package Sinfo is
    --    renaming declaration when it is a Renaming_As_Body. The field is Empty
    --    if there is no corresponding spec, as in the case of a subprogram body
    --    that serves as its own spec.
+   --    In Ada2012, Corresponding_Spec is set on expression functions that
+   --    complete a subprogram declaration.
 
    --  Corresponding_Stub (Node3-Sem)
    --    This field is present in an N_Subunit node. It holds the node in
@@ -4607,6 +4609,7 @@ package Sinfo is
       --  Sloc points to FUNCTION
       --  Specification (Node1)
       --  Expression (Node3)
+      --  Corresponding_Spec (Node5-Sem)
 
       -----------------------------------
       -- 6.4  Procedure Call Statement --
diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c
index 4d383fd0608..a4456f56a24 100644
--- a/gcc/ada/sysdep.c
+++ b/gcc/ada/sysdep.c
@@ -80,54 +80,6 @@ extern struct tm *localtime_r(const time_t *, struct tm *);
 #endif
 
 /*
-   mode_read_text
-   open text file for reading
-   rt for DOS and Windows NT, r for Unix
-
-   mode_write_text
-   truncate to zero length or create text file for writing
-   wt for DOS and Windows NT, w for Unix
-
-   mode_append_text
-   append; open or create text file for writing at end-of-file
-   at for DOS and Windows NT, a for Unix
-
-   mode_read_binary
-   open binary file for reading
-   rb for DOS and Windows NT, r for Unix
-
-   mode_write_binary
-   truncate to zero length or create binary file for writing
-   wb for DOS and Windows NT, w for Unix
-
-   mode_append_binary
-   append; open or create binary file for writing at end-of-file
-   ab for DOS and Windows NT, a for Unix
-
-   mode_read_text_plus
-   open text file for update (reading and writing)
-   r+t for DOS and Windows NT, r+ for Unix
-
-   mode_write_text_plus
-   truncate to zero length or create text file for update
-   w+t for DOS and Windows NT, w+ for Unix
-
-   mode_append_text_plus
-   append; open or create text file for update, writing at end-of-file
-   a+t for DOS and Windows NT, a+ for Unix
-
-   mode_read_binary_plus
-   open binary file for update (reading and writing)
-   r+b for DOS and Windows NT, r+ for Unix
-
-   mode_write_binary_plus
-   truncate to zero length or create binary file for update
-   w+b for DOS and Windows NT, w+ for Unix
-
-   mode_append_binary_plus
-   append; open or create binary file for update, writing at end-of-file
-   a+b for DOS and Windows NT, a+ for Unix
-
    Notes:
 
    (1) Opening a file with read mode fails if the file does not exist or
@@ -169,18 +121,7 @@ extern struct tm *localtime_r(const time_t *, struct tm *);
 */
 
 #if defined(WINNT)
-static const char *mode_read_text = "rt";
-static const char *mode_write_text = "wt";
-static const char *mode_append_text = "at";
-static const char *mode_read_binary = "rb";
-static const char *mode_write_binary = "wb";
-static const char *mode_append_binary = "ab";
-static const char *mode_read_text_plus = "r+t";
-static const char *mode_write_text_plus = "w+t";
-static const char *mode_append_text_plus = "a+t";
-static const char *mode_read_binary_plus = "r+b";
-static const char *mode_write_binary_plus = "w+b";
-static const char *mode_append_binary_plus = "a+b";
+
 const char __gnat_text_translation_required = 1;
 
 void
@@ -261,18 +202,6 @@ __gnat_get_stack_bounds (void **base, void **limit)
 
 #else
 
-static const char *mode_read_text = "r";
-static const char *mode_write_text = "w";
-static const char *mode_append_text = "a";
-static const char *mode_read_binary = "r";
-static const char *mode_write_binary = "w";
-static const char *mode_append_binary = "a";
-static const char *mode_read_text_plus = "r+";
-static const char *mode_write_text_plus = "w+";
-static const char *mode_append_text_plus = "a+";
-static const char *mode_read_binary_plus = "r+";
-static const char *mode_write_binary_plus = "w+";
-static const char *mode_append_binary_plus = "a+";
 const char __gnat_text_translation_required = 0;
 
 /* These functions do nothing in non-DOS systems. */