[multiple changes]

2011-08-03  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_res.adb, exp_ch13.adb, exp_disp.adb,
	exp_aggr.adb: Minor reformatting.

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): Do not force inlining of
	tagged assignment when discriminant checks are suppressed. This is
	useless and extremely costly in terms of static stack usage.

2011-08-03  Bob Duff  <duff@adacore.com>

	* sem_prag.adb (Get_Base_Subprogram): Do not follow Alias for instances
	of generics, because this leads to the wrong entity in the wrong scope,
	causing (e.g.) pragma Export_Procedure to get an error if the entity is
	an instance.
	(Process_Interface_Name): Follow Alias for instances of generics, to
	correct for the above change.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Selected_Component): If the discriminant value
	is an integer literal it is always safe to replace the reference. In
	addition, if the reference appears in the generated code for an object
	declaration it is necessary to copy because otherwise the reference
	might be to the uninitilized value of the discriminant of the object
	itself.

2011-08-03  Pascal Obry  <obry@adacore.com>

	* adaint.c (__gnat_is_executable_file_attr): Fix Win32 circuitry when no
	ACL used, in this case we want to check for ending .exe, not .exe
	anywhere in the path.

2011-08-03  Sergey Rybin  <rybin@adacore.com>

	* tree_io.ads (ASIS_Version_Number): Update because of the changes in
	the tree structure (semantic decoration of references to record
	discriminants).

From-SVN: r177237

gcc/ada/ChangeLog

+2011-08-03  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb, sem_res.adb, exp_ch13.adb, exp_disp.adb,
+	exp_aggr.adb: Minor reformatting.
+
+2011-08-03  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Assignment_Statement): Do not force inlining of
+	tagged assignment when discriminant checks are suppressed. This is
+	useless and extremely costly in terms of static stack usage.
+
+2011-08-03  Bob Duff  <duff@adacore.com>
+
+	* sem_prag.adb (Get_Base_Subprogram): Do not follow Alias for instances
+	of generics, because this leads to the wrong entity in the wrong scope,
+	causing (e.g.) pragma Export_Procedure to get an error if the entity is
+	an instance.
+	(Process_Interface_Name): Follow Alias for instances of generics, to
+	correct for the above change.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Selected_Component): If the discriminant value
+	is an integer literal it is always safe to replace the reference. In
+	addition, if the reference appears in the generated code for an object
+	declaration it is necessary to copy because otherwise the reference
+	might be to the uninitilized value of the discriminant of the object
+	itself.
+
+2011-08-03  Pascal Obry  <obry@adacore.com>
+
+	* adaint.c (__gnat_is_executable_file_attr): Fix Win32 circuitry when no
+	ACL used, in this case we want to check for ending .exe, not .exe
+	anywhere in the path.
+
+2011-08-03  Sergey Rybin  <rybin@adacore.com>
+
+	* tree_io.ads (ASIS_Version_Number): Update because of the changes in
+	the tree structure (semantic decoration of references to record
+	discriminants).
+
 2011-08-03  Gary Dismukes  <dismukes@adacore.com>
 
 	* sem_aggr.adb (Analyze_Array_Aggregate): When checking the discrete

gcc/ada/adaint.c

@@ -2145,8 +2145,15 @@ __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
            __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
        }
      else
-       attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
-         && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
+       {
+	 TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
+
+	 /* look for last .exe */
+	 while (l = _tcsstr(last+1, _T(".exe"))) last = l;
+
+	 attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
+	   && last - wname == (int) (_tcslen (wname) - 4);
+       }
 #else
      __gnat_stat_to_attr (-1, name, attr);
 #endif

gcc/ada/exp_aggr.adb

@@ -5700,7 +5700,7 @@ package body Exp_Aggr is
       elsif Has_Mutable_Components (Typ)
         and then
           (Nkind (Parent (N)) /= N_Object_Declaration
-             or else not Constant_Present (Parent (N)))
+            or else not Constant_Present (Parent (N)))
       then
          Convert_To_Assignments (N, Typ);
 

gcc/ada/exp_ch13.adb

@@ -311,7 +311,8 @@ package body Exp_Ch13 is
          In_Other_Scope := False;
          In_Outer_Scope := E_Scope /= Current_Scope;
 
-      --  Otherwise it is a local package or a different compilation unit.
+      --  Otherwise it is a local package or a different compilation unit
+
       else
          In_Other_Scope := True;
          In_Outer_Scope := False;

gcc/ada/exp_ch4.adb

@@ -7594,6 +7594,18 @@ package body Exp_Ch4 is
       --  unless the context of an assignment can provide size information.
       --  Don't we have a general routine that does this???
 
+      function Is_Subtype_Declaration return Boolean;
+      --  The replacement of a discriminant reference by its value is required
+      --  if this is part of the initialization of an temporary generated by
+      --  a change of representation. This shows up as the construction of a
+      --  discriminant constraint for a subtype declared at the same point as
+      --  the entity in the prefix of the selected component.
+      --  We recognize this case when the context of the reference is:
+      --
+      --   subtype ST is T(Obj.D);
+      --
+      --   The entity for Obj comes from source, and ST has the same sloc.
+
       -----------------------
       -- In_Left_Hand_Side --
       -----------------------
@@ -7607,6 +7619,21 @@ package body Exp_Ch4 is
                      and then In_Left_Hand_Side (Parent (Comp)));
       end In_Left_Hand_Side;
 
+      -----------------------------
+      --  Is_Subtype_Declaration --
+      -----------------------------
+
+      function Is_Subtype_Declaration return Boolean is
+         Par : constant Node_Id := Parent (N);
+
+      begin
+         return
+           Nkind (Par) = N_Index_Or_Discriminant_Constraint
+             and then Nkind (Parent (Parent (Par))) = N_Subtype_Declaration
+             and then Comes_From_Source (Entity (Prefix (N)))
+             and then Sloc (Par) = Sloc (Entity (Prefix (N)));
+      end Is_Subtype_Declaration;
+
    --  Start of processing for Expand_N_Selected_Component
 
    begin
@@ -7730,9 +7757,19 @@ package body Exp_Ch4 is
                   --  AND THEN was copied, causing problems for coverage
                   --  analysis tools).
 
+                  --  However, if the reference is part of the initialization
+                  --  code generated for an object declaration, we must use
+                  --  the discriminant value from the subtype constraint,
+                  --  because the selected component may be a reference to the
+                  --  object being initialized, whose discriminant is not yet
+                  --  set. This only happens in complex cases involving changes
+                  --  or representation.
+
                   if Disc = Entity (Selector_Name (N))
                     and then (Is_Entity_Name (Dval)
-                               or else Is_Static_Expression (Dval))
+                              or else Nkind (Dval) = N_Integer_Literal
+                              or else Is_Subtype_Declaration
+                              or else Is_Static_Expression (Dval))
                   then
                      --  Here we have the matching discriminant. Check for
                      --  the case of a discriminant of a component that is

gcc/ada/exp_ch5.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -1934,24 +1934,19 @@ package body Exp_Ch5 is
 
                --  If the type is tagged, we may as well use the predefined
                --  primitive assignment. This avoids inlining a lot of code
-               --  and in the class-wide case, the assignment is replaced by
-               --  dispatch call to _assign. Note that this cannot be done when
-               --  discriminant checks are locally suppressed (as in extension
-               --  aggregate expansions) because otherwise the discriminant
-               --  check will be performed within the _assign call. It is also
-               --  suppressed for assignments created by the expander that
-               --  correspond to initializations, where we do want to copy the
-               --  tag (No_Ctrl_Actions flag set True) by the expander and we
-               --  do not need to mess with tags ever (Expand_Ctrl_Actions flag
-               --  is set True in this case). Finally, it is suppressed if the
-               --  restriction No_Dispatching_Calls is in force because in that
-               --  case predefined primitives are not generated.
+               --  and in the class-wide case, the assignment is replaced by a
+               --  dispatching call to _assign. It is suppressed in the case of
+               --  assignments created by the expander that correspond to
+               --  initializations, where we do want to copy the tag
+               --  (Expand_Ctrl_Actions flag is set True in this case).
+               --  It is also suppressed if restriction No_Dispatching_Calls is
+               --  in force because in that case predefined primitives are not
+               --  generated.
 
                or else (Is_Tagged_Type (Typ)
                          and then not Is_Value_Type (Etype (Lhs))
                          and then Chars (Current_Scope) /= Name_uAssign
                          and then Expand_Ctrl_Actions
-                         and then not Discriminant_Checks_Suppressed (Empty)
                          and then
                            not Restriction_Active (No_Dispatching_Calls))
             then

gcc/ada/exp_disp.adb

@@ -3808,12 +3808,12 @@ package body Exp_Disp is
       --  calls through interface types; the latter secondary table is
       --  generated when Build_Thunks is False, and provides support for
       --  Generic Dispatching Constructors that dispatch calls through
-      --  interface types. When constructing this latter table the value
-      --  of Suffix_Index is -1 to indicate that there is no need to export
-      --  such table when building statically allocated dispatch tables; a
-      --  positive value of Suffix_Index must match the Suffix_Index value
-      --  assigned to this secondary dispatch table by Make_Tags when its
-      --  unique external name was generated.
+      --  interface types. When constructing this latter table the value of
+      --  Suffix_Index is -1 to indicate that there is no need to export such
+      --  table when building statically allocated dispatch tables; a positive
+      --  value of Suffix_Index must match the Suffix_Index value assigned to
+      --  this secondary dispatch table by Make_Tags when its unique external
+      --  name was generated.
 
       ------------------------------
       -- Check_Premature_Freezing --
@@ -3825,6 +3825,7 @@ package body Exp_Disp is
          Typ         : Entity_Id)
       is
          Comp : Entity_Id;
+
       begin
          if Present (N)
            and then Is_Private_Type (Typ)

gcc/ada/sem_ch3.adb

@@ -3402,16 +3402,16 @@ package body Sem_Ch3 is
 
          Remove_Side_Effects (E);
 
+      --  If this is a constant declaration of an unconstrained type and
+      --  the initialization is an aggregate, we can use the subtype of the
+      --  aggregate for the declared entity because it is immutable.
+
       elsif not Is_Constrained (T)
         and then Has_Discriminants (T)
         and then Constant_Present (N)
         and then not Has_Unchecked_Union (T)
         and then Nkind (E) = N_Aggregate
       then
-         --  If this is a constant declaration of an unconstrained type and
-         --  the initialization is an aggregate, we can use the subtype of the
-         --  aggregate for the declared entity because it is immutable.
-
          Act_T := Etype (E);
       end if;
 
@@ -3419,9 +3419,9 @@ package body Sem_Ch3 is
 
       Check_Wide_Character_Restriction (T, Object_Definition (N));
 
-      --  Indicate this is not set in source. Certainly true for constants,
-      --  and true for variables so far (will be reset for a variable if and
-      --  when we encounter a modification in the source).
+      --  Indicate this is not set in source. Certainly true for constants, and
+      --  true for variables so far (will be reset for a variable if and when
+      --  we encounter a modification in the source).
 
       Set_Never_Set_In_Source (Id, True);
 
@@ -3435,9 +3435,9 @@ package body Sem_Ch3 is
          Set_Ekind (Id, E_Variable);
 
          --  A variable is set as shared passive if it appears in a shared
-         --  passive package, and is at the outer level. This is not done
-         --  for entities generated during expansion, because those are
-         --  always manipulated locally.
+         --  passive package, and is at the outer level. This is not done for
+         --  entities generated during expansion, because those are always
+         --  manipulated locally.
 
          if Is_Shared_Passive (Current_Scope)
            and then Is_Library_Level_Entity (Id)

gcc/ada/sem_prag.adb

@@ -4723,8 +4723,17 @@ package body Sem_Prag is
                 Strval => End_String);
          end if;
 
-         Set_Encoded_Interface_Name
-           (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
+         --  Set the interface name. If the entity is a generic instance, use
+         --  its alias, which is the callable entity.
+
+         if Is_Generic_Instance (Subprogram_Def) then
+            Set_Encoded_Interface_Name
+              (Alias (Get_Base_Subprogram (Subprogram_Def)), Link_Nam);
+
+         else
+            Set_Encoded_Interface_Name
+              (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
+         end if;
 
          --  We allow duplicated export names in CIL, as they are always
          --  enclosed in a namespace that differentiates them, and overloaded
@@ -13890,9 +13899,8 @@ package body Sem_Prag is
       Result := Def_Id;
       while Is_Subprogram (Result)
         and then
-          (Is_Generic_Instance (Result)
-            or else Nkind (Parent (Declaration_Node (Result))) =
-                                         N_Subprogram_Renaming_Declaration)
+          Nkind (Parent (Declaration_Node (Result))) =
+                                         N_Subprogram_Renaming_Declaration
         and then Present (Alias (Result))
       loop
          Result := Alias (Result);

gcc/ada/sem_res.adb

@@ -9881,21 +9881,24 @@ package body Sem_Res is
          declare
             Index_List    : constant List_Id    := New_List;
             Index_Type    : constant Entity_Id := Etype (First_Index (Typ));
-            High_Bound    : constant Node_Id :=
-              Make_Attribute_Reference (Loc,
-                Attribute_Name => Name_Val,
-                Prefix => New_Occurrence_Of (Index_Type, Loc),
-                Expressions =>
-                New_List (
-                  Make_Op_Add (Loc,
-                    Left_Opnd =>
-                      Make_Attribute_Reference (Loc,
-                        Attribute_Name => Name_Pos,
-                        Prefix => New_Occurrence_Of (Index_Type, Loc),
-                        Expressions => New_List (New_Copy_Tree (Low_Bound))),
-                      Right_Opnd =>
-                            Make_Integer_Literal (Loc,
-                              String_Length (Strval (N)) - 1))));
+
+            High_Bound : constant Node_Id :=
+                           Make_Attribute_Reference (Loc,
+                             Attribute_Name => Name_Val,
+                             Prefix         =>
+                               New_Occurrence_Of (Index_Type, Loc),
+                             Expressions    => New_List (
+                               Make_Op_Add (Loc,
+                                 Left_Opnd  =>
+                                   Make_Attribute_Reference (Loc,
+                                     Attribute_Name => Name_Pos,
+                                     Prefix         =>
+                                       New_Occurrence_Of (Index_Type, Loc),
+                                     Expressions    =>
+                                       New_List (New_Copy_Tree (Low_Bound))),
+                                 Right_Opnd =>
+                                   Make_Integer_Literal (Loc,
+                                     String_Length (Strval (N)) - 1))));
 
             Array_Subtype : Entity_Id;
             Index_Subtype : Entity_Id;

gcc/ada/tree_io.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -47,7 +47,7 @@ package Tree_IO is
    Tree_Format_Error : exception;
    --  Raised if a format error is detected in the input file
 
-   ASIS_Version_Number : constant := 23;
+   ASIS_Version_Number : constant := 24;
    --  ASIS Version. This is used to check for consistency between the compiler
    --  used to generate trees and an ASIS application that is reading the
    --  trees. It must be incremented whenever a change is made to the tree