2011-09-06 Robert Dewar <dewar@adacore.com>

	* exp_ch7.adb, g-comlin.adb: Minor reformatting.

2011-09-06  Steve Baird  <baird@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): Look through
	derived subprograms in checking for presence of an
	Extra_Accessibility_Of_Result formal parameter.
	* exp_ch6.adb (Expand_Call): Look through derived subprograms in
	checking for presence of an Extra_Accessibility_Of_Result formal
	parameter.
	(Expand_Call.Add_Actual_Parameter): Fix a bug in the
	case where the Parameter_Associatiations attribute is already set,
	but set to an empty list.
	(Needs_Result_Accessibility_Level):
	Unconditionally return False. This is a temporary
	change, disabling the Extra_Accessibility_Of_Result
	mechanism.
	(Expand_Simple_Function_Return): Check for
	Extra_Accessibility_Of_Result parameter's presence instead of
	testing Ada_Version when generating a runtime accessibility
	check which makes use of the parameter.



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

5 files changed, 119 insertions, 62 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb3a5b674d2..9b2c1bcc631 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2011-09-06  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch7.adb, g-comlin.adb: Minor reformatting.
+
+2011-09-06  Steve Baird  <baird@adacore.com>
+
+	* exp_ch4.adb (Expand_Allocator_Expression): Look through
+	derived subprograms in checking for presence of an
+	Extra_Accessibility_Of_Result formal parameter.
+	* exp_ch6.adb (Expand_Call): Look through derived subprograms in
+	checking for presence of an Extra_Accessibility_Of_Result formal
+	parameter.
+	(Expand_Call.Add_Actual_Parameter): Fix a bug in the
+	case where the Parameter_Associatiations attribute is already set,
+	but set to an empty list.
+	(Needs_Result_Accessibility_Level):
+	Unconditionally return False. This is a temporary
+	change, disabling the Extra_Accessibility_Of_Result
+	mechanism.
+	(Expand_Simple_Function_Return): Check for
+	Extra_Accessibility_Of_Result parameter's presence instead of
+	testing Ada_Version when generating a runtime accessibility
+	check which makes use of the parameter.
+
 2011-09-06  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch4.adb (Expand_N_Case_Expression): Actions created for the
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8555883aa32..aef54a60ec2 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -783,6 +783,8 @@ package body Exp_Ch4 is
                Subp := Entity (Name (Exp));
             end if;
 
+            Subp := Ultimate_Alias (Subp);
+
             if Present (Extra_Accessibility_Of_Result (Subp)) then
                Add_Extra_Actual_To_Call
                  (Subprogram_Call => Exp,
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2638137b28f..014318d5ff8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1847,8 +1847,10 @@ package body Exp_Ch6 is
             if No (Prev) then
                if No (Parameter_Associations (Call_Node)) then
                   Set_Parameter_Associations (Call_Node, New_List);
-                  Append (Insert_Param, Parameter_Associations (Call_Node));
                end if;
+
+               Append (Insert_Param, Parameter_Associations (Call_Node));
+
             else
                Insert_After (Prev, Insert_Param);
             end if;
@@ -2754,7 +2756,8 @@ package body Exp_Ch6 is
       --  passed in to it, then pass it in.
 
       if Ekind_In (Subp, E_Function, E_Operator, E_Subprogram_Type)
-         and then Present (Extra_Accessibility_Of_Result (Subp))
+        and then
+          Present (Extra_Accessibility_Of_Result (Ultimate_Alias (Subp)))
       then
          declare
             Ancestor : Node_Id := Parent (Call_Node);
@@ -2763,15 +2766,19 @@ package body Exp_Ch6 is
 
          begin
             --  Unimplemented: if Subp returns an anonymous access type, then
+
             --    a) if the call is the operand of an explict conversion, then
             --       the target type of the conversion (a named access type)
             --       determines the accessibility level pass in;
+
             --    b) if the call defines an access discriminant of an object
             --       (e.g., the discriminant of an object being created by an
             --       allocator, or the discriminant of a function result),
             --       then the accessibility level to pass in is that of the
             --       discriminated object being initialized).
 
+            --  ???
+
             while Nkind (Ancestor) = N_Qualified_Expression
             loop
                Ancestor := Parent (Ancestor);
@@ -2851,7 +2858,9 @@ package body Exp_Ch6 is
                              Scope_Depth (Current_Scope) + 1);
                end if;
 
-               Add_Extra_Actual (Level, Extra_Accessibility_Of_Result (Subp));
+               Add_Extra_Actual
+                 (Level,
+                  Extra_Accessibility_Of_Result (Ultimate_Alias (Subp)));
             end if;
          end;
       end if;
@@ -6742,7 +6751,7 @@ package body Exp_Ch6 is
       --  ensure that the function result does not outlive an
       --  object designated by one of it discriminants.
 
-      if Ada_Version >= Ada_2012
+      if Present (Extra_Accessibility_Of_Result (Scope_Id))
         and then Has_Unconstrained_Access_Discriminants (R_Type)
       then
          declare
@@ -8320,6 +8329,9 @@ package body Exp_Ch6 is
          return False;
       end Has_Unconstrained_Access_Discriminant_Component;
 
+      Feature_Disabled : constant Boolean := True;
+      --  Temporary
+
    --  Start of processing for Needs_Result_Accessibility_Level
 
    begin
@@ -8328,6 +8340,9 @@ package body Exp_Ch6 is
       if not Present (Func_Typ) then
          return False;
 
+      elsif Feature_Disabled then
+         return False;
+
       --  False if not a function, also handle enum-lit renames case
 
       elsif Func_Typ = Standard_Void_Type
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 6975f3ed3ea..84ae17c975e 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1807,10 +1807,10 @@ package body Exp_Ch7 is
                             (Available_View (Designated_Type (Obj_Typ)))
                  and then Present (Expr)
                  and then
-                     (Is_Null_Access_BIP_Func_Call (Expr)
-                   or else
-                     (Is_Non_BIP_Func_Call (Expr)
-                        and then not Is_Related_To_Func_Return (Obj_Id)))
+                   (Is_Null_Access_BIP_Func_Call (Expr)
+                     or else
+                       (Is_Non_BIP_Func_Call (Expr)
+                         and then not Is_Related_To_Func_Return (Obj_Id)))
                then
                   Processing_Actions (Has_No_Init => True);
 
@@ -7035,17 +7035,14 @@ package body Exp_Ch7 is
 
       function Alignment_Of (Typ : Entity_Id) return Node_Id;
       --  Subsidiary routine, generate the following attribute reference:
-      --
       --    Typ'Alignment
 
       function Size_Of (Typ : Entity_Id) return Node_Id;
       --  Subsidiary routine, generate the following attribute reference:
-      --
       --    Typ'Size / Storage_Unit
 
       function Double_Size_Of (Typ : Entity_Id) return Node_Id;
       --  Subsidiary routine, generate the following expression:
-      --
       --    2 * Typ'Size / Storage_Unit
 
       ------------------
diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index e18a2b1ead6..07b01632f99 100644
--- a/gcc/ada/g-comlin.adb
+++ b/gcc/ada/g-comlin.adb
@@ -119,9 +119,9 @@ package body GNAT.Command_Line is
      (Config : in out Command_Line_Configuration;
       Switch : Switch_Definition);
    procedure Add
-     (Def : in out Alias_Definitions_List;
-      Alias  : Alias_Definition);
-   --  Add a new element to Def.
+     (Def   : in out Alias_Definitions_List;
+      Alias : Alias_Definition);
+   --  Add a new element to Def
 
    procedure Initialize_Switch_Def
      (Def         : out Switch_Definition;
@@ -226,9 +226,8 @@ package body GNAT.Command_Line is
          for J in S'Range loop
             if S (J) in 'A' .. 'Z' then
                S (J) := Character'Val
-                         (Character'Pos (S (J)) +
-                          Character'Pos ('a')   -
-                          Character'Pos ('A'));
+                          (Character'Pos (S (J)) +
+                            (Character'Pos ('a') - Character'Pos ('A')));
             end if;
          end loop;
       end if;
@@ -277,7 +276,8 @@ package body GNAT.Command_Line is
          --  go to the next level.
 
          elsif Is_Directory
-           (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
+                 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) &
+                    S (1 .. Last))
              and then S (1 .. Last) /= "."
              and then S (1 .. Last) /= ".."
          then
@@ -402,6 +402,7 @@ package body GNAT.Command_Line is
             loop
                Parser.Current_Argument := Parser.Current_Argument + 1;
             end loop;
+
          else
             return String'(1 .. 0 => ' ');
          end if;
@@ -533,8 +534,8 @@ package body GNAT.Command_Line is
             Length := Length + 1;
          end loop;
 
-         --  Length now marks the separator after the current switch
-         --  Last will mark the last character of the name of the switch
+         --  Length now marks the separator after the current switch. Last will
+         --  mark the last character of the name of the switch.
 
          if Length = Index + 1 then
             P := Parameter_None;
@@ -584,7 +585,7 @@ package body GNAT.Command_Line is
 
       --  If we have finished parsing the current command line item (there
       --  might be multiple switches in a single item), then go to the next
-      --  element
+      --  element.
 
       if Parser.Current_Argument > Parser.Arg_Count
         or else (Parser.Current_Index >
@@ -615,7 +616,7 @@ package body GNAT.Command_Line is
 
                --  If it isn't a switch, return it immediately. We also know it
                --  isn't the parameter to a previous switch, since that has
-               --  already been handled
+               --  already been handled.
 
                if Switches (Switches'First) = '*' then
                   Set_Parameter
@@ -754,6 +755,7 @@ package body GNAT.Command_Line is
                         First   => End_Index + 2,
                         Last    => Arg'Last);
                      Dummy := Goto_Next_Argument_In_Section (Parser);
+
                   else
                      Parser.Current_Index := End_Index + 1;
                      raise Invalid_Parameter;
@@ -993,9 +995,9 @@ package body GNAT.Command_Line is
       Parser.Stop_At_First    := Stop_At_First_Non_Switch;
       Parser.Section          := (others => 1);
 
-      --  If we are using sections, we have to preprocess the command line
-      --  to delimit them. A section can be repeated, so we just give each
-      --  item on the command line a section number
+      --  If we are using sections, we have to preprocess the command line to
+      --  delimit them. A section can be repeated, so we just give each item
+      --  on the command line a section number
 
       Section_Num   := 1;
       Section_Index := Section_Delimiters'First;
@@ -1014,8 +1016,8 @@ package body GNAT.Command_Line is
             if Argument (Parser, Index)(1) = Parser.Switch_Character
               and then
                 Argument (Parser, Index) = Parser.Switch_Character &
-                                        Section_Delimiters
-                                          (Section_Index .. Last - 1)
+                                             Section_Delimiters
+                                               (Section_Index .. Last - 1)
             then
                Parser.Section (Index) := 0;
                Delimiter_Found := True;
@@ -1164,8 +1166,8 @@ package body GNAT.Command_Line is
    ----------
 
    procedure Free (Parser : in out Opt_Parser) is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Opt_Parser_Data, Opt_Parser);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation (Opt_Parser_Data, Opt_Parser);
    begin
       if Parser /= null
         and then Parser /= Command_Line_Parser
@@ -1217,11 +1219,13 @@ package body GNAT.Command_Line is
    -- Add --
    ---------
 
-   procedure Add (Config : in out Command_Line_Configuration;
-                  Switch : Switch_Definition)
+   procedure Add
+     (Config : in out Command_Line_Configuration;
+      Switch : Switch_Definition)
    is
       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
         (Switch_Definitions, Switch_Definitions_List);
+
       Tmp : Switch_Definitions_List;
 
    begin
@@ -1253,8 +1257,10 @@ package body GNAT.Command_Line is
    procedure Add (Def : in out Alias_Definitions_List;
                   Alias : Alias_Definition)
    is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Alias_Definitions, Alias_Definitions_List);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation
+          (Alias_Definitions, Alias_Definitions_List);
+
       Tmp : Alias_Definitions_List := Def;
 
    begin
@@ -1433,7 +1439,7 @@ package body GNAT.Command_Line is
             if (Section = "" and then Config.Switches (J).Section = null)
               or else
                 (Config.Switches (J).Section /= null
-                 and then Config.Switches (J).Section.all = Section)
+                  and then Config.Switches (J).Section.all = Section)
             then
                exit when Config.Switches (J).Switch /= null
                  and then not Callback (Config.Switches (J).Switch.all, J);
@@ -1475,6 +1481,7 @@ package body GNAT.Command_Line is
          else
             Append (Ret, " " & S);
          end if;
+
          return True;
       end Add_Switch;
 
@@ -1768,12 +1775,12 @@ package body GNAT.Command_Line is
       function Is_In_Config
         (Config_Switch : String; Index : Integer) return Boolean;
       --  If Switch is the same as Config_Switch, run the callback and sets
-      --  Found_In_Config to True
+      --  Found_In_Config to True.
 
       function Starts_With
         (Config_Switch : String; Index : Integer) return Boolean;
       --  if Switch starts with Config_Switch, sets Found_In_Config to True.
-      --  The return value is for the Foreach_Switch iterator
+      --  The return value is for the Foreach_Switch iterator.
 
       --------------------
       -- Group_Analysis --
@@ -1832,9 +1839,7 @@ package body GNAT.Command_Line is
                   end loop;
                end if;
 
-               if not Require_Parameter (Switch)
-                 or else Last >= Param
-               then
+               if not Require_Parameter (Switch) or else Last >= Param then
                   if Idx = Group'First
                     and then Last = Group'Last
                     and then Last < Param
@@ -1860,6 +1865,7 @@ package body GNAT.Command_Line is
                         Section,
                         Prefix & Group (Idx .. Param - 1),
                         Group (Param .. Last));
+
                   else
                      For_Each_Simple_Switch
                        (Config, Section, Prefix & Group (Idx .. Last), "");
@@ -1881,7 +1887,6 @@ package body GNAT.Command_Line is
          Idx := Group'First;
          while Idx <= Group'Last loop
             Found := False;
-
             Foreach (Config, Section);
 
             if not Found then
@@ -1960,7 +1965,8 @@ package body GNAT.Command_Line is
          Decompose_Switch (Config_Switch, P, Last);
 
          if Looking_At
-           (Switch, Switch'First, Config_Switch (Config_Switch'First .. Last))
+              (Switch, Switch'First,
+               Config_Switch (Config_Switch'First .. Last))
          then
             --  Set first char of Param, and last char of Switch
 
@@ -2546,7 +2552,9 @@ package body GNAT.Command_Line is
             if Result (C) /= null
               and then Compatible_Parameter (Params (C))
               and then Looking_At
-                (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
+                         (Result (C).all,
+                          Result (C)'First,
+                          Cmd.Config.Prefixes (P).all)
             then
                --  If we are still in the same section, group the switches
 
@@ -2589,8 +2597,8 @@ package body GNAT.Command_Line is
                   Group :=
                     Ada.Strings.Unbounded.To_Unbounded_String
                       (Result (C)
-                       (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
-                            Result (C)'Last));
+                         (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
+                          Result (C)'Last));
                   First := C;
                end if;
             end if;
@@ -2642,8 +2650,8 @@ package body GNAT.Command_Line is
                if Result (E) /= null
                  and then
                    (Params (E) = null
-                    or else Params (E) (Params (E)'First + 1
-                                            .. Params (E)'Last) = Param)
+                     or else Params (E) (Params (E)'First + 1 ..
+                                         Params (E)'Last) = Param)
                  and then Result (E).all = Switch
                then
                   return;
@@ -2866,16 +2874,19 @@ package body GNAT.Command_Line is
 
    function Is_New_Section    (Iter : Command_Line_Iterator) return Boolean is
       Section : constant String := Current_Section (Iter);
+
    begin
       if Iter.Sections = null then
          return False;
+
       elsif Iter.Current = Iter.Sections'First
         or else Iter.Sections (Iter.Current - 1) = null
       then
          return Section /= "";
-      end if;
 
-      return Section /= Iter.Sections (Iter.Current - 1).all;
+      else
+         return Section /= Iter.Sections (Iter.Current - 1).all;
+      end if;
    end Is_New_Section;
 
    ---------------------
@@ -2933,12 +2944,11 @@ package body GNAT.Command_Line is
          return "";
 
       else
+         --  Return result, skipping separator
+
          declare
             P : constant String := Iter.Params (Iter.Current).all;
-
          begin
-            --  Skip separator
-
             return P (P'First + 1 .. P'Last);
          end;
       end if;
@@ -2972,10 +2982,14 @@ package body GNAT.Command_Line is
    ----------
 
    procedure Free (Config : in out Command_Line_Configuration) is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Switch_Definitions, Switch_Definitions_List);
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Alias_Definitions, Alias_Definitions_List);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation
+          (Switch_Definitions, Switch_Definitions_List);
+
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation
+          (Alias_Definitions, Alias_Definitions_List);
+
    begin
       if Config /= null then
          Free (Config.Prefixes);
@@ -2990,6 +3004,7 @@ package body GNAT.Command_Line is
                Free (Config.Aliases (A).Expansion);
                Free (Config.Aliases (A).Section);
             end loop;
+
             Unchecked_Free (Config.Aliases);
          end if;
 
@@ -3040,6 +3055,7 @@ package body GNAT.Command_Line is
       Free (Config.Usage);
       Free (Config.Help);
       Free (Config.Help_Msg);
+
       Config.Usage    := new String'(Usage);
       Config.Help     := new String'(Help);
       Config.Help_Msg := new String'(Help_Msg);
@@ -3070,6 +3086,7 @@ package body GNAT.Command_Line is
 
       procedure Display_Section_Help (Section : String) is
          Max_Len : Natural := 0;
+
       begin
          --  ??? Special display for "*"
 
@@ -3100,7 +3117,8 @@ package body GNAT.Command_Line is
          for S in Config.Switches'Range loop
             declare
                N : constant String :=
-                 Switch_Name (Config.Switches (S), Section);
+                     Switch_Name (Config.Switches (S), Section);
+
             begin
                if N /= "" then
                   Put (" ");
@@ -3176,9 +3194,7 @@ package body GNAT.Command_Line is
          if (Section = "" and then Def.Section = null)
            or else (Def.Section /= null and then Def.Section.all = Section)
          then
-            if Def.Switch /= null
-              and then Def.Switch.all = "*"
-            then
+            if Def.Switch /= null and then Def.Switch.all = "*" then
                return "[any switch]";
             end if;
 
@@ -3229,8 +3245,10 @@ package body GNAT.Command_Line is
 
       if Config.Help_Msg /= null and then Config.Help_Msg.all /= "" then
          Put_Line (Config.Help_Msg.all);
+
       else
          Display_Section_Help ("");
+
          if Config.Sections /= null and then Config.Switches /= null then
             for S in Config.Sections'Range loop
                Display_Section_Help (Config.Sections (S).all);
@@ -3395,13 +3413,15 @@ package body GNAT.Command_Line is
 
          elsif C /= ASCII.NUL then
             if Full_Switch (Parser) = "h"
-              or else Full_Switch (Parser) = "-help"
+                 or else
+               Full_Switch (Parser) = "-help"
             then
                Display_Help (Config);
                raise Exit_From_Command_Line;
             end if;
 
             --  Do switch expansion if needed
+
             For_Each_Simple
               (Config,
                Section   => Section_Name.all,
@@ -3482,8 +3502,7 @@ package body GNAT.Command_Line is
       Start (Line, Iter, Expanded => Expanded);
       while Has_More (Iter) loop
          if Is_New_Section (Iter) then
-            Args (Count) := new String'
-              (Switch_Char & Current_Section (Iter));
+            Args (Count) := new String'(Switch_Char & Current_Section (Iter));
             Count := Count + 1;
          end if;