[multiple changes]

2009-09-16  Vincent Celier  <celier@adacore.com>

	* gprep.adb (Yes_No): New global constant
	Unix_Line_Terminators: New global Boolean variable
	(Process_One_File): Create the out file with a "Text_Translation=" form
	that depends on the use of option -T.
	(Scan_Command_Line): Add option -T
	(Usage): Add line for option -T

2009-09-16  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.ads, exp_disp.adb (Is_Predefined_Internal_Operation): New
	predicate that describes a proper subset of
	Is_Predefined_Dispatching_Operation and excludes stream operations,
	which can be overridden by the user.
	* sem_ch6.adb (Create_Extra_Formals): use
	Is_Predefined_Internal_Operation, so that stream operations get extra
	formals.
	* exp_ch6.adb (Prevent double generation of extra actuals in calls to
	'Input, which may be expanded twice, first as a function call and then
	as a dispatching call.

From-SVN: r151748

6 files changed, 113 insertions, 11 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6c975b4..158d909 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2009-09-16  Vincent Celier  <celier@adacore.com>
+
+	* gprep.adb (Yes_No): New global constant
+	Unix_Line_Terminators: New global Boolean variable
+	(Process_One_File): Create the out file with a "Text_Translation=" form
+	that depends on the use of option -T.
+	(Scan_Command_Line): Add option -T
+	(Usage): Add line for option -T
+
+2009-09-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_disp.ads, exp_disp.adb (Is_Predefined_Internal_Operation): New
+	predicate that describes a proper subset of
+	Is_Predefined_Dispatching_Operation and excludes stream operations,
+	which can be overridden by the user.
+	* sem_ch6.adb (Create_Extra_Formals): use
+	Is_Predefined_Internal_Operation, so that stream operations get extra
+	formals.
+	* exp_ch6.adb (Prevent double generation of extra actuals in calls to
+	'Input, which may be expanded twice, first as a function call and then
+	as a dispatching call.
+
 2009-09-16  Thomas Quinot  <quinot@adacore.com>
 
 	* s-oscons-tmplt.c (Target_OS, Target_Name): New constants.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 44944ae..8827870 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -2282,14 +2282,31 @@ package body Exp_Ch6 is
                   when N_Attribute_Reference =>
                      case Get_Attribute_Id (Attribute_Name (Prev_Orig)) is
 
-                        --  For X'Access, pass on the level of the prefix X
+                        --  For X'Access, pass on the level of the prefix X.
+                        --  If the call is a rewritten attribute reference to
+                        --  'Input and the prefix is a tagged type, prevent
+                        --  double expansion (once as a function call and once
+                        --  as a dispatching call)
 
                         when Attribute_Access =>
-                           Add_Extra_Actual
-                             (Make_Integer_Literal (Loc,
-                                Intval =>
-                                  Object_Access_Level (Prefix (Prev_Orig))),
-                              Extra_Accessibility (Formal));
+                           declare
+                              Onode : constant Node_Id :=
+                                        Original_Node (Parent (N));
+                           begin
+                              if Nkind (Onode) = N_Attribute_Reference
+                                and then Attribute_Name (Onode) = Name_Input
+                                and then Is_Tagged_Type (Etype (Subp))
+                              then
+                                 null;
+                              else
+                                 Add_Extra_Actual
+                                   (Make_Integer_Literal (Loc,
+                                      Intval =>
+                                        Object_Access_Level
+                                          (Prefix (Prev_Orig))),
+                                    Extra_Accessibility (Formal));
+                              end if;
+                           end;
 
                         --  Treat the unchecked attributes as library-level
 
@@ -2328,7 +2345,6 @@ package body Exp_Ch6 is
                        (Make_Integer_Literal (Loc,
                           Intval => Type_Access_Level (Etype (Prev))),
                         Extra_Accessibility (Formal));
-
                end case;
             end if;
          end if;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index f34b1e9..671b663 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1740,6 +1740,48 @@ package body Exp_Disp is
       return False;
    end Is_Predefined_Dispatching_Operation;
 
+   ---------------------------------------
+   -- Is_Predefined_Internal_Operation  --
+   ---------------------------------------
+
+   function Is_Predefined_Internal_Operation
+     (E : Entity_Id) return Boolean
+   is
+      TSS_Name : TSS_Name_Type;
+
+   begin
+      if not Is_Dispatching_Operation (E) then
+         return False;
+      end if;
+
+      Get_Name_String (Chars (E));
+
+      --  Most predefined primitives have internally generated names. Equality
+      --  must be treated differently; the predefined operation is recognized
+      --  as a homogeneous binary operator that returns Boolean.
+
+      if Name_Len > TSS_Name_Type'Last then
+         TSS_Name :=
+           TSS_Name_Type
+             (Name_Buffer (Name_Len - TSS_Name'Length + 1 .. Name_Len));
+
+         if        Chars (E) = Name_uSize
+           or else Chars (E) = Name_uAlignment
+           or else
+             (Chars (E) = Name_Op_Eq
+                and then Etype (First_Entity (E)) = Etype (Last_Entity (E)))
+           or else Chars (E) = Name_uAssign
+           or else TSS_Name  = TSS_Deep_Adjust
+           or else TSS_Name  = TSS_Deep_Finalize
+           or else Is_Predefined_Interface_Primitive (E)
+         then
+            return True;
+         end if;
+      end if;
+
+      return False;
+   end Is_Predefined_Internal_Operation;
+
    -------------------------------------
    -- Is_Predefined_Dispatching_Alias --
    -------------------------------------
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index 18f751d..4aea2ca 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -218,6 +218,11 @@ package Exp_Disp is
    function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
    --  Ada 2005 (AI-251): Determines if E is a predefined primitive operation
 
+   function Is_Predefined_Internal_Operation (E : Entity_Id) return Boolean;
+   --  Similar to the previous one, but excludes stream operations, because
+   --  these may be overridden, and need extra formals, like user-defined
+   --  operations.
+
    function Is_Predefined_Interface_Primitive (E : Entity_Id) return Boolean;
    --  Ada 2005 (AI-345): Returns True if E is one of the predefined primitives
    --  required to implement interfaces.
diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb
index ec56bcc..b5e6b06 100644
--- a/gcc/ada/gprep.adb
+++ b/gcc/ada/gprep.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2009, 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- --
@@ -55,6 +55,14 @@ package body GPrep is
    -- Argument Line Data --
    ------------------------
 
+   Unix_Line_Terminators : Boolean := False;
+   --  Set to True with option -T
+
+   type String_Array is array (Boolean) of String_Access;
+   Yes_No : constant String_Array :=
+     (False => new String'("YES"),
+      True  => new String'("NO"));
+
    Infile_Name  : Name_Id := No_Name;
    Outfile_Name : Name_Id := No_Name;
    Deffile_Name : Name_Id := No_Name;
@@ -484,7 +492,12 @@ package body GPrep is
          --  Create the output file (fails if this does not work)
 
          begin
-            Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
+            Create
+              (File => Text_Outfile,
+               Mode => Out_File,
+               Name => Get_Name_String (Outfile_Name),
+               Form => "Text_Translation=" &
+                       Yes_No (Unix_Line_Terminators).all);
 
          exception
             when others =>
@@ -722,7 +735,7 @@ package body GPrep is
 
       loop
          begin
-            Switch := GNAT.Command_Line.Getopt ("D: b c C r s u v");
+            Switch := GNAT.Command_Line.Getopt ("D: b c C r s T u v");
 
             case Switch is
 
@@ -748,6 +761,9 @@ package body GPrep is
                when 's' =>
                   Opt.List_Preprocessing_Symbols := True;
 
+               when 'T' =>
+                  Unix_Line_Terminators := True;
+
                when 'u' =>
                   Opt.Undefined_Symbols_Are_False := True;
 
@@ -813,6 +829,7 @@ package body GPrep is
       Write_Line ("   -D  Associate symbol with value");
       Write_Line ("   -r  Generate Source_Reference pragma");
       Write_Line ("   -s  Print a sorted list of symbol names and values");
+      Write_Line ("   -T  Use LF as line terminators");
       Write_Line ("   -u  Treat undefined symbols as FALSE");
       Write_Line ("   -v  Verbose mode");
       Write_Eol;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 3232340..94ed69e 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -5465,7 +5465,7 @@ package body Sem_Ch6 is
       --  generated stream attributes do get passed through because extra
       --  build-in-place formals are needed in some cases (limited 'Input).
 
-      if Is_Predefined_Dispatching_Operation (E) then
+      if Is_Predefined_Internal_Operation (E) then
          goto Test_For_BIP_Extras;
       end if;