2010-06-23 Javier Miranda <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Generate internal
	entities for parent types that are interfaces. Needed in generics to
	handle formals that implement interfaces.
	(Derive_Subprograms): Add assertion for derivation of tagged types that
	do not cover interfaces. For generics, complete code that handles
	derivation of type that covers interfaces because the previous
	condition was weak (it required only name consistency; arguments were
	not checked). Add new code to locate primitives covering interfaces
	defined in generic units or instantiatons.
	* sem_util.adb (Has_Interfaces): Add missing support for derived types.
	* sem_ch6.adb (Check_Overriding_Indicator): Minor code cleanups.
	* exp_disp.adb (Make_Select_Specific_Data_Table): Skip primitives of
	interfaces that are parents of the type because they share the primary
	dispatch table.
	(Register_Primitive): Do not register primitives of interfaces that
	are parents of the type.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add documentation.
	* exp_cg.adb (Write_Type_Info): When displaying overriding of interface
	primitives skip primitives of interfaces that are parents of the type.

2010-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Eval_Attribute): If the prefix is an array, the
	attribute cannot be constant-folded if an index type is a formal type,
	or is derived from one.
	* checks.adb (Determine_Range): ditto.

2010-06-23  Arnaud Charlet  <charlet@adacore.com>

	* gnat_ugn.texi, gnatxref.adb: Add support for --ext switch.

2010-06-23  Bob Duff  <duff@adacore.com>

	* g-pehage.ads, g-pehage.adb (Put): Fix off-by-one bug.
	(Insert): Disallow nul characters.
	(misc output routines): Assert no nul characters.



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

1 files changed, 61 insertions, 30 deletions

diff --git a/gcc/ada/gnatxref.adb b/gcc/ada/gnatxref.adb
index 2cccc0f1f51..c20ef175564 100644
--- a/gcc/ada/gnatxref.adb
+++ b/gcc/ada/gnatxref.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2010, 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- --
@@ -52,6 +52,9 @@ procedure Gnatxref is
    RTS_Specified : String_Access := null;
    --  Used to detect multiple use of --RTS= switch
 
+   EXT_Specified : String_Access := null;
+   --  Used to detect multiple use of --ext= switch
+
    procedure Parse_Cmd_Line;
    --  Parse every switch on the command line
 
@@ -79,7 +82,7 @@ procedure Gnatxref is
       loop
          case
            GNAT.Command_Line.Getopt
-             ("a aI: aO: d f g h I: nostdinc nostdlib p: u v -RTS=")
+             ("a aI: aO: d f g h I: nostdinc nostdlib p: u v -RTS= -ext=")
          is
             when ASCII.NUL =>
                exit;
@@ -140,43 +143,70 @@ procedure Gnatxref is
 
                --  Check that it is the first time we see this switch
 
-               if RTS_Specified = null then
-                  RTS_Specified := new String'(GNAT.Command_Line.Parameter);
+               if Full_Switch = "-RTS" then
+                  if RTS_Specified = null then
+                     RTS_Specified := new String'(GNAT.Command_Line.Parameter);
 
-               elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then
-                  Osint.Fail ("--RTS cannot be specified multiple times");
-               end if;
+                  elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then
+                     Osint.Fail ("--RTS cannot be specified multiple times");
+                  end if;
 
-               Opt.No_Stdinc  := True;
-               Opt.RTS_Switch := True;
+                  Opt.No_Stdinc  := True;
+                  Opt.RTS_Switch := True;
 
-               declare
-                  Src_Path_Name : constant String_Ptr :=
-                                    Get_RTS_Search_Dir
-                                      (GNAT.Command_Line.Parameter, Include);
+                  declare
+                     Src_Path_Name : constant String_Ptr :=
+                                       Get_RTS_Search_Dir
+                                         (GNAT.Command_Line.Parameter,
+                                          Include);
 
-                  Lib_Path_Name : constant String_Ptr :=
-                                    Get_RTS_Search_Dir
-                                      (GNAT.Command_Line.Parameter, Objects);
+                     Lib_Path_Name : constant String_Ptr :=
+                                       Get_RTS_Search_Dir
+                                         (GNAT.Command_Line.Parameter,
+                                          Objects);
 
-               begin
-                  if Src_Path_Name /= null and then Lib_Path_Name /= null then
-                     Add_Search_Dirs (Src_Path_Name, Include);
-                     Add_Search_Dirs (Lib_Path_Name, Objects);
+                  begin
+                     if Src_Path_Name /= null
+                       and then Lib_Path_Name /= null
+                     then
+                        Add_Search_Dirs (Src_Path_Name, Include);
+                        Add_Search_Dirs (Lib_Path_Name, Objects);
+
+                     elsif Src_Path_Name = null
+                       and then Lib_Path_Name = null
+                     then
+                        Osint.Fail ("RTS path not valid: missing " &
+                                    "adainclude and adalib directories");
+
+                     elsif Src_Path_Name = null then
+                        Osint.Fail ("RTS path not valid: missing " &
+                                    "adainclude directory");
 
-                  elsif Src_Path_Name = null and then Lib_Path_Name = null then
-                     Osint.Fail ("RTS path not valid: missing " &
-                                 "adainclude and adalib directories");
+                     elsif  Lib_Path_Name = null then
+                        Osint.Fail ("RTS path not valid: missing " &
+                                    "adalib directory");
+                     end if;
+                  end;
 
-                  elsif Src_Path_Name = null then
-                     Osint.Fail ("RTS path not valid: missing " &
-                                 "adainclude directory");
+               elsif GNAT.Command_Line.Full_Switch = "-ext" then
 
-                  elsif  Lib_Path_Name = null then
-                     Osint.Fail ("RTS path not valid: missing " &
-                                 "adalib directory");
+                  --  Check that it is the first time we see this switch
+
+                  if EXT_Specified = null then
+                     EXT_Specified := new String'(GNAT.Command_Line.Parameter);
+
+                  elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then
+                     Osint.Fail ("--ext cannot be specified multiple times");
                   end if;
-               end;
+
+                  if EXT_Specified'Length
+                    = Osint.ALI_Default_Suffix'Length
+                  then
+                     Osint.ALI_Suffix := EXT_Specified.all'Access;
+                  else
+                     Osint.Fail ("--ext argument must have 3 characters");
+                  end if;
+               end if;
 
             when others =>
                Write_Usage;
@@ -239,6 +269,7 @@ procedure Gnatxref is
                 & " directory");
       Put_Line ("   -nostdlib Don't look for library files in the system"
                 & " default directory");
+      Put_Line ("   --ext=xxx Specify alternate ali file extension");
       Put_Line ("   --RTS=dir specify the default source and object search"
                 & " path");
       Put_Line ("   -p file   Use file as the default project file");